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