Reformatted.
[chise/xemacs-chise.git] / src / extents.c
1 /* Copyright (c) 1994, 1995 Free Software Foundation, Inc.
2    Copyright (c) 1995 Sun Microsystems, Inc.
3    Copyright (c) 1995, 1996, 2000 Ben Wing.
4
5 This file is part of XEmacs.
6
7 XEmacs is free software; you can redistribute it and/or modify it
8 under the terms of the GNU General Public License as published by the
9 Free Software Foundation; either version 2, or (at your option) any
10 later version.
11
12 XEmacs is distributed in the hope that it will be useful, but WITHOUT
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
14 FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
15 for more details.
16
17 You should have received a copy of the GNU General Public License
18 along with XEmacs; see the file COPYING.  If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA.  */
21
22 /* Synched up with: Not in FSF. */
23
24 /* This file has been Mule-ized. */
25
26 /* Written by Ben Wing <ben@xemacs.org>.
27
28    [Originally written by some people at Lucid.
29    Hacked on by jwz.
30    Start/end-open stuff added by John Rose (john.rose@eng.sun.com).
31    Rewritten from scratch by Ben Wing, December 1994.] */
32
33 /* Commentary:
34
35    Extents are regions over a buffer, with a start and an end position
36    denoting the region of the buffer included in the extent.  In
37    addition, either end can be closed or open, meaning that the endpoint
38    is or is not logically included in the extent.  Insertion of a character
39    at a closed endpoint causes the character to go inside the extent;
40    insertion at an open endpoint causes the character to go outside.
41
42    Extent endpoints are stored using memory indices (see insdel.c),
43    to minimize the amount of adjusting that needs to be done when
44    characters are inserted or deleted.
45
46    (Formerly, extent endpoints at the gap could be either before or
47    after the gap, depending on the open/closedness of the endpoint.
48    The intent of this was to make it so that insertions would
49    automatically go inside or out of extents as necessary with no
50    further work needing to be done.  It didn't work out that way,
51    however, and just ended up complexifying and buggifying all the
52    rest of the code.)
53
54    Extents are compared using memory indices.  There are two orderings
55    for extents and both orders are kept current at all times.  The normal
56    or "display" order is as follows:
57
58    Extent A is "less than" extent B, that is, earlier in the display order,
59    if:    A-start < B-start,
60    or if: A-start = B-start, and A-end > B-end
61
62    So if two extents begin at the same position, the larger of them is the
63    earlier one in the display order (EXTENT_LESS is true).
64
65    For the e-order, the same thing holds: Extent A is "less than" extent B
66    in e-order, that is, later in the buffer,
67    if:    A-end < B-end,
68    or if: A-end = B-end, and A-start > B-start
69
70    So if two extents end at the same position, the smaller of them is the
71    earlier one in the e-order (EXTENT_E_LESS is true).
72
73    The display order and the e-order are complementary orders: any
74    theorem about the display order also applies to the e-order if you
75    swap all occurrences of "display order" and "e-order", "less than"
76    and "greater than", and "extent start" and "extent end".
77
78    Extents can be zero-length, and will end up that way if their endpoints
79    are explicitly set that way or if their detachable property is nil
80    and all the text in the extent is deleted. (The exception is open-open
81    zero-length extents, which are barred from existing because there is
82    no sensible way to define their properties.  Deletion of the text in
83    an open-open extent causes it to be converted into a closed-open
84    extent.)  Zero-length extents are primarily used to represent
85    annotations, and behave as follows:
86
87    1) Insertion at the position of a zero-length extent expands the extent
88    if both endpoints are closed; goes after the extent if it is closed-open;
89    and goes before the extent if it is open-closed.
90
91    2) Deletion of a character on a side of a zero-length extent whose
92    corresponding endpoint is closed causes the extent to be detached if
93    it is detachable; if the extent is not detachable or the corresponding
94    endpoint is open, the extent remains in the buffer, moving as necessary.
95
96    Note that closed-open, non-detachable zero-length extents behave exactly
97    like markers and that open-closed, non-detachable zero-length extents
98    behave like the "point-type" marker in Mule.
99
100
101    #### The following information is wrong in places.
102
103    More about the different orders:
104    --------------------------------
105
106    The extents in a buffer are ordered by "display order" because that
107    is that order that the redisplay mechanism needs to process them in.
108    The e-order is an auxiliary ordering used to facilitate operations
109    over extents.  The operations that can be performed on the ordered
110    list of extents in a buffer are
111
112    1) Locate where an extent would go if inserted into the list.
113    2) Insert an extent into the list.
114    3) Remove an extent from the list.
115    4) Map over all the extents that overlap a range.
116
117    (4) requires being able to determine the first and last extents
118    that overlap a range.
119
120    NOTE: "overlap" is used as follows:
121
122    -- two ranges overlap if they have at least one point in common.
123       Whether the endpoints are open or closed makes a difference here.
124    -- a point overlaps a range if the point is contained within the
125       range; this is equivalent to treating a point P as the range
126       [P, P].
127    -- In the case of an *extent* overlapping a point or range, the
128       extent is normally treated as having closed endpoints.  This
129       applies consistently in the discussion of stacks of extents
130       and such below.  Note that this definition of overlap is not
131       necessarily consistent with the extents that `map-extents'
132       maps over, since `map-extents' sometimes pays attention to
133       whether the endpoints of an extents are open or closed.
134       But for our purposes, it greatly simplifies things to treat
135       all extents as having closed endpoints.
136
137    First, define >, <, <=, etc. as applied to extents to mean
138      comparison according to the display order.  Comparison between an
139      extent E and an index I means comparison between E and the range
140      [I, I].
141    Also define e>, e<, e<=, etc. to mean comparison according to the
142      e-order.
143    For any range R, define R(0) to be the starting index of the range
144      and R(1) to be the ending index of the range.
145    For any extent E, define E(next) to be the extent directly following
146      E, and E(prev) to be the extent directly preceding E.  Assume
147      E(next) and E(prev) can be determined from E in constant time.
148      (This is because we store the extent list as a doubly linked
149      list.)
150    Similarly, define E(e-next) and E(e-prev) to be the extents
151      directly following and preceding E in the e-order.
152
153    Now:
154
155    Let R be a range.
156    Let F be the first extent overlapping R.
157    Let L be the last extent overlapping R.
158
159    Theorem 1: R(1) lies between L and L(next), i.e. L <= R(1) < L(next).
160
161    This follows easily from the definition of display order.  The
162    basic reason that this theorem applies is that the display order
163    sorts by increasing starting index.
164
165    Therefore, we can determine L just by looking at where we would
166    insert R(1) into the list, and if we know F and are moving forward
167    over extents, we can easily determine when we've hit L by comparing
168    the extent we're at to R(1).
169
170    Theorem 2: F(e-prev) e< [1, R(0)] e<= F.
171
172    This is the analog of Theorem 1, and applies because the e-order
173    sorts by increasing ending index.
174
175    Therefore, F can be found in the same amount of time as operation (1),
176    i.e. the time that it takes to locate where an extent would go if
177    inserted into the e-order list.
178
179    If the lists were stored as balanced binary trees, then operation (1)
180    would take logarithmic time, which is usually quite fast.  However,
181    currently they're stored as simple doubly-linked lists, and instead
182    we do some caching to try to speed things up.
183
184    Define a "stack of extents" (or "SOE") as the set of extents
185    (ordered in the display order) that overlap an index I, together with
186    the SOE's "previous" extent, which is an extent that precedes I in
187    the e-order. (Hopefully there will not be very many extents between
188    I and the previous extent.)
189
190    Now:
191
192    Let I be an index, let S be the stack of extents on I, let F be
193    the first extent in S, and let P be S's previous extent.
194
195    Theorem 3: The first extent in S is the first extent that overlaps
196    any range [I, J].
197
198    Proof: Any extent that overlaps [I, J] but does not include I must
199    have a start index > I, and thus be greater than any extent in S.
200
201    Therefore, finding the first extent that overlaps a range R is the
202    same as finding the first extent that overlaps R(0).
203
204    Theorem 4: Let I2 be an index such that I2 > I, and let F2 be the
205    first extent that overlaps I2.  Then, either F2 is in S or F2 is
206    greater than any extent in S.
207
208    Proof: If F2 does not include I then its start index is greater
209    than I and thus it is greater than any extent in S, including F.
210    Otherwise, F2 includes I and thus is in S, and thus F2 >= F.
211
212 */
213
214 #include <config.h>
215 #include "lisp.h"
216
217 #include "buffer.h"
218 #include "debug.h"
219 #include "device.h"
220 #include "elhash.h"
221 #include "extents.h"
222 #include "faces.h"
223 #include "frame.h"
224 #include "glyphs.h"
225 #include "insdel.h"
226 #include "keymap.h"
227 #include "opaque.h"
228 #include "process.h"
229 #include "redisplay.h"
230 #include "gutter.h"
231
232 /* ------------------------------- */
233 /*            gap array            */
234 /* ------------------------------- */
235
236 /* Note that this object is not extent-specific and should perhaps be
237    moved into another file. */
238
239 /* Holds a marker that moves as elements in the array are inserted and
240    deleted, similar to standard markers. */
241
242 typedef struct gap_array_marker
243 {
244   int pos;
245   struct gap_array_marker *next;
246 } Gap_Array_Marker;
247
248 /* Holds a "gap array", which is an array of elements with a gap located
249    in it.  Insertions and deletions with a high degree of locality
250    are very fast, essentially in constant time.  Array positions as
251    used and returned in the gap array functions are independent of
252    the gap. */
253
254 typedef struct gap_array
255 {
256   char *array;
257   int gap;
258   int gapsize;
259   int numels;
260   int elsize;
261   Gap_Array_Marker *markers;
262 } Gap_Array;
263
264 static Gap_Array_Marker *gap_array_marker_freelist;
265
266 /* Convert a "memory position" (i.e. taking the gap into account) into
267    the address of the element at (i.e. after) that position.  "Memory
268    positions" are only used internally and are of type Memind.
269    "Array positions" are used externally and are of type int. */
270 #define GAP_ARRAY_MEMEL_ADDR(ga, memel) ((ga)->array + (ga)->elsize*(memel))
271
272 /* Number of elements currently in a gap array */
273 #define GAP_ARRAY_NUM_ELS(ga) ((ga)->numels)
274
275 #define GAP_ARRAY_ARRAY_TO_MEMORY_POS(ga, pos) \
276   ((pos) <= (ga)->gap ? (pos) : (pos) + (ga)->gapsize)
277
278 #define GAP_ARRAY_MEMORY_TO_ARRAY_POS(ga, pos) \
279   ((pos) <= (ga)->gap ? (pos) : (pos) - (ga)->gapsize)
280
281 /* Convert an array position into the address of the element at
282    (i.e. after) that position. */
283 #define GAP_ARRAY_EL_ADDR(ga, pos) ((pos) < (ga)->gap ? \
284   GAP_ARRAY_MEMEL_ADDR(ga, pos) : \
285   GAP_ARRAY_MEMEL_ADDR(ga, (pos) + (ga)->gapsize))
286
287 /* ------------------------------- */
288 /*          extent list            */
289 /* ------------------------------- */
290
291 typedef struct extent_list_marker
292 {
293   Gap_Array_Marker *m;
294   int endp;
295   struct extent_list_marker *next;
296 } Extent_List_Marker;
297
298 typedef struct extent_list
299 {
300   Gap_Array *start;
301   Gap_Array *end;
302   Extent_List_Marker *markers;
303 } Extent_List;
304
305 static Extent_List_Marker *extent_list_marker_freelist;
306
307 #define EXTENT_LESS_VALS(e,st,nd) ((extent_start (e) < (st)) || \
308                                    ((extent_start (e) == (st)) && \
309                                     (extent_end (e) > (nd))))
310
311 #define EXTENT_EQUAL_VALS(e,st,nd) ((extent_start (e) == (st)) && \
312                                     (extent_end (e) == (nd)))
313
314 #define EXTENT_LESS_EQUAL_VALS(e,st,nd) ((extent_start (e) < (st)) || \
315                                          ((extent_start (e) == (st)) && \
316                                           (extent_end (e) >= (nd))))
317
318 /* Is extent E1 less than extent E2 in the display order? */
319 #define EXTENT_LESS(e1,e2) \
320   EXTENT_LESS_VALS (e1, extent_start (e2), extent_end (e2))
321
322 /* Is extent E1 equal to extent E2? */
323 #define EXTENT_EQUAL(e1,e2) \
324   EXTENT_EQUAL_VALS (e1, extent_start (e2), extent_end (e2))
325
326 /* Is extent E1 less than or equal to extent E2 in the display order? */
327 #define EXTENT_LESS_EQUAL(e1,e2) \
328   EXTENT_LESS_EQUAL_VALS (e1, extent_start (e2), extent_end (e2))
329
330 #define EXTENT_E_LESS_VALS(e,st,nd) ((extent_end (e) < (nd)) || \
331                                      ((extent_end (e) == (nd)) && \
332                                       (extent_start (e) > (st))))
333
334 #define EXTENT_E_LESS_EQUAL_VALS(e,st,nd) ((extent_end (e) < (nd)) || \
335                                            ((extent_end (e) == (nd)) && \
336                                             (extent_start (e) >= (st))))
337
338 /* Is extent E1 less than extent E2 in the e-order? */
339 #define EXTENT_E_LESS(e1,e2) \
340         EXTENT_E_LESS_VALS(e1, extent_start (e2), extent_end (e2))
341
342 /* Is extent E1 less than or equal to extent E2 in the e-order? */
343 #define EXTENT_E_LESS_EQUAL(e1,e2) \
344   EXTENT_E_LESS_EQUAL_VALS (e1, extent_start (e2), extent_end (e2))
345
346 #define EXTENT_GAP_ARRAY_AT(ga, pos) (* (EXTENT *) GAP_ARRAY_EL_ADDR(ga, pos))
347
348 /* ------------------------------- */
349 /*    auxiliary extent structure   */
350 /* ------------------------------- */
351
352 struct extent_auxiliary extent_auxiliary_defaults;
353
354 /* ------------------------------- */
355 /*     buffer-extent primitives    */
356 /* ------------------------------- */
357
358 typedef struct stack_of_extents
359 {
360   Extent_List *extents;
361   Memind pos; /* Position of stack of extents.  EXTENTS is the list of
362                  all extents that overlap this position.  This position
363                  can be -1 if the stack of extents is invalid (this
364                  happens when a buffer is first created or a string's
365                  stack of extents is created [a string's stack of extents
366                  is nuked when a GC occurs, to conserve memory]). */
367 } Stack_Of_Extents;
368
369 /* ------------------------------- */
370 /*           map-extents           */
371 /* ------------------------------- */
372
373 typedef int Endpoint_Index;
374
375 #define memind_to_startind(x, start_open) \
376   ((Endpoint_Index) (((x) << 1) + !!(start_open)))
377 #define memind_to_endind(x, end_open) \
378   ((Endpoint_Index) (((x) << 1) - !!(end_open)))
379
380 /* Combination macros */
381 #define bytind_to_startind(buf, x, start_open) \
382   memind_to_startind (bytind_to_memind (buf, x), start_open)
383 #define bytind_to_endind(buf, x, end_open) \
384   memind_to_endind (bytind_to_memind (buf, x), end_open)
385
386 /* ------------------------------- */
387 /*    buffer-or-string primitives  */
388 /* ------------------------------- */
389
390 /* Similar for Bytinds and start/end indices. */
391
392 #define buffer_or_string_bytind_to_startind(obj, ind, start_open)       \
393   memind_to_startind (buffer_or_string_bytind_to_memind (obj, ind),     \
394                       start_open)
395
396 #define buffer_or_string_bytind_to_endind(obj, ind, end_open)           \
397   memind_to_endind (buffer_or_string_bytind_to_memind (obj, ind),       \
398                     end_open)
399
400 /* ------------------------------- */
401 /*      Lisp-level functions       */
402 /* ------------------------------- */
403
404 /* flags for decode_extent() */
405 #define DE_MUST_HAVE_BUFFER 1
406 #define DE_MUST_BE_ATTACHED 2
407
408 Lisp_Object Vlast_highlighted_extent;
409 Fixnum mouse_highlight_priority;
410
411 Lisp_Object Qextentp;
412 Lisp_Object Qextent_live_p;
413
414 Lisp_Object Qall_extents_closed;
415 Lisp_Object Qall_extents_open;
416 Lisp_Object Qall_extents_closed_open;
417 Lisp_Object Qall_extents_open_closed;
418 Lisp_Object Qstart_in_region;
419 Lisp_Object Qend_in_region;
420 Lisp_Object Qstart_and_end_in_region;
421 Lisp_Object Qstart_or_end_in_region;
422 Lisp_Object Qnegate_in_region;
423
424 Lisp_Object Qdetached;
425 Lisp_Object Qdestroyed;
426 Lisp_Object Qbegin_glyph;
427 Lisp_Object Qend_glyph;
428 Lisp_Object Qstart_open;
429 Lisp_Object Qend_open;
430 Lisp_Object Qstart_closed;
431 Lisp_Object Qend_closed;
432 Lisp_Object Qread_only;
433 /* Qhighlight defined in general.c */
434 Lisp_Object Qunique;
435 Lisp_Object Qduplicable;
436 Lisp_Object Qdetachable;
437 Lisp_Object Qpriority;
438 Lisp_Object Qmouse_face;
439 Lisp_Object Qinitial_redisplay_function;
440
441 Lisp_Object Qglyph_layout;  /* This exists only for backwards compatibility. */
442 Lisp_Object Qbegin_glyph_layout, Qend_glyph_layout;
443 Lisp_Object Qoutside_margin;
444 Lisp_Object Qinside_margin;
445 Lisp_Object Qwhitespace;
446 /* Qtext defined in general.c */
447
448 Lisp_Object Qcopy_function;
449 Lisp_Object Qpaste_function;
450
451 /* The idea here is that if we're given a list of faces, we
452    need to "memoize" this so that two lists of faces that are `equal'
453    turn into the same object.  When `set-extent-face' is called, we
454    "memoize" into a list of actual faces; when `extent-face' is called,
455    we do a reverse lookup to get the list of symbols. */
456
457 static Lisp_Object canonicalize_extent_property (Lisp_Object prop,
458                                                  Lisp_Object value);
459 Lisp_Object Vextent_face_memoize_hash_table;
460 Lisp_Object Vextent_face_reverse_memoize_hash_table;
461 Lisp_Object Vextent_face_reusable_list;
462 /* FSFmacs bogosity */
463 Lisp_Object Vdefault_text_properties;
464
465 EXFUN (Fextent_properties, 1);
466 EXFUN (Fset_extent_property, 3);
467
468 /* if true, we don't want to set any redisplay flags on modeline extent
469    changes */
470 int in_modeline_generation;
471
472 \f
473 /************************************************************************/
474 /*                       Generalized gap array                          */
475 /************************************************************************/
476
477 /* This generalizes the "array with a gap" model used to store buffer
478    characters.  This is based on the stuff in insdel.c and should
479    probably be merged with it.  This is not extent-specific and should
480    perhaps be moved into a separate file. */
481
482 /* ------------------------------- */
483 /*        internal functions       */
484 /* ------------------------------- */
485
486 /* Adjust the gap array markers in the range (FROM, TO].  Parallel to
487    adjust_markers() in insdel.c. */
488
489 static void
490 gap_array_adjust_markers (Gap_Array *ga, Memind from,
491                           Memind to, int amount)
492 {
493   Gap_Array_Marker *m;
494
495   for (m = ga->markers; m; m = m->next)
496     m->pos = do_marker_adjustment (m->pos, from, to, amount);
497 }
498
499 /* Move the gap to array position POS.  Parallel to move_gap() in
500    insdel.c but somewhat simplified. */
501
502 static void
503 gap_array_move_gap (Gap_Array *ga, int pos)
504 {
505   int gap = ga->gap;
506   int gapsize = ga->gapsize;
507
508   assert (ga->array);
509   if (pos < gap)
510     {
511       memmove (GAP_ARRAY_MEMEL_ADDR (ga, pos + gapsize),
512                GAP_ARRAY_MEMEL_ADDR (ga, pos),
513                (gap - pos)*ga->elsize);
514       gap_array_adjust_markers (ga, (Memind) pos, (Memind) gap,
515                                 gapsize);
516     }
517   else if (pos > gap)
518     {
519       memmove (GAP_ARRAY_MEMEL_ADDR (ga, gap),
520                GAP_ARRAY_MEMEL_ADDR (ga, gap + gapsize),
521                (pos - gap)*ga->elsize);
522       gap_array_adjust_markers (ga, (Memind) (gap + gapsize),
523                                 (Memind) (pos + gapsize), - gapsize);
524     }
525   ga->gap = pos;
526 }
527
528 /* Make the gap INCREMENT characters longer.  Parallel to make_gap() in
529    insdel.c. */
530
531 static void
532 gap_array_make_gap (Gap_Array *ga, int increment)
533 {
534   char *ptr = ga->array;
535   int real_gap_loc;
536   int old_gap_size;
537
538   /* If we have to get more space, get enough to last a while.  We use
539      a geometric progression that saves on realloc space. */
540   increment += 100 + ga->numels / 8;
541
542   ptr = (char *) xrealloc (ptr,
543                            (ga->numels + ga->gapsize + increment)*ga->elsize);
544   if (ptr == 0)
545     memory_full ();
546   ga->array = ptr;
547
548   real_gap_loc = ga->gap;
549   old_gap_size = ga->gapsize;
550
551   /* Call the newly allocated space a gap at the end of the whole space.  */
552   ga->gap = ga->numels + ga->gapsize;
553   ga->gapsize = increment;
554
555   /* Move the new gap down to be consecutive with the end of the old one.
556      This adjusts the markers properly too.  */
557   gap_array_move_gap (ga, real_gap_loc + old_gap_size);
558
559   /* Now combine the two into one large gap.  */
560   ga->gapsize += old_gap_size;
561   ga->gap = real_gap_loc;
562 }
563
564 /* ------------------------------- */
565 /*        external functions       */
566 /* ------------------------------- */
567
568 /* Insert NUMELS elements (pointed to by ELPTR) into the specified
569    gap array at POS. */
570
571 static void
572 gap_array_insert_els (Gap_Array *ga, int pos, void *elptr, int numels)
573 {
574   assert (pos >= 0 && pos <= ga->numels);
575   if (ga->gapsize < numels)
576     gap_array_make_gap (ga, numels - ga->gapsize);
577   if (pos != ga->gap)
578     gap_array_move_gap (ga, pos);
579
580   memcpy (GAP_ARRAY_MEMEL_ADDR (ga, ga->gap), (char *) elptr,
581           numels*ga->elsize);
582   ga->gapsize -= numels;
583   ga->gap += numels;
584   ga->numels += numels;
585   /* This is the equivalent of insert-before-markers.
586
587      #### Should only happen if marker is "moves forward at insert" type.
588      */
589
590   gap_array_adjust_markers (ga, pos - 1, pos, numels);
591 }
592
593 /* Delete NUMELS elements from the specified gap array, starting at FROM. */
594
595 static void
596 gap_array_delete_els (Gap_Array *ga, int from, int numdel)
597 {
598   int to = from + numdel;
599   int gapsize = ga->gapsize;
600
601   assert (from >= 0);
602   assert (numdel >= 0);
603   assert (to <= ga->numels);
604
605   /* Make sure the gap is somewhere in or next to what we are deleting.  */
606   if (to < ga->gap)
607     gap_array_move_gap (ga, to);
608   if (from > ga->gap)
609     gap_array_move_gap (ga, from);
610
611   /* Relocate all markers pointing into the new, larger gap
612      to point at the end of the text before the gap.  */
613   gap_array_adjust_markers (ga, to + gapsize, to + gapsize,
614                             - numdel - gapsize);
615
616   ga->gapsize += numdel;
617   ga->numels -= numdel;
618   ga->gap = from;
619 }
620
621 static Gap_Array_Marker *
622 gap_array_make_marker (Gap_Array *ga, int pos)
623 {
624   Gap_Array_Marker *m;
625
626   assert (pos >= 0 && pos <= ga->numels);
627   if (gap_array_marker_freelist)
628     {
629       m = gap_array_marker_freelist;
630       gap_array_marker_freelist = gap_array_marker_freelist->next;
631     }
632   else
633     m = xnew (Gap_Array_Marker);
634
635   m->pos = GAP_ARRAY_ARRAY_TO_MEMORY_POS (ga, pos);
636   m->next = ga->markers;
637   ga->markers = m;
638   return m;
639 }
640
641 static void
642 gap_array_delete_marker (Gap_Array *ga, Gap_Array_Marker *m)
643 {
644   Gap_Array_Marker *p, *prev;
645
646   for (prev = 0, p = ga->markers; p && p != m; prev = p, p = p->next)
647     ;
648   assert (p);
649   if (prev)
650     prev->next = p->next;
651   else
652     ga->markers = p->next;
653   m->next = gap_array_marker_freelist;
654   m->pos = 0xDEADBEEF; /* -559038737 as an int */
655   gap_array_marker_freelist = m;
656 }
657
658 static void
659 gap_array_delete_all_markers (Gap_Array *ga)
660 {
661   Gap_Array_Marker *p, *next;
662
663   for (p = ga->markers; p; p = next)
664     {
665       next = p->next;
666       p->next = gap_array_marker_freelist;
667       p->pos = 0xDEADBEEF; /* -559038737 as an int */
668       gap_array_marker_freelist = p;
669     }
670 }
671
672 static void
673 gap_array_move_marker (Gap_Array *ga, Gap_Array_Marker *m, int pos)
674 {
675   assert (pos >= 0 && pos <= ga->numels);
676   m->pos = GAP_ARRAY_ARRAY_TO_MEMORY_POS (ga, pos);
677 }
678
679 #define gap_array_marker_pos(ga, m) \
680   GAP_ARRAY_MEMORY_TO_ARRAY_POS (ga, (m)->pos)
681
682 static Gap_Array *
683 make_gap_array (int elsize)
684 {
685   Gap_Array *ga = xnew_and_zero (Gap_Array);
686   ga->elsize = elsize;
687   return ga;
688 }
689
690 static void
691 free_gap_array (Gap_Array *ga)
692 {
693   if (ga->array)
694     xfree (ga->array);
695   gap_array_delete_all_markers (ga);
696   xfree (ga);
697 }
698
699 \f
700 /************************************************************************/
701 /*                       Extent list primitives                         */
702 /************************************************************************/
703
704 /* A list of extents is maintained as a double gap array: one gap array
705    is ordered by start index (the "display order") and the other is
706    ordered by end index (the "e-order").  Note that positions in an
707    extent list should logically be conceived of as referring *to*
708    a particular extent (as is the norm in programs) rather than
709    sitting between two extents.  Note also that callers of these
710    functions should not be aware of the fact that the extent list is
711    implemented as an array, except for the fact that positions are
712    integers (this should be generalized to handle integers and linked
713    list equally well).
714 */
715
716 /* Number of elements in an extent list */
717 #define extent_list_num_els(el) GAP_ARRAY_NUM_ELS(el->start)
718
719 /* Return the position at which EXTENT is located in the specified extent
720    list (in the display order if ENDP is 0, in the e-order otherwise).
721    If the extent is not found, the position where the extent would
722    be inserted is returned.  If ENDP is 0, the insertion would go after
723    all other equal extents.  If ENDP is not 0, the insertion would go
724    before all other equal extents.  If FOUNDP is not 0, then whether
725    the extent was found will get written into it. */
726
727 static int
728 extent_list_locate (Extent_List *el, EXTENT extent, int endp, int *foundp)
729 {
730   Gap_Array *ga = endp ? el->end : el->start;
731   int left = 0, right = GAP_ARRAY_NUM_ELS (ga);
732   int oldfoundpos, foundpos;
733   int found;
734
735   while (left != right)
736     {
737       /* RIGHT might not point to a valid extent (i.e. it's at the end
738          of the list), so NEWPOS must round down. */
739       unsigned int newpos = (left + right) >> 1;
740       EXTENT e = EXTENT_GAP_ARRAY_AT (ga, (int) newpos);
741
742       if (endp ? EXTENT_E_LESS (e, extent) : EXTENT_LESS (e, extent))
743         left = newpos+1;
744       else
745         right = newpos;
746     }
747
748   /* Now we're at the beginning of all equal extents. */
749   found = 0;
750   oldfoundpos = foundpos = left;
751   while (foundpos < GAP_ARRAY_NUM_ELS (ga))
752     {
753       EXTENT e = EXTENT_GAP_ARRAY_AT (ga, foundpos);
754       if (e == extent)
755         {
756           found = 1;
757           break;
758         }
759       if (!EXTENT_EQUAL (e, extent))
760         break;
761       foundpos++;
762     }
763   if (foundp)
764     *foundp = found;
765   if (found || !endp)
766     return foundpos;
767   else
768     return oldfoundpos;
769 }
770
771 /* Return the position of the first extent that begins at or after POS
772    (or ends at or after POS, if ENDP is not 0).
773
774    An out-of-range value for POS is allowed, and guarantees that the
775    position at the beginning or end of the extent list is returned. */
776
777 static int
778 extent_list_locate_from_pos (Extent_List *el, Memind pos, int endp)
779 {
780   struct extent fake_extent;
781   /*
782
783    Note that if we search for [POS, POS], then we get the following:
784
785    -- if ENDP is 0, then all extents whose start position is <= POS
786       lie before the returned position, and all extents whose start
787       position is > POS lie at or after the returned position.
788
789    -- if ENDP is not 0, then all extents whose end position is < POS
790       lie before the returned position, and all extents whose end
791       position is >= POS lie at or after the returned position.
792
793    */
794   set_extent_start (&fake_extent, endp ? pos : pos-1);
795   set_extent_end (&fake_extent, endp ? pos : pos-1);
796   return extent_list_locate (el, &fake_extent, endp, 0);
797 }
798
799 /* Return the extent at POS. */
800
801 static EXTENT
802 extent_list_at (Extent_List *el, Memind pos, int endp)
803 {
804   Gap_Array *ga = endp ? el->end : el->start;
805
806   assert (pos >= 0 && pos < GAP_ARRAY_NUM_ELS (ga));
807   return EXTENT_GAP_ARRAY_AT (ga, pos);
808 }
809
810 /* Insert an extent into an extent list. */
811
812 static void
813 extent_list_insert (Extent_List *el, EXTENT extent)
814 {
815   int pos, foundp;
816
817   pos = extent_list_locate (el, extent, 0, &foundp);
818   assert (!foundp);
819   gap_array_insert_els (el->start, pos, &extent, 1);
820   pos = extent_list_locate (el, extent, 1, &foundp);
821   assert (!foundp);
822   gap_array_insert_els (el->end, pos, &extent, 1);
823 }
824
825 /* Delete an extent from an extent list. */
826
827 static void
828 extent_list_delete (Extent_List *el, EXTENT extent)
829 {
830   int pos, foundp;
831
832   pos = extent_list_locate (el, extent, 0, &foundp);
833   assert (foundp);
834   gap_array_delete_els (el->start, pos, 1);
835   pos = extent_list_locate (el, extent, 1, &foundp);
836   assert (foundp);
837   gap_array_delete_els (el->end, pos, 1);
838 }
839
840 static void
841 extent_list_delete_all (Extent_List *el)
842 {
843   gap_array_delete_els (el->start, 0, GAP_ARRAY_NUM_ELS (el->start));
844   gap_array_delete_els (el->end, 0, GAP_ARRAY_NUM_ELS (el->end));
845 }
846
847 static Extent_List_Marker *
848 extent_list_make_marker (Extent_List *el, int pos, int endp)
849 {
850   Extent_List_Marker *m;
851
852   if (extent_list_marker_freelist)
853     {
854       m = extent_list_marker_freelist;
855       extent_list_marker_freelist = extent_list_marker_freelist->next;
856     }
857   else
858     m = xnew (Extent_List_Marker);
859
860   m->m = gap_array_make_marker (endp ? el->end : el->start, pos);
861   m->endp = endp;
862   m->next = el->markers;
863   el->markers = m;
864   return m;
865 }
866
867 #define extent_list_move_marker(el, mkr, pos) \
868   gap_array_move_marker((mkr)->endp ? (el)->end : (el)->start, (mkr)->m, pos)
869
870 static void
871 extent_list_delete_marker (Extent_List *el, Extent_List_Marker *m)
872 {
873   Extent_List_Marker *p, *prev;
874
875   for (prev = 0, p = el->markers; p && p != m; prev = p, p = p->next)
876     ;
877   assert (p);
878   if (prev)
879     prev->next = p->next;
880   else
881     el->markers = p->next;
882   m->next = extent_list_marker_freelist;
883   extent_list_marker_freelist = m;
884   gap_array_delete_marker (m->endp ? el->end : el->start, m->m);
885 }
886
887 #define extent_list_marker_pos(el, mkr) \
888   gap_array_marker_pos ((mkr)->endp ? (el)->end : (el)->start, (mkr)->m)
889
890 static Extent_List *
891 allocate_extent_list (void)
892 {
893   Extent_List *el = xnew (Extent_List);
894   el->start = make_gap_array (sizeof (EXTENT));
895   el->end = make_gap_array (sizeof (EXTENT));
896   el->markers = 0;
897   return el;
898 }
899
900 static void
901 free_extent_list (Extent_List *el)
902 {
903   free_gap_array (el->start);
904   free_gap_array (el->end);
905   xfree (el);
906 }
907
908 \f
909 /************************************************************************/
910 /*                       Auxiliary extent structure                     */
911 /************************************************************************/
912
913 static Lisp_Object
914 mark_extent_auxiliary (Lisp_Object obj)
915 {
916   struct extent_auxiliary *data = XEXTENT_AUXILIARY (obj);
917   mark_object (data->begin_glyph);
918   mark_object (data->end_glyph);
919   mark_object (data->invisible);
920   mark_object (data->children);
921   mark_object (data->read_only);
922   mark_object (data->mouse_face);
923   mark_object (data->initial_redisplay_function);
924   mark_object (data->before_change_functions);
925   mark_object (data->after_change_functions);
926   return data->parent;
927 }
928
929 DEFINE_LRECORD_IMPLEMENTATION ("extent-auxiliary", extent_auxiliary,
930                                mark_extent_auxiliary, internal_object_printer,
931                                0, 0, 0, 0, struct extent_auxiliary);
932
933 void
934 allocate_extent_auxiliary (EXTENT ext)
935 {
936   Lisp_Object extent_aux;
937   struct extent_auxiliary *data =
938     alloc_lcrecord_type (struct extent_auxiliary, &lrecord_extent_auxiliary);
939
940   copy_lcrecord (data, &extent_auxiliary_defaults);
941   XSETEXTENT_AUXILIARY (extent_aux, data);
942   ext->plist = Fcons (extent_aux, ext->plist);
943   ext->flags.has_aux = 1;
944 }
945
946 \f
947 /************************************************************************/
948 /*                         Extent info structure                        */
949 /************************************************************************/
950
951 /* An extent-info structure consists of a list of the buffer or string's
952    extents and a "stack of extents" that lists all of the extents over
953    a particular position.  The stack-of-extents info is used for
954    optimization purposes -- it basically caches some info that might
955    be expensive to compute.  Certain otherwise hard computations are easy
956    given the stack of extents over a particular position, and if the
957    stack of extents over a nearby position is known (because it was
958    calculated at some prior point in time), it's easy to move the stack
959    of extents to the proper position.
960
961    Given that the stack of extents is an optimization, and given that
962    it requires memory, a string's stack of extents is wiped out each
963    time a garbage collection occurs.  Therefore, any time you retrieve
964    the stack of extents, it might not be there.  If you need it to
965    be there, use the _force version.
966
967    Similarly, a string may or may not have an extent_info structure.
968    (Generally it won't if there haven't been any extents added to the
969    string.) So use the _force version if you need the extent_info
970    structure to be there. */
971
972 static struct stack_of_extents *allocate_soe (void);
973 static void free_soe (struct stack_of_extents *soe);
974 static void soe_invalidate (Lisp_Object obj);
975
976 static Lisp_Object
977 mark_extent_info (Lisp_Object obj)
978 {
979   struct extent_info *data = (struct extent_info *) XEXTENT_INFO (obj);
980   int i;
981   Extent_List *list = data->extents;
982
983   /* Vbuffer_defaults and Vbuffer_local_symbols are buffer-like
984      objects that are created specially and never have their extent
985      list initialized (or rather, it is set to zero in
986      nuke_all_buffer_slots()).  However, these objects get
987      garbage-collected so we have to deal.
988
989      (Also the list can be zero when we're dealing with a destroyed
990      buffer.) */
991
992   if (list)
993     {
994       for (i = 0; i < extent_list_num_els (list); i++)
995         {
996           struct extent *extent = extent_list_at (list, i, 0);
997           Lisp_Object exobj;
998
999           XSETEXTENT (exobj, extent);
1000           mark_object (exobj);
1001         }
1002     }
1003
1004   return Qnil;
1005 }
1006
1007 static void
1008 finalize_extent_info (void *header, int for_disksave)
1009 {
1010   struct extent_info *data = (struct extent_info *) header;
1011
1012   if (for_disksave)
1013     return;
1014
1015   if (data->soe)
1016     {
1017       free_soe (data->soe);
1018       data->soe = 0;
1019     }
1020   if (data->extents)
1021     {
1022       free_extent_list (data->extents);
1023       data->extents = 0;
1024     }
1025 }
1026
1027 DEFINE_LRECORD_IMPLEMENTATION ("extent-info", extent_info,
1028                                mark_extent_info, internal_object_printer,
1029                                finalize_extent_info, 0, 0, 0,
1030                                struct extent_info);
1031 \f
1032 static Lisp_Object
1033 allocate_extent_info (void)
1034 {
1035   Lisp_Object extent_info;
1036   struct extent_info *data =
1037     alloc_lcrecord_type (struct extent_info, &lrecord_extent_info);
1038
1039   XSETEXTENT_INFO (extent_info, data);
1040   data->extents = allocate_extent_list ();
1041   data->soe = 0;
1042   return extent_info;
1043 }
1044
1045 void
1046 flush_cached_extent_info (Lisp_Object extent_info)
1047 {
1048   struct extent_info *data = XEXTENT_INFO (extent_info);
1049
1050   if (data->soe)
1051     {
1052       free_soe (data->soe);
1053       data->soe = 0;
1054     }
1055 }
1056
1057 \f
1058 /************************************************************************/
1059 /*                    Buffer/string extent primitives                   */
1060 /************************************************************************/
1061
1062 /* The functions in this section are the ONLY ones that should know
1063    about the internal implementation of the extent lists.  Other functions
1064    should only know that there are two orderings on extents, the "display"
1065    order (sorted by start position, basically) and the e-order (sorted
1066    by end position, basically), and that certain operations are provided
1067    to manipulate the list. */
1068
1069 /* ------------------------------- */
1070 /*        basic primitives         */
1071 /* ------------------------------- */
1072
1073 static Lisp_Object
1074 decode_buffer_or_string (Lisp_Object object)
1075 {
1076   if (NILP (object))
1077     XSETBUFFER (object, current_buffer);
1078   else if (BUFFERP (object))
1079     CHECK_LIVE_BUFFER (object);
1080   else if (STRINGP (object))
1081     ;
1082   else
1083     dead_wrong_type_argument (Qbuffer_or_string_p, object);
1084
1085   return object;
1086 }
1087
1088 EXTENT
1089 extent_ancestor_1 (EXTENT e)
1090 {
1091   while (e->flags.has_parent)
1092     {
1093       /* There should be no circularities except in case of a logic
1094          error somewhere in the extent code */
1095       e = XEXTENT (XEXTENT_AUXILIARY (XCAR (e->plist))->parent);
1096     }
1097   return e;
1098 }
1099
1100 /* Given an extent object (string or buffer or nil), return its extent info.
1101    This may be 0 for a string. */
1102
1103 static struct extent_info *
1104 buffer_or_string_extent_info (Lisp_Object object)
1105 {
1106   if (STRINGP (object))
1107     {
1108       Lisp_Object plist = XSTRING (object)->plist;
1109       if (!CONSP (plist) || !EXTENT_INFOP (XCAR (plist)))
1110         return 0;
1111       return XEXTENT_INFO (XCAR (plist));
1112     }
1113   else if (NILP (object))
1114     return 0;
1115   else
1116     return XEXTENT_INFO (XBUFFER (object)->extent_info);
1117 }
1118
1119 /* Given a string or buffer, return its extent list.  This may be
1120    0 for a string. */
1121
1122 static Extent_List *
1123 buffer_or_string_extent_list (Lisp_Object object)
1124 {
1125   struct extent_info *info = buffer_or_string_extent_info (object);
1126
1127   if (!info)
1128     return 0;
1129   return info->extents;
1130 }
1131
1132 /* Given a string or buffer, return its extent info.  If it's not there,
1133    create it. */
1134
1135 static struct extent_info *
1136 buffer_or_string_extent_info_force (Lisp_Object object)
1137 {
1138   struct extent_info *info = buffer_or_string_extent_info (object);
1139
1140   if (!info)
1141     {
1142       Lisp_Object extent_info;
1143
1144       assert (STRINGP (object)); /* should never happen for buffers --
1145                                     the only buffers without an extent
1146                                     info are those after finalization,
1147                                     destroyed buffers, or special
1148                                     Lisp-inaccessible buffer objects. */
1149       extent_info = allocate_extent_info ();
1150       XSTRING (object)->plist = Fcons (extent_info, XSTRING (object)->plist);
1151       return XEXTENT_INFO (extent_info);
1152     }
1153
1154   return info;
1155 }
1156
1157 /* Detach all the extents in OBJECT.  Called from redisplay. */
1158
1159 void
1160 detach_all_extents (Lisp_Object object)
1161 {
1162   struct extent_info *data = buffer_or_string_extent_info (object);
1163
1164   if (data)
1165     {
1166       if (data->extents)
1167         {
1168           int i;
1169
1170           for (i = 0; i < extent_list_num_els (data->extents); i++)
1171             {
1172               EXTENT e = extent_list_at (data->extents, i, 0);
1173               /* No need to do detach_extent().  Just nuke the damn things,
1174                  which results in the equivalent but faster. */
1175               set_extent_start (e, -1);
1176               set_extent_end (e, -1);
1177             }
1178
1179           /* But we need to clear all the lists containing extents or
1180              havoc will result. */
1181           extent_list_delete_all (data->extents);
1182         }
1183
1184       soe_invalidate (object);
1185     }
1186 }
1187
1188
1189 void
1190 init_buffer_extents (struct buffer *b)
1191 {
1192   b->extent_info = allocate_extent_info ();
1193 }
1194
1195 void
1196 uninit_buffer_extents (struct buffer *b)
1197 {
1198   struct extent_info *data = XEXTENT_INFO (b->extent_info);
1199
1200   /* Don't destroy the extents here -- there may still be children
1201      extents pointing to the extents. */
1202   detach_all_extents (make_buffer (b));
1203   finalize_extent_info (data, 0);
1204 }
1205
1206 /* Retrieve the extent list that an extent is a member of; the
1207    return value will never be 0 except in destroyed buffers (in which
1208    case the only extents that can refer to this buffer are detached
1209    ones). */
1210
1211 #define extent_extent_list(e) buffer_or_string_extent_list (extent_object (e))
1212
1213 /* ------------------------------- */
1214 /*        stack of extents         */
1215 /* ------------------------------- */
1216
1217 #ifdef ERROR_CHECK_EXTENTS
1218
1219 void
1220 sledgehammer_extent_check (Lisp_Object object)
1221 {
1222   int i;
1223   int endp;
1224   Extent_List *el = buffer_or_string_extent_list (object);
1225   struct buffer *buf = 0;
1226
1227   if (!el)
1228     return;
1229
1230   if (BUFFERP (object))
1231     buf = XBUFFER (object);
1232
1233   for (endp = 0; endp < 2; endp++)
1234     for (i = 1; i < extent_list_num_els (el); i++)
1235       {
1236         EXTENT e1 = extent_list_at (el, i-1, endp);
1237         EXTENT e2 = extent_list_at (el, i, endp);
1238         if (buf)
1239           {
1240             assert (extent_start (e1) <= buf->text->gpt ||
1241                     extent_start (e1) > buf->text->gpt + buf->text->gap_size);
1242             assert (extent_end (e1) <= buf->text->gpt ||
1243                     extent_end (e1) > buf->text->gpt + buf->text->gap_size);
1244           }
1245         assert (extent_start (e1) <= extent_end (e1));
1246         assert (endp ? (EXTENT_E_LESS_EQUAL (e1, e2)) :
1247                        (EXTENT_LESS_EQUAL (e1, e2)));
1248       }
1249 }
1250
1251 #endif
1252
1253 static Stack_Of_Extents *
1254 buffer_or_string_stack_of_extents (Lisp_Object object)
1255 {
1256   struct extent_info *info = buffer_or_string_extent_info (object);
1257   if (!info)
1258     return 0;
1259   return info->soe;
1260 }
1261
1262 static Stack_Of_Extents *
1263 buffer_or_string_stack_of_extents_force (Lisp_Object object)
1264 {
1265   struct extent_info *info = buffer_or_string_extent_info_force (object);
1266   if (!info->soe)
1267     info->soe = allocate_soe ();
1268   return info->soe;
1269 }
1270
1271 /* #define SOE_DEBUG */
1272
1273 #ifdef SOE_DEBUG
1274
1275 static void print_extent_1 (char *buf, Lisp_Object extent);
1276
1277 static void
1278 print_extent_2 (EXTENT e)
1279 {
1280   Lisp_Object extent;
1281   char buf[200];
1282
1283   XSETEXTENT (extent, e);
1284   print_extent_1 (buf, extent);
1285   fputs (buf, stdout);
1286 }
1287
1288 static void
1289 soe_dump (Lisp_Object obj)
1290 {
1291   int i;
1292   Stack_Of_Extents *soe = buffer_or_string_stack_of_extents (obj);
1293   Extent_List *sel;
1294   int endp;
1295
1296   if (!soe)
1297     {
1298       printf ("No SOE");
1299       return;
1300     }
1301   sel = soe->extents;
1302   printf ("SOE pos is %d (memind %d)\n",
1303           soe->pos < 0 ? soe->pos :
1304           buffer_or_string_memind_to_bytind (obj, soe->pos),
1305           soe->pos);
1306   for (endp = 0; endp < 2; endp++)
1307     {
1308       printf (endp ? "SOE end:" : "SOE start:");
1309       for (i = 0; i < extent_list_num_els (sel); i++)
1310         {
1311           EXTENT e = extent_list_at (sel, i, endp);
1312           putchar ('\t');
1313           print_extent_2 (e);
1314         }
1315       putchar ('\n');
1316     }
1317   putchar ('\n');
1318 }
1319
1320 #endif
1321
1322 /* Insert EXTENT into OBJ's stack of extents, if necessary. */
1323
1324 static void
1325 soe_insert (Lisp_Object obj, EXTENT extent)
1326 {
1327   Stack_Of_Extents *soe = buffer_or_string_stack_of_extents (obj);
1328
1329 #ifdef SOE_DEBUG
1330   printf ("Inserting into SOE: ");
1331   print_extent_2 (extent);
1332   putchar ('\n');
1333 #endif
1334   if (!soe || soe->pos < extent_start (extent) ||
1335       soe->pos > extent_end (extent))
1336     {
1337 #ifdef SOE_DEBUG
1338       printf ("(not needed)\n\n");
1339 #endif
1340       return;
1341     }
1342   extent_list_insert (soe->extents, extent);
1343 #ifdef SOE_DEBUG
1344   puts ("SOE afterwards is:");
1345   soe_dump (obj);
1346 #endif
1347 }
1348
1349 /* Delete EXTENT from OBJ's stack of extents, if necessary. */
1350
1351 static void
1352 soe_delete (Lisp_Object obj, EXTENT extent)
1353 {
1354   Stack_Of_Extents *soe = buffer_or_string_stack_of_extents (obj);
1355
1356 #ifdef SOE_DEBUG
1357   printf ("Deleting from SOE: ");
1358   print_extent_2 (extent);
1359   putchar ('\n');
1360 #endif
1361   if (!soe || soe->pos < extent_start (extent) ||
1362       soe->pos > extent_end (extent))
1363     {
1364 #ifdef SOE_DEBUG
1365       puts ("(not needed)\n");
1366 #endif
1367       return;
1368     }
1369   extent_list_delete (soe->extents, extent);
1370 #ifdef SOE_DEBUG
1371   puts ("SOE afterwards is:");
1372   soe_dump (obj);
1373 #endif
1374 }
1375
1376 /* Move OBJ's stack of extents to lie over the specified position. */
1377
1378 static void
1379 soe_move (Lisp_Object obj, Memind pos)
1380 {
1381   Stack_Of_Extents *soe = buffer_or_string_stack_of_extents_force (obj);
1382   Extent_List *sel = soe->extents;
1383   int numsoe = extent_list_num_els (sel);
1384   Extent_List *bel = buffer_or_string_extent_list (obj);
1385   int direction;
1386   int endp;
1387
1388 #ifdef ERROR_CHECK_EXTENTS
1389   assert (bel);
1390 #endif
1391
1392 #ifdef SOE_DEBUG
1393   printf ("Moving SOE from %d (memind %d) to %d (memind %d)\n",
1394           soe->pos < 0 ? soe->pos :
1395           buffer_or_string_memind_to_bytind (obj, soe->pos), soe->pos,
1396           buffer_or_string_memind_to_bytind (obj, pos), pos);
1397 #endif
1398   if (soe->pos < pos)
1399     {
1400       direction = 1;
1401       endp = 0;
1402     }
1403   else if (soe->pos > pos)
1404     {
1405       direction = -1;
1406       endp = 1;
1407     }
1408   else
1409     {
1410 #ifdef SOE_DEBUG
1411       puts ("(not needed)\n");
1412 #endif
1413       return;
1414     }
1415
1416   /* For DIRECTION = 1: Any extent that overlaps POS is either in the
1417      SOE (if the extent starts at or before SOE->POS) or is greater
1418      (in the display order) than any extent in the SOE (if it starts
1419      after SOE->POS).
1420
1421      For DIRECTION = -1: Any extent that overlaps POS is either in the
1422      SOE (if the extent ends at or after SOE->POS) or is less (in the
1423      e-order) than any extent in the SOE (if it ends before SOE->POS).
1424
1425      We proceed in two stages:
1426
1427      1) delete all extents in the SOE that don't overlap POS.
1428      2) insert all extents into the SOE that start (or end, when
1429         DIRECTION = -1) in (SOE->POS, POS] and that overlap
1430         POS. (Don't include SOE->POS in the range because those
1431         extents would already be in the SOE.)
1432    */
1433
1434   /* STAGE 1. */
1435
1436   if (numsoe > 0)
1437     {
1438       /* Delete all extents in the SOE that don't overlap POS.
1439          This is all extents that end before (or start after,
1440          if DIRECTION = -1) POS.
1441        */
1442
1443       /* Deleting extents from the SOE is tricky because it changes
1444          the positions of extents.  If we are deleting in the forward
1445          direction we have to call extent_list_at() on the same position
1446          over and over again because positions after the deleted element
1447          get shifted back by 1.  To make life simplest, we delete forward
1448          irrespective of DIRECTION.
1449        */
1450       int start, end;
1451       int i;
1452
1453       if (direction > 0)
1454         {
1455           start = 0;
1456           end = extent_list_locate_from_pos (sel, pos, 1);
1457         }
1458       else
1459         {
1460           start = extent_list_locate_from_pos (sel, pos+1, 0);
1461           end = numsoe;
1462         }
1463
1464       for (i = start; i < end; i++)
1465         extent_list_delete (sel, extent_list_at (sel, start /* see above */,
1466                                                  !endp));
1467     }
1468
1469   /* STAGE 2. */
1470
1471   {
1472     int start_pos;
1473
1474     if (direction < 0)
1475       start_pos = extent_list_locate_from_pos (bel, soe->pos, endp) - 1;
1476     else
1477       start_pos = extent_list_locate_from_pos (bel, soe->pos + 1, endp);
1478
1479     for (; start_pos >= 0 && start_pos < extent_list_num_els (bel);
1480          start_pos += direction)
1481       {
1482         EXTENT e = extent_list_at (bel, start_pos, endp);
1483         if ((direction > 0) ?
1484             (extent_start (e) > pos) :
1485             (extent_end (e) < pos))
1486           break; /* All further extents lie on the far side of POS
1487                     and thus can't overlap. */
1488         if ((direction > 0) ?
1489             (extent_end (e) >= pos) :
1490             (extent_start (e) <= pos))
1491           extent_list_insert (sel, e);
1492       }
1493   }
1494
1495   soe->pos = pos;
1496 #ifdef SOE_DEBUG
1497   puts ("SOE afterwards is:");
1498   soe_dump (obj);
1499 #endif
1500 }
1501
1502 static void
1503 soe_invalidate (Lisp_Object obj)
1504 {
1505   Stack_Of_Extents *soe = buffer_or_string_stack_of_extents (obj);
1506
1507   if (soe)
1508     {
1509       extent_list_delete_all (soe->extents);
1510       soe->pos = -1;
1511     }
1512 }
1513
1514 static struct stack_of_extents *
1515 allocate_soe (void)
1516 {
1517   struct stack_of_extents *soe = xnew_and_zero (struct stack_of_extents);
1518   soe->extents = allocate_extent_list ();
1519   soe->pos = -1;
1520   return soe;
1521 }
1522
1523 static void
1524 free_soe (struct stack_of_extents *soe)
1525 {
1526   free_extent_list (soe->extents);
1527   xfree (soe);
1528 }
1529
1530 /* ------------------------------- */
1531 /*        other primitives         */
1532 /* ------------------------------- */
1533
1534 /* Return the start (endp == 0) or end (endp == 1) of an extent as
1535    a byte index.  If you want the value as a memory index, use
1536    extent_endpoint().  If you want the value as a buffer position,
1537    use extent_endpoint_bufpos(). */
1538
1539 static Bytind
1540 extent_endpoint_bytind (EXTENT extent, int endp)
1541 {
1542   assert (EXTENT_LIVE_P (extent));
1543   assert (!extent_detached_p (extent));
1544   {
1545     Memind i = endp ? extent_end (extent) : extent_start (extent);
1546     Lisp_Object obj = extent_object (extent);
1547     return buffer_or_string_memind_to_bytind (obj, i);
1548   }
1549 }
1550
1551 static Bufpos
1552 extent_endpoint_bufpos (EXTENT extent, int endp)
1553 {
1554   assert (EXTENT_LIVE_P (extent));
1555   assert (!extent_detached_p (extent));
1556   {
1557     Memind i = endp ? extent_end (extent) : extent_start (extent);
1558     Lisp_Object obj = extent_object (extent);
1559     return buffer_or_string_memind_to_bufpos (obj, i);
1560   }
1561 }
1562
1563 /* A change to an extent occurred that will change the display, so
1564    notify redisplay.  Maybe also recurse over all the extent's
1565    descendants. */
1566
1567 static void
1568 extent_changed_for_redisplay (EXTENT extent, int descendants_too,
1569                               int invisibility_change)
1570 {
1571   Lisp_Object object;
1572   Lisp_Object rest;
1573
1574   /* we could easily encounter a detached extent while traversing the
1575      children, but we should never be able to encounter a dead extent. */
1576   assert (EXTENT_LIVE_P (extent));
1577
1578   if (descendants_too)
1579     {
1580       Lisp_Object children = extent_children (extent);
1581
1582       if (!NILP (children))
1583         {
1584           /* first mark all of the extent's children.  We will lose big-time
1585              if there are any circularities here, so we sure as hell better
1586              ensure that there aren't. */
1587           LIST_LOOP (rest, XWEAK_LIST_LIST (children))
1588             extent_changed_for_redisplay (XEXTENT (XCAR (rest)), 1,
1589                                           invisibility_change);
1590         }
1591     }
1592
1593   /* now mark the extent itself. */
1594
1595   object = extent_object (extent);
1596
1597   if (extent_detached_p (extent))
1598     return;
1599
1600   else if (STRINGP (object))
1601     {
1602     /* #### Changes to string extents can affect redisplay if they are
1603        in the modeline or in the gutters.
1604
1605        If the extent is in some generated-modeline-string: when we
1606        change an extent in generated-modeline-string, this changes its
1607        parent, which is in `modeline-format', so we should force the
1608        modeline to be updated.  But how to determine whether a string
1609        is a `generated-modeline-string'?  Looping through all buffers
1610        is not very efficient.  Should we add all
1611        `generated-modeline-string' strings to a hash table?  Maybe
1612        efficiency is not the greatest concern here and there's no big
1613        loss in looping over the buffers.
1614
1615        If the extent is in a gutter we mark the gutter as
1616        changed. This means (a) we can update extents in the gutters
1617        when we need it. (b) we don't have to update the gutters when
1618        only extents attached to buffers have changed. */
1619
1620       if (!in_modeline_generation)
1621         MARK_EXTENTS_CHANGED;
1622       gutter_extent_signal_changed_region_maybe (object,
1623                                                  extent_endpoint_bufpos (extent, 0),
1624                                                  extent_endpoint_bufpos (extent, 1));
1625     }
1626   else if (BUFFERP (object))
1627     {
1628       struct buffer *b;
1629       b = XBUFFER (object);
1630       BUF_FACECHANGE (b)++;
1631       MARK_EXTENTS_CHANGED;
1632       if (invisibility_change)
1633         MARK_CLIP_CHANGED;
1634       buffer_extent_signal_changed_region (b,
1635                                            extent_endpoint_bufpos (extent, 0),
1636                                            extent_endpoint_bufpos (extent, 1));
1637     }
1638 }
1639
1640 /* A change to an extent occurred that might affect redisplay.
1641    This is called when properties such as the endpoints, the layout,
1642    or the priority changes.  Redisplay will be affected only if
1643    the extent has any displayable attributes. */
1644
1645 static void
1646 extent_maybe_changed_for_redisplay (EXTENT extent, int descendants_too,
1647                                     int invisibility_change)
1648 {
1649   /* Retrieve the ancestor for efficiency */
1650   EXTENT anc = extent_ancestor (extent);
1651   if (!NILP (extent_face        (anc)) ||
1652       !NILP (extent_begin_glyph (anc)) ||
1653       !NILP (extent_end_glyph   (anc)) ||
1654       !NILP (extent_mouse_face  (anc)) ||
1655       !NILP (extent_invisible   (anc)) ||
1656       !NILP (extent_initial_redisplay_function (anc)) ||
1657       invisibility_change)
1658     extent_changed_for_redisplay (extent, descendants_too,
1659                                   invisibility_change);
1660 }
1661
1662 static EXTENT
1663 make_extent_detached (Lisp_Object object)
1664 {
1665   EXTENT extent = allocate_extent ();
1666
1667   assert (NILP (object) || STRINGP (object) ||
1668           (BUFFERP (object) && BUFFER_LIVE_P (XBUFFER (object))));
1669   extent_object (extent) = object;
1670   /* Now make sure the extent info exists. */
1671   if (!NILP (object))
1672     buffer_or_string_extent_info_force (object);
1673   return extent;
1674 }
1675
1676 /* A "real" extent is any extent other than the internal (not-user-visible)
1677    extents used by `map-extents'. */
1678
1679 static EXTENT
1680 real_extent_at_forward (Extent_List *el, int pos, int endp)
1681 {
1682   for (; pos < extent_list_num_els (el); pos++)
1683     {
1684       EXTENT e = extent_list_at (el, pos, endp);
1685       if (!extent_internal_p (e))
1686         return e;
1687     }
1688   return 0;
1689 }
1690
1691 static EXTENT
1692 real_extent_at_backward (Extent_List *el, int pos, int endp)
1693 {
1694   for (; pos >= 0; pos--)
1695     {
1696       EXTENT e = extent_list_at (el, pos, endp);
1697       if (!extent_internal_p (e))
1698         return e;
1699     }
1700   return 0;
1701 }
1702
1703 static EXTENT
1704 extent_first (Lisp_Object obj)
1705 {
1706   Extent_List *el = buffer_or_string_extent_list (obj);
1707
1708   if (!el)
1709     return 0;
1710   return real_extent_at_forward (el, 0, 0);
1711 }
1712
1713 #ifdef DEBUG_XEMACS
1714 static EXTENT
1715 extent_e_first (Lisp_Object obj)
1716 {
1717   Extent_List *el = buffer_or_string_extent_list (obj);
1718
1719   if (!el)
1720     return 0;
1721   return real_extent_at_forward (el, 0, 1);
1722 }
1723 #endif
1724
1725 static EXTENT
1726 extent_next (EXTENT e)
1727 {
1728   Extent_List *el = extent_extent_list (e);
1729   int foundp;
1730   int pos = extent_list_locate (el, e, 0, &foundp);
1731   assert (foundp);
1732   return real_extent_at_forward (el, pos+1, 0);
1733 }
1734
1735 #ifdef DEBUG_XEMACS
1736 static EXTENT
1737 extent_e_next (EXTENT e)
1738 {
1739   Extent_List *el = extent_extent_list (e);
1740   int foundp;
1741   int pos = extent_list_locate (el, e, 1, &foundp);
1742   assert (foundp);
1743   return real_extent_at_forward (el, pos+1, 1);
1744 }
1745 #endif
1746
1747 static EXTENT
1748 extent_last (Lisp_Object obj)
1749 {
1750   Extent_List *el = buffer_or_string_extent_list (obj);
1751
1752   if (!el)
1753     return 0;
1754   return real_extent_at_backward (el, extent_list_num_els (el) - 1, 0);
1755 }
1756
1757 #ifdef DEBUG_XEMACS
1758 static EXTENT
1759 extent_e_last (Lisp_Object obj)
1760 {
1761   Extent_List *el = buffer_or_string_extent_list (obj);
1762
1763   if (!el)
1764     return 0;
1765   return real_extent_at_backward (el, extent_list_num_els (el) - 1, 1);
1766 }
1767 #endif
1768
1769 static EXTENT
1770 extent_previous (EXTENT e)
1771 {
1772   Extent_List *el = extent_extent_list (e);
1773   int foundp;
1774   int pos = extent_list_locate (el, e, 0, &foundp);
1775   assert (foundp);
1776   return real_extent_at_backward (el, pos-1, 0);
1777 }
1778
1779 #ifdef DEBUG_XEMACS
1780 static EXTENT
1781 extent_e_previous (EXTENT e)
1782 {
1783   Extent_List *el = extent_extent_list (e);
1784   int foundp;
1785   int pos = extent_list_locate (el, e, 1, &foundp);
1786   assert (foundp);
1787   return real_extent_at_backward (el, pos-1, 1);
1788 }
1789 #endif
1790
1791 static void
1792 extent_attach (EXTENT extent)
1793 {
1794   Extent_List *el = extent_extent_list (extent);
1795
1796   extent_list_insert (el, extent);
1797   soe_insert (extent_object (extent), extent);
1798   /* only this extent changed */
1799   extent_maybe_changed_for_redisplay (extent, 0,
1800                                       !NILP (extent_invisible (extent)));
1801 }
1802
1803 static void
1804 extent_detach (EXTENT extent)
1805 {
1806   Extent_List *el;
1807
1808   if (extent_detached_p (extent))
1809     return;
1810   el = extent_extent_list (extent);
1811
1812   /* call this before messing with the extent. */
1813   extent_maybe_changed_for_redisplay (extent, 0,
1814                                       !NILP (extent_invisible (extent)));
1815   extent_list_delete (el, extent);
1816   soe_delete (extent_object (extent), extent);
1817   set_extent_start (extent, -1);
1818   set_extent_end (extent, -1);
1819 }
1820
1821 /* ------------------------------- */
1822 /*        map-extents et al.       */
1823 /* ------------------------------- */
1824
1825 /* Returns true iff map_extents() would visit the given extent.
1826    See the comments at map_extents() for info on the overlap rule.
1827    Assumes that all validation on the extent and buffer positions has
1828    already been performed (see Fextent_in_region_p ()).
1829  */
1830 static int
1831 extent_in_region_p (EXTENT extent, Bytind from, Bytind to,
1832                     unsigned int flags)
1833 {
1834   Lisp_Object obj = extent_object (extent);
1835   Endpoint_Index start, end, exs, exe;
1836   int start_open, end_open;
1837   unsigned int all_extents_flags = flags & ME_ALL_EXTENTS_MASK;
1838   unsigned int in_region_flags   = flags & ME_IN_REGION_MASK;
1839   int retval;
1840
1841   /* A zero-length region is treated as closed-closed. */
1842   if (from == to)
1843     {
1844       flags |= ME_END_CLOSED;
1845       flags &= ~ME_START_OPEN;
1846     }
1847
1848   /* So is a zero-length extent. */
1849   if (extent_start (extent) == extent_end (extent))
1850     start_open = 0, end_open = 0;
1851   /* `all_extents_flags' will almost always be zero. */
1852   else if (all_extents_flags == 0)
1853     {
1854       start_open = extent_start_open_p (extent);
1855       end_open   = extent_end_open_p   (extent);
1856     }
1857   else
1858     switch (all_extents_flags)
1859       {
1860       case ME_ALL_EXTENTS_CLOSED:      start_open = 0, end_open = 0; break;
1861       case ME_ALL_EXTENTS_OPEN:        start_open = 1, end_open = 1; break;
1862       case ME_ALL_EXTENTS_CLOSED_OPEN: start_open = 0, end_open = 1; break;
1863       case ME_ALL_EXTENTS_OPEN_CLOSED: start_open = 1, end_open = 0; break;
1864       default: ABORT(); return 0;
1865       }
1866
1867   start = buffer_or_string_bytind_to_startind (obj, from,
1868                                                flags & ME_START_OPEN);
1869   end = buffer_or_string_bytind_to_endind (obj, to, ! (flags & ME_END_CLOSED));
1870   exs = memind_to_startind (extent_start (extent), start_open);
1871   exe = memind_to_endind   (extent_end   (extent), end_open);
1872
1873   /* It's easy to determine whether an extent lies *outside* the
1874      region -- just determine whether it's completely before
1875      or completely after the region.  Reject all such extents, so
1876      we're now left with only the extents that overlap the region.
1877    */
1878
1879   if (exs > end || exe < start)
1880     return 0;
1881
1882   /* See if any further restrictions are called for. */
1883   /* in_region_flags will almost always be zero. */
1884   if (in_region_flags == 0)
1885     retval = 1;
1886   else
1887     switch (in_region_flags)
1888       {
1889       case ME_START_IN_REGION:
1890         retval = start <= exs && exs <= end; break;
1891       case ME_END_IN_REGION:
1892         retval = start <= exe && exe <= end; break;
1893       case ME_START_AND_END_IN_REGION:
1894         retval = start <= exs && exe <= end; break;
1895       case ME_START_OR_END_IN_REGION:
1896         retval = (start <= exs && exs <= end) || (start <= exe && exe <= end);
1897         break;
1898       default:
1899         ABORT(); return 0;
1900       }
1901   return flags & ME_NEGATE_IN_REGION ? !retval : retval;
1902 }
1903
1904 struct map_extents_struct
1905 {
1906   Extent_List *el;
1907   Extent_List_Marker *mkr;
1908   EXTENT range;
1909 };
1910
1911 static Lisp_Object
1912 map_extents_unwind (Lisp_Object obj)
1913 {
1914   struct map_extents_struct *closure =
1915     (struct map_extents_struct *) get_opaque_ptr (obj);
1916   free_opaque_ptr (obj);
1917   if (closure->range)
1918     extent_detach (closure->range);
1919   if (closure->mkr)
1920     extent_list_delete_marker (closure->el, closure->mkr);
1921   return Qnil;
1922 }
1923
1924 /* This is the guts of `map-extents' and the other functions that
1925    map over extents.  In theory the operation of this function is
1926    simple: just figure out what extents we're mapping over, and
1927    call the function on each one of them in the range.  Unfortunately
1928    there are a wide variety of things that the mapping function
1929    might do, and we have to be very tricky to avoid getting messed
1930    up.  Furthermore, this function needs to be very fast (it is
1931    called multiple times every time text is inserted or deleted
1932    from a buffer), and so we can't always afford the overhead of
1933    dealing with all the possible things that the mapping function
1934    might do; thus, there are many flags that can be specified
1935    indicating what the mapping function might or might not do.
1936
1937    The result of all this is that this is the most complicated
1938    function in this file.  Change it at your own risk!
1939
1940    A potential simplification to the logic below is to determine
1941    all the extents that the mapping function should be called on
1942    before any calls are actually made and save them in an array.
1943    That introduces its own complications, however (the array
1944    needs to be marked for garbage-collection, and a static array
1945    cannot be used because map_extents() needs to be reentrant).
1946    Furthermore, the results might be a little less sensible than
1947    the logic below. */
1948
1949
1950 static void
1951 map_extents_bytind (Bytind from, Bytind to, map_extents_fun fn, void *arg,
1952                     Lisp_Object obj, EXTENT after, unsigned int flags)
1953 {
1954   Memind st, en; /* range we're mapping over */
1955   EXTENT range = 0; /* extent for this, if ME_MIGHT_MODIFY_TEXT */
1956   Extent_List *el = 0; /* extent list we're iterating over */
1957   Extent_List_Marker *posm = 0; /* marker for extent list,
1958                                    if ME_MIGHT_MODIFY_EXTENTS */
1959   /* count and struct for unwind-protect, if ME_MIGHT_THROW */
1960   int count = 0;
1961   struct map_extents_struct closure;
1962
1963 #ifdef ERROR_CHECK_EXTENTS
1964   assert (from <= to);
1965   assert (from >= buffer_or_string_absolute_begin_byte (obj) &&
1966           from <= buffer_or_string_absolute_end_byte (obj) &&
1967           to >= buffer_or_string_absolute_begin_byte (obj) &&
1968           to <= buffer_or_string_absolute_end_byte (obj));
1969 #endif
1970
1971   if (after)
1972     {
1973       assert (EQ (obj, extent_object (after)));
1974       assert (!extent_detached_p (after));
1975     }
1976
1977   el = buffer_or_string_extent_list (obj);
1978   if (!el || !extent_list_num_els(el))
1979     return;
1980   el = 0;
1981
1982   st = buffer_or_string_bytind_to_memind (obj, from);
1983   en = buffer_or_string_bytind_to_memind (obj, to);
1984
1985   if (flags & ME_MIGHT_MODIFY_TEXT)
1986     {
1987       /* The mapping function might change the text in the buffer,
1988          so make an internal extent to hold the range we're mapping
1989          over. */
1990       range = make_extent_detached (obj);
1991       set_extent_start (range, st);
1992       set_extent_end (range, en);
1993       range->flags.start_open = flags & ME_START_OPEN;
1994       range->flags.end_open = !(flags & ME_END_CLOSED);
1995       range->flags.internal = 1;
1996       range->flags.detachable = 0;
1997       extent_attach (range);
1998     }
1999
2000   if (flags & ME_MIGHT_THROW)
2001     {
2002       /* The mapping function might throw past us so we need to use an
2003          unwind_protect() to eliminate the internal extent and range
2004          that we use. */
2005       count = specpdl_depth ();
2006       closure.range = range;
2007       closure.mkr = 0;
2008       record_unwind_protect (map_extents_unwind,
2009                              make_opaque_ptr (&closure));
2010     }
2011
2012   /* ---------- Figure out where we start and what direction
2013                 we move in.  This is the trickiest part of this
2014                 function. ---------- */
2015
2016   /* If ME_START_IN_REGION, ME_END_IN_REGION or ME_START_AND_END_IN_REGION
2017      was specified and ME_NEGATE_IN_REGION was not specified, our job
2018      is simple because of the presence of the display order and e-order.
2019      (Note that theoretically do something similar for
2020      ME_START_OR_END_IN_REGION, but that would require more trickiness
2021      than it's worth to avoid hitting the same extent twice.)
2022
2023      In the general case, all the extents that overlap a range can be
2024      divided into two classes: those whose start position lies within
2025      the range (including the range's end but not including the
2026      range's start), and those that overlap the start position,
2027      i.e. those in the SOE for the start position.  Or equivalently,
2028      the extents can be divided into those whose end position lies
2029      within the range and those in the SOE for the end position.  Note
2030      that for this purpose we treat both the range and all extents in
2031      the buffer as closed on both ends.  If this is not what the ME_
2032      flags specified, then we've mapped over a few too many extents,
2033      but no big deal because extent_in_region_p() will filter them
2034      out.   Ideally, we could move the SOE to the closer of the range's
2035      two ends and work forwards or backwards from there.  However, in
2036      order to make the semantics of the AFTER argument work out, we
2037      have to always go in the same direction; so we choose to always
2038      move the SOE to the start position.
2039
2040      When it comes time to do the SOE stage, we first call soe_move()
2041      so that the SOE gets set up.  Note that the SOE might get
2042      changed while we are mapping over its contents.  If we can
2043      guarantee that the SOE won't get moved to a new position, we
2044      simply need to put a marker in the SOE and we will track deletions
2045      and insertions of extents in the SOE.  If the SOE might get moved,
2046      however (this would happen as a result of a recursive invocation
2047      of map-extents or a call to a redisplay-type function), then
2048      trying to track its changes is hopeless, so we just keep a
2049      marker to the first (or last) extent in the SOE and use that as
2050      our bound.
2051
2052      Finally, if DONT_USE_SOE is defined, we don't use the SOE at all
2053      and instead just map from the beginning of the buffer.  This is
2054      used for testing purposes and allows the SOE to be calculated
2055      using map_extents() instead of the other way around. */
2056
2057   {
2058     int range_flag; /* ME_*_IN_REGION subset of flags */
2059     int do_soe_stage = 0; /* Are we mapping over the SOE? */
2060     /* Does the range stage map over start or end positions? */
2061     int range_endp;
2062     /* If type == 0, we include the start position in the range stage mapping.
2063        If type == 1, we exclude the start position in the range stage mapping.
2064        If type == 2, we begin at range_start_pos, an extent-list position.
2065      */
2066     int range_start_type = 0;
2067     int range_start_pos = 0;
2068     int stage;
2069
2070     range_flag = flags & ME_IN_REGION_MASK;
2071     if ((range_flag == ME_START_IN_REGION ||
2072          range_flag == ME_START_AND_END_IN_REGION) &&
2073         !(flags & ME_NEGATE_IN_REGION))
2074       {
2075         /* map over start position in [range-start, range-end].  No SOE
2076            stage. */
2077         range_endp = 0;
2078       }
2079     else if (range_flag == ME_END_IN_REGION && !(flags & ME_NEGATE_IN_REGION))
2080       {
2081         /* map over end position in [range-start, range-end].  No SOE
2082            stage. */
2083         range_endp = 1;
2084       }
2085     else
2086       {
2087         /* Need to include the SOE extents. */
2088 #ifdef DONT_USE_SOE
2089         /* Just brute-force it: start from the beginning. */
2090         range_endp = 0;
2091         range_start_type = 2;
2092         range_start_pos = 0;
2093 #else
2094         Stack_Of_Extents *soe = buffer_or_string_stack_of_extents_force (obj);
2095         int numsoe;
2096
2097         /* Move the SOE to the closer end of the range.  This dictates
2098            whether we map over start positions or end positions. */
2099         range_endp = 0;
2100         soe_move (obj, st);
2101         numsoe = extent_list_num_els (soe->extents);
2102         if (numsoe)
2103           {
2104             if (flags & ME_MIGHT_MOVE_SOE)
2105               {
2106                 int foundp;
2107                 /* Can't map over SOE, so just extend range to cover the
2108                    SOE. */
2109                 EXTENT e = extent_list_at (soe->extents, 0, 0);
2110                 range_start_pos =
2111                   extent_list_locate (buffer_or_string_extent_list (obj), e, 0,
2112                                       &foundp);
2113                 assert (foundp);
2114                 range_start_type = 2;
2115               }
2116             else
2117               {
2118                 /* We can map over the SOE. */
2119                 do_soe_stage = 1;
2120                 range_start_type = 1;
2121               }
2122           }
2123         else
2124           {
2125             /* No extents in the SOE to map over, so we act just as if
2126                ME_START_IN_REGION or ME_END_IN_REGION was specified.
2127                RANGE_ENDP already specified so no need to do anything else. */
2128           }
2129       }
2130 #endif
2131
2132   /* ---------- Now loop over the extents. ---------- */
2133
2134     /* We combine the code for the two stages because much of it
2135        overlaps. */
2136     for (stage = 0; stage < 2; stage++)
2137       {
2138         int pos = 0; /* Position in extent list */
2139
2140         /* First set up start conditions */
2141         if (stage == 0)
2142           { /* The SOE stage */
2143             if (!do_soe_stage)
2144               continue;
2145             el = buffer_or_string_stack_of_extents_force (obj)->extents;
2146             /* We will always be looping over start extents here. */
2147             assert (!range_endp);
2148             pos = 0;
2149           }
2150         else
2151           { /* The range stage */
2152             el = buffer_or_string_extent_list (obj);
2153             switch (range_start_type)
2154               {
2155               case 0:
2156                 pos = extent_list_locate_from_pos (el, st, range_endp);
2157                 break;
2158               case 1:
2159                 pos = extent_list_locate_from_pos (el, st + 1, range_endp);
2160                 break;
2161               case 2:
2162                 pos = range_start_pos;
2163                 break;
2164               }
2165           }
2166
2167         if (flags & ME_MIGHT_MODIFY_EXTENTS)
2168           {
2169             /* Create a marker to track changes to the extent list */
2170             if (posm)
2171               /* Delete the marker used in the SOE stage. */
2172               extent_list_delete_marker
2173                 (buffer_or_string_stack_of_extents_force (obj)->extents, posm);
2174             posm = extent_list_make_marker (el, pos, range_endp);
2175             /* tell the unwind function about the marker. */
2176             closure.el = el;
2177             closure.mkr = posm;
2178           }
2179
2180         /* Now loop! */
2181         for (;;)
2182           {
2183             EXTENT e;
2184             Lisp_Object obj2;
2185
2186             /* ----- update position in extent list
2187                      and fetch next extent ----- */
2188
2189             if (posm)
2190               /* fetch POS again to track extent insertions or deletions */
2191               pos = extent_list_marker_pos (el, posm);
2192             if (pos >= extent_list_num_els (el))
2193               break;
2194             e = extent_list_at (el, pos, range_endp);
2195             pos++;
2196             if (posm)
2197               /* now point the marker to the next one we're going to process.
2198                  This ensures graceful behavior if this extent is deleted. */
2199               extent_list_move_marker (el, posm, pos);
2200
2201             /* ----- deal with internal extents ----- */
2202
2203             if (extent_internal_p (e))
2204               {
2205                 if (!(flags & ME_INCLUDE_INTERNAL))
2206                   continue;
2207                 else if (e == range)
2208                   {
2209                     /* We're processing internal extents and we've
2210                        come across our own special range extent.
2211                        (This happens only in adjust_extents*() and
2212                        process_extents*(), which handle text
2213                        insertion and deletion.) We need to omit
2214                        processing of this extent; otherwise
2215                        we will probably end up prematurely
2216                        terminating this loop. */
2217                     continue;
2218                   }
2219               }
2220
2221             /* ----- deal with AFTER condition ----- */
2222
2223             if (after)
2224               {
2225                 /* if e > after, then we can stop skipping extents. */
2226                 if (EXTENT_LESS (after, e))
2227                   after = 0;
2228                 else /* otherwise, skip this extent. */
2229                   continue;
2230               }
2231
2232             /* ----- stop if we're completely outside the range ----- */
2233
2234             /* fetch ST and EN again to track text insertions or deletions */
2235             if (range)
2236               {
2237                 st = extent_start (range);
2238                 en = extent_end (range);
2239               }
2240             if (extent_endpoint (e, range_endp) > en)
2241               {
2242                 /* Can't be mapping over SOE because all extents in
2243                    there should overlap ST */
2244                 assert (stage == 1);
2245                 break;
2246               }
2247
2248             /* ----- Now actually call the function ----- */
2249
2250             obj2 = extent_object (e);
2251             if (extent_in_region_p (e,
2252                                     buffer_or_string_memind_to_bytind (obj2,
2253                                                                        st),
2254                                     buffer_or_string_memind_to_bytind (obj2,
2255                                                                        en),
2256                                     flags))
2257               {
2258                 if ((*fn)(e, arg))
2259                   {
2260                     /* Function wants us to stop mapping. */
2261                     stage = 1; /* so outer for loop will terminate */
2262                     break;
2263                   }
2264               }
2265           }
2266       }
2267   /* ---------- Finished looping. ---------- */
2268   }
2269
2270   if (flags & ME_MIGHT_THROW)
2271     /* This deletes the range extent and frees the marker. */
2272     unbind_to (count, Qnil);
2273   else
2274     {
2275       /* Delete them ourselves */
2276       if (range)
2277         extent_detach (range);
2278       if (posm)
2279         extent_list_delete_marker (el, posm);
2280     }
2281 }
2282
2283 void
2284 map_extents (Bufpos from, Bufpos to, map_extents_fun fn,
2285              void *arg, Lisp_Object obj, EXTENT after, unsigned int flags)
2286 {
2287   map_extents_bytind (buffer_or_string_bufpos_to_bytind (obj, from),
2288                       buffer_or_string_bufpos_to_bytind (obj, to), fn, arg,
2289                       obj, after, flags);
2290 }
2291
2292 /* ------------------------------- */
2293 /*         adjust_extents()        */
2294 /* ------------------------------- */
2295
2296 /* Add AMOUNT to all extent endpoints in the range (FROM, TO].  This
2297    happens whenever the gap is moved or (under Mule) a character in a
2298    string is substituted for a different-length one.  The reason for
2299    this is that extent endpoints behave just like markers (all memory
2300    indices do) and this adjustment correct for markers -- see
2301    adjust_markers().  Note that it is important that we visit all
2302    extent endpoints in the range, irrespective of whether the
2303    endpoints are open or closed.
2304
2305    We could use map_extents() for this (and in fact the function
2306    was originally written that way), but the gap is in an incoherent
2307    state when this function is called and this function plays
2308    around with extent endpoints without detaching and reattaching
2309    the extents (this is provably correct and saves lots of time),
2310    so for safety we make it just look at the extent lists directly. */
2311
2312 void
2313 adjust_extents (Lisp_Object obj, Memind from, Memind to, int amount)
2314 {
2315   int endp;
2316   int pos;
2317   int startpos[2];
2318   Extent_List *el;
2319   Stack_Of_Extents *soe;
2320
2321 #ifdef ERROR_CHECK_EXTENTS
2322   sledgehammer_extent_check (obj);
2323 #endif
2324   el = buffer_or_string_extent_list (obj);
2325
2326   if (!el || !extent_list_num_els(el))
2327     return;
2328
2329   /* IMPORTANT! Compute the starting positions of the extents to
2330      modify BEFORE doing any modification!  Otherwise the starting
2331      position for the second time through the loop might get
2332      incorrectly calculated (I got bit by this bug real bad). */
2333   startpos[0] = extent_list_locate_from_pos (el, from+1, 0);
2334   startpos[1] = extent_list_locate_from_pos (el, from+1, 1);
2335   for (endp = 0; endp < 2; endp++)
2336     {
2337       for (pos = startpos[endp]; pos < extent_list_num_els (el);
2338            pos++)
2339         {
2340           EXTENT e = extent_list_at (el, pos, endp);
2341           if (extent_endpoint (e, endp) > to)
2342             break;
2343           set_extent_endpoint (e,
2344                                do_marker_adjustment (extent_endpoint (e, endp),
2345                                                      from, to, amount),
2346                                endp);
2347         }
2348     }
2349
2350   /* The index for the buffer's SOE is a memory index and thus
2351      needs to be adjusted like a marker. */
2352   soe = buffer_or_string_stack_of_extents (obj);
2353   if (soe && soe->pos >= 0)
2354     soe->pos = do_marker_adjustment (soe->pos, from, to, amount);
2355 }
2356
2357 /* ------------------------------- */
2358 /*  adjust_extents_for_deletion()  */
2359 /* ------------------------------- */
2360
2361 struct adjust_extents_for_deletion_arg
2362 {
2363   EXTENT_dynarr *list;
2364 };
2365
2366 static int
2367 adjust_extents_for_deletion_mapper (EXTENT extent, void *arg)
2368 {
2369   struct adjust_extents_for_deletion_arg *closure =
2370     (struct adjust_extents_for_deletion_arg *) arg;
2371
2372   Dynarr_add (closure->list, extent);
2373   return 0; /* continue mapping */
2374 }
2375
2376 /* For all extent endpoints in the range (FROM, TO], move them to the beginning
2377    of the new gap.   Note that it is important that we visit all extent
2378    endpoints in the range, irrespective of whether the endpoints are open or
2379    closed.
2380
2381    This function deals with weird stuff such as the fact that extents
2382    may get reordered.
2383
2384    There is no string correspondent for this because you can't
2385    delete characters from a string.
2386  */
2387
2388 void
2389 adjust_extents_for_deletion (Lisp_Object object, Bytind from,
2390                              Bytind to, int gapsize, int numdel,
2391                              int movegapsize)
2392 {
2393   struct adjust_extents_for_deletion_arg closure;
2394   int i;
2395   Memind adjust_to = (Memind) (to + gapsize);
2396   Bytecount amount = - numdel - movegapsize;
2397   Memind oldsoe = 0, newsoe = 0;
2398   Stack_Of_Extents *soe = buffer_or_string_stack_of_extents (object);
2399
2400 #ifdef ERROR_CHECK_EXTENTS
2401   sledgehammer_extent_check (object);
2402 #endif
2403   closure.list = Dynarr_new (EXTENT);
2404
2405   /* We're going to be playing weird games below with extents and the SOE
2406      and such, so compute the list now of all the extents that we're going
2407      to muck with.  If we do the mapping and adjusting together, things can
2408      get all screwed up. */
2409
2410   map_extents_bytind (from, to, adjust_extents_for_deletion_mapper,
2411                       (void *) &closure, object, 0,
2412                       /* extent endpoints move like markers regardless
2413                          of their open/closeness. */
2414                       ME_ALL_EXTENTS_CLOSED | ME_END_CLOSED |
2415                       ME_START_OR_END_IN_REGION | ME_INCLUDE_INTERNAL);
2416
2417   /*
2418     Old and new values for the SOE's position. (It gets adjusted
2419     like a marker, just like extent endpoints.)
2420   */
2421
2422   if (soe)
2423     {
2424       oldsoe = soe->pos;
2425       if (soe->pos >= 0)
2426         newsoe = do_marker_adjustment (soe->pos,
2427                                                 adjust_to, adjust_to,
2428                                                 amount);
2429       else
2430         newsoe = soe->pos;
2431     }
2432
2433   for (i = 0; i < Dynarr_length (closure.list); i++)
2434     {
2435       EXTENT extent = Dynarr_at (closure.list, i);
2436       Memind new_start = extent_start (extent);
2437       Memind new_end = extent_end (extent);
2438
2439       /* do_marker_adjustment() will not adjust values that should not be
2440          adjusted.  We're passing the same funky arguments to
2441          do_marker_adjustment() as buffer_delete_range() does. */
2442       new_start =
2443         do_marker_adjustment (new_start,
2444                                        adjust_to, adjust_to,
2445                                        amount);
2446       new_end =
2447         do_marker_adjustment (new_end,
2448                                        adjust_to, adjust_to,
2449                                        amount);
2450
2451       /* We need to be very careful here so that the SOE doesn't get
2452          corrupted.  We are shrinking extents out of the deleted region
2453          and simultaneously moving the SOE's pos out of the deleted
2454          region, so the SOE should contain the same extents at the end
2455          as at the beginning.  However, extents may get reordered
2456          by this process, so we have to operate by pulling the extents
2457          out of the buffer and SOE, changing their bounds, and then
2458          reinserting them.  In order for the SOE not to get screwed up,
2459          we have to make sure that the SOE's pos points to its old
2460          location whenever we pull an extent out, and points to its
2461          new location whenever we put the extent back in.
2462        */
2463
2464       if (new_start != extent_start (extent) ||
2465           new_end != extent_end (extent))
2466         {
2467           extent_detach (extent);
2468           set_extent_start (extent, new_start);
2469           set_extent_end (extent, new_end);
2470           if (soe)
2471             soe->pos = newsoe;
2472           extent_attach (extent);
2473           if (soe)
2474             soe->pos = oldsoe;
2475         }
2476     }
2477
2478   if (soe)
2479     soe->pos = newsoe;
2480
2481 #ifdef ERROR_CHECK_EXTENTS
2482   sledgehammer_extent_check (object);
2483 #endif
2484   Dynarr_free (closure.list);
2485 }
2486
2487 /* ------------------------------- */
2488 /*         extent fragments        */
2489 /* ------------------------------- */
2490
2491 /* Imagine that the buffer is divided up into contiguous,
2492    nonoverlapping "runs" of text such that no extent
2493    starts or ends within a run (extents that abut the
2494    run don't count).
2495
2496    An extent fragment is a structure that holds data about
2497    the run that contains a particular buffer position (if
2498    the buffer position is at the junction of two runs, the
2499    run after the position is used) -- the beginning and
2500    end of the run, a list of all of the extents in that
2501    run, the "merged face" that results from merging all of
2502    the faces corresponding to those extents, the begin and
2503    end glyphs at the beginning of the run, etc.  This is
2504    the information that redisplay needs in order to
2505    display this run.
2506
2507    Extent fragments have to be very quick to update to
2508    a new buffer position when moving linearly through
2509    the buffer.  They rely on the stack-of-extents code,
2510    which does the heavy-duty algorithmic work of determining
2511    which extents overly a particular position. */
2512
2513 /* This function returns the position of the beginning of
2514    the first run that begins after POS, or returns POS if
2515    there are no such runs. */
2516
2517 static Bytind
2518 extent_find_end_of_run (Lisp_Object obj, Bytind pos, int outside_accessible)
2519 {
2520   Extent_List *sel;
2521   Extent_List *bel = buffer_or_string_extent_list (obj);
2522   Bytind pos1, pos2;
2523   int elind1, elind2;
2524   Memind mempos = buffer_or_string_bytind_to_memind (obj, pos);
2525   Bytind limit = outside_accessible ?
2526     buffer_or_string_absolute_end_byte (obj) :
2527       buffer_or_string_accessible_end_byte (obj);
2528
2529   if (!bel || !extent_list_num_els(bel))
2530     return limit;
2531
2532   sel = buffer_or_string_stack_of_extents_force (obj)->extents;
2533   soe_move (obj, mempos);
2534
2535   /* Find the first start position after POS. */
2536   elind1 = extent_list_locate_from_pos (bel, mempos+1, 0);
2537   if (elind1 < extent_list_num_els (bel))
2538     pos1 = buffer_or_string_memind_to_bytind
2539       (obj, extent_start (extent_list_at (bel, elind1, 0)));
2540   else
2541     pos1 = limit;
2542
2543   /* Find the first end position after POS.  The extent corresponding
2544      to this position is either in the SOE or is greater than or
2545      equal to POS1, so we just have to look in the SOE. */
2546   elind2 = extent_list_locate_from_pos (sel, mempos+1, 1);
2547   if (elind2 < extent_list_num_els (sel))
2548     pos2 = buffer_or_string_memind_to_bytind
2549       (obj, extent_end (extent_list_at (sel, elind2, 1)));
2550   else
2551     pos2 = limit;
2552
2553   return min (min (pos1, pos2), limit);
2554 }
2555
2556 static Bytind
2557 extent_find_beginning_of_run (Lisp_Object obj, Bytind pos,
2558                               int outside_accessible)
2559 {
2560   Extent_List *sel;
2561   Extent_List *bel = buffer_or_string_extent_list (obj);
2562   Bytind pos1, pos2;
2563   int elind1, elind2;
2564   Memind mempos = buffer_or_string_bytind_to_memind (obj, pos);
2565   Bytind limit = outside_accessible ?
2566     buffer_or_string_absolute_begin_byte (obj) :
2567       buffer_or_string_accessible_begin_byte (obj);
2568
2569   if (!bel || !extent_list_num_els(bel))
2570     return limit;
2571
2572   sel = buffer_or_string_stack_of_extents_force (obj)->extents;
2573   soe_move (obj, mempos);
2574
2575   /* Find the first end position before POS. */
2576   elind1 = extent_list_locate_from_pos (bel, mempos, 1);
2577   if (elind1 > 0)
2578     pos1 = buffer_or_string_memind_to_bytind
2579       (obj, extent_end (extent_list_at (bel, elind1 - 1, 1)));
2580   else
2581     pos1 = limit;
2582
2583   /* Find the first start position before POS.  The extent corresponding
2584      to this position is either in the SOE or is less than or
2585      equal to POS1, so we just have to look in the SOE. */
2586   elind2 = extent_list_locate_from_pos (sel, mempos, 0);
2587   if (elind2 > 0)
2588     pos2 = buffer_or_string_memind_to_bytind
2589       (obj, extent_start (extent_list_at (sel, elind2 - 1, 0)));
2590   else
2591     pos2 = limit;
2592
2593   return max (max (pos1, pos2), limit);
2594 }
2595
2596 struct extent_fragment *
2597 extent_fragment_new (Lisp_Object buffer_or_string, struct frame *frm)
2598 {
2599   struct extent_fragment *ef = xnew_and_zero (struct extent_fragment);
2600
2601   ef->object = buffer_or_string;
2602   ef->frm = frm;
2603   ef->extents = Dynarr_new (EXTENT);
2604   ef->begin_glyphs = Dynarr_new (glyph_block);
2605   ef->end_glyphs   = Dynarr_new (glyph_block);
2606
2607   return ef;
2608 }
2609
2610 void
2611 extent_fragment_delete (struct extent_fragment *ef)
2612 {
2613   Dynarr_free (ef->extents);
2614   Dynarr_free (ef->begin_glyphs);
2615   Dynarr_free (ef->end_glyphs);
2616   xfree (ef);
2617 }
2618
2619 static int
2620 extent_priority_sort_function (const void *humpty, const void *dumpty)
2621 {
2622   const EXTENT foo = * (const EXTENT *) humpty;
2623   const EXTENT bar = * (const EXTENT *) dumpty;
2624   if (extent_priority (foo) < extent_priority (bar))
2625     return -1;
2626   return extent_priority (foo) > extent_priority (bar);
2627 }
2628
2629 static void
2630 extent_fragment_sort_by_priority (EXTENT_dynarr *extarr)
2631 {
2632   int i;
2633
2634   /* Sort our copy of the stack by extent_priority.  We use a bubble
2635      sort here because it's going to be faster than qsort() for small
2636      numbers of extents (less than 10 or so), and 99.999% of the time
2637      there won't ever be more extents than this in the stack. */
2638   if (Dynarr_length (extarr) < 10)
2639     {
2640       for (i = 1; i < Dynarr_length (extarr); i++)
2641         {
2642           int j = i - 1;
2643           while (j >= 0 &&
2644                  (extent_priority (Dynarr_at (extarr, j)) >
2645                   extent_priority (Dynarr_at (extarr, j+1))))
2646             {
2647               EXTENT tmp = Dynarr_at (extarr, j);
2648               Dynarr_at (extarr, j) = Dynarr_at (extarr, j+1);
2649               Dynarr_at (extarr, j+1) = tmp;
2650               j--;
2651             }
2652         }
2653     }
2654   else
2655     /* But some loser programs mess up and may create a large number
2656        of extents overlapping the same spot.  This will result in
2657        catastrophic behavior if we use the bubble sort above. */
2658     qsort (Dynarr_atp (extarr, 0), Dynarr_length (extarr),
2659            sizeof (EXTENT), extent_priority_sort_function);
2660 }
2661
2662 /* If PROP is the `invisible' property of an extent,
2663    this is 1 if the extent should be treated as invisible.  */
2664
2665 #define EXTENT_PROP_MEANS_INVISIBLE(buf, prop)                  \
2666   (EQ (buf->invisibility_spec, Qt)                              \
2667    ? ! NILP (prop)                                              \
2668    : invisible_p (prop, buf->invisibility_spec))
2669
2670 /* If PROP is the `invisible' property of a extent,
2671    this is 1 if the extent should be treated as invisible
2672    and should have an ellipsis.  */
2673
2674 #define EXTENT_PROP_MEANS_INVISIBLE_WITH_ELLIPSIS(buf, prop)    \
2675   (EQ (buf->invisibility_spec, Qt)                              \
2676    ? 0                                                          \
2677    : invisible_ellipsis_p (prop, buf->invisibility_spec))
2678
2679 /* This is like a combination of memq and assq.
2680    Return 1 if PROPVAL appears as an element of LIST
2681    or as the car of an element of LIST.
2682    If PROPVAL is a list, compare each element against LIST
2683    in that way, and return 1 if any element of PROPVAL is found in LIST.
2684    Otherwise return 0.
2685    This function cannot quit.  */
2686
2687 static int
2688 invisible_p (REGISTER Lisp_Object propval, Lisp_Object list)
2689 {
2690   REGISTER Lisp_Object tail, proptail;
2691   for (tail = list; CONSP (tail); tail = XCDR (tail))
2692     {
2693       REGISTER Lisp_Object tem;
2694       tem = XCAR (tail);
2695       if (EQ (propval, tem))
2696         return 1;
2697       if (CONSP (tem) && EQ (propval, XCAR (tem)))
2698         return 1;
2699     }
2700   if (CONSP (propval))
2701     for (proptail = propval; CONSP (proptail);
2702          proptail = XCDR (proptail))
2703       {
2704         Lisp_Object propelt;
2705         propelt = XCAR (proptail);
2706         for (tail = list; CONSP (tail); tail = XCDR (tail))
2707           {
2708             REGISTER Lisp_Object tem;
2709             tem = XCAR (tail);
2710             if (EQ (propelt, tem))
2711               return 1;
2712             if (CONSP (tem) && EQ (propelt, XCAR (tem)))
2713               return 1;
2714           }
2715       }
2716   return 0;
2717 }
2718
2719 /* Return 1 if PROPVAL appears as the car of an element of LIST
2720    and the cdr of that element is non-nil.
2721    If PROPVAL is a list, check each element of PROPVAL in that way,
2722    and the first time some element is found,
2723    return 1 if the cdr of that element is non-nil.
2724    Otherwise return 0.
2725    This function cannot quit.  */
2726
2727 static int
2728 invisible_ellipsis_p (REGISTER Lisp_Object propval, Lisp_Object list)
2729 {
2730   REGISTER Lisp_Object tail, proptail;
2731   for (tail = list; CONSP (tail); tail = XCDR (tail))
2732     {
2733       REGISTER Lisp_Object tem;
2734       tem = XCAR (tail);
2735       if (CONSP (tem) && EQ (propval, XCAR (tem)))
2736         return ! NILP (XCDR (tem));
2737     }
2738   if (CONSP (propval))
2739     for (proptail = propval; CONSP (proptail);
2740          proptail = XCDR (proptail))
2741       {
2742         Lisp_Object propelt;
2743         propelt = XCAR (proptail);
2744         for (tail = list; CONSP (tail); tail = XCDR (tail))
2745           {
2746             REGISTER Lisp_Object tem;
2747             tem = XCAR (tail);
2748             if (CONSP (tem) && EQ (propelt, XCAR (tem)))
2749               return ! NILP (XCDR (tem));
2750           }
2751       }
2752   return 0;
2753 }
2754
2755 face_index
2756 extent_fragment_update (struct window *w, struct extent_fragment *ef,
2757                         Bytind pos, Lisp_Object last_glyph)
2758 {
2759   int i;
2760   int seen_glyph = NILP (last_glyph) ? 1 : 0;
2761   Extent_List *sel =
2762     buffer_or_string_stack_of_extents_force (ef->object)->extents;
2763   EXTENT lhe = 0;
2764   struct extent dummy_lhe_extent;
2765   Memind mempos = buffer_or_string_bytind_to_memind (ef->object, pos);
2766
2767 #ifdef ERROR_CHECK_EXTENTS
2768   assert (pos >= buffer_or_string_accessible_begin_byte (ef->object)
2769           && pos <= buffer_or_string_accessible_end_byte (ef->object));
2770 #endif
2771
2772   Dynarr_reset (ef->extents);
2773   Dynarr_reset (ef->begin_glyphs);
2774   Dynarr_reset (ef->end_glyphs);
2775
2776   ef->previously_invisible = ef->invisible;
2777   if (ef->invisible)
2778     {
2779       if (ef->invisible_ellipses)
2780         ef->invisible_ellipses_already_displayed = 1;
2781     }
2782   else
2783     ef->invisible_ellipses_already_displayed = 0;
2784   ef->invisible = 0;
2785   ef->invisible_ellipses = 0;
2786
2787   /* Set up the begin and end positions. */
2788   ef->pos = pos;
2789   ef->end = extent_find_end_of_run (ef->object, pos, 0);
2790
2791   /* Note that extent_find_end_of_run() already moved the SOE for us. */
2792   /* soe_move (ef->object, mempos); */
2793
2794   /* Determine the begin glyphs at POS. */
2795   for (i = 0; i < extent_list_num_els (sel); i++)
2796     {
2797       EXTENT e = extent_list_at (sel, i, 0);
2798       if (extent_start (e) == mempos && !NILP (extent_begin_glyph (e)))
2799         {
2800           Lisp_Object glyph = extent_begin_glyph (e);
2801           if (seen_glyph) {
2802             struct glyph_block gb;
2803             
2804             gb.glyph = glyph;
2805             XSETEXTENT (gb.extent, e);
2806             Dynarr_add (ef->begin_glyphs, gb);
2807           }
2808           else if (EQ (glyph, last_glyph))
2809             seen_glyph = 1;
2810         }
2811     }
2812
2813   /* Determine the end glyphs at POS. */
2814   for (i = 0; i < extent_list_num_els (sel); i++)
2815     {
2816       EXTENT e = extent_list_at (sel, i, 1);
2817       if (extent_end (e) == mempos && !NILP (extent_end_glyph (e)))
2818         {
2819           Lisp_Object glyph = extent_end_glyph (e);
2820           if (seen_glyph) {
2821             struct glyph_block gb;
2822
2823             gb.glyph = glyph;
2824             XSETEXTENT (gb.extent, e);
2825             Dynarr_add (ef->end_glyphs, gb);
2826           }
2827           else if (EQ (glyph, last_glyph))
2828             seen_glyph = 1;
2829         }
2830     }
2831
2832   /* We tried determining all the charsets used in the run here,
2833      but that fails even if we only do the current line -- display
2834      tables or non-printable characters might cause other charsets
2835      to be used. */
2836
2837   /* Determine whether the last-highlighted-extent is present. */
2838   if (EXTENTP (Vlast_highlighted_extent))
2839     lhe = XEXTENT (Vlast_highlighted_extent);
2840
2841   /* Now add all extents that overlap the character after POS and
2842      have a non-nil face.  Also check if the character is invisible. */
2843   for (i = 0; i < extent_list_num_els (sel); i++)
2844     {
2845       EXTENT e = extent_list_at (sel, i, 0);
2846       if (extent_end (e) > mempos)
2847         {
2848           Lisp_Object invis_prop = extent_invisible (e);
2849
2850           if (!NILP (invis_prop))
2851             {
2852               if (!BUFFERP (ef->object))
2853                 /* #### no `string-invisibility-spec' */
2854                 ef->invisible = 1;
2855               else
2856                 {
2857                   if (!ef->invisible_ellipses_already_displayed &&
2858                       EXTENT_PROP_MEANS_INVISIBLE_WITH_ELLIPSIS
2859                       (XBUFFER (ef->object), invis_prop))
2860                     {
2861                       ef->invisible = 1;
2862                       ef->invisible_ellipses = 1;
2863                     }
2864                   else if (EXTENT_PROP_MEANS_INVISIBLE
2865                            (XBUFFER (ef->object), invis_prop))
2866                     ef->invisible = 1;
2867                 }
2868             }
2869
2870           /* Remember that one of the extents in the list might be our
2871              dummy extent representing the highlighting that is
2872              attached to some other extent that is currently
2873              mouse-highlighted.  When an extent is mouse-highlighted,
2874              it is as if there are two extents there, of potentially
2875              different priorities: the extent being highlighted, with
2876              whatever face and priority it has; and an ephemeral
2877              extent in the `mouse-face' face with
2878              `mouse-highlight-priority'.
2879              */
2880
2881           if (!NILP (extent_face (e)))
2882             Dynarr_add (ef->extents, e);
2883           if (e == lhe)
2884             {
2885               Lisp_Object f;
2886               /* zeroing isn't really necessary; we only deref `priority'
2887                  and `face' */
2888               xzero (dummy_lhe_extent);
2889               set_extent_priority (&dummy_lhe_extent,
2890                                    mouse_highlight_priority);
2891               /* Need to break up the following expression, due to an */
2892               /* error in the Digital UNIX 3.2g C compiler (Digital */
2893               /* UNIX Compiler Driver 3.11). */
2894               f = extent_mouse_face (lhe);
2895               extent_face (&dummy_lhe_extent) = f;
2896               Dynarr_add (ef->extents, &dummy_lhe_extent);
2897             }
2898           /* since we are looping anyway, we might as well do this here */
2899           if ((!NILP(extent_initial_redisplay_function (e))) &&
2900               !extent_in_red_event_p(e))
2901             {
2902               Lisp_Object function = extent_initial_redisplay_function (e);
2903               Lisp_Object obj;
2904
2905               /* printf ("initial redisplay function called!\n "); */
2906
2907               /* print_extent_2 (e);
2908                  printf ("\n"); */
2909
2910               /* FIXME: One should probably inhibit the displaying of
2911                  this extent to reduce flicker */
2912               extent_in_red_event_p(e) = 1;
2913
2914               /* call the function */
2915               XSETEXTENT(obj,e);
2916               if(!NILP(function))
2917                  Fenqueue_eval_event(function,obj);
2918             }
2919         }
2920     }
2921
2922   extent_fragment_sort_by_priority (ef->extents);
2923
2924   /* Now merge the faces together into a single face.  The code to
2925      do this is in faces.c because it involves manipulating faces. */
2926   return get_extent_fragment_face_cache_index (w, ef);
2927 }
2928
2929 \f
2930 /************************************************************************/
2931 /*                      extent-object methods                           */
2932 /************************************************************************/
2933
2934 /* These are the basic helper functions for handling the allocation of
2935    extent objects.  They are similar to the functions for other
2936    lrecord objects.  allocate_extent() is in alloc.c, not here. */
2937
2938 static Lisp_Object
2939 mark_extent (Lisp_Object obj)
2940 {
2941   struct extent *extent = XEXTENT (obj);
2942
2943   mark_object (extent_object (extent));
2944   mark_object (extent_no_chase_normal_field (extent, face));
2945   return extent->plist;
2946 }
2947
2948 static void
2949 print_extent_1 (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
2950 {
2951   EXTENT ext = XEXTENT (obj);
2952   EXTENT anc = extent_ancestor (ext);
2953   Lisp_Object tail;
2954   char buf[64], *bp = buf;
2955
2956   /* Retrieve the ancestor and use it, for faster retrieval of properties */
2957
2958   if (!NILP (extent_begin_glyph (anc))) *bp++ = '*';
2959   *bp++ = (extent_start_open_p (anc) ? '(': '[');
2960   if (extent_detached_p (ext))
2961     strcpy (bp, "detached");
2962   else
2963     sprintf (bp, "%ld, %ld",
2964              XINT (Fextent_start_position (obj)),
2965              XINT (Fextent_end_position (obj)));
2966   bp += strlen (bp);
2967   *bp++ = (extent_end_open_p (anc) ? ')': ']');
2968   if (!NILP (extent_end_glyph (anc))) *bp++ = '*';
2969   *bp++ = ' ';
2970
2971   if (!NILP (extent_read_only (anc))) *bp++ = '%';
2972   if (!NILP (extent_mouse_face (anc))) *bp++ = 'H';
2973   if (extent_unique_p (anc)) *bp++ = 'U';
2974   else if (extent_duplicable_p (anc)) *bp++ = 'D';
2975   if (!NILP (extent_invisible (anc))) *bp++ = 'I';
2976
2977   if (!NILP (extent_read_only (anc)) || !NILP (extent_mouse_face (anc)) ||
2978       extent_unique_p (anc) ||
2979       extent_duplicable_p (anc) || !NILP (extent_invisible (anc)))
2980     *bp++ = ' ';
2981   *bp = '\0';
2982   write_c_string (buf, printcharfun);
2983
2984   tail = extent_plist_slot (anc);
2985
2986   for (; !NILP (tail); tail = Fcdr (Fcdr (tail)))
2987     {
2988       Lisp_Object v = XCAR (XCDR (tail));
2989       if (NILP (v)) continue;
2990       print_internal (XCAR (tail), printcharfun, escapeflag);
2991       write_c_string (" ", printcharfun);
2992     }
2993
2994   sprintf (buf, "0x%lx", (long) ext);
2995   write_c_string (buf, printcharfun);
2996 }
2997
2998 static void
2999 print_extent (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
3000 {
3001   if (escapeflag)
3002     {
3003       const char *title = "";
3004       const char *name = "";
3005       const char *posttitle = "";
3006       Lisp_Object obj2 = Qnil;
3007
3008       /* Destroyed extents have 't' in the object field, causing
3009          extent_object() to ABORT (maybe). */
3010       if (EXTENT_LIVE_P (XEXTENT (obj)))
3011         obj2 = extent_object (XEXTENT (obj));
3012
3013       if (NILP (obj2))
3014         title = "no buffer";
3015       else if (BUFFERP (obj2))
3016         {
3017           if (BUFFER_LIVE_P (XBUFFER (obj2)))
3018             {
3019               title = "buffer ";
3020               name = (char *) XSTRING_DATA (XBUFFER (obj2)->name);
3021             }
3022           else
3023             {
3024               title = "Killed Buffer";
3025               name = "";
3026             }
3027         }
3028       else
3029         {
3030           assert (STRINGP (obj2));
3031           title = "string \"";
3032           posttitle = "\"";
3033           name = (char *) XSTRING_DATA (obj2);
3034         }
3035
3036       if (print_readably)
3037         {
3038           if (!EXTENT_LIVE_P (XEXTENT (obj)))
3039             error ("printing unreadable object #<destroyed extent>");
3040           else
3041             error ("printing unreadable object #<extent 0x%lx>",
3042                    (long) XEXTENT (obj));
3043         }
3044
3045       if (!EXTENT_LIVE_P (XEXTENT (obj)))
3046         write_c_string ("#<destroyed extent", printcharfun);
3047       else
3048         {
3049           char *buf = (char *)
3050             alloca (strlen (title) + strlen (name) + strlen (posttitle) + 1);
3051           write_c_string ("#<extent ", printcharfun);
3052           print_extent_1 (obj, printcharfun, escapeflag);
3053           write_c_string (extent_detached_p (XEXTENT (obj))
3054                           ? " from " : " in ", printcharfun);
3055           sprintf (buf, "%s%s%s", title, name, posttitle);
3056           write_c_string (buf, printcharfun);
3057         }
3058     }
3059   else
3060     {
3061       if (print_readably)
3062         error ("printing unreadable object #<extent>");
3063       write_c_string ("#<extent", printcharfun);
3064     }
3065   write_c_string (">", printcharfun);
3066 }
3067
3068 static int
3069 properties_equal (EXTENT e1, EXTENT e2, int depth)
3070 {
3071   /* When this function is called, all indirections have been followed.
3072      Thus, the indirection checks in the various macros below will not
3073      amount to anything, and could be removed.  However, the time
3074      savings would probably not be significant. */
3075   if (!(EQ (extent_face (e1), extent_face (e2)) &&
3076         extent_priority (e1) == extent_priority (e2) &&
3077         internal_equal (extent_begin_glyph (e1), extent_begin_glyph (e2),
3078                         depth + 1) &&
3079         internal_equal (extent_end_glyph (e1), extent_end_glyph (e2),
3080                         depth + 1)))
3081     return 0;
3082
3083   /* compare the bit flags. */
3084   {
3085     /* The has_aux field should not be relevant. */
3086     int e1_has_aux = e1->flags.has_aux;
3087     int e2_has_aux = e2->flags.has_aux;
3088     int value;
3089
3090     e1->flags.has_aux = e2->flags.has_aux = 0;
3091     value = memcmp (&e1->flags, &e2->flags, sizeof (e1->flags));
3092     e1->flags.has_aux = e1_has_aux;
3093     e2->flags.has_aux = e2_has_aux;
3094     if (value)
3095       return 0;
3096   }
3097
3098   /* compare the random elements of the plists. */
3099   return !plists_differ (extent_no_chase_plist (e1),
3100                          extent_no_chase_plist (e2),
3101                          0, 0, depth + 1);
3102 }
3103
3104 static int
3105 extent_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
3106 {
3107   struct extent *e1 = XEXTENT (obj1);
3108   struct extent *e2 = XEXTENT (obj2);
3109   return
3110     (extent_start (e1) == extent_start (e2) &&
3111      extent_end   (e1) == extent_end   (e2) &&
3112      internal_equal (extent_object (e1), extent_object (e2), depth + 1) &&
3113      properties_equal (extent_ancestor (e1), extent_ancestor (e2),
3114                        depth));
3115 }
3116
3117 static unsigned long
3118 extent_hash (Lisp_Object obj, int depth)
3119 {
3120   struct extent *e = XEXTENT (obj);
3121   /* No need to hash all of the elements; that would take too long.
3122      Just hash the most common ones. */
3123   return HASH3 (extent_start (e), extent_end (e),
3124                 internal_hash (extent_object (e), depth + 1));
3125 }
3126
3127 static const struct lrecord_description extent_description[] = {
3128   { XD_LISP_OBJECT, offsetof (struct extent, object) },
3129   { XD_LISP_OBJECT, offsetof (struct extent, flags.face) },
3130   { XD_LISP_OBJECT, offsetof (struct extent, plist) },
3131   { XD_END }
3132 };
3133
3134 static Lisp_Object
3135 extent_getprop (Lisp_Object obj, Lisp_Object prop)
3136 {
3137   return Fextent_property (obj, prop, Qunbound);
3138 }
3139
3140 static int
3141 extent_putprop (Lisp_Object obj, Lisp_Object prop, Lisp_Object value)
3142 {
3143   Fset_extent_property (obj, prop, value);
3144   return 1;
3145 }
3146
3147 static int
3148 extent_remprop (Lisp_Object obj, Lisp_Object prop)
3149 {
3150   EXTENT ext = XEXTENT (obj);
3151
3152   /* This list is taken from Fset_extent_property, and should be kept
3153      in synch.  */
3154   if (EQ (prop, Qread_only)
3155       || EQ (prop, Qunique)
3156       || EQ (prop, Qduplicable)
3157       || EQ (prop, Qinvisible)
3158       || EQ (prop, Qdetachable)
3159       || EQ (prop, Qdetached)
3160       || EQ (prop, Qdestroyed)
3161       || EQ (prop, Qpriority)
3162       || EQ (prop, Qface)
3163       || EQ (prop, Qinitial_redisplay_function)
3164       || EQ (prop, Qafter_change_functions)
3165       || EQ (prop, Qbefore_change_functions)
3166       || EQ (prop, Qmouse_face)
3167       || EQ (prop, Qhighlight)
3168       || EQ (prop, Qbegin_glyph_layout)
3169       || EQ (prop, Qend_glyph_layout)
3170       || EQ (prop, Qglyph_layout)
3171       || EQ (prop, Qbegin_glyph)
3172       || EQ (prop, Qend_glyph)
3173       || EQ (prop, Qstart_open)
3174       || EQ (prop, Qend_open)
3175       || EQ (prop, Qstart_closed)
3176       || EQ (prop, Qend_closed)
3177       || EQ (prop, Qkeymap))
3178     {
3179       /* #### Is this correct, anyway?  */
3180       return -1;
3181     }
3182
3183   return external_remprop (extent_plist_addr (ext), prop, 0, ERROR_ME);
3184 }
3185
3186 static Lisp_Object
3187 extent_plist (Lisp_Object obj)
3188 {
3189   return Fextent_properties (obj);
3190 }
3191
3192 DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS ("extent", extent,
3193                                                 mark_extent,
3194                                                 print_extent,
3195                                                 /* NOTE: If you declare a
3196                                                    finalization method here,
3197                                                    it will NOT be called.
3198                                                    Shaft city. */
3199                                                 0,
3200                                                 extent_equal, extent_hash,
3201                                                 extent_description,
3202                                                 extent_getprop, extent_putprop,
3203                                                 extent_remprop, extent_plist,
3204                                                 struct extent);
3205
3206 \f
3207 /************************************************************************/
3208 /*                      basic extent accessors                          */
3209 /************************************************************************/
3210
3211 /* These functions are for checking externally-passed extent objects
3212    and returning an extent's basic properties, which include the
3213    buffer the extent is associated with, the endpoints of the extent's
3214    range, the open/closed-ness of those endpoints, and whether the
3215    extent is detached.  Manipulating these properties requires
3216    manipulating the ordered lists that hold extents; thus, functions
3217    to do that are in a later section. */
3218
3219 /* Given a Lisp_Object that is supposed to be an extent, make sure it
3220    is OK and return an extent pointer.  Extents can be in one of four
3221    states:
3222
3223    1) destroyed
3224    2) detached and not associated with a buffer
3225    3) detached and associated with a buffer
3226    4) attached to a buffer
3227
3228    If FLAGS is 0, types 2-4 are allowed.  If FLAGS is DE_MUST_HAVE_BUFFER,
3229    types 3-4 are allowed.  If FLAGS is DE_MUST_BE_ATTACHED, only type 4
3230    is allowed.
3231    */
3232
3233 static EXTENT
3234 decode_extent (Lisp_Object extent_obj, unsigned int flags)
3235 {
3236   EXTENT extent;
3237   Lisp_Object obj;
3238
3239   CHECK_LIVE_EXTENT (extent_obj);
3240   extent = XEXTENT (extent_obj);
3241   obj = extent_object (extent);
3242
3243   /* the following condition will fail if we're dealing with a freed extent */
3244   assert (NILP (obj) || BUFFERP (obj) || STRINGP (obj));
3245
3246   if (flags & DE_MUST_BE_ATTACHED)
3247     flags |= DE_MUST_HAVE_BUFFER;
3248
3249   /* if buffer is dead, then convert extent to have no buffer. */
3250   if (BUFFERP (obj) && !BUFFER_LIVE_P (XBUFFER (obj)))
3251     obj = extent_object (extent) = Qnil;
3252
3253   assert (!NILP (obj) || extent_detached_p (extent));
3254
3255   if ((NILP (obj) && (flags & DE_MUST_HAVE_BUFFER))
3256       || (extent_detached_p (extent) && (flags & DE_MUST_BE_ATTACHED)))
3257     {
3258       invalid_argument ("extent doesn't belong to a buffer or string",
3259                          extent_obj);
3260     }
3261
3262   return extent;
3263 }
3264
3265 /* Note that the returned value is a buffer position, not a byte index. */
3266
3267 static Lisp_Object
3268 extent_endpoint_external (Lisp_Object extent_obj, int endp)
3269 {
3270   EXTENT extent = decode_extent (extent_obj, 0);
3271
3272   if (extent_detached_p (extent))
3273     return Qnil;
3274   else
3275     return make_int (extent_endpoint_bufpos (extent, endp));
3276 }
3277
3278 DEFUN ("extentp", Fextentp, 1, 1, 0, /*
3279 Return t if OBJECT is an extent.
3280 */
3281        (object))
3282 {
3283   return EXTENTP (object) ? Qt : Qnil;
3284 }
3285
3286 DEFUN ("extent-live-p", Fextent_live_p, 1, 1, 0, /*
3287 Return t if OBJECT is an extent that has not been destroyed.
3288 */
3289        (object))
3290 {
3291   return EXTENTP (object) && EXTENT_LIVE_P (XEXTENT (object)) ? Qt : Qnil;
3292 }
3293
3294 DEFUN ("extent-detached-p", Fextent_detached_p, 1, 1, 0, /*
3295 Return t if EXTENT is detached.
3296 */
3297        (extent))
3298 {
3299   return extent_detached_p (decode_extent (extent, 0)) ? Qt : Qnil;
3300 }
3301
3302 DEFUN ("extent-object", Fextent_object, 1, 1, 0, /*
3303 Return object (buffer or string) that EXTENT refers to.
3304 */
3305        (extent))
3306 {
3307   return extent_object (decode_extent (extent, 0));
3308 }
3309
3310 DEFUN ("extent-start-position", Fextent_start_position, 1, 1, 0, /*
3311 Return start position of EXTENT, or nil if EXTENT is detached.
3312 */
3313        (extent))
3314 {
3315   return extent_endpoint_external (extent, 0);
3316 }
3317
3318 DEFUN ("extent-end-position", Fextent_end_position, 1, 1, 0, /*
3319 Return end position of EXTENT, or nil if EXTENT is detached.
3320 */
3321        (extent))
3322 {
3323   return extent_endpoint_external (extent, 1);
3324 }
3325
3326 DEFUN ("extent-length", Fextent_length, 1, 1, 0, /*
3327 Return length of EXTENT in characters.
3328 */
3329        (extent))
3330 {
3331   EXTENT e = decode_extent (extent, DE_MUST_BE_ATTACHED);
3332   return make_int (extent_endpoint_bufpos (e, 1)
3333                    - extent_endpoint_bufpos (e, 0));
3334 }
3335
3336 DEFUN ("next-extent", Fnext_extent, 1, 1, 0, /*
3337 Find next extent after EXTENT.
3338 If EXTENT is a buffer return the first extent in the buffer; likewise
3339  for strings.
3340 Extents in a buffer are ordered in what is called the "display"
3341  order, which sorts by increasing start positions and then by *decreasing*
3342  end positions.
3343 If you want to perform an operation on a series of extents, use
3344  `map-extents' instead of this function; it is much more efficient.
3345  The primary use of this function should be to enumerate all the
3346  extents in a buffer.
3347 Note: The display order is not necessarily the order that `map-extents'
3348  processes extents in!
3349 */
3350        (extent))
3351 {
3352   Lisp_Object val;
3353   EXTENT next;
3354
3355   if (EXTENTP (extent))
3356     next = extent_next (decode_extent (extent, DE_MUST_BE_ATTACHED));
3357   else
3358     next = extent_first (decode_buffer_or_string (extent));
3359
3360   if (!next)
3361     return Qnil;
3362   XSETEXTENT (val, next);
3363   return val;
3364 }
3365
3366 DEFUN ("previous-extent", Fprevious_extent, 1, 1, 0, /*
3367 Find last extent before EXTENT.
3368 If EXTENT is a buffer return the last extent in the buffer; likewise
3369  for strings.
3370 This function is analogous to `next-extent'.
3371 */
3372        (extent))
3373 {
3374   Lisp_Object val;
3375   EXTENT prev;
3376
3377   if (EXTENTP (extent))
3378     prev = extent_previous (decode_extent (extent, DE_MUST_BE_ATTACHED));
3379   else
3380     prev = extent_last (decode_buffer_or_string (extent));
3381
3382   if (!prev)
3383     return Qnil;
3384   XSETEXTENT (val, prev);
3385   return val;
3386 }
3387
3388 #ifdef DEBUG_XEMACS
3389
3390 DEFUN ("next-e-extent", Fnext_e_extent, 1, 1, 0, /*
3391 Find next extent after EXTENT using the "e" order.
3392 If EXTENT is a buffer return the first extent in the buffer; likewise
3393  for strings.
3394 */
3395        (extent))
3396 {
3397   Lisp_Object val;
3398   EXTENT next;
3399
3400   if (EXTENTP (extent))
3401     next = extent_e_next (decode_extent (extent, DE_MUST_BE_ATTACHED));
3402   else
3403     next = extent_e_first (decode_buffer_or_string (extent));
3404
3405   if (!next)
3406     return Qnil;
3407   XSETEXTENT (val, next);
3408   return val;
3409 }
3410
3411 DEFUN ("previous-e-extent", Fprevious_e_extent, 1, 1, 0, /*
3412 Find last extent before EXTENT using the "e" order.
3413 If EXTENT is a buffer return the last extent in the buffer; likewise
3414  for strings.
3415 This function is analogous to `next-e-extent'.
3416 */
3417        (extent))
3418 {
3419   Lisp_Object val;
3420   EXTENT prev;
3421
3422   if (EXTENTP (extent))
3423     prev = extent_e_previous (decode_extent (extent, DE_MUST_BE_ATTACHED));
3424   else
3425     prev = extent_e_last (decode_buffer_or_string (extent));
3426
3427   if (!prev)
3428     return Qnil;
3429   XSETEXTENT (val, prev);
3430   return val;
3431 }
3432
3433 #endif
3434
3435 DEFUN ("next-extent-change", Fnext_extent_change, 1, 2, 0, /*
3436 Return the next position after POS where an extent begins or ends.
3437 If POS is at the end of the buffer or string, POS will be returned;
3438  otherwise a position greater than POS will always be returned.
3439 If OBJECT is nil, the current buffer is assumed.
3440 */
3441        (pos, object))
3442 {
3443   Lisp_Object obj = decode_buffer_or_string (object);
3444   Bytind bpos;
3445
3446   bpos = get_buffer_or_string_pos_byte (obj, pos, GB_ALLOW_PAST_ACCESSIBLE);
3447   bpos = extent_find_end_of_run (obj, bpos, 1);
3448   return make_int (buffer_or_string_bytind_to_bufpos (obj, bpos));
3449 }
3450
3451 DEFUN ("previous-extent-change", Fprevious_extent_change, 1, 2, 0, /*
3452 Return the last position before POS where an extent begins or ends.
3453 If POS is at the beginning of the buffer or string, POS will be returned;
3454  otherwise a position less than POS will always be returned.
3455 If OBJECT is nil, the current buffer is assumed.
3456 */
3457        (pos, object))
3458 {
3459   Lisp_Object obj = decode_buffer_or_string (object);
3460   Bytind bpos;
3461
3462   bpos = get_buffer_or_string_pos_byte (obj, pos, GB_ALLOW_PAST_ACCESSIBLE);
3463   bpos = extent_find_beginning_of_run (obj, bpos, 1);
3464   return make_int (buffer_or_string_bytind_to_bufpos (obj, bpos));
3465 }
3466
3467 \f
3468 /************************************************************************/
3469 /*                      parent and children stuff                       */
3470 /************************************************************************/
3471
3472 DEFUN ("extent-parent", Fextent_parent, 1, 1, 0, /*
3473 Return the parent (if any) of EXTENT.
3474 If an extent has a parent, it derives all its properties from that extent
3475 and has no properties of its own. (The only "properties" that the
3476 extent keeps are the buffer/string it refers to and the start and end
3477 points.) It is possible for an extent's parent to itself have a parent.
3478 */
3479        (extent))
3480 /* do I win the prize for the strangest split infinitive? */
3481 {
3482   EXTENT e = decode_extent (extent, 0);
3483   return extent_parent (e);
3484 }
3485
3486 DEFUN ("extent-children", Fextent_children, 1, 1, 0, /*
3487 Return a list of the children (if any) of EXTENT.
3488 The children of an extent are all those extents whose parent is that extent.
3489 This function does not recursively trace children of children.
3490 \(To do that, use `extent-descendants'.)
3491 */
3492        (extent))
3493 {
3494   EXTENT e = decode_extent (extent, 0);
3495   Lisp_Object children = extent_children (e);
3496
3497   if (!NILP (children))
3498     return Fcopy_sequence (XWEAK_LIST_LIST (children));
3499   else
3500     return Qnil;
3501 }
3502
3503 static void
3504 remove_extent_from_children_list (EXTENT e, Lisp_Object child)
3505 {
3506   Lisp_Object children = extent_children (e);
3507
3508 #ifdef ERROR_CHECK_EXTENTS
3509   assert (!NILP (memq_no_quit (child, XWEAK_LIST_LIST (children))));
3510 #endif
3511   XWEAK_LIST_LIST (children) =
3512     delq_no_quit (child, XWEAK_LIST_LIST (children));
3513 }
3514
3515 static void
3516 add_extent_to_children_list (EXTENT e, Lisp_Object child)
3517 {
3518   Lisp_Object children = extent_children (e);
3519
3520   if (NILP (children))
3521     {
3522       children = make_weak_list (WEAK_LIST_SIMPLE);
3523       set_extent_no_chase_aux_field (e, children, children);
3524     }
3525
3526 #ifdef ERROR_CHECK_EXTENTS
3527   assert (NILP (memq_no_quit (child, XWEAK_LIST_LIST (children))));
3528 #endif
3529   XWEAK_LIST_LIST (children) = Fcons (child, XWEAK_LIST_LIST (children));
3530 }
3531
3532 DEFUN ("set-extent-parent", Fset_extent_parent, 2, 2, 0, /*
3533 Set the parent of EXTENT to PARENT (may be nil).
3534 See `extent-parent'.
3535 */
3536        (extent, parent))
3537 {
3538   EXTENT e = decode_extent (extent, 0);
3539   Lisp_Object cur_parent = extent_parent (e);
3540   Lisp_Object rest;
3541
3542   XSETEXTENT (extent, e);
3543   if (!NILP (parent))
3544     CHECK_LIVE_EXTENT (parent);
3545   if (EQ (parent, cur_parent))
3546     return Qnil;
3547   for (rest = parent; !NILP (rest); rest = extent_parent (XEXTENT (rest)))
3548     if (EQ (rest, extent))
3549       signal_type_error (Qinvalid_change,
3550                          "Circular parent chain would result",
3551                          extent);
3552   if (NILP (parent))
3553     {
3554       remove_extent_from_children_list (XEXTENT (cur_parent), extent);
3555       set_extent_no_chase_aux_field (e, parent, Qnil);
3556       e->flags.has_parent = 0;
3557     }
3558   else
3559     {
3560       add_extent_to_children_list (XEXTENT (parent), extent);
3561       set_extent_no_chase_aux_field (e, parent, parent);
3562       e->flags.has_parent = 1;
3563     }
3564   /* changing the parent also changes the properties of all children. */
3565   {
3566     int old_invis = (!NILP (cur_parent) &&
3567                      !NILP (extent_invisible (XEXTENT (cur_parent))));
3568     int new_invis = (!NILP (parent) &&
3569                      !NILP (extent_invisible (XEXTENT (parent))));
3570
3571     extent_maybe_changed_for_redisplay (e, 1, new_invis != old_invis);
3572   }
3573
3574   return Qnil;
3575 }
3576
3577 \f
3578 /************************************************************************/
3579 /*                      basic extent mutators                           */
3580 /************************************************************************/
3581
3582 /* Note:  If you track non-duplicable extents by undo, you'll get bogus
3583    undo records for transient extents via update-extent.
3584    For example, query-replace will do this.
3585  */
3586
3587 static void
3588 set_extent_endpoints_1 (EXTENT extent, Memind start, Memind end)
3589 {
3590 #ifdef ERROR_CHECK_EXTENTS
3591   Lisp_Object obj = extent_object (extent);
3592
3593   assert (start <= end);
3594   if (BUFFERP (obj))
3595     {
3596       assert (valid_memind_p (XBUFFER (obj), start));
3597       assert (valid_memind_p (XBUFFER (obj), end));
3598     }
3599 #endif
3600
3601   /* Optimization: if the extent is already where we want it to be,
3602      do nothing. */
3603   if (!extent_detached_p (extent) && extent_start (extent) == start &&
3604       extent_end (extent) == end)
3605     return;
3606
3607   if (extent_detached_p (extent))
3608     {
3609       if (extent_duplicable_p (extent))
3610         {
3611           Lisp_Object extent_obj;
3612           XSETEXTENT (extent_obj, extent);
3613           record_extent (extent_obj, 1);
3614         }
3615     }
3616   else
3617     extent_detach (extent);
3618
3619   set_extent_start (extent, start);
3620   set_extent_end (extent, end);
3621   extent_attach (extent);
3622 }
3623
3624 /* Set extent's endpoints to S and E, and put extent in buffer or string
3625    OBJECT. (If OBJECT is nil, do not change the extent's object.) */
3626
3627 void
3628 set_extent_endpoints (EXTENT extent, Bytind s, Bytind e, Lisp_Object object)
3629 {
3630   Memind start, end;
3631
3632   if (NILP (object))
3633     {
3634       object = extent_object (extent);
3635       assert (!NILP (object));
3636     }
3637   else if (!EQ (object, extent_object (extent)))
3638     {
3639       extent_detach (extent);
3640       extent_object (extent) = object;
3641     }
3642
3643   start = s < 0 ? extent_start (extent) :
3644     buffer_or_string_bytind_to_memind (object, s);
3645   end = e < 0 ? extent_end (extent) :
3646     buffer_or_string_bytind_to_memind (object, e);
3647   set_extent_endpoints_1 (extent, start, end);
3648 }
3649
3650 static void
3651 set_extent_openness (EXTENT extent, int start_open, int end_open)
3652 {
3653   if (start_open != -1)
3654     extent_start_open_p (extent) = start_open;
3655   if (end_open != -1)
3656     extent_end_open_p (extent) = end_open;
3657   /* changing the open/closedness of an extent does not affect
3658      redisplay. */
3659 }
3660
3661 static EXTENT
3662 make_extent_internal (Lisp_Object object, Bytind from, Bytind to)
3663 {
3664   EXTENT extent;
3665
3666   extent = make_extent_detached (object);
3667   set_extent_endpoints (extent, from, to, Qnil);
3668   return extent;
3669 }
3670
3671 static EXTENT
3672 copy_extent (EXTENT original, Bytind from, Bytind to, Lisp_Object object)
3673 {
3674   EXTENT e;
3675
3676   e = make_extent_detached (object);
3677   if (from >= 0)
3678     set_extent_endpoints (e, from, to, Qnil);
3679
3680   e->plist = Fcopy_sequence (original->plist);
3681   memcpy (&e->flags, &original->flags, sizeof (e->flags));
3682   if (e->flags.has_aux)
3683     {
3684       /* also need to copy the aux struct.  It won't work for
3685          this extent to share the same aux struct as the original
3686          one. */
3687       struct extent_auxiliary *data =
3688         alloc_lcrecord_type (struct extent_auxiliary,
3689                              &lrecord_extent_auxiliary);
3690
3691       copy_lcrecord (data, XEXTENT_AUXILIARY (XCAR (original->plist)));
3692       XSETEXTENT_AUXILIARY (XCAR (e->plist), data);
3693     }
3694
3695   {
3696     /* we may have just added another child to the parent extent. */
3697     Lisp_Object parent = extent_parent (e);
3698     if (!NILP (parent))
3699       {
3700         Lisp_Object extent;
3701         XSETEXTENT (extent, e);
3702         add_extent_to_children_list (XEXTENT (parent), extent);
3703       }
3704   }
3705
3706   return e;
3707 }
3708
3709 static void
3710 destroy_extent (EXTENT extent)
3711 {
3712   Lisp_Object rest, nextrest, children;
3713   Lisp_Object extent_obj;
3714
3715   if (!extent_detached_p (extent))
3716     extent_detach (extent);
3717   /* disassociate the extent from its children and parent */
3718   children = extent_children (extent);
3719   if (!NILP (children))
3720     {
3721       LIST_LOOP_DELETING (rest, nextrest, XWEAK_LIST_LIST (children))
3722         Fset_extent_parent (XCAR (rest), Qnil);
3723     }
3724   XSETEXTENT (extent_obj, extent);
3725   Fset_extent_parent (extent_obj, Qnil);
3726   /* mark the extent as destroyed */
3727   extent_object (extent) = Qt;
3728 }
3729
3730 DEFUN ("make-extent", Fmake_extent, 2, 3, 0, /*
3731 Make an extent for the range [FROM, TO) in BUFFER-OR-STRING.
3732 BUFFER-OR-STRING defaults to the current buffer.  Insertions at point
3733 TO will be outside of the extent; insertions at FROM will be inside the
3734 extent, causing the extent to grow. (This is the same way that markers
3735 behave.) You can change the behavior of insertions at the endpoints
3736 using `set-extent-property'.  The extent is initially detached if both
3737 FROM and TO are nil, and in this case BUFFER-OR-STRING defaults to nil,
3738 meaning the extent is in no buffer and no string.
3739 */
3740        (from, to, buffer_or_string))
3741 {
3742   Lisp_Object extent_obj;
3743   Lisp_Object obj;
3744
3745   obj = decode_buffer_or_string (buffer_or_string);
3746   if (NILP (from) && NILP (to))
3747     {
3748       if (NILP (buffer_or_string))
3749         obj = Qnil;
3750       XSETEXTENT (extent_obj, make_extent_detached (obj));
3751     }
3752   else
3753     {
3754       Bytind start, end;
3755
3756       get_buffer_or_string_range_byte (obj, from, to, &start, &end,
3757                                        GB_ALLOW_PAST_ACCESSIBLE);
3758       XSETEXTENT (extent_obj, make_extent_internal (obj, start, end));
3759     }
3760   return extent_obj;
3761 }
3762
3763 DEFUN ("copy-extent", Fcopy_extent, 1, 2, 0, /*
3764 Make a copy of EXTENT.  It is initially detached.
3765 Optional argument BUFFER-OR-STRING defaults to EXTENT's buffer or string.
3766 */
3767        (extent, buffer_or_string))
3768 {
3769   EXTENT ext = decode_extent (extent, 0);
3770
3771   if (NILP (buffer_or_string))
3772     buffer_or_string = extent_object (ext);
3773   else
3774     buffer_or_string = decode_buffer_or_string (buffer_or_string);
3775
3776   XSETEXTENT (extent, copy_extent (ext, -1, -1, buffer_or_string));
3777   return extent;
3778 }
3779
3780 DEFUN ("delete-extent", Fdelete_extent, 1, 1, 0, /*
3781 Remove EXTENT from its buffer and destroy it.
3782 This does not modify the buffer's text, only its display properties.
3783 The extent cannot be used thereafter.
3784 */
3785        (extent))
3786 {
3787   EXTENT ext;
3788
3789   /* We do not call decode_extent() here because already-destroyed
3790      extents are OK. */
3791   CHECK_EXTENT (extent);
3792   ext = XEXTENT (extent);
3793
3794   if (!EXTENT_LIVE_P (ext))
3795     return Qnil;
3796   destroy_extent (ext);
3797   return Qnil;
3798 }
3799
3800 DEFUN ("detach-extent", Fdetach_extent, 1, 1, 0, /*
3801 Remove EXTENT from its buffer in such a way that it can be re-inserted.
3802 An extent is also detached when all of its characters are all killed by a
3803 deletion, unless its `detachable' property has been unset.
3804
3805 Extents which have the `duplicable' attribute are tracked by the undo
3806 mechanism.  Detachment via `detach-extent' and string deletion is recorded,
3807 as is attachment via `insert-extent' and string insertion.  Extent motion,
3808 face changes, and attachment via `make-extent' and `set-extent-endpoints'
3809 are not recorded.  This means that extent changes which are to be undo-able
3810 must be performed by character editing, or by insertion and detachment of
3811 duplicable extents.
3812 */
3813        (extent))
3814 {
3815   EXTENT ext = decode_extent (extent, 0);
3816
3817   if (extent_detached_p (ext))
3818     return extent;
3819   if (extent_duplicable_p (ext))
3820     record_extent (extent, 0);
3821   extent_detach (ext);
3822
3823   return extent;
3824 }
3825
3826 DEFUN ("set-extent-endpoints", Fset_extent_endpoints, 3, 4, 0, /*
3827 Set the endpoints of EXTENT to START, END.
3828 If START and END are null, call detach-extent on EXTENT.
3829 BUFFER-OR-STRING specifies the new buffer or string that the extent should
3830 be in, and defaults to EXTENT's buffer or string. (If nil, and EXTENT
3831 is in no buffer and no string, it defaults to the current buffer.)
3832 See documentation on `detach-extent' for a discussion of undo recording.
3833 */
3834        (extent, start, end, buffer_or_string))
3835 {
3836   EXTENT ext;
3837   Bytind s, e;
3838
3839   ext = decode_extent (extent, 0);
3840
3841   if (NILP (buffer_or_string))
3842     {
3843       buffer_or_string = extent_object (ext);
3844       if (NILP (buffer_or_string))
3845         buffer_or_string = Fcurrent_buffer ();
3846     }
3847   else
3848     buffer_or_string = decode_buffer_or_string (buffer_or_string);
3849
3850   if (NILP (start) && NILP (end))
3851     return Fdetach_extent (extent);
3852
3853   get_buffer_or_string_range_byte (buffer_or_string, start, end, &s, &e,
3854                                    GB_ALLOW_PAST_ACCESSIBLE);
3855
3856   buffer_or_string_extent_info_force (buffer_or_string);
3857   set_extent_endpoints (ext, s, e, buffer_or_string);
3858   return extent;
3859 }
3860
3861 \f
3862 /************************************************************************/
3863 /*                         mapping over extents                         */
3864 /************************************************************************/
3865
3866 static unsigned int
3867 decode_map_extents_flags (Lisp_Object flags)
3868 {
3869   unsigned int retval = 0;
3870   unsigned int all_extents_specified = 0;
3871   unsigned int in_region_specified = 0;
3872
3873   if (EQ (flags, Qt)) /* obsoleteness compatibility */
3874     return ME_END_CLOSED;
3875   if (NILP (flags))
3876     return 0;
3877   if (SYMBOLP (flags))
3878     flags = Fcons (flags, Qnil);
3879   while (!NILP (flags))
3880     {
3881       Lisp_Object sym;
3882       CHECK_CONS (flags);
3883       sym = XCAR (flags);
3884       CHECK_SYMBOL (sym);
3885       if (EQ (sym, Qall_extents_closed) || EQ (sym, Qall_extents_open) ||
3886           EQ (sym, Qall_extents_closed_open) ||
3887           EQ (sym, Qall_extents_open_closed))
3888         {
3889           if (all_extents_specified)
3890             error ("Only one `all-extents-*' flag may be specified");
3891           all_extents_specified = 1;
3892         }
3893       if (EQ (sym, Qstart_in_region) || EQ (sym, Qend_in_region) ||
3894           EQ (sym, Qstart_and_end_in_region) ||
3895           EQ (sym, Qstart_or_end_in_region))
3896         {
3897           if (in_region_specified)
3898             error ("Only one `*-in-region' flag may be specified");
3899           in_region_specified = 1;
3900         }
3901
3902       /* I do so love that conditional operator ... */
3903       retval |=
3904         EQ (sym, Qend_closed)              ? ME_END_CLOSED :
3905         EQ (sym, Qstart_open)              ? ME_START_OPEN :
3906         EQ (sym, Qall_extents_closed)      ? ME_ALL_EXTENTS_CLOSED :
3907         EQ (sym, Qall_extents_open)        ? ME_ALL_EXTENTS_OPEN :
3908         EQ (sym, Qall_extents_closed_open) ? ME_ALL_EXTENTS_CLOSED_OPEN :
3909         EQ (sym, Qall_extents_open_closed) ? ME_ALL_EXTENTS_OPEN_CLOSED :
3910         EQ (sym, Qstart_in_region)         ? ME_START_IN_REGION :
3911         EQ (sym, Qend_in_region)           ? ME_END_IN_REGION :
3912         EQ (sym, Qstart_and_end_in_region) ? ME_START_AND_END_IN_REGION :
3913         EQ (sym, Qstart_or_end_in_region)  ? ME_START_OR_END_IN_REGION :
3914         EQ (sym, Qnegate_in_region)        ? ME_NEGATE_IN_REGION :
3915         (invalid_argument ("Invalid `map-extents' flag", sym), 0);
3916
3917       flags = XCDR (flags);
3918     }
3919   return retval;
3920 }
3921
3922 DEFUN ("extent-in-region-p", Fextent_in_region_p, 1, 4, 0, /*
3923 Return whether EXTENT overlaps a specified region.
3924 This is equivalent to whether `map-extents' would visit EXTENT when called
3925 with these args.
3926 */
3927        (extent, from, to, flags))
3928 {
3929   Bytind start, end;
3930   EXTENT ext = decode_extent (extent, DE_MUST_BE_ATTACHED);
3931   Lisp_Object obj = extent_object (ext);
3932
3933   get_buffer_or_string_range_byte (obj, from, to, &start, &end, GB_ALLOW_NIL |
3934                                    GB_ALLOW_PAST_ACCESSIBLE);
3935
3936   return extent_in_region_p (ext, start, end, decode_map_extents_flags (flags)) ?
3937     Qt : Qnil;
3938 }
3939
3940 struct slow_map_extents_arg
3941 {
3942   Lisp_Object map_arg;
3943   Lisp_Object map_routine;
3944   Lisp_Object result;
3945   Lisp_Object property;
3946   Lisp_Object value;
3947 };
3948
3949 static int
3950 slow_map_extents_function (EXTENT extent, void *arg)
3951 {
3952   /* This function can GC */
3953   struct slow_map_extents_arg *closure = (struct slow_map_extents_arg *) arg;
3954   Lisp_Object extent_obj;
3955
3956   XSETEXTENT (extent_obj, extent);
3957
3958   /* make sure this extent qualifies according to the PROPERTY
3959      and VALUE args */
3960
3961   if (!NILP (closure->property))
3962     {
3963       Lisp_Object value = Fextent_property (extent_obj, closure->property,
3964                                             Qnil);
3965       if ((NILP (closure->value) && NILP (value)) ||
3966           (!NILP (closure->value) && !EQ (value, closure->value)))
3967         return 0;
3968     }
3969
3970   closure->result = call2 (closure->map_routine, extent_obj,
3971                            closure->map_arg);
3972   return !NILP (closure->result);
3973 }
3974
3975 DEFUN ("map-extents", Fmap_extents, 1, 8, 0, /*
3976 Map FUNCTION over the extents which overlap a region in OBJECT.
3977 OBJECT is normally a buffer or string but could be an extent (see below).
3978 The region is normally bounded by [FROM, TO) (i.e. the beginning of the
3979 region is closed and the end of the region is open), but this can be
3980 changed with the FLAGS argument (see below for a complete discussion).
3981
3982 FUNCTION is called with the arguments (extent, MAPARG).  The arguments
3983 OBJECT, FROM, TO, MAPARG, and FLAGS are all optional and default to
3984 the current buffer, the beginning of OBJECT, the end of OBJECT, nil,
3985 and nil, respectively.  `map-extents' returns the first non-nil result
3986 produced by FUNCTION, and no more calls to FUNCTION are made after it
3987 returns non-nil.
3988
3989 If OBJECT is an extent, FROM and TO default to the extent's endpoints,
3990 and the mapping omits that extent and its predecessors.  This feature
3991 supports restarting a loop based on `map-extents'.  Note: OBJECT must
3992 be attached to a buffer or string, and the mapping is done over that
3993 buffer or string.
3994
3995 An extent overlaps the region if there is any point in the extent that is
3996 also in the region. (For the purpose of overlap, zero-length extents and
3997 regions are treated as closed on both ends regardless of their endpoints'
3998 specified open/closedness.) Note that the endpoints of an extent or region
3999 are considered to be in that extent or region if and only if the
4000 corresponding end is closed.  For example, the extent [5,7] overlaps the
4001 region [2,5] because 5 is in both the extent and the region.  However, (5,7]
4002 does not overlap [2,5] because 5 is not in the extent, and neither [5,7] nor
4003 \(5,7] overlaps the region [2,5) because 5 is not in the region.
4004
4005 The optional FLAGS can be a symbol or a list of one or more symbols,
4006 modifying the behavior of `map-extents'.  Allowed symbols are:
4007
4008 end-closed              The region's end is closed.
4009
4010 start-open              The region's start is open.
4011
4012 all-extents-closed      Treat all extents as closed on both ends for the
4013                         purpose of determining whether they overlap the
4014                         region, irrespective of their actual open- or
4015                         closedness.
4016 all-extents-open        Treat all extents as open on both ends.
4017 all-extents-closed-open Treat all extents as start-closed, end-open.
4018 all-extents-open-closed Treat all extents as start-open, end-closed.
4019
4020 start-in-region         In addition to the above conditions for extent
4021                         overlap, the extent's start position must lie within
4022                         the specified region.  Note that, for this
4023                         condition, open start positions are treated as if
4024                         0.5 was added to the endpoint's value, and open
4025                         end positions are treated as if 0.5 was subtracted
4026                         from the endpoint's value.
4027 end-in-region           The extent's end position must lie within the
4028                         region.
4029 start-and-end-in-region Both the extent's start and end positions must lie
4030                         within the region.
4031 start-or-end-in-region  Either the extent's start or end position must lie
4032                         within the region.
4033
4034 negate-in-region        The condition specified by a `*-in-region' flag
4035                         must NOT hold for the extent to be considered.
4036
4037
4038 At most one of `all-extents-closed', `all-extents-open',
4039 `all-extents-closed-open', and `all-extents-open-closed' may be specified.
4040
4041 At most one of `start-in-region', `end-in-region',
4042 `start-and-end-in-region', and `start-or-end-in-region' may be specified.
4043
4044 If optional arg PROPERTY is non-nil, only extents with that property set
4045 on them will be visited.  If optional arg VALUE is non-nil, only extents
4046 whose value for that property is `eq' to VALUE will be visited.
4047 */
4048   (function, object, from, to, maparg, flags, property, value))
4049 {
4050   /* This function can GC */
4051   struct slow_map_extents_arg closure;
4052   unsigned int me_flags;
4053   Bytind start, end;
4054   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
4055   EXTENT after = 0;
4056
4057   if (EXTENTP (object))
4058     {
4059       after = decode_extent (object, DE_MUST_BE_ATTACHED);
4060       if (NILP (from))
4061         from = Fextent_start_position (object);
4062       if (NILP (to))
4063         to = Fextent_end_position (object);
4064       object = extent_object (after);
4065     }
4066   else
4067     object = decode_buffer_or_string (object);
4068
4069   get_buffer_or_string_range_byte (object, from, to, &start, &end,
4070                                    GB_ALLOW_NIL | GB_ALLOW_PAST_ACCESSIBLE);
4071
4072   me_flags = decode_map_extents_flags (flags);
4073
4074   if (!NILP (property))
4075     {
4076       if (!NILP (value))
4077         value = canonicalize_extent_property (property, value);
4078     }
4079
4080   GCPRO5 (function, maparg, object, property, value);
4081
4082   closure.map_arg = maparg;
4083   closure.map_routine = function;
4084   closure.result = Qnil;
4085   closure.property = property;
4086   closure.value = value;
4087
4088   map_extents_bytind (start, end, slow_map_extents_function,
4089                       (void *) &closure, object, after,
4090                       /* You never know what the user might do ... */
4091                       me_flags | ME_MIGHT_CALL_ELISP);
4092
4093   UNGCPRO;
4094   return closure.result;
4095 }
4096
4097 \f
4098 /************************************************************************/
4099 /*              mapping over extents -- other functions                 */
4100 /************************************************************************/
4101
4102 /* ------------------------------- */
4103 /*      map-extent-children        */
4104 /* ------------------------------- */
4105
4106 struct slow_map_extent_children_arg
4107 {
4108   Lisp_Object map_arg;
4109   Lisp_Object map_routine;
4110   Lisp_Object result;
4111   Lisp_Object property;
4112   Lisp_Object value;
4113   Bytind start_min;
4114   Bytind prev_start;
4115   Bytind prev_end;
4116 };
4117
4118 static int
4119 slow_map_extent_children_function (EXTENT extent, void *arg)
4120 {
4121   /* This function can GC */
4122   struct slow_map_extent_children_arg *closure =
4123     (struct slow_map_extent_children_arg *) arg;
4124   Lisp_Object extent_obj;
4125   Bytind start = extent_endpoint_bytind (extent, 0);
4126   Bytind end = extent_endpoint_bytind (extent, 1);
4127   /* Make sure the extent starts inside the region of interest,
4128      rather than just overlaps it.
4129      */
4130   if (start < closure->start_min)
4131     return 0;
4132   /* Make sure the extent is not a child of a previous visited one.
4133      We know already, because of extent ordering,
4134      that start >= prev_start, and that if
4135      start == prev_start, then end <= prev_end.
4136      */
4137   if (start == closure->prev_start)
4138     {
4139       if (end < closure->prev_end)
4140         return 0;
4141     }
4142   else /* start > prev_start */
4143     {
4144       if (start < closure->prev_end)
4145         return 0;
4146       /* corner case:  prev_end can be -1 if there is no prev */
4147     }
4148   XSETEXTENT (extent_obj, extent);
4149
4150   /* make sure this extent qualifies according to the PROPERTY
4151      and VALUE args */
4152
4153   if (!NILP (closure->property))
4154     {
4155       Lisp_Object value = Fextent_property (extent_obj, closure->property,
4156                                             Qnil);
4157       if ((NILP (closure->value) && NILP (value)) ||
4158           (!NILP (closure->value) && !EQ (value, closure->value)))
4159         return 0;
4160     }
4161
4162   closure->result = call2 (closure->map_routine, extent_obj,
4163                            closure->map_arg);
4164
4165   /* Since the callback may change the buffer, compute all stored
4166      buffer positions here.
4167      */
4168   closure->start_min = -1;      /* no need for this any more */
4169   closure->prev_start = extent_endpoint_bytind (extent, 0);
4170   closure->prev_end = extent_endpoint_bytind (extent, 1);
4171
4172   return !NILP (closure->result);
4173 }
4174
4175 DEFUN ("map-extent-children", Fmap_extent_children, 1, 8, 0, /*
4176 Map FUNCTION over the extents in the region from FROM to TO.
4177 FUNCTION is called with arguments (extent, MAPARG).  See `map-extents'
4178 for a full discussion of the arguments FROM, TO, and FLAGS.
4179
4180 The arguments are the same as for `map-extents', but this function differs
4181 in that it only visits extents which start in the given region, and also
4182 in that, after visiting an extent E, it skips all other extents which start
4183 inside E but end before E's end.
4184
4185 Thus, this function may be used to walk a tree of extents in a buffer:
4186         (defun walk-extents (buffer &optional ignore)
4187          (map-extent-children 'walk-extents buffer))
4188 */
4189        (function, object, from, to, maparg, flags, property, value))
4190 {
4191   /* This function can GC */
4192   struct slow_map_extent_children_arg closure;
4193   unsigned int me_flags;
4194   Bytind start, end;
4195   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
4196   EXTENT after = 0;
4197
4198   if (EXTENTP (object))
4199     {
4200       after = decode_extent (object, DE_MUST_BE_ATTACHED);
4201       if (NILP (from))
4202         from = Fextent_start_position (object);
4203       if (NILP (to))
4204         to = Fextent_end_position (object);
4205       object = extent_object (after);
4206     }
4207   else
4208     object = decode_buffer_or_string (object);
4209
4210   get_buffer_or_string_range_byte (object, from, to, &start, &end,
4211                                    GB_ALLOW_NIL | GB_ALLOW_PAST_ACCESSIBLE);
4212
4213   me_flags = decode_map_extents_flags (flags);
4214
4215   if (!NILP (property))
4216     {
4217       if (!NILP (value))
4218         value = canonicalize_extent_property (property, value);
4219     }
4220
4221   GCPRO5 (function, maparg, object, property, value);
4222
4223   closure.map_arg = maparg;
4224   closure.map_routine = function;
4225   closure.result = Qnil;
4226   closure.property = property;
4227   closure.value = value;
4228   closure.start_min = start;
4229   closure.prev_start = -1;
4230   closure.prev_end = -1;
4231   map_extents_bytind (start, end, slow_map_extent_children_function,
4232                       (void *) &closure, object, after,
4233                       /* You never know what the user might do ... */
4234                       me_flags | ME_MIGHT_CALL_ELISP);
4235
4236   UNGCPRO;
4237   return closure.result;
4238 }
4239
4240 /* ------------------------------- */
4241 /*             extent-at           */
4242 /* ------------------------------- */
4243
4244 /* find "smallest" matching extent containing pos -- (flag == 0) means
4245    all extents match, else (EXTENT_FLAGS (extent) & flag) must be true;
4246    for more than one matching extent with precisely the same endpoints,
4247    we choose the last extent in the extents_list.
4248    The search stops just before "before", if that is non-null.
4249    */
4250
4251 struct extent_at_arg
4252 {
4253   Lisp_Object best_match; /* or list of extents */
4254   Memind best_start;
4255   Memind best_end;
4256   Lisp_Object prop;
4257   EXTENT before;
4258   int all_extents;
4259 };
4260
4261 enum extent_at_flag
4262 {
4263   EXTENT_AT_AFTER,
4264   EXTENT_AT_BEFORE,
4265   EXTENT_AT_AT
4266 };
4267
4268 static enum extent_at_flag
4269 decode_extent_at_flag (Lisp_Object at_flag)
4270 {
4271   if (NILP (at_flag))
4272     return EXTENT_AT_AFTER;
4273
4274   CHECK_SYMBOL (at_flag);
4275   if (EQ (at_flag, Qafter))  return EXTENT_AT_AFTER;
4276   if (EQ (at_flag, Qbefore)) return EXTENT_AT_BEFORE;
4277   if (EQ (at_flag, Qat))     return EXTENT_AT_AT;
4278
4279   invalid_argument ("Invalid AT-FLAG in `extent-at'", at_flag);
4280   return EXTENT_AT_AFTER; /* unreached */
4281 }
4282
4283 static int
4284 extent_at_mapper (EXTENT e, void *arg)
4285 {
4286   struct extent_at_arg *closure = (struct extent_at_arg *) arg;
4287
4288   if (e == closure->before)
4289     return 1;
4290
4291   /* If closure->prop is non-nil, then the extent is only acceptable
4292      if it has a non-nil value for that property. */
4293   if (!NILP (closure->prop))
4294     {
4295       Lisp_Object extent;
4296       XSETEXTENT (extent, e);
4297       if (NILP (Fextent_property (extent, closure->prop, Qnil)))
4298         return 0;
4299     }
4300
4301   if (!closure->all_extents)
4302     {
4303       EXTENT current;
4304
4305       if (NILP (closure->best_match))
4306         goto accept;
4307       current = XEXTENT (closure->best_match);
4308       /* redundant but quick test */
4309       if (extent_start (current) > extent_start (e))
4310         return 0;
4311
4312       /* we return the "last" best fit, instead of the first --
4313          this is because then the glyph closest to two equivalent
4314          extents corresponds to the "extent-at" the text just past
4315          that same glyph */
4316       else if (!EXTENT_LESS_VALS (e, closure->best_start,
4317                                   closure->best_end))
4318         goto accept;
4319       else
4320         return 0;
4321     accept:
4322       XSETEXTENT (closure->best_match, e);
4323       closure->best_start = extent_start (e);
4324       closure->best_end = extent_end (e);
4325     }
4326   else
4327     {
4328       Lisp_Object extent;
4329
4330       XSETEXTENT (extent, e);
4331       closure->best_match = Fcons (extent, closure->best_match);
4332     }
4333
4334   return 0;
4335 }
4336
4337 static Lisp_Object
4338 extent_at_bytind (Bytind position, Lisp_Object object, Lisp_Object property,
4339                   EXTENT before, enum extent_at_flag at_flag, int all_extents)
4340 {
4341   struct extent_at_arg closure;
4342   struct gcpro gcpro1;
4343
4344   /* it might be argued that invalid positions should cause
4345      errors, but the principle of least surprise dictates that
4346      nil should be returned (extent-at is often used in
4347      response to a mouse event, and in many cases previous events
4348      have changed the buffer contents).
4349
4350      Also, the openness stuff in the text-property code currently
4351      does not check its limits and might go off the end. */
4352   if ((at_flag == EXTENT_AT_BEFORE
4353        ? position <= buffer_or_string_absolute_begin_byte (object)
4354        : position < buffer_or_string_absolute_begin_byte (object))
4355       || (at_flag == EXTENT_AT_AFTER
4356           ? position >= buffer_or_string_absolute_end_byte (object)
4357           : position > buffer_or_string_absolute_end_byte (object)))
4358     return Qnil;
4359
4360   closure.best_match = Qnil;
4361   closure.prop = property;
4362   closure.before = before;
4363   closure.all_extents = all_extents;
4364
4365   GCPRO1 (closure.best_match);
4366   map_extents_bytind (at_flag == EXTENT_AT_BEFORE ? position - 1 : position,
4367                       at_flag == EXTENT_AT_AFTER ? position + 1 : position,
4368                       extent_at_mapper, (void *) &closure, object, 0,
4369                       ME_START_OPEN | ME_ALL_EXTENTS_CLOSED);
4370   if (all_extents)
4371     closure.best_match = Fnreverse (closure.best_match);
4372   UNGCPRO;
4373
4374   return closure.best_match;
4375 }
4376
4377 DEFUN ("extent-at", Fextent_at, 1, 5, 0, /*
4378 Find "smallest" extent at POS in OBJECT having PROPERTY set.
4379 Normally, an extent is "at" POS if it overlaps the region (POS, POS+1);
4380  i.e. if it covers the character after POS. (However, see the definition
4381  of AT-FLAG.) "Smallest" means the extent that comes last in the display
4382  order; this normally means the extent whose start position is closest to
4383  POS.  See `next-extent' for more information.
4384 OBJECT specifies a buffer or string and defaults to the current buffer.
4385 PROPERTY defaults to nil, meaning that any extent will do.
4386 Properties are attached to extents with `set-extent-property', which see.
4387 Returns nil if POS is invalid or there is no matching extent at POS.
4388 If the fourth argument BEFORE is not nil, it must be an extent; any returned
4389  extent will precede that extent.  This feature allows `extent-at' to be
4390  used by a loop over extents.
4391 AT-FLAG controls how end cases are handled, and should be one of:
4392
4393 nil or `after'          An extent is at POS if it covers the character
4394                         after POS.  This is consistent with the way
4395                         that text properties work.
4396 `before'                An extent is at POS if it covers the character
4397                         before POS.
4398 `at'                    An extent is at POS if it overlaps or abuts POS.
4399                         This includes all zero-length extents at POS.
4400
4401 Note that in all cases, the start-openness and end-openness of the extents
4402 considered is ignored.  If you want to pay attention to those properties,
4403 you should use `map-extents', which gives you more control.
4404 */
4405      (pos, object, property, before, at_flag))
4406 {
4407   Bytind position;
4408   EXTENT before_extent;
4409   enum extent_at_flag fl;
4410
4411   object = decode_buffer_or_string (object);
4412   position = get_buffer_or_string_pos_byte (object, pos, GB_NO_ERROR_IF_BAD);
4413   if (NILP (before))
4414     before_extent = 0;
4415   else
4416     before_extent = decode_extent (before, DE_MUST_BE_ATTACHED);
4417   if (before_extent && !EQ (object, extent_object (before_extent)))
4418     invalid_argument ("extent not in specified buffer or string", object);
4419   fl = decode_extent_at_flag (at_flag);
4420
4421   return extent_at_bytind (position, object, property, before_extent, fl, 0);
4422 }
4423
4424 DEFUN ("extents-at", Fextents_at, 1, 5, 0, /*
4425 Find all extents at POS in OBJECT having PROPERTY set.
4426 Normally, an extent is "at" POS if it overlaps the region (POS, POS+1);
4427  i.e. if it covers the character after POS. (However, see the definition
4428  of AT-FLAG.)
4429 This provides similar functionality to `extent-list', but does so in a way
4430  that is compatible with `extent-at'. (For example, errors due to POS out of
4431  range are ignored; this makes it safer to use this function in response to
4432  a mouse event, because in many cases previous events have changed the buffer
4433  contents.)
4434 OBJECT specifies a buffer or string and defaults to the current buffer.
4435 PROPERTY defaults to nil, meaning that any extent will do.
4436 Properties are attached to extents with `set-extent-property', which see.
4437 Returns nil if POS is invalid or there is no matching extent at POS.
4438 If the fourth argument BEFORE is not nil, it must be an extent; any returned
4439  extent will precede that extent.  This feature allows `extents-at' to be
4440  used by a loop over extents.
4441 AT-FLAG controls how end cases are handled, and should be one of:
4442
4443 nil or `after'          An extent is at POS if it covers the character
4444                         after POS.  This is consistent with the way
4445                         that text properties work.
4446 `before'                An extent is at POS if it covers the character
4447                         before POS.
4448 `at'                    An extent is at POS if it overlaps or abuts POS.
4449                         This includes all zero-length extents at POS.
4450
4451 Note that in all cases, the start-openness and end-openness of the extents
4452 considered is ignored.  If you want to pay attention to those properties,
4453 you should use `map-extents', which gives you more control.
4454 */
4455      (pos, object, property, before, at_flag))
4456 {
4457   Bytind position;
4458   EXTENT before_extent;
4459   enum extent_at_flag fl;
4460
4461   object = decode_buffer_or_string (object);
4462   position = get_buffer_or_string_pos_byte (object, pos, GB_NO_ERROR_IF_BAD);
4463   if (NILP (before))
4464     before_extent = 0;
4465   else
4466     before_extent = decode_extent (before, DE_MUST_BE_ATTACHED);
4467   if (before_extent && !EQ (object, extent_object (before_extent)))
4468     invalid_argument ("extent not in specified buffer or string", object);
4469   fl = decode_extent_at_flag (at_flag);
4470
4471   return extent_at_bytind (position, object, property, before_extent, fl, 1);
4472 }
4473
4474 /* ------------------------------- */
4475 /*   verify_extent_modification()  */
4476 /* ------------------------------- */
4477
4478 /* verify_extent_modification() is called when a buffer or string is
4479    modified to check whether the modification is occuring inside a
4480    read-only extent.
4481  */
4482
4483 struct verify_extents_arg
4484 {
4485   Lisp_Object object;
4486   Memind start;
4487   Memind end;
4488   Lisp_Object iro; /* value of inhibit-read-only */
4489 };
4490
4491 static int
4492 verify_extent_mapper (EXTENT extent, void *arg)
4493 {
4494   struct verify_extents_arg *closure = (struct verify_extents_arg *) arg;
4495   Lisp_Object prop = extent_read_only (extent);
4496
4497   if (NILP (prop))
4498     return 0;
4499
4500   if (CONSP (closure->iro) && !NILP (Fmemq (prop, closure->iro)))
4501     return 0;
4502
4503 #if 0 /* Nobody seems to care for this any more -sb */
4504   /* Allow deletion if the extent is completely contained in
4505      the region being deleted.
4506      This is important for supporting tokens which are internally
4507      write-protected, but which can be killed and yanked as a whole.
4508      Ignore open/closed distinctions at this point.
4509      -- Rose
4510      */
4511   if (closure->start != closure->end &&
4512       extent_start (extent) >= closure->start &&
4513       extent_end (extent) <= closure->end)
4514     return 0;
4515 #endif
4516
4517   while (1)
4518     Fsignal (Qbuffer_read_only, (list1 (closure->object)));
4519
4520   RETURN_NOT_REACHED(0)
4521 }
4522
4523 /* Value of Vinhibit_read_only is precomputed and passed in for
4524    efficiency */
4525
4526 void
4527 verify_extent_modification (Lisp_Object object, Bytind from, Bytind to,
4528                             Lisp_Object inhibit_read_only_value)
4529 {
4530   int closed;
4531   struct verify_extents_arg closure;
4532
4533   /* If insertion, visit closed-endpoint extents touching the insertion
4534      point because the text would go inside those extents.  If deletion,
4535      treat the range as open on both ends so that touching extents are not
4536      visited.  Note that we assume that an insertion is occurring if the
4537      changed range has zero length, and a deletion otherwise.  This
4538      fails if a change (i.e. non-insertion, non-deletion) is happening.
4539      As far as I know, this doesn't currently occur in XEmacs. --ben */
4540   closed = (from==to);
4541   closure.object = object;
4542   closure.start = buffer_or_string_bytind_to_memind (object, from);
4543   closure.end = buffer_or_string_bytind_to_memind (object, to);
4544   closure.iro = inhibit_read_only_value;
4545
4546   map_extents_bytind (from, to, verify_extent_mapper, (void *) &closure,
4547                       object, 0, closed ? ME_END_CLOSED : ME_START_OPEN);
4548 }
4549
4550 /* ------------------------------------ */
4551 /*    process_extents_for_insertion()   */
4552 /* ------------------------------------ */
4553
4554 struct process_extents_for_insertion_arg
4555 {
4556   Bytind opoint;
4557   int length;
4558   Lisp_Object object;
4559 };
4560
4561 /*   A region of length LENGTH was just inserted at OPOINT.  Modify all
4562      of the extents as required for the insertion, based on their
4563      start-open/end-open properties.
4564  */
4565
4566 static int
4567 process_extents_for_insertion_mapper (EXTENT extent, void *arg)
4568 {
4569   struct process_extents_for_insertion_arg *closure =
4570     (struct process_extents_for_insertion_arg *) arg;
4571   Memind indice = buffer_or_string_bytind_to_memind (closure->object,
4572                                                       closure->opoint);
4573
4574   /* When this function is called, one end of the newly-inserted text should
4575      be adjacent to some endpoint of the extent, or disjoint from it.  If
4576      the insertion overlaps any existing extent, something is wrong.
4577    */
4578 #ifdef ERROR_CHECK_EXTENTS
4579   if (extent_start (extent) > indice &&
4580       extent_start (extent) < indice + closure->length)
4581     ABORT ();
4582   if (extent_end (extent) > indice &&
4583       extent_end (extent) < indice + closure->length)
4584     ABORT ();
4585 #endif
4586
4587   /* The extent-adjustment code adjusted the extent's endpoints as if
4588      all extents were closed-open -- endpoints at the insertion point
4589      remain unchanged.  We need to fix the other kinds of extents:
4590
4591      1. Start position of start-open extents needs to be moved.
4592
4593      2. End position of end-closed extents needs to be moved.
4594
4595      Note that both conditions hold for zero-length (] extents at the
4596      insertion point.  But under these rules, zero-length () extents
4597      would get adjusted such that their start is greater than their
4598      end; instead of allowing that, we treat them as [) extents by
4599      modifying condition #1 to not fire nothing when dealing with a
4600      zero-length open-open extent.
4601
4602      Existence of zero-length open-open extents is unfortunately an
4603      inelegant part of the extent model, but there is no way around
4604      it. */
4605
4606   {
4607     Memind new_start = extent_start (extent);
4608     Memind new_end   = extent_end (extent);
4609
4610     if (indice == extent_start (extent) && extent_start_open_p (extent)
4611         /* zero-length () extents are exempt; see comment above. */
4612         && !(new_start == new_end && extent_end_open_p (extent))
4613         )
4614       new_start += closure->length;
4615     if (indice == extent_end (extent) && !extent_end_open_p (extent))
4616       new_end += closure->length;
4617
4618     set_extent_endpoints_1 (extent, new_start, new_end);
4619   }
4620
4621   return 0;
4622 }
4623
4624 void
4625 process_extents_for_insertion (Lisp_Object object, Bytind opoint,
4626                                Bytecount length)
4627 {
4628   struct process_extents_for_insertion_arg closure;
4629
4630   closure.opoint = opoint;
4631   closure.length = length;
4632   closure.object = object;
4633
4634   map_extents_bytind (opoint, opoint + length,
4635                       process_extents_for_insertion_mapper,
4636                       (void *) &closure, object, 0,
4637                       ME_END_CLOSED | ME_MIGHT_MODIFY_EXTENTS |
4638                       ME_INCLUDE_INTERNAL);
4639 }
4640
4641 /* ------------------------------------ */
4642 /*    process_extents_for_deletion()    */
4643 /* ------------------------------------ */
4644
4645 struct process_extents_for_deletion_arg
4646 {
4647   Memind start, end;
4648   int destroy_included_extents;
4649 };
4650
4651 /* This function is called when we're about to delete the range [from, to].
4652    Detach all of the extents that are completely inside the range [from, to],
4653    if they're detachable or open-open. */
4654
4655 static int
4656 process_extents_for_deletion_mapper (EXTENT extent, void *arg)
4657 {
4658   struct process_extents_for_deletion_arg *closure =
4659     (struct process_extents_for_deletion_arg *) arg;
4660
4661   /* If the extent lies completely within the range that
4662      is being deleted, then nuke the extent if it's detachable
4663      (otherwise, it will become a zero-length extent). */
4664
4665   if (closure->start <= extent_start (extent) &&
4666       extent_end (extent) <= closure->end)
4667     {
4668       if (extent_detachable_p (extent))
4669         {
4670           if (closure->destroy_included_extents)
4671             destroy_extent (extent);
4672           else
4673             extent_detach (extent);
4674         }
4675     }
4676
4677   return 0;
4678 }
4679
4680 /* DESTROY_THEM means destroy the extents instead of just deleting them.
4681    It is unused currently, but perhaps might be used (there used to
4682    be a function process_extents_for_destruction(), #if 0'd out,
4683    that did the equivalent). */
4684 void
4685 process_extents_for_deletion (Lisp_Object object, Bytind from,
4686                               Bytind to, int destroy_them)
4687 {
4688   struct process_extents_for_deletion_arg closure;
4689
4690   closure.start = buffer_or_string_bytind_to_memind (object, from);
4691   closure.end = buffer_or_string_bytind_to_memind (object, to);
4692   closure.destroy_included_extents = destroy_them;
4693
4694   map_extents_bytind (from, to, process_extents_for_deletion_mapper,
4695                       (void *) &closure, object, 0,
4696                       ME_END_CLOSED | ME_MIGHT_MODIFY_EXTENTS);
4697 }
4698
4699 /* ------------------------------- */
4700 /*   report_extent_modification()  */
4701 /* ------------------------------- */
4702 struct report_extent_modification_closure {
4703   Lisp_Object buffer;
4704   Bufpos start, end;
4705   int afterp;
4706   int speccount;
4707 };
4708
4709 static Lisp_Object
4710 report_extent_modification_restore (Lisp_Object buffer)
4711 {
4712   if (current_buffer != XBUFFER (buffer))
4713     Fset_buffer (buffer);
4714   return Qnil;
4715 }
4716
4717 static int
4718 report_extent_modification_mapper (EXTENT extent, void *arg)
4719 {
4720   struct report_extent_modification_closure *closure =
4721     (struct report_extent_modification_closure *)arg;
4722   Lisp_Object exobj, startobj, endobj;
4723   Lisp_Object hook = (closure->afterp
4724                       ? extent_after_change_functions (extent)
4725                       : extent_before_change_functions (extent));
4726   if (NILP (hook))
4727     return 0;
4728
4729   XSETEXTENT (exobj, extent);
4730   XSETINT (startobj, closure->start);
4731   XSETINT (endobj, closure->end);
4732
4733   /* Now that we are sure to call elisp, set up an unwind-protect so
4734      inside_change_hook gets restored in case we throw.  Also record
4735      the current buffer, in case we change it.  Do the recording only
4736      once.
4737
4738      One confusing thing here is that our caller never actually calls
4739      unbind_to (closure.speccount, Qnil).  This is because
4740      map_extents_bytind() unbinds before, and with a smaller
4741      speccount.  The additional unbind_to() in
4742      report_extent_modification() would cause XEmacs to ABORT.  */
4743   if (closure->speccount == -1)
4744     {
4745       closure->speccount = specpdl_depth ();
4746       record_unwind_protect (report_extent_modification_restore,
4747                              Fcurrent_buffer ());
4748     }
4749
4750   /* The functions will expect closure->buffer to be the current
4751      buffer, so change it if it isn't.  */
4752   if (current_buffer != XBUFFER (closure->buffer))
4753     Fset_buffer (closure->buffer);
4754
4755   /* #### It's a shame that we can't use any of the existing run_hook*
4756      functions here.  This is so because all of them work with
4757      symbols, to be able to retrieve default values of local hooks.
4758      <sigh>
4759
4760      #### Idea: we could set up a dummy symbol, and call the hook
4761      functions on *that*.  */
4762
4763   if (!CONSP (hook) || EQ (XCAR (hook), Qlambda))
4764     call3 (hook, exobj, startobj, endobj);
4765   else
4766     {
4767       Lisp_Object tail;
4768       EXTERNAL_LIST_LOOP (tail, hook)
4769         /* #### Shouldn't this perform the same Fset_buffer() check as
4770            above?  */
4771         call3 (XCAR (tail), exobj, startobj, endobj);
4772     }
4773   return 0;
4774 }
4775
4776 void
4777 report_extent_modification (Lisp_Object buffer, Bufpos start, Bufpos end,
4778                             int afterp)
4779 {
4780   struct report_extent_modification_closure closure;
4781
4782   closure.buffer = buffer;
4783   closure.start = start;
4784   closure.end = end;
4785   closure.afterp = afterp;
4786   closure.speccount = -1;
4787
4788   map_extents (start, end, report_extent_modification_mapper, (void *)&closure,
4789                buffer, NULL, ME_MIGHT_CALL_ELISP);
4790 }
4791
4792 \f
4793 /************************************************************************/
4794 /*                      extent properties                               */
4795 /************************************************************************/
4796
4797 static void
4798 set_extent_invisible (EXTENT extent, Lisp_Object value)
4799 {
4800   if (!EQ (extent_invisible (extent), value))
4801     {
4802       set_extent_invisible_1 (extent, value);
4803       extent_changed_for_redisplay (extent, 1, 1);
4804     }
4805 }
4806
4807 /* This function does "memoization" -- similar to the interning
4808    that happens with symbols.  Given a list of faces, an equivalent
4809    list is returned such that if this function is called twice with
4810    input that is `equal', the resulting outputs will be `eq'.
4811
4812    Note that the inputs and outputs are in general *not* `equal' --
4813    faces in symbol form become actual face objects in the output.
4814    This is necessary so that temporary faces stay around. */
4815
4816 static Lisp_Object
4817 memoize_extent_face_internal (Lisp_Object list)
4818 {
4819   int len;
4820   int thelen;
4821   Lisp_Object cons, thecons;
4822   Lisp_Object oldtail, tail;
4823   struct gcpro gcpro1;
4824
4825   if (NILP (list))
4826     return Qnil;
4827   if (!CONSP (list))
4828     return Fget_face (list);
4829
4830   /* To do the memoization, we use a hash table mapping from
4831      external lists to internal lists.  We do `equal' comparisons
4832      on the keys so the memoization works correctly.
4833
4834      Note that we canonicalize things so that the keys in the
4835      hash table (the external lists) always contain symbols and
4836      the values (the internal lists) always contain face objects.
4837
4838      We also maintain a "reverse" table that maps from the internal
4839      lists to the external equivalents.  The idea here is twofold:
4840
4841      1) `extent-face' wants to return a list containing face symbols
4842         rather than face objects.
4843      2) We don't want things to get quite so messed up if the user
4844         maliciously side-effects the returned lists.
4845      */
4846
4847   len = XINT (Flength (list));
4848   thelen = XINT (Flength (Vextent_face_reusable_list));
4849   oldtail = Qnil;
4850   tail = Qnil;
4851   GCPRO1 (oldtail);
4852
4853   /* We canonicalize the given list into another list.
4854      We try to avoid consing except when necessary, so we have
4855      a reusable list.
4856   */
4857
4858   if (thelen < len)
4859     {
4860       cons = Vextent_face_reusable_list;
4861       while (!NILP (XCDR (cons)))
4862         cons = XCDR (cons);
4863       XCDR (cons) = Fmake_list (make_int (len - thelen), Qnil);
4864     }
4865   else if (thelen > len)
4866     {
4867       int i;
4868
4869       /* Truncate the list temporarily so it's the right length;
4870          remember the old tail. */
4871       cons = Vextent_face_reusable_list;
4872       for (i = 0; i < len - 1; i++)
4873         cons = XCDR (cons);
4874       tail = cons;
4875       oldtail = XCDR (cons);
4876       XCDR (cons) = Qnil;
4877     }
4878
4879   thecons = Vextent_face_reusable_list;
4880   EXTERNAL_LIST_LOOP (cons, list)
4881     {
4882       Lisp_Object face = Fget_face (XCAR (cons));
4883
4884       XCAR (thecons) = Fface_name (face);
4885       thecons = XCDR (thecons);
4886     }
4887
4888   list = Fgethash (Vextent_face_reusable_list, Vextent_face_memoize_hash_table,
4889                    Qnil);
4890   if (NILP (list))
4891     {
4892       Lisp_Object symlist = Fcopy_sequence (Vextent_face_reusable_list);
4893       Lisp_Object facelist = Fcopy_sequence (Vextent_face_reusable_list);
4894
4895       LIST_LOOP (cons, facelist)
4896         {
4897           XCAR (cons) = Fget_face (XCAR (cons));
4898         }
4899       Fputhash (symlist, facelist, Vextent_face_memoize_hash_table);
4900       Fputhash (facelist, symlist, Vextent_face_reverse_memoize_hash_table);
4901       list = facelist;
4902     }
4903
4904   /* Now restore the truncated tail of the reusable list, if necessary. */
4905   if (!NILP (tail))
4906     XCDR (tail) = oldtail;
4907
4908   UNGCPRO;
4909   return list;
4910 }
4911
4912 static Lisp_Object
4913 external_of_internal_memoized_face (Lisp_Object face)
4914 {
4915   if (NILP (face))
4916     return Qnil;
4917   else if (!CONSP (face))
4918     return XFACE (face)->name;
4919   else
4920     {
4921       face = Fgethash (face, Vextent_face_reverse_memoize_hash_table,
4922                        Qunbound);
4923       assert (!UNBOUNDP (face));
4924       return face;
4925     }
4926 }
4927
4928 static Lisp_Object
4929 canonicalize_extent_property (Lisp_Object prop, Lisp_Object value)
4930 {
4931   if (EQ (prop, Qface) || EQ (prop, Qmouse_face))
4932     value = (external_of_internal_memoized_face
4933              (memoize_extent_face_internal (value)));
4934   return value;
4935 }
4936
4937 /* Do we need a lisp-level function ? */
4938 DEFUN ("set-extent-initial-redisplay-function", Fset_extent_initial_redisplay_function,
4939        2,2,0, /*
4940 Note: This feature is experimental!
4941
4942 Set initial-redisplay-function of EXTENT to the function
4943 FUNCTION.
4944
4945 The first time the EXTENT is (re)displayed, an eval event will be
4946 dispatched calling FUNCTION with EXTENT as its only argument.
4947 */
4948        (extent, function))
4949 {
4950   EXTENT e = decode_extent(extent, DE_MUST_BE_ATTACHED);
4951
4952   e = extent_ancestor (e);  /* Is this needed? Macro also does chasing!*/
4953   set_extent_initial_redisplay_function(e,function);
4954   extent_in_red_event_p(e) = 0;  /* If the function changed we can spawn
4955                                     new events */
4956   extent_changed_for_redisplay(e,1,0); /* Do we need to mark children too ?*/
4957
4958   return function;
4959 }
4960
4961 DEFUN ("extent-face", Fextent_face, 1, 1, 0, /*
4962 Return the name of the face in which EXTENT is displayed, or nil
4963 if the extent's face is unspecified.  This might also return a list
4964 of face names.
4965 */
4966        (extent))
4967 {
4968   Lisp_Object face;
4969
4970   CHECK_EXTENT (extent);
4971   face = extent_face (XEXTENT (extent));
4972
4973   return external_of_internal_memoized_face (face);
4974 }
4975
4976 DEFUN ("set-extent-face", Fset_extent_face, 2, 2, 0, /*
4977 Make the given EXTENT have the graphic attributes specified by FACE.
4978 FACE can also be a list of faces, and all faces listed will apply,
4979 with faces earlier in the list taking priority over those later in the
4980 list.
4981 */
4982        (extent, face))
4983 {
4984   EXTENT e = decode_extent(extent, 0);
4985   Lisp_Object orig_face = face;
4986
4987   /* retrieve the ancestor for efficiency and proper redisplay noting. */
4988   e = extent_ancestor (e);
4989
4990   face = memoize_extent_face_internal (face);
4991
4992   extent_face (e) = face;
4993   extent_changed_for_redisplay (e, 1, 0);
4994
4995   return orig_face;
4996 }
4997
4998
4999 DEFUN ("extent-mouse-face", Fextent_mouse_face, 1, 1, 0, /*
5000 Return the face used to highlight EXTENT when the mouse passes over it.
5001 The return value will be a face name, a list of face names, or nil
5002 if the extent's mouse face is unspecified.
5003 */
5004        (extent))
5005 {
5006   Lisp_Object face;
5007
5008   CHECK_EXTENT (extent);
5009   face = extent_mouse_face (XEXTENT (extent));
5010
5011   return external_of_internal_memoized_face (face);
5012 }
5013
5014 DEFUN ("set-extent-mouse-face", Fset_extent_mouse_face, 2, 2, 0, /*
5015 Set the face used to highlight EXTENT when the mouse passes over it.
5016 FACE can also be a list of faces, and all faces listed will apply,
5017 with faces earlier in the list taking priority over those later in the
5018 list.
5019 */
5020        (extent, face))
5021 {
5022   EXTENT e;
5023   Lisp_Object orig_face = face;
5024
5025   CHECK_EXTENT (extent);
5026   e = XEXTENT (extent);
5027   /* retrieve the ancestor for efficiency and proper redisplay noting. */
5028   e = extent_ancestor (e);
5029
5030   face = memoize_extent_face_internal (face);
5031
5032   set_extent_mouse_face (e, face);
5033   extent_changed_for_redisplay (e, 1, 0);
5034
5035   return orig_face;
5036 }
5037
5038 void
5039 set_extent_glyph (EXTENT extent, Lisp_Object glyph, int endp,
5040                   glyph_layout layout)
5041 {
5042   extent = extent_ancestor (extent);
5043
5044   if (!endp)
5045     {
5046       set_extent_begin_glyph (extent, glyph);
5047       extent_begin_glyph_layout (extent) = layout;
5048     }
5049   else
5050     {
5051       set_extent_end_glyph (extent, glyph);
5052       extent_end_glyph_layout (extent) = layout;
5053     }
5054
5055   extent_changed_for_redisplay (extent, 1, 0);
5056 }
5057
5058 static Lisp_Object
5059 glyph_layout_to_symbol (glyph_layout layout)
5060 {
5061   switch (layout)
5062     {
5063     case GL_TEXT:           return Qtext;
5064     case GL_OUTSIDE_MARGIN: return Qoutside_margin;
5065     case GL_INSIDE_MARGIN:  return Qinside_margin;
5066     case GL_WHITESPACE:     return Qwhitespace;
5067     default:
5068       ABORT ();
5069       return Qnil; /* unreached */
5070     }
5071 }
5072
5073 static glyph_layout
5074 symbol_to_glyph_layout (Lisp_Object layout_obj)
5075 {
5076   if (NILP (layout_obj))
5077     return GL_TEXT;
5078
5079   CHECK_SYMBOL (layout_obj);
5080   if (EQ (layout_obj, Qoutside_margin)) return GL_OUTSIDE_MARGIN;
5081   if (EQ (layout_obj, Qinside_margin))  return GL_INSIDE_MARGIN;
5082   if (EQ (layout_obj, Qwhitespace))     return GL_WHITESPACE;
5083   if (EQ (layout_obj, Qtext))           return GL_TEXT;
5084
5085   invalid_argument ("Unknown glyph layout type", layout_obj);
5086   return GL_TEXT; /* unreached */
5087 }
5088
5089 static Lisp_Object
5090 set_extent_glyph_1 (Lisp_Object extent_obj, Lisp_Object glyph, int endp,
5091                     Lisp_Object layout_obj)
5092 {
5093   EXTENT extent = decode_extent (extent_obj, 0);
5094   glyph_layout layout = symbol_to_glyph_layout (layout_obj);
5095
5096   /* Make sure we've actually been given a valid glyph or it's nil
5097      (meaning we're deleting a glyph from an extent). */
5098   if (!NILP (glyph))
5099     CHECK_BUFFER_GLYPH (glyph);
5100
5101   set_extent_glyph (extent, glyph, endp, layout);
5102   return glyph;
5103 }
5104
5105 DEFUN ("set-extent-begin-glyph", Fset_extent_begin_glyph, 2, 3, 0, /*
5106 Display a bitmap, subwindow or string at the beginning of EXTENT.
5107 BEGIN-GLYPH must be a glyph object.  The layout policy defaults to `text'.
5108 */
5109        (extent, begin_glyph, layout))
5110 {
5111   return set_extent_glyph_1 (extent, begin_glyph, 0, layout);
5112 }
5113
5114 DEFUN ("set-extent-end-glyph", Fset_extent_end_glyph, 2, 3, 0, /*
5115 Display a bitmap, subwindow or string at the end of EXTENT.
5116 END-GLYPH must be a glyph object.  The layout policy defaults to `text'.
5117 */
5118        (extent, end_glyph, layout))
5119 {
5120   return set_extent_glyph_1 (extent, end_glyph, 1, layout);
5121 }
5122
5123 DEFUN ("extent-begin-glyph", Fextent_begin_glyph, 1, 1, 0, /*
5124 Return the glyph object displayed at the beginning of EXTENT.
5125 If there is none, nil is returned.
5126 */
5127        (extent))
5128 {
5129   return extent_begin_glyph (decode_extent (extent, 0));
5130 }
5131
5132 DEFUN ("extent-end-glyph", Fextent_end_glyph, 1, 1, 0, /*
5133 Return the glyph object displayed at the end of EXTENT.
5134 If there is none, nil is returned.
5135 */
5136        (extent))
5137 {
5138   return extent_end_glyph (decode_extent (extent, 0));
5139 }
5140
5141 DEFUN ("set-extent-begin-glyph-layout", Fset_extent_begin_glyph_layout, 2, 2, 0, /*
5142 Set the layout policy of EXTENT's begin glyph.
5143 Access this using the `extent-begin-glyph-layout' function.
5144 */
5145        (extent, layout))
5146 {
5147   EXTENT e = decode_extent (extent, 0);
5148   e = extent_ancestor (e);
5149   extent_begin_glyph_layout (e) = symbol_to_glyph_layout (layout);
5150   extent_maybe_changed_for_redisplay (e, 1, 0);
5151   return layout;
5152 }
5153
5154 DEFUN ("set-extent-end-glyph-layout", Fset_extent_end_glyph_layout, 2, 2, 0, /*
5155 Set the layout policy of EXTENT's end glyph.
5156 Access this using the `extent-end-glyph-layout' function.
5157 */
5158        (extent, layout))
5159 {
5160   EXTENT e = decode_extent (extent, 0);
5161   e = extent_ancestor (e);
5162   extent_end_glyph_layout (e) = symbol_to_glyph_layout (layout);
5163   extent_maybe_changed_for_redisplay (e, 1, 0);
5164   return layout;
5165 }
5166
5167 DEFUN ("extent-begin-glyph-layout", Fextent_begin_glyph_layout, 1, 1, 0, /*
5168 Return the layout policy associated with EXTENT's begin glyph.
5169 Set this using the `set-extent-begin-glyph-layout' function.
5170 */
5171        (extent))
5172 {
5173   EXTENT e = decode_extent (extent, 0);
5174   return glyph_layout_to_symbol ((glyph_layout) extent_begin_glyph_layout (e));
5175 }
5176
5177 DEFUN ("extent-end-glyph-layout", Fextent_end_glyph_layout, 1, 1, 0, /*
5178 Return the layout policy associated with EXTENT's end glyph.
5179 Set this using the `set-extent-end-glyph-layout' function.
5180 */
5181        (extent))
5182 {
5183   EXTENT e = decode_extent (extent, 0);
5184   return glyph_layout_to_symbol ((glyph_layout) extent_end_glyph_layout (e));
5185 }
5186
5187 DEFUN ("set-extent-priority", Fset_extent_priority, 2, 2, 0, /*
5188 Set the display priority of EXTENT to PRIORITY (an integer).
5189 When the extent attributes are being merged for display, the priority
5190 is used to determine which extent takes precedence in the event of a
5191 conflict (two extents whose faces both specify font, for example: the
5192 font of the extent with the higher priority will be used).
5193 Extents are created with priority 0; priorities may be negative.
5194 */
5195        (extent, priority))
5196 {
5197   EXTENT e = decode_extent (extent, 0);
5198
5199   CHECK_INT (priority);
5200   e = extent_ancestor (e);
5201   set_extent_priority (e, XINT (priority));
5202   extent_maybe_changed_for_redisplay (e, 1, 0);
5203   return priority;
5204 }
5205
5206 DEFUN ("extent-priority", Fextent_priority, 1, 1, 0, /*
5207 Return the display priority of EXTENT; see `set-extent-priority'.
5208 */
5209        (extent))
5210 {
5211   EXTENT e = decode_extent (extent, 0);
5212   return make_int (extent_priority (e));
5213 }
5214
5215 DEFUN ("set-extent-property", Fset_extent_property, 3, 3, 0, /*
5216 Change a property of an extent.
5217 PROPERTY may be any symbol; the value stored may be accessed with
5218  the `extent-property' function.
5219 The following symbols have predefined meanings:
5220
5221  detached           Removes the extent from its buffer; setting this is
5222                     the same as calling `detach-extent'.
5223
5224  destroyed          Removes the extent from its buffer, and makes it
5225                     unusable in the future; this is the same calling
5226                     `delete-extent'.
5227
5228  priority           Change redisplay priority; same as `set-extent-priority'.
5229
5230  start-open         Whether the set of characters within the extent is
5231                     treated being open on the left, that is, whether
5232                     the start position is an exclusive, rather than
5233                     inclusive, boundary.  If true, then characters
5234                     inserted exactly at the beginning of the extent
5235                     will remain outside of the extent; otherwise they
5236                     will go into the extent, extending it.
5237
5238  end-open           Whether the set of characters within the extent is
5239                     treated being open on the right, that is, whether
5240                     the end position is an exclusive, rather than
5241                     inclusive, boundary.  If true, then characters
5242                     inserted exactly at the end of the extent will
5243                     remain outside of the extent; otherwise they will
5244                     go into the extent, extending it.
5245
5246                     By default, extents have the `end-open' but not the
5247                     `start-open' property set.
5248
5249  read-only          Text within this extent will be unmodifiable.
5250
5251  initial-redisplay-function (EXPERIMENTAL)
5252                     function to be called the first time (part of) the extent
5253                     is redisplayed. It will be called with the extent as its
5254                     first argument.
5255                     Note: The function will not be called immediately
5256                     during redisplay, an eval event will be dispatched.
5257
5258  detachable         Whether the extent gets detached (as with
5259                     `detach-extent') when all the text within the
5260                     extent is deleted.  This is true by default.  If
5261                     this property is not set, the extent becomes a
5262                     zero-length extent when its text is deleted. (In
5263                     such a case, the `start-open' property is
5264                     automatically removed if both the `start-open' and
5265                     `end-open' properties are set, since zero-length
5266                     extents open on both ends are not allowed.)
5267
5268  face               The face in which to display the text.  Setting
5269                     this is the same as calling `set-extent-face'.
5270
5271  mouse-face         If non-nil, the extent will be highlighted in this
5272                     face when the mouse moves over it.
5273
5274  pointer            If non-nil, and a valid pointer glyph, this specifies
5275                     the shape of the mouse pointer while over the extent.
5276
5277  highlight          Obsolete: Setting this property is equivalent to
5278                     setting a `mouse-face' property of `highlight'.
5279                     Reading this property returns non-nil if
5280                     the extent has a non-nil `mouse-face' property.
5281
5282  duplicable         Whether this extent should be copied into strings,
5283                     so that kill, yank, and undo commands will restore
5284                     or copy it.  `duplicable' extents are copied from
5285                     an extent into a string when `buffer-substring' or
5286                     a similar function creates a string.  The extents
5287                     in a string are copied into other strings created
5288                     from the string using `concat' or `substring'.
5289                     When `insert' or a similar function inserts the
5290                     string into a buffer, the extents are copied back
5291                     into the buffer.
5292
5293  unique             Meaningful only in conjunction with `duplicable'.
5294                     When this is set, there may be only one instance
5295                     of this extent attached at a time: if it is copied
5296                     to the kill ring and then yanked, the extent is
5297                     not copied.  If, however, it is killed (removed
5298                     from the buffer) and then yanked, it will be
5299                     re-attached at the new position.
5300
5301  invisible          If the value is non-nil, text under this extent
5302                     may be treated as not present for the purpose of
5303                     redisplay, or may be displayed using an ellipsis
5304                     or other marker; see `buffer-invisibility-spec'
5305                     and `invisible-text-glyph'.  In all cases,
5306                     however, the text is still visible to other
5307                     functions that examine a buffer's text.
5308
5309  keymap             This keymap is consulted for mouse clicks on this
5310                     extent, or keypresses made while point is within the
5311                     extent.
5312
5313  copy-function      This is a hook that is run when a duplicable extent
5314                     is about to be copied from a buffer to a string (or
5315                     the kill ring).  It is called with three arguments,
5316                     the extent, and the buffer-positions within it
5317                     which are being copied.  If this function returns
5318                     nil, then the extent will not be copied; otherwise
5319                     it will.
5320
5321  paste-function     This is a hook that is run when a duplicable extent is
5322                     about to be copied from a string (or the kill ring)
5323                     into a buffer.  It is called with three arguments,
5324                     the original extent, and the buffer positions which
5325                     the copied extent will occupy.  (This hook is run
5326                     after the corresponding text has already been
5327                     inserted into the buffer.)  Note that the extent
5328                     argument may be detached when this function is run.
5329                     If this function returns nil, no extent will be
5330                     inserted.  Otherwise, there will be an extent
5331                     covering the range in question.
5332
5333                     If the original extent is not attached to a buffer,
5334                     then it will be re-attached at this range.
5335                     Otherwise, a copy will be made, and that copy
5336                     attached here.
5337
5338                     The copy-function and paste-function are meaningful
5339                     only for extents with the `duplicable' flag set,
5340                     and if they are not specified, behave as if `t' was
5341                     the returned value.  When these hooks are invoked,
5342                     the current buffer is the buffer which the extent
5343                     is being copied from/to, respectively.
5344
5345  begin-glyph        A glyph to be displayed at the beginning of the extent,
5346                     or nil.
5347
5348  end-glyph          A glyph to be displayed at the end of the extent,
5349                     or nil.
5350
5351  begin-glyph-layout The layout policy (one of `text', `whitespace',
5352                     `inside-margin', or `outside-margin') of the extent's
5353                     begin glyph.
5354
5355  end-glyph-layout   The layout policy of the extent's end glyph.
5356
5357  syntax-table       A cons or a syntax table object.  If a cons, the car must
5358                     be an integer (interpreted as a syntax code, applicable to
5359                     all characters in the extent).  Otherwise, syntax of
5360                     characters in the extent is looked up in the syntax table.
5361                     You should use the text property API to manipulate this
5362                     property.  (This may be required in the future.)
5363 */
5364        (extent, property, value))
5365 {
5366   /* This function can GC if property is `keymap' */
5367   EXTENT e = decode_extent (extent, 0);
5368
5369   if (EQ (property, Qread_only))
5370     set_extent_read_only (e, value);
5371   else if (EQ (property, Qunique))
5372     extent_unique_p (e) = !NILP (value);
5373   else if (EQ (property, Qduplicable))
5374     extent_duplicable_p (e) = !NILP (value);
5375   else if (EQ (property, Qinvisible))
5376     set_extent_invisible (e, value);
5377   else if (EQ (property, Qdetachable))
5378     extent_detachable_p (e) = !NILP (value);
5379
5380   else if (EQ (property, Qdetached))
5381     {
5382       if (NILP (value))
5383         error ("can only set `detached' to t");
5384       Fdetach_extent (extent);
5385     }
5386   else if (EQ (property, Qdestroyed))
5387     {
5388       if (NILP (value))
5389         error ("can only set `destroyed' to t");
5390       Fdelete_extent (extent);
5391     }
5392   else if (EQ (property, Qpriority))
5393     Fset_extent_priority (extent, value);
5394   else if (EQ (property, Qface))
5395     Fset_extent_face (extent, value);
5396   else if (EQ (property, Qinitial_redisplay_function))
5397     Fset_extent_initial_redisplay_function (extent, value);
5398   else if (EQ (property, Qbefore_change_functions))
5399     set_extent_before_change_functions (e, value);
5400   else if (EQ (property, Qafter_change_functions))
5401     set_extent_after_change_functions (e, value);
5402   else if (EQ (property, Qmouse_face))
5403     Fset_extent_mouse_face (extent, value);
5404   /* Obsolete: */
5405   else if (EQ (property, Qhighlight))
5406     Fset_extent_mouse_face (extent, Qhighlight);
5407   else if (EQ (property, Qbegin_glyph_layout))
5408     Fset_extent_begin_glyph_layout (extent, value);
5409   else if (EQ (property, Qend_glyph_layout))
5410     Fset_extent_end_glyph_layout (extent, value);
5411   /* For backwards compatibility.  We use begin glyph because it is by
5412      far the more used of the two. */
5413   else if (EQ (property, Qglyph_layout))
5414     Fset_extent_begin_glyph_layout (extent, value);
5415   else if (EQ (property, Qbegin_glyph))
5416     Fset_extent_begin_glyph (extent, value, Qnil);
5417   else if (EQ (property, Qend_glyph))
5418     Fset_extent_end_glyph (extent, value, Qnil);
5419   else if (EQ (property, Qstart_open))
5420     set_extent_openness (e, !NILP (value), -1);
5421   else if (EQ (property, Qend_open))
5422     set_extent_openness (e, -1, !NILP (value));
5423   /* Support (but don't document...) the obvious *_closed antonyms. */
5424   else if (EQ (property, Qstart_closed))
5425     set_extent_openness (e, NILP (value), -1);
5426   else if (EQ (property, Qend_closed))
5427     set_extent_openness (e, -1, NILP (value));
5428   else
5429     {
5430       if (EQ (property, Qkeymap))
5431         while (!NILP (value) && NILP (Fkeymapp (value)))
5432           value = wrong_type_argument (Qkeymapp, value);
5433
5434       external_plist_put (extent_plist_addr (e), property, value, 0, ERROR_ME);
5435     }
5436
5437   return value;
5438 }
5439
5440 DEFUN ("set-extent-properties", Fset_extent_properties, 2, 2, 0, /*
5441 Change some properties of EXTENT.
5442 PLIST is a property list.
5443 For a list of built-in properties, see `set-extent-property'.
5444 */
5445        (extent, plist))
5446 {
5447   /* This function can GC, if one of the properties is `keymap' */
5448   Lisp_Object property, value;
5449   struct gcpro gcpro1;
5450   GCPRO1 (plist);
5451
5452   plist = Fcopy_sequence (plist);
5453   Fcanonicalize_plist (plist, Qnil);
5454
5455   while (!NILP (plist))
5456     {
5457       property = Fcar (plist); plist = Fcdr (plist);
5458       value    = Fcar (plist); plist = Fcdr (plist);
5459       Fset_extent_property (extent, property, value);
5460     }
5461   UNGCPRO;
5462   return Qnil;
5463 }
5464
5465 DEFUN ("extent-property", Fextent_property, 2, 3, 0, /*
5466 Return EXTENT's value for property PROPERTY.
5467 If no such property exists, DEFAULT is returned.
5468 See `set-extent-property' for the built-in property names.
5469 */
5470        (extent, property, default_))
5471 {
5472   EXTENT e = decode_extent (extent, 0);
5473
5474   if (EQ (property, Qdetached))
5475     return extent_detached_p (e) ? Qt : Qnil;
5476   else if (EQ (property, Qdestroyed))
5477     return !EXTENT_LIVE_P (e) ? Qt : Qnil;
5478   else if (EQ (property, Qstart_open))
5479     return extent_normal_field (e, start_open) ? Qt : Qnil;
5480   else if (EQ (property, Qend_open))
5481     return extent_normal_field (e, end_open) ? Qt : Qnil;
5482   else if (EQ (property, Qunique))
5483     return extent_normal_field (e, unique) ? Qt : Qnil;
5484   else if (EQ (property, Qduplicable))
5485     return extent_normal_field (e, duplicable) ? Qt : Qnil;
5486   else if (EQ (property, Qdetachable))
5487     return extent_normal_field (e, detachable) ? Qt : Qnil;
5488   /* Support (but don't document...) the obvious *_closed antonyms. */
5489   else if (EQ (property, Qstart_closed))
5490     return extent_start_open_p (e) ? Qnil : Qt;
5491   else if (EQ (property, Qend_closed))
5492     return extent_end_open_p (e) ? Qnil : Qt;
5493   else if (EQ (property, Qpriority))
5494     return make_int (extent_priority (e));
5495   else if (EQ (property, Qread_only))
5496     return extent_read_only (e);
5497   else if (EQ (property, Qinvisible))
5498     return extent_invisible (e);
5499   else if (EQ (property, Qface))
5500     return Fextent_face (extent);
5501   else if (EQ (property, Qinitial_redisplay_function))
5502     return extent_initial_redisplay_function (e);
5503   else if (EQ (property, Qbefore_change_functions))
5504     return extent_before_change_functions (e);
5505   else if (EQ (property, Qafter_change_functions))
5506     return extent_after_change_functions (e);
5507   else if (EQ (property, Qmouse_face))
5508     return Fextent_mouse_face (extent);
5509   /* Obsolete: */
5510   else if (EQ (property, Qhighlight))
5511     return !NILP (Fextent_mouse_face (extent)) ? Qt : Qnil;
5512   else if (EQ (property, Qbegin_glyph_layout))
5513     return Fextent_begin_glyph_layout (extent);
5514   else if (EQ (property, Qend_glyph_layout))
5515     return Fextent_end_glyph_layout (extent);
5516   /* For backwards compatibility.  We use begin glyph because it is by
5517      far the more used of the two. */
5518   else if (EQ (property, Qglyph_layout))
5519     return Fextent_begin_glyph_layout (extent);
5520   else if (EQ (property, Qbegin_glyph))
5521     return extent_begin_glyph (e);
5522   else if (EQ (property, Qend_glyph))
5523     return extent_end_glyph (e);
5524   else
5525     {
5526       Lisp_Object value = external_plist_get (extent_plist_addr (e),
5527                                               property, 0, ERROR_ME);
5528       return UNBOUNDP (value) ? default_ : value;
5529     }
5530 }
5531
5532 DEFUN ("extent-properties", Fextent_properties, 1, 1, 0, /*
5533 Return a property list of the attributes of EXTENT.
5534 Do not modify this list; use `set-extent-property' instead.
5535 */
5536        (extent))
5537 {
5538   EXTENT e, anc;
5539   Lisp_Object result, face, anc_obj;
5540   glyph_layout layout;
5541
5542   CHECK_EXTENT (extent);
5543   e = XEXTENT (extent);
5544   if (!EXTENT_LIVE_P (e))
5545     return cons3 (Qdestroyed, Qt, Qnil);
5546
5547   anc = extent_ancestor (e);
5548   XSETEXTENT (anc_obj, anc);
5549
5550   /* For efficiency, use the ancestor for all properties except detached */
5551
5552   result = extent_plist_slot (anc);
5553
5554   if (!NILP (face = Fextent_face (anc_obj)))
5555     result = cons3 (Qface, face, result);
5556
5557   if (!NILP (face = Fextent_mouse_face (anc_obj)))
5558     result = cons3 (Qmouse_face, face, result);
5559
5560   if ((layout = (glyph_layout) extent_begin_glyph_layout (anc)) != GL_TEXT)
5561     {
5562       Lisp_Object sym = glyph_layout_to_symbol (layout);
5563       result = cons3 (Qglyph_layout,       sym, result); /* compatibility */
5564       result = cons3 (Qbegin_glyph_layout, sym, result);
5565     }
5566
5567   if ((layout = (glyph_layout) extent_end_glyph_layout (anc)) != GL_TEXT)
5568     result = cons3 (Qend_glyph_layout, glyph_layout_to_symbol (layout), result);
5569
5570   if (!NILP (extent_end_glyph (anc)))
5571     result = cons3 (Qend_glyph, extent_end_glyph (anc), result);
5572
5573   if (!NILP (extent_begin_glyph (anc)))
5574     result = cons3 (Qbegin_glyph, extent_begin_glyph (anc), result);
5575
5576   if (extent_priority (anc) != 0)
5577     result = cons3 (Qpriority, make_int (extent_priority (anc)), result);
5578
5579   if (!NILP (extent_initial_redisplay_function (anc)))
5580     result = cons3 (Qinitial_redisplay_function,
5581                     extent_initial_redisplay_function (anc), result);
5582
5583   if (!NILP (extent_before_change_functions (anc)))
5584     result = cons3 (Qbefore_change_functions,
5585                     extent_before_change_functions (anc), result);
5586
5587   if (!NILP (extent_after_change_functions (anc)))
5588     result = cons3 (Qafter_change_functions,
5589                     extent_after_change_functions (anc), result);
5590
5591   if (!NILP (extent_invisible (anc)))
5592     result = cons3 (Qinvisible, extent_invisible (anc), result);
5593
5594   if (!NILP (extent_read_only (anc)))
5595     result = cons3 (Qread_only, extent_read_only (anc), result);
5596
5597   if  (extent_normal_field (anc, end_open))
5598     result = cons3 (Qend_open, Qt, result);
5599
5600   if  (extent_normal_field (anc, start_open))
5601     result = cons3 (Qstart_open, Qt, result);
5602
5603   if  (extent_normal_field (anc, detachable))
5604     result = cons3 (Qdetachable, Qt, result);
5605
5606   if  (extent_normal_field (anc, duplicable))
5607     result = cons3 (Qduplicable, Qt, result);
5608
5609   if  (extent_normal_field (anc, unique))
5610     result = cons3 (Qunique, Qt, result);
5611
5612   /* detached is not an inherited property */
5613   if (extent_detached_p (e))
5614     result = cons3 (Qdetached, Qt, result);
5615
5616   return result;
5617 }
5618
5619 \f
5620 /************************************************************************/
5621 /*                           highlighting                               */
5622 /************************************************************************/
5623
5624 /* The display code looks into the Vlast_highlighted_extent variable to
5625    correctly display highlighted extents.  This updates that variable,
5626    and marks the appropriate buffers as needing some redisplay.
5627  */
5628 static void
5629 do_highlight (Lisp_Object extent_obj, int highlight_p)
5630 {
5631   if (( highlight_p && (EQ (Vlast_highlighted_extent, extent_obj))) ||
5632       (!highlight_p && (EQ (Vlast_highlighted_extent, Qnil))))
5633     return;
5634   if (EXTENTP (Vlast_highlighted_extent) &&
5635       EXTENT_LIVE_P (XEXTENT (Vlast_highlighted_extent)))
5636     {
5637       /* do not recurse on descendants.  Only one extent is highlighted
5638          at a time. */
5639       extent_changed_for_redisplay (XEXTENT (Vlast_highlighted_extent), 0, 0);
5640     }
5641   Vlast_highlighted_extent = Qnil;
5642   if (!NILP (extent_obj)
5643       && BUFFERP (extent_object (XEXTENT (extent_obj)))
5644       && highlight_p)
5645     {
5646       extent_changed_for_redisplay (XEXTENT (extent_obj), 0, 0);
5647       Vlast_highlighted_extent = extent_obj;
5648     }
5649 }
5650
5651 DEFUN ("force-highlight-extent", Fforce_highlight_extent, 1, 2, 0, /*
5652 Highlight or unhighlight the given extent.
5653 If the second arg is non-nil, it will be highlighted, else dehighlighted.
5654 This is the same as `highlight-extent', except that it will work even
5655 on extents without the `mouse-face' property.
5656 */
5657        (extent, highlight_p))
5658 {
5659   if (NILP (extent))
5660     highlight_p = Qnil;
5661   else
5662     XSETEXTENT (extent, decode_extent (extent, DE_MUST_BE_ATTACHED));
5663   do_highlight (extent, !NILP (highlight_p));
5664   return Qnil;
5665 }
5666
5667 DEFUN ("highlight-extent", Fhighlight_extent, 1, 2, 0, /*
5668 Highlight EXTENT, if it is highlightable.
5669 \(that is, if it has the `mouse-face' property).
5670 If the second arg is non-nil, it will be highlighted, else dehighlighted.
5671 Highlighted extents are displayed as if they were merged with the face
5672 or faces specified by the `mouse-face' property.
5673 */
5674        (extent, highlight_p))
5675 {
5676   if (EXTENTP (extent) && NILP (extent_mouse_face (XEXTENT (extent))))
5677     return Qnil;
5678   else
5679     return Fforce_highlight_extent (extent, highlight_p);
5680 }
5681
5682 \f
5683 /************************************************************************/
5684 /*                         strings and extents                          */
5685 /************************************************************************/
5686
5687 /* copy/paste hooks */
5688
5689 static int
5690 run_extent_copy_paste_internal (EXTENT e, Bufpos from, Bufpos to,
5691                                 Lisp_Object object,
5692                                 Lisp_Object prop)
5693 {
5694   /* This function can GC */
5695   Lisp_Object extent;
5696   Lisp_Object copy_fn;
5697   XSETEXTENT (extent, e);
5698   copy_fn = Fextent_property (extent, prop, Qnil);
5699   if (!NILP (copy_fn))
5700     {
5701       Lisp_Object flag;
5702       struct gcpro gcpro1, gcpro2, gcpro3;
5703       GCPRO3 (extent, copy_fn, object);
5704       if (BUFFERP (object))
5705         flag = call3_in_buffer (XBUFFER (object), copy_fn, extent,
5706                                 make_int (from), make_int (to));
5707       else
5708         flag = call3 (copy_fn, extent, make_int (from), make_int (to));
5709       UNGCPRO;
5710       if (NILP (flag) || !EXTENT_LIVE_P (XEXTENT (extent)))
5711         return 0;
5712     }
5713   return 1;
5714 }
5715
5716 static int
5717 run_extent_copy_function (EXTENT e, Bytind from, Bytind to)
5718 {
5719   Lisp_Object object = extent_object (e);
5720   /* This function can GC */
5721   return run_extent_copy_paste_internal
5722     (e, buffer_or_string_bytind_to_bufpos (object, from),
5723      buffer_or_string_bytind_to_bufpos (object, to), object,
5724      Qcopy_function);
5725 }
5726
5727 static int
5728 run_extent_paste_function (EXTENT e, Bytind from, Bytind to,
5729                            Lisp_Object object)
5730 {
5731   /* This function can GC */
5732   return run_extent_copy_paste_internal
5733     (e, buffer_or_string_bytind_to_bufpos (object, from),
5734      buffer_or_string_bytind_to_bufpos (object, to), object,
5735      Qpaste_function);
5736 }
5737
5738 static void
5739 update_extent (EXTENT extent, Bytind from, Bytind to)
5740 {
5741   set_extent_endpoints (extent, from, to, Qnil);
5742 }
5743
5744 /* Insert an extent, usually from the dup_list of a string which
5745    has just been inserted.
5746    This code does not handle the case of undo.
5747    */
5748 static Lisp_Object
5749 insert_extent (EXTENT extent, Bytind new_start, Bytind new_end,
5750                Lisp_Object object, int run_hooks)
5751 {
5752   /* This function can GC */
5753   Lisp_Object tmp;
5754
5755   if (!EQ (extent_object (extent), object))
5756     goto copy_it;
5757
5758   if (extent_detached_p (extent))
5759     {
5760       if (run_hooks &&
5761           !run_extent_paste_function (extent, new_start, new_end, object))
5762         /* The paste-function said don't re-attach this extent here. */
5763         return Qnil;
5764       else
5765         update_extent (extent, new_start, new_end);
5766     }
5767   else
5768     {
5769       Bytind exstart = extent_endpoint_bytind (extent, 0);
5770       Bytind exend = extent_endpoint_bytind (extent, 1);
5771
5772       if (exend < new_start || exstart > new_end)
5773         goto copy_it;
5774       else
5775         {
5776           new_start = min (exstart, new_start);
5777           new_end = max (exend, new_end);
5778           if (exstart != new_start || exend != new_end)
5779             update_extent (extent, new_start, new_end);
5780         }
5781     }
5782
5783   XSETEXTENT (tmp, extent);
5784   return tmp;
5785
5786  copy_it:
5787   if (run_hooks &&
5788       !run_extent_paste_function (extent, new_start, new_end, object))
5789     /* The paste-function said don't attach a copy of the extent here. */
5790     return Qnil;
5791   else
5792     {
5793       XSETEXTENT (tmp, copy_extent (extent, new_start, new_end, object));
5794       return tmp;
5795     }
5796 }
5797
5798 DEFUN ("insert-extent", Finsert_extent, 1, 5, 0, /*
5799 Insert EXTENT from START to END in BUFFER-OR-STRING.
5800 BUFFER-OR-STRING defaults to the current buffer if omitted.
5801 This operation does not insert any characters,
5802 but otherwise acts as if there were a replicating extent whose
5803 parent is EXTENT in some string that was just inserted.
5804 Returns the newly-inserted extent.
5805 The fourth arg, NO-HOOKS, can be used to inhibit the running of the
5806  extent's `paste-function' property if it has one.
5807 See documentation on `detach-extent' for a discussion of undo recording.
5808 */
5809        (extent, start, end, no_hooks, buffer_or_string))
5810 {
5811   EXTENT ext = decode_extent (extent, 0);
5812   Lisp_Object copy;
5813   Bytind s, e;
5814
5815   buffer_or_string = decode_buffer_or_string (buffer_or_string);
5816   get_buffer_or_string_range_byte (buffer_or_string, start, end, &s, &e,
5817                                    GB_ALLOW_PAST_ACCESSIBLE);
5818
5819   copy = insert_extent (ext, s, e, buffer_or_string, NILP (no_hooks));
5820   if (EXTENTP (copy))
5821     {
5822       if (extent_duplicable_p (XEXTENT (copy)))
5823         record_extent (copy, 1);
5824     }
5825   return copy;
5826 }
5827
5828 \f
5829 /* adding buffer extents to a string */
5830
5831 struct add_string_extents_arg
5832 {
5833   Bytind from;
5834   Bytecount length;
5835   Lisp_Object string;
5836 };
5837
5838 static int
5839 add_string_extents_mapper (EXTENT extent, void *arg)
5840 {
5841   /* This function can GC */
5842   struct add_string_extents_arg *closure =
5843     (struct add_string_extents_arg *) arg;
5844   Bytecount start = extent_endpoint_bytind (extent, 0) - closure->from;
5845   Bytecount end   = extent_endpoint_bytind (extent, 1) - closure->from;
5846
5847   if (extent_duplicable_p (extent))
5848     {
5849       start = max (start, 0);
5850       end = min (end, closure->length);
5851
5852       /* Run the copy-function to give an extent the option of
5853          not being copied into the string (or kill ring).
5854          */
5855       if (extent_duplicable_p (extent) &&
5856           !run_extent_copy_function (extent, start + closure->from,
5857                                      end + closure->from))
5858         return 0;
5859       copy_extent (extent, start, end, closure->string);
5860     }
5861
5862   return 0;
5863 }
5864
5865 /* Add the extents in buffer BUF from OPOINT to OPOINT+LENGTH to
5866    the string STRING. */
5867 void
5868 add_string_extents (Lisp_Object string, struct buffer *buf, Bytind opoint,
5869                     Bytecount length)
5870 {
5871   /* This function can GC */
5872   struct add_string_extents_arg closure;
5873   struct gcpro gcpro1, gcpro2;
5874   Lisp_Object buffer;
5875
5876   closure.from = opoint;
5877   closure.length = length;
5878   closure.string = string;
5879   buffer = make_buffer (buf);
5880   GCPRO2 (buffer, string);
5881   map_extents_bytind (opoint, opoint + length, add_string_extents_mapper,
5882                       (void *) &closure, buffer, 0,
5883                       /* ignore extents that just abut the region */
5884                       ME_END_CLOSED | ME_ALL_EXTENTS_OPEN |
5885                       /* we are calling E-Lisp (the extent's copy function)
5886                          so anything might happen */
5887                       ME_MIGHT_CALL_ELISP);
5888   UNGCPRO;
5889 }
5890
5891 struct splice_in_string_extents_arg
5892 {
5893   Bytecount pos;
5894   Bytecount length;
5895   Bytind opoint;
5896   Lisp_Object buffer;
5897 };
5898
5899 static int
5900 splice_in_string_extents_mapper (EXTENT extent, void *arg)
5901 {
5902   /* This function can GC */
5903   struct splice_in_string_extents_arg *closure =
5904     (struct splice_in_string_extents_arg *) arg;
5905   /* BASE_START and BASE_END are the limits in the buffer of the string
5906      that was just inserted.
5907
5908      NEW_START and NEW_END are the prospective buffer positions of the
5909      extent that is going into the buffer. */
5910   Bytind base_start = closure->opoint;
5911   Bytind base_end = base_start + closure->length;
5912   Bytind new_start = (base_start + extent_endpoint_bytind (extent, 0) -
5913                       closure->pos);
5914   Bytind new_end = (base_start + extent_endpoint_bytind (extent, 1) -
5915                     closure->pos);
5916
5917   if (new_start < base_start)
5918     new_start = base_start;
5919   if (new_end > base_end)
5920     new_end = base_end;
5921   if (new_end <= new_start)
5922     return 0;
5923
5924   if (!extent_duplicable_p (extent))
5925     return 0;
5926
5927   if (!inside_undo &&
5928       !run_extent_paste_function (extent, new_start, new_end,
5929                                   closure->buffer))
5930     return 0;
5931   copy_extent (extent, new_start, new_end, closure->buffer);
5932
5933   return 0;
5934 }
5935
5936 /* We have just inserted a section of STRING (starting at POS, of
5937    length LENGTH) into buffer BUF at OPOINT.  Do whatever is necessary
5938    to get the string's extents into the buffer. */
5939
5940 void
5941 splice_in_string_extents (Lisp_Object string, struct buffer *buf,
5942                           Bytind opoint, Bytecount length, Bytecount pos)
5943 {
5944   struct splice_in_string_extents_arg closure;
5945   struct gcpro gcpro1, gcpro2;
5946   Lisp_Object buffer;
5947
5948   buffer = make_buffer (buf);
5949   closure.opoint = opoint;
5950   closure.pos = pos;
5951   closure.length = length;
5952   closure.buffer = buffer;
5953   GCPRO2 (buffer, string);
5954   map_extents_bytind (pos, pos + length,
5955                       splice_in_string_extents_mapper,
5956                       (void *) &closure, string, 0,
5957                       /* ignore extents that just abut the region */
5958                       ME_END_CLOSED | ME_ALL_EXTENTS_OPEN |
5959                       /* we are calling E-Lisp (the extent's copy function)
5960                          so anything might happen */
5961                       ME_MIGHT_CALL_ELISP);
5962   UNGCPRO;
5963 }
5964
5965 struct copy_string_extents_arg
5966 {
5967   Bytecount new_pos;
5968   Bytecount old_pos;
5969   Bytecount length;
5970   Lisp_Object new_string;
5971 };
5972
5973 struct copy_string_extents_1_arg
5974 {
5975   Lisp_Object parent_in_question;
5976   EXTENT found_extent;
5977 };
5978
5979 static int
5980 copy_string_extents_mapper (EXTENT extent, void *arg)
5981 {
5982   struct copy_string_extents_arg *closure =
5983     (struct copy_string_extents_arg *) arg;
5984   Bytecount old_start, old_end, new_start, new_end;
5985
5986   old_start = extent_endpoint_bytind (extent, 0);
5987   old_end   = extent_endpoint_bytind (extent, 1);
5988
5989   old_start = max (closure->old_pos, old_start);
5990   old_end   = min (closure->old_pos + closure->length, old_end);
5991
5992   if (old_start >= old_end)
5993     return 0;
5994
5995   new_start = old_start + closure->new_pos - closure->old_pos;
5996   new_end   = old_end   + closure->new_pos - closure->old_pos;
5997
5998   copy_extent (extent, new_start, new_end, closure->new_string);
5999   return 0;
6000 }
6001
6002 /* The string NEW_STRING was partially constructed from OLD_STRING.
6003    In particular, the section of length LEN starting at NEW_POS in
6004    NEW_STRING came from the section of the same length starting at
6005    OLD_POS in OLD_STRING.  Copy the extents as appropriate. */
6006
6007 void
6008 copy_string_extents (Lisp_Object new_string, Lisp_Object old_string,
6009                      Bytecount new_pos, Bytecount old_pos,
6010                      Bytecount length)
6011 {
6012   struct copy_string_extents_arg closure;
6013   struct gcpro gcpro1, gcpro2;
6014
6015   closure.new_pos = new_pos;
6016   closure.old_pos = old_pos;
6017   closure.new_string = new_string;
6018   closure.length = length;
6019   GCPRO2 (new_string, old_string);
6020   map_extents_bytind (old_pos, old_pos + length,
6021                       copy_string_extents_mapper,
6022                       (void *) &closure, old_string, 0,
6023                       /* ignore extents that just abut the region */
6024                       ME_END_CLOSED | ME_ALL_EXTENTS_OPEN |
6025                       /* we are calling E-Lisp (the extent's copy function)
6026                          so anything might happen */
6027                       ME_MIGHT_CALL_ELISP);
6028   UNGCPRO;
6029 }
6030
6031 /* Checklist for sanity checking:
6032    - {kill, yank, copy} at {open, closed} {start, end} of {writable, read-only} extent
6033    - {kill, copy} & yank {once, repeatedly} duplicable extent in {same, different} buffer
6034  */
6035
6036 \f
6037 /************************************************************************/
6038 /*                              text properties                         */
6039 /************************************************************************/
6040
6041 /* Text properties
6042    Originally this stuff was implemented in lisp (all of the functionality
6043    exists to make that possible) but speed was a problem.
6044  */
6045
6046 Lisp_Object Qtext_prop;
6047 Lisp_Object Qtext_prop_extent_paste_function;
6048
6049 static Lisp_Object
6050 get_text_property_bytind (Bytind position, Lisp_Object prop,
6051                           Lisp_Object object, enum extent_at_flag fl,
6052                           int text_props_only)
6053 {
6054   Lisp_Object extent;
6055
6056   /* text_props_only specifies whether we only consider text-property
6057      extents (those with the 'text-prop property set) or all extents. */
6058   if (!text_props_only)
6059     extent = extent_at_bytind (position, object, prop, 0, fl, 0);
6060   else
6061     {
6062       EXTENT prior = 0;
6063       while (1)
6064         {
6065           extent = extent_at_bytind (position, object, Qtext_prop, prior,
6066                                      fl, 0);
6067           if (NILP (extent))
6068             return Qnil;
6069           if (EQ (prop, Fextent_property (extent, Qtext_prop, Qnil)))
6070             break;
6071           prior = XEXTENT (extent);
6072         }
6073     }
6074
6075   if (!NILP (extent))
6076     return Fextent_property (extent, prop, Qnil);
6077   if (!NILP (Vdefault_text_properties))
6078     return Fplist_get (Vdefault_text_properties, prop, Qnil);
6079   return Qnil;
6080 }
6081
6082 static Lisp_Object
6083 get_text_property_1 (Lisp_Object pos, Lisp_Object prop, Lisp_Object object,
6084                      Lisp_Object at_flag, int text_props_only)
6085 {
6086   Bytind position;
6087   int invert = 0;
6088
6089   object = decode_buffer_or_string (object);
6090   position = get_buffer_or_string_pos_byte (object, pos, GB_NO_ERROR_IF_BAD);
6091
6092   /* We canonicalize the start/end-open/closed properties to the
6093      non-default version -- "adding" the default property really
6094      needs to remove the non-default one.  See below for more
6095      on this. */
6096   if (EQ (prop, Qstart_closed))
6097     {
6098       prop = Qstart_open;
6099       invert = 1;
6100     }
6101
6102   if (EQ (prop, Qend_open))
6103     {
6104       prop = Qend_closed;
6105       invert = 1;
6106     }
6107
6108   {
6109     Lisp_Object val =
6110       get_text_property_bytind (position, prop, object,
6111                                 decode_extent_at_flag (at_flag),
6112                                 text_props_only);
6113     if (invert)
6114       val = NILP (val) ? Qt : Qnil;
6115     return val;
6116   }
6117 }
6118
6119 DEFUN ("get-text-property", Fget_text_property, 2, 4, 0, /*
6120 Return the value of the PROP property at the given position.
6121 Optional arg OBJECT specifies the buffer or string to look in, and
6122  defaults to the current buffer.
6123 Optional arg AT-FLAG controls what it means for a property to be "at"
6124  a position, and has the same meaning as in `extent-at'.
6125 This examines only those properties added with `put-text-property'.
6126 See also `get-char-property'.
6127 */
6128        (pos, prop, object, at_flag))
6129 {
6130   return get_text_property_1 (pos, prop, object, at_flag, 1);
6131 }
6132
6133 DEFUN ("get-char-property", Fget_char_property, 2, 4, 0, /*
6134 Return the value of the PROP property at the given position.
6135 Optional arg OBJECT specifies the buffer or string to look in, and
6136  defaults to the current buffer.
6137 Optional arg AT-FLAG controls what it means for a property to be "at"
6138  a position, and has the same meaning as in `extent-at'.
6139 This examines properties on all extents.
6140 See also `get-text-property'.
6141 */
6142        (pos, prop, object, at_flag))
6143 {
6144   return get_text_property_1 (pos, prop, object, at_flag, 0);
6145 }
6146
6147 /* About start/end-open/closed:
6148
6149    These properties have to be handled specially because of their
6150    strange behavior.  If I put the "start-open" property on a region,
6151    then *all* text-property extents in the region have to have their
6152    start be open.  This is unlike all other properties, which don't
6153    affect the extents of text properties other than their own.
6154
6155    So:
6156
6157    1) We have to map start-closed to (not start-open) and end-open
6158       to (not end-closed) -- i.e. adding the default is really the
6159       same as remove the non-default property.  It won't work, for
6160       example, to have both "start-open" and "start-closed" on
6161       the same region.
6162    2) Whenever we add one of these properties, we go through all
6163       text-property extents in the region and set the appropriate
6164       open/closedness on them.
6165    3) Whenever we change a text-property extent for a property,
6166       we have to make sure we set the open/closedness properly.
6167
6168       (2) and (3) together rely on, and maintain, the invariant
6169       that the open/closedness of text-property extents is correct
6170       at the beginning and end of each operation.
6171    */
6172
6173 struct put_text_prop_arg
6174 {
6175   Lisp_Object prop, value;      /* The property and value we are storing */
6176   Bytind start, end;    /* The region into which we are storing it */
6177   Lisp_Object object;
6178   Lisp_Object the_extent;       /* Our chosen extent; this is used for
6179                                    communication between subsequent passes. */
6180   int changed_p;                /* Output: whether we have modified anything */
6181 };
6182
6183 static int
6184 put_text_prop_mapper (EXTENT e, void *arg)
6185 {
6186   struct put_text_prop_arg *closure = (struct put_text_prop_arg *) arg;
6187
6188   Lisp_Object object = closure->object;
6189   Lisp_Object value = closure->value;
6190   Bytind e_start, e_end;
6191   Bytind start = closure->start;
6192   Bytind end   = closure->end;
6193   Lisp_Object extent, e_val;
6194   int is_eq;
6195
6196   XSETEXTENT (extent, e);
6197
6198   /* Note: in some cases when the property itself is 'start-open
6199      or 'end-closed, the checks to set the openness may do a bit
6200      of extra work; but it won't hurt because we then fix up the
6201      openness later on in put_text_prop_openness_mapper(). */
6202   if (!EQ (Fextent_property (extent, Qtext_prop, Qnil), closure->prop))
6203     /* It's not for this property; do nothing. */
6204     return 0;
6205
6206   e_start = extent_endpoint_bytind (e, 0);
6207   e_end   = extent_endpoint_bytind (e, 1);
6208   e_val = Fextent_property (extent, closure->prop, Qnil);
6209   is_eq = EQ (value, e_val);
6210
6211   if (!NILP (value) && NILP (closure->the_extent) && is_eq)
6212     {
6213       /* We want there to be an extent here at the end, and we haven't picked
6214          one yet, so use this one.  Extend it as necessary.  We only reuse an
6215          extent which has an EQ value for the prop in question to avoid
6216          side-effecting the kill ring (that is, we never change the property
6217          on an extent after it has been created.)
6218        */
6219       if (e_start != start || e_end != end)
6220         {
6221           Bytind new_start = min (e_start, start);
6222           Bytind new_end = max (e_end, end);
6223           set_extent_endpoints (e, new_start, new_end, Qnil);
6224           /* If we changed the endpoint, then we need to set its
6225              openness. */
6226           set_extent_openness (e, new_start != e_start
6227                                ? !NILP (get_text_property_bytind
6228                                         (start, Qstart_open, object,
6229                                          EXTENT_AT_AFTER, 1)) : -1,
6230                                new_end != e_end
6231                                ? NILP (get_text_property_bytind
6232                                        (end - 1, Qend_closed, object,
6233                                         EXTENT_AT_AFTER, 1))
6234                                : -1);
6235           closure->changed_p = 1;
6236         }
6237       closure->the_extent = extent;
6238     }
6239
6240   /* Even if we're adding a prop, at this point, we want all other extents of
6241      this prop to go away (as now they overlap).  So the theory here is that,
6242      when we are adding a prop to a region that has multiple (disjoint)
6243      occurrences of that prop in it already, we pick one of those and extend
6244      it, and remove the others.
6245    */
6246
6247   else if (EQ (extent, closure->the_extent))
6248     {
6249       /* just in case map-extents hits it again (does that happen?) */
6250       ;
6251     }
6252   else if (e_start >= start && e_end <= end)
6253     {
6254       /* Extent is contained in region; remove it.  Don't destroy or modify
6255          it, because we don't want to change the attributes pointed to by the
6256          duplicates in the kill ring.
6257        */
6258       extent_detach (e);
6259       closure->changed_p = 1;
6260     }
6261   else if (!NILP (closure->the_extent) &&
6262            is_eq &&
6263            e_start <= end &&
6264            e_end >= start)
6265     {
6266       EXTENT te = XEXTENT (closure->the_extent);
6267       /* This extent overlaps, and has the same prop/value as the extent we've
6268          decided to reuse, so we can remove this existing extent as well (the
6269          whole thing, even the part outside of the region) and extend
6270          the-extent to cover it, resulting in the minimum number of extents in
6271          the buffer.
6272        */
6273       Bytind the_start = extent_endpoint_bytind (te, 0);
6274       Bytind the_end = extent_endpoint_bytind (te, 1);
6275       if (e_start != the_start &&  /* note AND not OR -- hmm, why is this
6276                                       the case? I think it's because the
6277                                       assumption that the text-property
6278                                       extents don't overlap makes it
6279                                       OK; changing it to an OR would
6280                                       result in changed_p sometimes getting
6281                                       falsely marked.  Is this bad? */
6282           e_end   != the_end)
6283         {
6284           Bytind new_start = min (e_start, the_start);
6285           Bytind new_end = max (e_end, the_end);
6286           set_extent_endpoints (te, new_start, new_end, Qnil);
6287           /* If we changed the endpoint, then we need to set its
6288              openness.  We are setting the endpoint to be the same as
6289              that of the extent we're about to remove, and we assume
6290              (the invariant mentioned above) that extent has the
6291              proper endpoint setting, so we just use it. */
6292           set_extent_openness (te, new_start != e_start ?
6293                                (int) extent_start_open_p (e) : -1,
6294                                new_end != e_end ?
6295                                (int) extent_end_open_p (e) : -1);
6296           closure->changed_p = 1;
6297         }
6298       extent_detach (e);
6299     }
6300   else if (e_end <= end)
6301     {
6302       /* Extent begins before start but ends before end, so we can just
6303          decrease its end position.
6304        */
6305       if (e_end != start)
6306         {
6307           set_extent_endpoints (e, e_start, start, Qnil);
6308           set_extent_openness (e, -1, NILP (get_text_property_bytind
6309                                        (start - 1, Qend_closed, object,
6310                                         EXTENT_AT_AFTER, 1)));
6311           closure->changed_p = 1;
6312         }
6313     }
6314   else if (e_start >= start)
6315     {
6316       /* Extent ends after end but begins after start, so we can just
6317          increase its start position.
6318        */
6319       if (e_start != end)
6320         {
6321           set_extent_endpoints (e, end, e_end, Qnil);
6322           set_extent_openness (e, !NILP (get_text_property_bytind
6323                                         (end, Qstart_open, object,
6324                                          EXTENT_AT_AFTER, 1)), -1);
6325           closure->changed_p = 1;
6326         }
6327     }
6328   else
6329     {
6330       /* Otherwise, `extent' straddles the region.  We need to split it.
6331        */
6332       set_extent_endpoints (e, e_start, start, Qnil);
6333       set_extent_openness (e, -1, NILP (get_text_property_bytind
6334                                         (start - 1, Qend_closed, object,
6335                                          EXTENT_AT_AFTER, 1)));
6336       set_extent_openness (copy_extent (e, end, e_end, extent_object (e)),
6337                            !NILP (get_text_property_bytind
6338                                   (end, Qstart_open, object,
6339                                    EXTENT_AT_AFTER, 1)), -1);
6340       closure->changed_p = 1;
6341     }
6342
6343   return 0;  /* to continue mapping. */
6344 }
6345
6346 static int
6347 put_text_prop_openness_mapper (EXTENT e, void *arg)
6348 {
6349   struct put_text_prop_arg *closure = (struct put_text_prop_arg *) arg;
6350   Bytind e_start, e_end;
6351   Bytind start = closure->start;
6352   Bytind end   = closure->end;
6353   Lisp_Object extent;
6354   XSETEXTENT (extent, e);
6355   e_start = extent_endpoint_bytind (e, 0);
6356   e_end   = extent_endpoint_bytind (e, 1);
6357
6358   if (NILP (Fextent_property (extent, Qtext_prop, Qnil)))
6359     {
6360       /* It's not a text-property extent; do nothing. */
6361       ;
6362     }
6363   /* Note end conditions and NILP/!NILP's carefully. */
6364   else if (EQ (closure->prop, Qstart_open)
6365            && e_start >= start && e_start < end)
6366     set_extent_openness (e, !NILP (closure->value), -1);
6367   else if (EQ (closure->prop, Qend_closed)
6368            && e_end > start && e_end <= end)
6369     set_extent_openness (e, -1, NILP (closure->value));
6370
6371   return 0;  /* to continue mapping. */
6372 }
6373
6374 static int
6375 put_text_prop (Bytind start, Bytind end, Lisp_Object object,
6376                Lisp_Object prop, Lisp_Object value,
6377                int duplicable_p)
6378 {
6379   /* This function can GC */
6380   struct put_text_prop_arg closure;
6381
6382   if (start == end)   /* There are no characters in the region. */
6383     return 0;
6384
6385   /* convert to the non-default versions, since a nil property is
6386      the same as it not being present. */
6387   if (EQ (prop, Qstart_closed))
6388     {
6389       prop = Qstart_open;
6390       value = NILP (value) ? Qt : Qnil;
6391     }
6392   else if (EQ (prop, Qend_open))
6393     {
6394       prop = Qend_closed;
6395       value = NILP (value) ? Qt : Qnil;
6396     }
6397
6398   value = canonicalize_extent_property (prop, value);
6399
6400   closure.prop = prop;
6401   closure.value = value;
6402   closure.start = start;
6403   closure.end = end;
6404   closure.object = object;
6405   closure.changed_p = 0;
6406   closure.the_extent = Qnil;
6407
6408   map_extents_bytind (start, end,
6409                       put_text_prop_mapper,
6410                       (void *) &closure, object, 0,
6411                       /* get all extents that abut the region */
6412                       ME_ALL_EXTENTS_CLOSED | ME_END_CLOSED |
6413                       /* it might QUIT or error if the user has
6414                          fucked with the extent plist. */
6415                       /* #### dmoore - I think this should include
6416                          ME_MIGHT_MOVE_SOE, since the callback function
6417                          might recurse back into map_extents_bytind. */
6418                       ME_MIGHT_THROW |
6419                       ME_MIGHT_MODIFY_EXTENTS);
6420
6421   /* If we made it through the loop without reusing an extent
6422      (and we want there to be one) make it now.
6423    */
6424   if (!NILP (value) && NILP (closure.the_extent))
6425     {
6426       Lisp_Object extent;
6427
6428       XSETEXTENT (extent, make_extent_internal (object, start, end));
6429       closure.changed_p = 1;
6430       Fset_extent_property (extent, Qtext_prop, prop);
6431       Fset_extent_property (extent, prop, value);
6432       if (duplicable_p)
6433         {
6434           extent_duplicable_p (XEXTENT (extent)) = 1;
6435           Fset_extent_property (extent, Qpaste_function,
6436                                 Qtext_prop_extent_paste_function);
6437         }
6438       set_extent_openness (XEXTENT (extent),
6439                            !NILP (get_text_property_bytind
6440                                   (start, Qstart_open, object,
6441                                    EXTENT_AT_AFTER, 1)),
6442                            NILP (get_text_property_bytind
6443                                  (end - 1, Qend_closed, object,
6444                                   EXTENT_AT_AFTER, 1)));
6445     }
6446
6447   if (EQ (prop, Qstart_open) || EQ (prop, Qend_closed))
6448     {
6449       map_extents_bytind (start, end,
6450                           put_text_prop_openness_mapper,
6451                           (void *) &closure, object, 0,
6452                           /* get all extents that abut the region */
6453                           ME_ALL_EXTENTS_CLOSED | ME_END_CLOSED |
6454                           ME_MIGHT_MODIFY_EXTENTS);
6455     }
6456
6457   return closure.changed_p;
6458 }
6459
6460 DEFUN ("put-text-property", Fput_text_property, 4, 5, 0, /*
6461 Adds the given property/value to all characters in the specified region.
6462 The property is conceptually attached to the characters rather than the
6463 region.  The properties are copied when the characters are copied/pasted.
6464 Fifth argument OBJECT is the buffer or string containing the text, and
6465 defaults to the current buffer.
6466 */
6467        (start, end, prop, value, object))
6468 {
6469   /* This function can GC */
6470   Bytind s, e;
6471
6472   object = decode_buffer_or_string (object);
6473   get_buffer_or_string_range_byte (object, start, end, &s, &e, 0);
6474   put_text_prop (s, e, object, prop, value, 1);
6475   return prop;
6476 }
6477
6478 DEFUN ("put-nonduplicable-text-property", Fput_nonduplicable_text_property,
6479        4, 5, 0, /*
6480 Adds the given property/value to all characters in the specified region.
6481 The property is conceptually attached to the characters rather than the
6482 region, however the properties will not be copied when the characters
6483 are copied.
6484 Fifth argument OBJECT is the buffer or string containing the text, and
6485 defaults to the current buffer.
6486 */
6487        (start, end, prop, value, object))
6488 {
6489   /* This function can GC */
6490   Bytind s, e;
6491
6492   object = decode_buffer_or_string (object);
6493   get_buffer_or_string_range_byte (object, start, end, &s, &e, 0);
6494   put_text_prop (s, e, object, prop, value, 0);
6495   return prop;
6496 }
6497
6498 DEFUN ("add-text-properties", Fadd_text_properties, 3, 4, 0, /*
6499 Add properties to the characters from START to END.
6500 The third argument PROPS is a property list specifying the property values
6501 to add.  The optional fourth argument, OBJECT, is the buffer or string
6502 containing the text and defaults to the current buffer.  Returns t if
6503 any property was changed, nil otherwise.
6504 */
6505        (start, end, props, object))
6506 {
6507   /* This function can GC */
6508   int changed = 0;
6509   Bytind s, e;
6510
6511   object = decode_buffer_or_string (object);
6512   get_buffer_or_string_range_byte (object, start, end, &s, &e, 0);
6513   CHECK_LIST (props);
6514   for (; !NILP (props); props = Fcdr (Fcdr (props)))
6515     {
6516       Lisp_Object prop = XCAR (props);
6517       Lisp_Object value = Fcar (XCDR (props));
6518       changed |= put_text_prop (s, e, object, prop, value, 1);
6519     }
6520   return changed ? Qt : Qnil;
6521 }
6522
6523
6524 DEFUN ("add-nonduplicable-text-properties", Fadd_nonduplicable_text_properties,
6525        3, 4, 0, /*
6526 Add nonduplicable properties to the characters from START to END.
6527 \(The properties will not be copied when the characters are copied.)
6528 The third argument PROPS is a property list specifying the property values
6529 to add.  The optional fourth argument, OBJECT, is the buffer or string
6530 containing the text and defaults to the current buffer.  Returns t if
6531 any property was changed, nil otherwise.
6532 */
6533        (start, end, props, object))
6534 {
6535   /* This function can GC */
6536   int changed = 0;
6537   Bytind s, e;
6538
6539   object = decode_buffer_or_string (object);
6540   get_buffer_or_string_range_byte (object, start, end, &s, &e, 0);
6541   CHECK_LIST (props);
6542   for (; !NILP (props); props = Fcdr (Fcdr (props)))
6543     {
6544       Lisp_Object prop = XCAR (props);
6545       Lisp_Object value = Fcar (XCDR (props));
6546       changed |= put_text_prop (s, e, object, prop, value, 0);
6547     }
6548   return changed ? Qt : Qnil;
6549 }
6550
6551 DEFUN ("remove-text-properties", Fremove_text_properties, 3, 4, 0, /*
6552 Remove the given properties from all characters in the specified region.
6553 PROPS should be a plist, but the values in that plist are ignored (treated
6554 as nil).  Returns t if any property was changed, nil otherwise.
6555 Fourth argument OBJECT is the buffer or string containing the text, and
6556 defaults to the current buffer.
6557 */
6558        (start, end, props, object))
6559 {
6560   /* This function can GC */
6561   int changed = 0;
6562   Bytind s, e;
6563
6564   object = decode_buffer_or_string (object);
6565   get_buffer_or_string_range_byte (object, start, end, &s, &e, 0);
6566   CHECK_LIST (props);
6567   for (; !NILP (props); props = Fcdr (Fcdr (props)))
6568     {
6569       Lisp_Object prop = XCAR (props);
6570       changed |= put_text_prop (s, e, object, prop, Qnil, 1);
6571     }
6572   return changed ? Qt : Qnil;
6573 }
6574
6575 /* Whenever a text-prop extent is pasted into a buffer (via `yank' or `insert'
6576    or whatever) we attach the properties to the buffer by calling
6577    `put-text-property' instead of by simply allowing the extent to be copied or
6578    re-attached.  Then we return nil, telling the extents code not to attach it
6579    again.  By handing the insertion hackery in this way, we make kill/yank
6580    behave consistently with put-text-property and not fragment the extents
6581    (since text-prop extents must partition, not overlap).
6582
6583    The lisp implementation of this was probably fast enough, but since I moved
6584    the rest of the put-text-prop code here, I moved this as well for
6585    completeness.
6586  */
6587 DEFUN ("text-prop-extent-paste-function", Ftext_prop_extent_paste_function,
6588        3, 3, 0, /*
6589 Used as the `paste-function' property of `text-prop' extents.
6590 */
6591        (extent, from, to))
6592 {
6593   /* This function can GC */
6594   Lisp_Object prop, val;
6595
6596   prop = Fextent_property (extent, Qtext_prop, Qnil);
6597   if (NILP (prop))
6598     signal_type_error (Qinternal_error,
6599                        "Internal error: no text-prop", extent);
6600   val = Fextent_property (extent, prop, Qnil);
6601 #if 0
6602   /* removed by bill perry, 2/9/97
6603   ** This little bit of code would not allow you to have a text property
6604   ** with a value of Qnil.  This is bad bad bad.
6605   */
6606   if (NILP (val))
6607     signal_type_error_2 (Qinternal_error,
6608                          "Internal error: no text-prop",
6609                          extent, prop);
6610 #endif
6611   Fput_text_property (from, to, prop, val, Qnil);
6612   return Qnil; /* important! */
6613 }
6614
6615 /* This function could easily be written in Lisp but the C code wants
6616    to use it in connection with invisible extents (at least currently).
6617    If this changes, consider moving this back into Lisp. */
6618
6619 DEFUN ("next-single-property-change", Fnext_single_property_change,
6620        2, 4, 0, /*
6621 Return the position of next property change for a specific property.
6622 Scans characters forward from POS till it finds a change in the PROP
6623  property, then returns the position of the change.  The optional third
6624  argument OBJECT is the buffer or string to scan (defaults to the current
6625  buffer).
6626 The property values are compared with `eq'.
6627 Return nil if the property is constant all the way to the end of OBJECT.
6628 If the value is non-nil, it is a position greater than POS, never equal.
6629
6630 If the optional fourth argument LIMIT is non-nil, don't search
6631  past position LIMIT; return LIMIT if nothing is found before LIMIT.
6632 If two or more extents with conflicting non-nil values for PROP overlap
6633  a particular character, it is undefined which value is considered to be
6634  the value of PROP. (Note that this situation will not happen if you always
6635  use the text-property primitives.)
6636 */
6637        (pos, prop, object, limit))
6638 {
6639   Bufpos bpos;
6640   Bufpos blim;
6641   Lisp_Object extent, value;
6642   int limit_was_nil;
6643
6644   object = decode_buffer_or_string (object);
6645   bpos = get_buffer_or_string_pos_char (object, pos, 0);
6646   if (NILP (limit))
6647     {
6648       blim = buffer_or_string_accessible_end_char (object);
6649       limit_was_nil = 1;
6650     }
6651   else
6652     {
6653       blim = get_buffer_or_string_pos_char (object, limit, 0);
6654       limit_was_nil = 0;
6655     }
6656
6657   extent = Fextent_at (make_int (bpos), object, prop, Qnil, Qnil);
6658   if (!NILP (extent))
6659     value = Fextent_property (extent, prop, Qnil);
6660   else
6661     value = Qnil;
6662
6663   while (1)
6664     {
6665       bpos = XINT (Fnext_extent_change (make_int (bpos), object));
6666       if (bpos >= blim)
6667         break; /* property is the same all the way to the end */
6668       extent = Fextent_at (make_int (bpos), object, prop, Qnil, Qnil);
6669       if ((NILP (extent) && !NILP (value)) ||
6670           (!NILP (extent) && !EQ (value,
6671                                   Fextent_property (extent, prop, Qnil))))
6672         return make_int (bpos);
6673     }
6674
6675   /* I think it's more sensible for this function to return nil always
6676      in this situation and it used to do it this way, but it's been changed
6677      for FSF compatibility. */
6678   if (limit_was_nil)
6679     return Qnil;
6680   else
6681     return make_int (blim);
6682 }
6683
6684 /* See comment on previous function about why this is written in C. */
6685
6686 DEFUN ("previous-single-property-change", Fprevious_single_property_change,
6687        2, 4, 0, /*
6688 Return the position of next property change for a specific property.
6689 Scans characters backward from POS till it finds a change in the PROP
6690  property, then returns the position of the change.  The optional third
6691  argument OBJECT is the buffer or string to scan (defaults to the current
6692  buffer).
6693 The property values are compared with `eq'.
6694 Return nil if the property is constant all the way to the start of OBJECT.
6695 If the value is non-nil, it is a position less than POS, never equal.
6696
6697 If the optional fourth argument LIMIT is non-nil, don't search back
6698  past position LIMIT; return LIMIT if nothing is found until LIMIT.
6699 If two or more extents with conflicting non-nil values for PROP overlap
6700  a particular character, it is undefined which value is considered to be
6701  the value of PROP. (Note that this situation will not happen if you always
6702  use the text-property primitives.)
6703 */
6704        (pos, prop, object, limit))
6705 {
6706   Bufpos bpos;
6707   Bufpos blim;
6708   Lisp_Object extent, value;
6709   int limit_was_nil;
6710
6711   object = decode_buffer_or_string (object);
6712   bpos = get_buffer_or_string_pos_char (object, pos, 0);
6713   if (NILP (limit))
6714     {
6715       blim = buffer_or_string_accessible_begin_char (object);
6716       limit_was_nil = 1;
6717     }
6718   else
6719     {
6720       blim = get_buffer_or_string_pos_char (object, limit, 0);
6721       limit_was_nil = 0;
6722     }
6723
6724   /* extent-at refers to the character AFTER bpos, but we want the
6725      character before bpos.  Thus the - 1.  extent-at simply
6726      returns nil on bogus positions, so not to worry. */
6727   extent = Fextent_at (make_int (bpos - 1), object, prop, Qnil, Qnil);
6728   if (!NILP (extent))
6729     value = Fextent_property (extent, prop, Qnil);
6730   else
6731     value = Qnil;
6732
6733   while (1)
6734     {
6735       bpos = XINT (Fprevious_extent_change (make_int (bpos), object));
6736       if (bpos <= blim)
6737         break; /* property is the same all the way to the beginning */
6738       extent = Fextent_at (make_int (bpos - 1), object, prop, Qnil, Qnil);
6739       if ((NILP (extent) && !NILP (value)) ||
6740           (!NILP (extent) && !EQ (value,
6741                                   Fextent_property (extent, prop, Qnil))))
6742         return make_int (bpos);
6743     }
6744
6745   /* I think it's more sensible for this function to return nil always
6746      in this situation and it used to do it this way, but it's been changed
6747      for FSF compatibility. */
6748   if (limit_was_nil)
6749     return Qnil;
6750   else
6751     return make_int (blim);
6752 }
6753
6754 #ifdef MEMORY_USAGE_STATS
6755
6756 int
6757 compute_buffer_extent_usage (struct buffer *b, struct overhead_stats *ovstats)
6758 {
6759   /* #### not yet written */
6760   return 0;
6761 }
6762
6763 #endif /* MEMORY_USAGE_STATS */
6764
6765 \f
6766 /************************************************************************/
6767 /*                              initialization                          */
6768 /************************************************************************/
6769
6770 void
6771 syms_of_extents (void)
6772 {
6773   INIT_LRECORD_IMPLEMENTATION (extent);
6774   INIT_LRECORD_IMPLEMENTATION (extent_info);
6775   INIT_LRECORD_IMPLEMENTATION (extent_auxiliary);
6776
6777   defsymbol (&Qextentp, "extentp");
6778   defsymbol (&Qextent_live_p, "extent-live-p");
6779
6780   defsymbol (&Qall_extents_closed, "all-extents-closed");
6781   defsymbol (&Qall_extents_open, "all-extents-open");
6782   defsymbol (&Qall_extents_closed_open, "all-extents-closed-open");
6783   defsymbol (&Qall_extents_open_closed, "all-extents-open-closed");
6784   defsymbol (&Qstart_in_region, "start-in-region");
6785   defsymbol (&Qend_in_region, "end-in-region");
6786   defsymbol (&Qstart_and_end_in_region, "start-and-end-in-region");
6787   defsymbol (&Qstart_or_end_in_region, "start-or-end-in-region");
6788   defsymbol (&Qnegate_in_region, "negate-in-region");
6789
6790   defsymbol (&Qdetached, "detached");
6791   defsymbol (&Qdestroyed, "destroyed");
6792   defsymbol (&Qbegin_glyph, "begin-glyph");
6793   defsymbol (&Qend_glyph, "end-glyph");
6794   defsymbol (&Qstart_open, "start-open");
6795   defsymbol (&Qend_open, "end-open");
6796   defsymbol (&Qstart_closed, "start-closed");
6797   defsymbol (&Qend_closed, "end-closed");
6798   defsymbol (&Qread_only, "read-only");
6799   /* defsymbol (&Qhighlight, "highlight"); in faces.c */
6800   defsymbol (&Qunique, "unique");
6801   defsymbol (&Qduplicable, "duplicable");
6802   defsymbol (&Qdetachable, "detachable");
6803   defsymbol (&Qpriority, "priority");
6804   defsymbol (&Qmouse_face, "mouse-face");
6805   defsymbol (&Qinitial_redisplay_function,"initial-redisplay-function");
6806
6807
6808   defsymbol (&Qglyph_layout, "glyph-layout");   /* backwards compatibility */
6809   defsymbol (&Qbegin_glyph_layout, "begin-glyph-layout");
6810   defsymbol (&Qend_glyph_layout, "end-glyph-layout");
6811   defsymbol (&Qoutside_margin, "outside-margin");
6812   defsymbol (&Qinside_margin, "inside-margin");
6813   defsymbol (&Qwhitespace, "whitespace");
6814   /* Qtext defined in general.c */
6815
6816   defsymbol (&Qpaste_function, "paste-function");
6817   defsymbol (&Qcopy_function,  "copy-function");
6818
6819   defsymbol (&Qtext_prop, "text-prop");
6820   defsymbol (&Qtext_prop_extent_paste_function,
6821              "text-prop-extent-paste-function");
6822
6823   DEFSUBR (Fextentp);
6824   DEFSUBR (Fextent_live_p);
6825   DEFSUBR (Fextent_detached_p);
6826   DEFSUBR (Fextent_start_position);
6827   DEFSUBR (Fextent_end_position);
6828   DEFSUBR (Fextent_object);
6829   DEFSUBR (Fextent_length);
6830
6831   DEFSUBR (Fmake_extent);
6832   DEFSUBR (Fcopy_extent);
6833   DEFSUBR (Fdelete_extent);
6834   DEFSUBR (Fdetach_extent);
6835   DEFSUBR (Fset_extent_endpoints);
6836   DEFSUBR (Fnext_extent);
6837   DEFSUBR (Fprevious_extent);
6838 #if DEBUG_XEMACS
6839   DEFSUBR (Fnext_e_extent);
6840   DEFSUBR (Fprevious_e_extent);
6841 #endif
6842   DEFSUBR (Fnext_extent_change);
6843   DEFSUBR (Fprevious_extent_change);
6844
6845   DEFSUBR (Fextent_parent);
6846   DEFSUBR (Fextent_children);
6847   DEFSUBR (Fset_extent_parent);
6848
6849   DEFSUBR (Fextent_in_region_p);
6850   DEFSUBR (Fmap_extents);
6851   DEFSUBR (Fmap_extent_children);
6852   DEFSUBR (Fextent_at);
6853   DEFSUBR (Fextents_at);
6854
6855   DEFSUBR (Fset_extent_initial_redisplay_function);
6856   DEFSUBR (Fextent_face);
6857   DEFSUBR (Fset_extent_face);
6858   DEFSUBR (Fextent_mouse_face);
6859   DEFSUBR (Fset_extent_mouse_face);
6860   DEFSUBR (Fset_extent_begin_glyph);
6861   DEFSUBR (Fset_extent_end_glyph);
6862   DEFSUBR (Fextent_begin_glyph);
6863   DEFSUBR (Fextent_end_glyph);
6864   DEFSUBR (Fset_extent_begin_glyph_layout);
6865   DEFSUBR (Fset_extent_end_glyph_layout);
6866   DEFSUBR (Fextent_begin_glyph_layout);
6867   DEFSUBR (Fextent_end_glyph_layout);
6868   DEFSUBR (Fset_extent_priority);
6869   DEFSUBR (Fextent_priority);
6870   DEFSUBR (Fset_extent_property);
6871   DEFSUBR (Fset_extent_properties);
6872   DEFSUBR (Fextent_property);
6873   DEFSUBR (Fextent_properties);
6874
6875   DEFSUBR (Fhighlight_extent);
6876   DEFSUBR (Fforce_highlight_extent);
6877
6878   DEFSUBR (Finsert_extent);
6879
6880   DEFSUBR (Fget_text_property);
6881   DEFSUBR (Fget_char_property);
6882   DEFSUBR (Fput_text_property);
6883   DEFSUBR (Fput_nonduplicable_text_property);
6884   DEFSUBR (Fadd_text_properties);
6885   DEFSUBR (Fadd_nonduplicable_text_properties);
6886   DEFSUBR (Fremove_text_properties);
6887   DEFSUBR (Ftext_prop_extent_paste_function);
6888   DEFSUBR (Fnext_single_property_change);
6889   DEFSUBR (Fprevious_single_property_change);
6890 }
6891
6892 void
6893 reinit_vars_of_extents (void)
6894 {
6895   extent_auxiliary_defaults.begin_glyph = Qnil;
6896   extent_auxiliary_defaults.end_glyph = Qnil;
6897   extent_auxiliary_defaults.parent = Qnil;
6898   extent_auxiliary_defaults.children = Qnil;
6899   extent_auxiliary_defaults.priority = 0;
6900   extent_auxiliary_defaults.invisible = Qnil;
6901   extent_auxiliary_defaults.read_only = Qnil;
6902   extent_auxiliary_defaults.mouse_face = Qnil;
6903   extent_auxiliary_defaults.initial_redisplay_function = Qnil;
6904   extent_auxiliary_defaults.before_change_functions = Qnil;
6905   extent_auxiliary_defaults.after_change_functions = Qnil;
6906 }
6907
6908 void
6909 vars_of_extents (void)
6910 {
6911   reinit_vars_of_extents ();
6912
6913   DEFVAR_INT ("mouse-highlight-priority", &mouse_highlight_priority /*
6914 The priority to use for the mouse-highlighting pseudo-extent
6915 that is used to highlight extents with the `mouse-face' attribute set.
6916 See `set-extent-priority'.
6917 */ );
6918   /* Set mouse-highlight-priority (which ends up being used both for the
6919      mouse-highlighting pseudo-extent and the primary selection extent)
6920      to a very high value because very few extents should override it.
6921      1000 gives lots of room below it for different-prioritized extents.
6922      10 doesn't. ediff, for example, likes to use priorities around 100.
6923      --ben */
6924   mouse_highlight_priority = /* 10 */ 1000;
6925
6926   DEFVAR_LISP ("default-text-properties", &Vdefault_text_properties /*
6927 Property list giving default values for text properties.
6928 Whenever a character does not specify a value for a property, the value
6929 stored in this list is used instead.  This only applies when the
6930 functions `get-text-property' or `get-char-property' are called.
6931 */ );
6932   Vdefault_text_properties = Qnil;
6933
6934   staticpro (&Vlast_highlighted_extent);
6935   Vlast_highlighted_extent = Qnil;
6936
6937   Vextent_face_reusable_list = Fcons (Qnil, Qnil);
6938   staticpro (&Vextent_face_reusable_list);
6939 }
6940
6941 void
6942 complex_vars_of_extents (void)
6943 {
6944   staticpro (&Vextent_face_memoize_hash_table);
6945   /* The memoize hash table maps from lists of symbols to lists of
6946      faces.  It needs to be `equal' to implement the memoization.
6947      The reverse table maps in the other direction and just needs
6948      to do `eq' comparison because the lists of faces are already
6949      memoized. */
6950   Vextent_face_memoize_hash_table =
6951     make_lisp_hash_table (100, HASH_TABLE_VALUE_WEAK, HASH_TABLE_EQUAL);
6952   staticpro (&Vextent_face_reverse_memoize_hash_table);
6953   Vextent_face_reverse_memoize_hash_table =
6954     make_lisp_hash_table (100, HASH_TABLE_KEY_WEAK, HASH_TABLE_EQ);
6955 }