1 /* Copyright (c) 1994, 1995 Free Software Foundation, Inc.
2 Copyright (c) 1995 Sun Microsystems, Inc.
3 Copyright (c) 1995, 1996 Ben Wing.
5 This file is part of XEmacs.
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
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
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. */
22 /* Synched up with: Not in FSF. */
24 /* This file has been Mule-ized. */
26 /* Written by Ben Wing <ben@xemacs.org>.
28 [Originally written by some people at Lucid.
30 Start/end-open stuff added by John Rose (john.rose@eng.sun.com).
31 Rewritten from scratch by Ben Wing, December 1994.] */
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.
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.
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
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:
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
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).
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,
68 or if: A-end = B-end, and A-start > B-start
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).
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".
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:
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.
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.
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.
101 #### The following information is wrong in places.
103 More about the different orders:
104 --------------------------------
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
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.
117 (4) requires being able to determine the first and last extents
118 that overlap a range.
120 NOTE: "overlap" is used as follows:
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
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.
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
141 Also define e>, e<, e<=, etc. to mean comparison according to the
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
150 Similarly, define E(e-next) and E(e-prev) to be the extents
151 directly following and preceding E in the e-order.
156 Let F be the first extent overlapping R.
157 Let L be the last extent overlapping R.
159 Theorem 1: R(1) lies between L and L(next), i.e. L <= R(1) < L(next).
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.
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).
170 Theorem 2: F(e-prev) e< [1, R(0)] e<= F.
172 This is the analog of Theorem 1, and applies because the e-order
173 sorts by increasing ending index.
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.
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.
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.)
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.
195 Theorem 3: The first extent in S is the first extent that overlaps
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.
201 Therefore, finding the first extent that overlaps a range R is the
202 same as finding the first extent that overlaps R(0).
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.
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.
230 #include "redisplay.h"
232 /* ------------------------------- */
234 /* ------------------------------- */
236 /* Note that this object is not extent-specific and should perhaps be
237 moved into another file. */
239 /* Holds a marker that moves as elements in the array are inserted and
240 deleted, similar to standard markers. */
242 typedef struct gap_array_marker
245 struct gap_array_marker *next;
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
254 typedef struct gap_array
261 Gap_Array_Marker *markers;
264 Gap_Array_Marker *gap_array_marker_freelist;
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))
272 /* Number of elements currently in a gap array */
273 #define GAP_ARRAY_NUM_ELS(ga) ((ga)->numels)
275 #define GAP_ARRAY_ARRAY_TO_MEMORY_POS(ga, pos) \
276 ((pos) <= (ga)->gap ? (pos) : (pos) + (ga)->gapsize)
278 #define GAP_ARRAY_MEMORY_TO_ARRAY_POS(ga, pos) \
279 ((pos) <= (ga)->gap ? (pos) : (pos) - (ga)->gapsize)
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))
287 /* ------------------------------- */
289 /* ------------------------------- */
291 typedef struct extent_list_marker
295 struct extent_list_marker *next;
296 } Extent_List_Marker;
298 typedef struct extent_list
302 Extent_List_Marker *markers;
305 Extent_List_Marker *extent_list_marker_freelist;
307 #define EXTENT_LESS_VALS(e,st,nd) ((extent_start (e) < (st)) || \
308 ((extent_start (e) == (st)) && \
309 (extent_end (e) > (nd))))
311 #define EXTENT_EQUAL_VALS(e,st,nd) ((extent_start (e) == (st)) && \
312 (extent_end (e) == (nd)))
314 #define EXTENT_LESS_EQUAL_VALS(e,st,nd) ((extent_start (e) < (st)) || \
315 ((extent_start (e) == (st)) && \
316 (extent_end (e) >= (nd))))
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))
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))
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))
330 #define EXTENT_E_LESS_VALS(e,st,nd) ((extent_end (e) < (nd)) || \
331 ((extent_end (e) == (nd)) && \
332 (extent_start (e) > (st))))
334 #define EXTENT_E_LESS_EQUAL_VALS(e,st,nd) ((extent_end (e) < (nd)) || \
335 ((extent_end (e) == (nd)) && \
336 (extent_start (e) >= (st))))
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))
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))
346 #define EXTENT_GAP_ARRAY_AT(ga, pos) (* (EXTENT *) GAP_ARRAY_EL_ADDR(ga, pos))
348 /* ------------------------------- */
349 /* auxiliary extent structure */
350 /* ------------------------------- */
352 struct extent_auxiliary extent_auxiliary_defaults;
354 /* ------------------------------- */
355 /* buffer-extent primitives */
356 /* ------------------------------- */
358 typedef struct stack_of_extents
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]). */
369 /* ------------------------------- */
371 /* ------------------------------- */
373 typedef int Endpoint_Index;
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)))
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)
386 /* ------------------------------- */
387 /* buffer-or-string primitives */
388 /* ------------------------------- */
390 /* Similar for Bytinds and start/end indices. */
392 #define buffer_or_string_bytind_to_startind(obj, ind, start_open) \
393 memind_to_startind (buffer_or_string_bytind_to_memind (obj, ind), \
396 #define buffer_or_string_bytind_to_endind(obj, ind, end_open) \
397 memind_to_endind (buffer_or_string_bytind_to_memind (obj, ind), \
400 /* ------------------------------- */
401 /* Lisp-level functions */
402 /* ------------------------------- */
404 /* flags for decode_extent() */
405 #define DE_MUST_HAVE_BUFFER 1
406 #define DE_MUST_BE_ATTACHED 2
408 Lisp_Object Vlast_highlighted_extent;
409 int mouse_highlight_priority;
411 Lisp_Object Qextentp;
412 Lisp_Object Qextent_live_p;
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;
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 */
435 Lisp_Object Qduplicable;
436 Lisp_Object Qdetachable;
437 Lisp_Object Qpriority;
438 Lisp_Object Qmouse_face;
439 Lisp_Object Qinitial_redisplay_function;
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 */
448 /* partially used in redisplay */
449 Lisp_Object Qglyph_invisible;
451 Lisp_Object Qcopy_function;
452 Lisp_Object Qpaste_function;
454 /* The idea here is that if we're given a list of faces, we
455 need to "memoize" this so that two lists of faces that are `equal'
456 turn into the same object. When `set-extent-face' is called, we
457 "memoize" into a list of actual faces; when `extent-face' is called,
458 we do a reverse lookup to get the list of symbols. */
460 static Lisp_Object canonicalize_extent_property (Lisp_Object prop,
462 Lisp_Object Vextent_face_memoize_hash_table;
463 Lisp_Object Vextent_face_reverse_memoize_hash_table;
464 Lisp_Object Vextent_face_reusable_list;
465 /* FSFmacs bogosity */
466 Lisp_Object Vdefault_text_properties;
469 EXFUN (Fextent_properties, 1);
470 EXFUN (Fset_extent_property, 3);
473 /************************************************************************/
474 /* Generalized gap array */
475 /************************************************************************/
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. */
482 /* ------------------------------- */
483 /* internal functions */
484 /* ------------------------------- */
486 /* Adjust the gap array markers in the range (FROM, TO]. Parallel to
487 adjust_markers() in insdel.c. */
490 gap_array_adjust_markers (Gap_Array *ga, Memind from,
491 Memind to, int amount)
495 for (m = ga->markers; m; m = m->next)
496 m->pos = do_marker_adjustment (m->pos, from, to, amount);
499 /* Move the gap to array position POS. Parallel to move_gap() in
500 insdel.c but somewhat simplified. */
503 gap_array_move_gap (Gap_Array *ga, int pos)
506 int gapsize = ga->gapsize;
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,
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);
528 /* Make the gap INCREMENT characters longer. Parallel to make_gap() in
532 gap_array_make_gap (Gap_Array *ga, int increment)
534 char *ptr = ga->array;
538 /* If we have to get more space, get enough to last a while. We use
539 a geometric progession that saves on realloc space. */
540 increment += 100 + ga->numels / 8;
542 ptr = (char *) xrealloc (ptr,
543 (ga->numels + ga->gapsize + increment)*ga->elsize);
548 real_gap_loc = ga->gap;
549 old_gap_size = ga->gapsize;
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;
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);
559 /* Now combine the two into one large gap. */
560 ga->gapsize += old_gap_size;
561 ga->gap = real_gap_loc;
564 /* ------------------------------- */
565 /* external functions */
566 /* ------------------------------- */
568 /* Insert NUMELS elements (pointed to by ELPTR) into the specified
572 gap_array_insert_els (Gap_Array *ga, int pos, void *elptr, int numels)
574 assert (pos >= 0 && pos <= ga->numels);
575 if (ga->gapsize < numels)
576 gap_array_make_gap (ga, numels - ga->gapsize);
578 gap_array_move_gap (ga, pos);
580 memcpy (GAP_ARRAY_MEMEL_ADDR (ga, ga->gap), (char *) elptr,
582 ga->gapsize -= numels;
584 ga->numels += numels;
585 /* This is the equivalent of insert-before-markers.
587 #### Should only happen if marker is "moves forward at insert" type.
590 gap_array_adjust_markers (ga, pos - 1, pos, numels);
593 /* Delete NUMELS elements from the specified gap array, starting at FROM. */
596 gap_array_delete_els (Gap_Array *ga, int from, int numdel)
598 int to = from + numdel;
599 int gapsize = ga->gapsize;
602 assert (numdel >= 0);
603 assert (to <= ga->numels);
605 /* Make sure the gap is somewhere in or next to what we are deleting. */
607 gap_array_move_gap (ga, to);
609 gap_array_move_gap (ga, from);
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,
616 ga->gapsize += numdel;
617 ga->numels -= numdel;
621 static Gap_Array_Marker *
622 gap_array_make_marker (Gap_Array *ga, int pos)
626 assert (pos >= 0 && pos <= ga->numels);
627 if (gap_array_marker_freelist)
629 m = gap_array_marker_freelist;
630 gap_array_marker_freelist = gap_array_marker_freelist->next;
633 m = xnew (Gap_Array_Marker);
635 m->pos = GAP_ARRAY_ARRAY_TO_MEMORY_POS (ga, pos);
636 m->next = ga->markers;
642 gap_array_delete_marker (Gap_Array *ga, Gap_Array_Marker *m)
644 Gap_Array_Marker *p, *prev;
646 for (prev = 0, p = ga->markers; p && p != m; prev = p, p = p->next)
650 prev->next = p->next;
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;
659 gap_array_delete_all_markers (Gap_Array *ga)
661 Gap_Array_Marker *p, *next;
663 for (p = ga->markers; p; p = next)
666 p->next = gap_array_marker_freelist;
667 p->pos = 0xDEADBEEF; /* -559038737 as an int */
668 gap_array_marker_freelist = p;
673 gap_array_move_marker (Gap_Array *ga, Gap_Array_Marker *m, int pos)
675 assert (pos >= 0 && pos <= ga->numels);
676 m->pos = GAP_ARRAY_ARRAY_TO_MEMORY_POS (ga, pos);
679 #define gap_array_marker_pos(ga, m) \
680 GAP_ARRAY_MEMORY_TO_ARRAY_POS (ga, (m)->pos)
683 make_gap_array (int elsize)
685 Gap_Array *ga = xnew_and_zero (Gap_Array);
691 free_gap_array (Gap_Array *ga)
695 gap_array_delete_all_markers (ga);
700 /************************************************************************/
701 /* Extent list primitives */
702 /************************************************************************/
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
716 /* Number of elements in an extent list */
717 #define extent_list_num_els(el) GAP_ARRAY_NUM_ELS(el->start)
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. */
728 extent_list_locate (Extent_List *el, EXTENT extent, int endp, int *foundp)
730 Gap_Array *ga = endp ? el->end : el->start;
731 int left = 0, right = GAP_ARRAY_NUM_ELS (ga);
732 int oldfoundpos, foundpos;
735 while (left != right)
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);
742 if (endp ? EXTENT_E_LESS (e, extent) : EXTENT_LESS (e, extent))
748 /* Now we're at the beginning of all equal extents. */
750 oldfoundpos = foundpos = left;
751 while (foundpos < GAP_ARRAY_NUM_ELS (ga))
753 EXTENT e = EXTENT_GAP_ARRAY_AT (ga, foundpos);
759 if (!EXTENT_EQUAL (e, extent))
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).
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. */
778 extent_list_locate_from_pos (Extent_List *el, Memind pos, int endp)
780 struct extent fake_extent;
783 Note that if we search for [POS, POS], then we get the following:
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.
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.
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);
799 /* Return the extent at POS. */
802 extent_list_at (Extent_List *el, Memind pos, int endp)
804 Gap_Array *ga = endp ? el->end : el->start;
806 assert (pos >= 0 && pos < GAP_ARRAY_NUM_ELS (ga));
807 return EXTENT_GAP_ARRAY_AT (ga, pos);
810 /* Insert an extent into an extent list. */
813 extent_list_insert (Extent_List *el, EXTENT extent)
817 pos = extent_list_locate (el, extent, 0, &foundp);
819 gap_array_insert_els (el->start, pos, &extent, 1);
820 pos = extent_list_locate (el, extent, 1, &foundp);
822 gap_array_insert_els (el->end, pos, &extent, 1);
825 /* Delete an extent from an extent list. */
828 extent_list_delete (Extent_List *el, EXTENT extent)
832 pos = extent_list_locate (el, extent, 0, &foundp);
834 gap_array_delete_els (el->start, pos, 1);
835 pos = extent_list_locate (el, extent, 1, &foundp);
837 gap_array_delete_els (el->end, pos, 1);
841 extent_list_delete_all (Extent_List *el)
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));
847 static Extent_List_Marker *
848 extent_list_make_marker (Extent_List *el, int pos, int endp)
850 Extent_List_Marker *m;
852 if (extent_list_marker_freelist)
854 m = extent_list_marker_freelist;
855 extent_list_marker_freelist = extent_list_marker_freelist->next;
858 m = xnew (Extent_List_Marker);
860 m->m = gap_array_make_marker (endp ? el->end : el->start, pos);
862 m->next = el->markers;
867 #define extent_list_move_marker(el, mkr, pos) \
868 gap_array_move_marker((mkr)->endp ? (el)->end : (el)->start, (mkr)->m, pos)
871 extent_list_delete_marker (Extent_List *el, Extent_List_Marker *m)
873 Extent_List_Marker *p, *prev;
875 for (prev = 0, p = el->markers; p && p != m; prev = p, p = p->next)
879 prev->next = p->next;
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);
887 #define extent_list_marker_pos(el, mkr) \
888 gap_array_marker_pos ((mkr)->endp ? (el)->end : (el)->start, (mkr)->m)
891 allocate_extent_list (void)
893 Extent_List *el = xnew (Extent_List);
894 el->start = make_gap_array (sizeof(EXTENT));
895 el->end = make_gap_array (sizeof(EXTENT));
901 free_extent_list (Extent_List *el)
903 free_gap_array (el->start);
904 free_gap_array (el->end);
909 /************************************************************************/
910 /* Auxiliary extent structure */
911 /************************************************************************/
914 mark_extent_auxiliary (Lisp_Object obj, void (*markobj) (Lisp_Object))
916 struct extent_auxiliary *data = XEXTENT_AUXILIARY (obj);
917 ((markobj) (data->begin_glyph));
918 ((markobj) (data->end_glyph));
919 ((markobj) (data->invisible));
920 ((markobj) (data->children));
921 ((markobj) (data->read_only));
922 ((markobj) (data->mouse_face));
923 ((markobj) (data->initial_redisplay_function));
927 DEFINE_LRECORD_IMPLEMENTATION ("extent-auxiliary", extent_auxiliary,
928 mark_extent_auxiliary, internal_object_printer,
929 0, 0, 0, struct extent_auxiliary);
932 allocate_extent_auxiliary (EXTENT ext)
934 Lisp_Object extent_aux;
935 struct extent_auxiliary *data =
936 alloc_lcrecord_type (struct extent_auxiliary, lrecord_extent_auxiliary);
938 copy_lcrecord (data, &extent_auxiliary_defaults);
939 XSETEXTENT_AUXILIARY (extent_aux, data);
940 ext->plist = Fcons (extent_aux, ext->plist);
941 ext->flags.has_aux = 1;
945 /************************************************************************/
946 /* Extent info structure */
947 /************************************************************************/
949 /* An extent-info structure consists of a list of the buffer or string's
950 extents and a "stack of extents" that lists all of the extents over
951 a particular position. The stack-of-extents info is used for
952 optimization purposes -- it basically caches some info that might
953 be expensive to compute. Certain otherwise hard computations are easy
954 given the stack of extents over a particular position, and if the
955 stack of extents over a nearby position is known (because it was
956 calculated at some prior point in time), it's easy to move the stack
957 of extents to the proper position.
959 Given that the stack of extents is an optimization, and given that
960 it requires memory, a string's stack of extents is wiped out each
961 time a garbage collection occurs. Therefore, any time you retrieve
962 the stack of extents, it might not be there. If you need it to
963 be there, use the _force version.
965 Similarly, a string may or may not have an extent_info structure.
966 (Generally it won't if there haven't been any extents added to the
967 string.) So use the _force version if you need the extent_info
968 structure to be there. */
970 static struct stack_of_extents *allocate_soe (void);
971 static void free_soe (struct stack_of_extents *soe);
972 static void soe_invalidate (Lisp_Object obj);
975 mark_extent_info (Lisp_Object obj, void (*markobj) (Lisp_Object))
977 struct extent_info *data =
978 (struct extent_info *) XEXTENT_INFO (obj);
982 /* Vbuffer_defaults and Vbuffer_local_symbols are buffer-like
983 objects that are created specially and never have their extent
984 list initialized (or rather, it is set to zero in
985 nuke_all_buffer_slots()). However, these objects get
986 garbage-collected so we have to deal.
988 (Also the list can be zero when we're dealing with a destroyed
991 list = data->extents;
994 for (i = 0; i < extent_list_num_els (list); i++)
996 struct extent *extent = extent_list_at (list, i, 0);
999 XSETEXTENT (exobj, extent);
1000 ((markobj) (exobj));
1008 finalize_extent_info (void *header, int for_disksave)
1010 struct extent_info *data = (struct extent_info *) header;
1017 free_soe (data->soe);
1022 free_extent_list (data->extents);
1027 DEFINE_LRECORD_IMPLEMENTATION ("extent-info", extent_info,
1028 mark_extent_info, internal_object_printer,
1029 finalize_extent_info, 0, 0,
1030 struct extent_info);
1033 allocate_extent_info (void)
1035 Lisp_Object extent_info;
1036 struct extent_info *data =
1037 alloc_lcrecord_type (struct extent_info, lrecord_extent_info);
1039 XSETEXTENT_INFO (extent_info, data);
1040 data->extents = allocate_extent_list ();
1046 flush_cached_extent_info (Lisp_Object extent_info)
1048 struct extent_info *data = XEXTENT_INFO (extent_info);
1052 free_soe (data->soe);
1058 /************************************************************************/
1059 /* Buffer/string extent primitives */
1060 /************************************************************************/
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. */
1069 /* ------------------------------- */
1070 /* basic primitives */
1071 /* ------------------------------- */
1074 decode_buffer_or_string (Lisp_Object object)
1077 XSETBUFFER (object, current_buffer);
1078 else if (BUFFERP (object))
1079 CHECK_LIVE_BUFFER (object);
1080 else if (STRINGP (object))
1083 dead_wrong_type_argument (Qbuffer_or_string_p, object);
1089 extent_ancestor_1 (EXTENT e)
1091 while (e->flags.has_parent)
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);
1100 /* Given an extent object (string or buffer or nil), return its extent info.
1101 This may be 0 for a string. */
1103 static struct extent_info *
1104 buffer_or_string_extent_info (Lisp_Object object)
1106 if (STRINGP (object))
1108 Lisp_Object plist = XSTRING (object)->plist;
1109 if (!CONSP (plist) || !EXTENT_INFOP (XCAR (plist)))
1111 return XEXTENT_INFO (XCAR (plist));
1113 else if (NILP (object))
1116 return XEXTENT_INFO (XBUFFER (object)->extent_info);
1119 /* Given a string or buffer, return its extent list. This may be
1122 static Extent_List *
1123 buffer_or_string_extent_list (Lisp_Object object)
1125 struct extent_info *info = buffer_or_string_extent_info (object);
1129 return info->extents;
1132 /* Given a string or buffer, return its extent info. If it's not there,
1135 static struct extent_info *
1136 buffer_or_string_extent_info_force (Lisp_Object object)
1138 struct extent_info *info = buffer_or_string_extent_info (object);
1142 Lisp_Object extent_info;
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);
1157 /* Detach all the extents in OBJECT. Called from redisplay. */
1160 detach_all_extents (Lisp_Object object)
1162 struct extent_info *data = buffer_or_string_extent_info (object);
1170 for (i = 0; i < extent_list_num_els (data->extents); i++)
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);
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);
1189 init_buffer_extents (struct buffer *b)
1191 b->extent_info = allocate_extent_info ();
1195 uninit_buffer_extents (struct buffer *b)
1197 struct extent_info *data = XEXTENT_INFO (b->extent_info);
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);
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
1210 #define extent_extent_list(e) buffer_or_string_extent_list (extent_object (e))
1212 /* ------------------------------- */
1213 /* stack of extents */
1214 /* ------------------------------- */
1216 #ifdef ERROR_CHECK_EXTENTS
1219 sledgehammer_extent_check (Lisp_Object object)
1223 Extent_List *el = buffer_or_string_extent_list (object);
1224 struct buffer *buf = 0;
1229 if (BUFFERP (object))
1230 buf = XBUFFER (object);
1232 for (endp = 0; endp < 2; endp++)
1233 for (i = 1; i < extent_list_num_els (el); i++)
1235 EXTENT e1 = extent_list_at (el, i-1, endp);
1236 EXTENT e2 = extent_list_at (el, i, endp);
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);
1244 assert (extent_start (e1) <= extent_end (e1));
1245 assert (endp ? (EXTENT_E_LESS_EQUAL (e1, e2)) :
1246 (EXTENT_LESS_EQUAL (e1, e2)));
1252 static Stack_Of_Extents *
1253 buffer_or_string_stack_of_extents (Lisp_Object object)
1255 struct extent_info *info = buffer_or_string_extent_info (object);
1261 static Stack_Of_Extents *
1262 buffer_or_string_stack_of_extents_force (Lisp_Object object)
1264 struct extent_info *info = buffer_or_string_extent_info_force (object);
1266 info->soe = allocate_soe ();
1270 /* #define SOE_DEBUG */
1274 static void print_extent_1 (char *buf, Lisp_Object extent);
1277 print_extent_2 (EXTENT e)
1282 XSETEXTENT (extent, e);
1283 print_extent_1 (buf, extent);
1284 fputs (buf, stdout);
1288 soe_dump (Lisp_Object obj)
1291 Stack_Of_Extents *soe = buffer_or_string_stack_of_extents (obj);
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),
1305 for (endp = 0; endp < 2; endp++)
1307 printf (endp ? "SOE end:" : "SOE start:");
1308 for (i = 0; i < extent_list_num_els (sel); i++)
1310 EXTENT e = extent_list_at (sel, i, endp);
1321 /* Insert EXTENT into OBJ's stack of extents, if necessary. */
1324 soe_insert (Lisp_Object obj, EXTENT extent)
1326 Stack_Of_Extents *soe = buffer_or_string_stack_of_extents (obj);
1329 printf ("Inserting into SOE: ");
1330 print_extent_2 (extent);
1333 if (!soe || soe->pos < extent_start (extent) ||
1334 soe->pos > extent_end (extent))
1337 printf ("(not needed)\n\n");
1341 extent_list_insert (soe->extents, extent);
1343 puts ("SOE afterwards is:");
1348 /* Delete EXTENT from OBJ's stack of extents, if necessary. */
1351 soe_delete (Lisp_Object obj, EXTENT extent)
1353 Stack_Of_Extents *soe = buffer_or_string_stack_of_extents (obj);
1356 printf ("Deleting from SOE: ");
1357 print_extent_2 (extent);
1360 if (!soe || soe->pos < extent_start (extent) ||
1361 soe->pos > extent_end (extent))
1364 puts ("(not needed)\n");
1368 extent_list_delete (soe->extents, extent);
1370 puts ("SOE afterwards is:");
1375 /* Move OBJ's stack of extents to lie over the specified position. */
1378 soe_move (Lisp_Object obj, Memind pos)
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);
1387 #ifdef ERROR_CHECK_EXTENTS
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);
1402 else if (soe->pos > pos)
1410 puts ("(not needed)\n");
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
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).
1424 We proceed in two stages:
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.)
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.
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.
1455 end = extent_list_locate_from_pos (sel, pos, 1);
1459 start = extent_list_locate_from_pos (sel, pos+1, 0);
1463 for (i = start; i < end; i++)
1464 extent_list_delete (sel, extent_list_at (sel, start /* see above */,
1474 start_pos = extent_list_locate_from_pos (bel, soe->pos, endp) - 1;
1476 start_pos = extent_list_locate_from_pos (bel, soe->pos + 1, endp);
1478 for (; start_pos >= 0 && start_pos < extent_list_num_els (bel);
1479 start_pos += direction)
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);
1496 puts ("SOE afterwards is:");
1502 soe_invalidate (Lisp_Object obj)
1504 Stack_Of_Extents *soe = buffer_or_string_stack_of_extents (obj);
1508 extent_list_delete_all (soe->extents);
1513 static struct stack_of_extents *
1516 struct stack_of_extents *soe = xnew_and_zero (struct stack_of_extents);
1517 soe->extents = allocate_extent_list ();
1523 free_soe (struct stack_of_extents *soe)
1525 free_extent_list (soe->extents);
1529 /* ------------------------------- */
1530 /* other primitives */
1531 /* ------------------------------- */
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(). */
1539 extent_endpoint_bytind (EXTENT extent, int endp)
1541 assert (EXTENT_LIVE_P (extent));
1542 assert (!extent_detached_p (extent));
1544 Memind i = (endp) ? (extent_end (extent)) :
1545 (extent_start (extent));
1546 Lisp_Object obj = extent_object (extent);
1547 return buffer_or_string_memind_to_bytind (obj, i);
1552 extent_endpoint_bufpos (EXTENT extent, int endp)
1554 assert (EXTENT_LIVE_P (extent));
1555 assert (!extent_detached_p (extent));
1557 Memind i = (endp) ? (extent_end (extent)) :
1558 (extent_start (extent));
1559 Lisp_Object obj = extent_object (extent);
1560 return buffer_or_string_memind_to_bufpos (obj, i);
1564 /* A change to an extent occurred that will change the display, so
1565 notify redisplay. Maybe also recurse over all the extent's
1569 extent_changed_for_redisplay (EXTENT extent, int descendants_too,
1570 int invisibility_change)
1575 /* we could easily encounter a detached extent while traversing the
1576 children, but we should never be able to encounter a dead extent. */
1577 assert (EXTENT_LIVE_P (extent));
1579 if (descendants_too)
1581 Lisp_Object children = extent_children (extent);
1583 if (!NILP (children))
1585 /* first mark all of the extent's children. We will lose big-time
1586 if there are any circularities here, so we sure as hell better
1587 ensure that there aren't. */
1588 LIST_LOOP (rest, XWEAK_LIST_LIST (children))
1589 extent_changed_for_redisplay (XEXTENT (XCAR (rest)), 1,
1590 invisibility_change);
1594 /* now mark the extent itself. */
1596 object = extent_object (extent);
1598 if (!BUFFERP (object) || extent_detached_p (extent))
1599 /* #### Can changes to string extents affect redisplay?
1600 I will have to think about this. What about string glyphs?
1601 Things in the modeline? etc. */
1602 /* #### changes to string extents can certainly affect redisplay
1603 if the extent is in some generated-modeline-string: when
1604 we change an extent in generated-modeline-string, this changes
1605 its parent, which is in `modeline-format', so we should
1606 force the modeline to be updated. But how to determine whether
1607 a string is a `generated-modeline-string'? Looping through
1608 all buffers is not very efficient. Should we add all
1609 `generated-modeline-string' strings to a hashtable?
1610 Maybe efficiency is not the greatest concern here and there's
1611 no big loss in looping over the buffers. */
1616 b = XBUFFER (object);
1617 BUF_FACECHANGE (b)++;
1618 MARK_EXTENTS_CHANGED;
1619 if (invisibility_change)
1621 buffer_extent_signal_changed_region (b,
1622 extent_endpoint_bufpos (extent, 0),
1623 extent_endpoint_bufpos (extent, 1));
1627 /* A change to an extent occurred that might affect redisplay.
1628 This is called when properties such as the endpoints, the layout,
1629 or the priority changes. Redisplay will be affected only if
1630 the extent has any displayable attributes. */
1633 extent_maybe_changed_for_redisplay (EXTENT extent, int descendants_too,
1634 int invisibility_change)
1636 /* Retrieve the ancestor for efficiency */
1637 EXTENT anc = extent_ancestor (extent);
1638 if (!NILP (extent_face (anc)) ||
1639 !NILP (extent_begin_glyph (anc)) ||
1640 !NILP (extent_end_glyph (anc)) ||
1641 !NILP (extent_mouse_face (anc)) ||
1642 !NILP (extent_invisible (anc)) ||
1643 !NILP (extent_initial_redisplay_function (anc)) ||
1644 invisibility_change)
1645 extent_changed_for_redisplay (extent, descendants_too,
1646 invisibility_change);
1650 make_extent_detached (Lisp_Object object)
1652 EXTENT extent = allocate_extent ();
1654 assert (NILP (object) || STRINGP (object) ||
1655 (BUFFERP (object) && BUFFER_LIVE_P (XBUFFER (object))));
1656 extent_object (extent) = object;
1657 /* Now make sure the extent info exists. */
1659 buffer_or_string_extent_info_force (object);
1663 /* A "real" extent is any extent other than the internal (not-user-visible)
1664 extents used by `map-extents'. */
1667 real_extent_at_forward (Extent_List *el, int pos, int endp)
1669 for (; pos < extent_list_num_els (el); pos++)
1671 EXTENT e = extent_list_at (el, pos, endp);
1672 if (!extent_internal_p (e))
1679 real_extent_at_backward (Extent_List *el, int pos, int endp)
1681 for (; pos >= 0; pos--)
1683 EXTENT e = extent_list_at (el, pos, endp);
1684 if (!extent_internal_p (e))
1691 extent_first (Lisp_Object obj)
1693 Extent_List *el = buffer_or_string_extent_list (obj);
1697 return real_extent_at_forward (el, 0, 0);
1702 extent_e_first (Lisp_Object obj)
1704 Extent_List *el = buffer_or_string_extent_list (obj);
1708 return real_extent_at_forward (el, 0, 1);
1713 extent_next (EXTENT e)
1715 Extent_List *el = extent_extent_list (e);
1717 int pos = extent_list_locate (el, e, 0, &foundp);
1719 return real_extent_at_forward (el, pos+1, 0);
1724 extent_e_next (EXTENT e)
1726 Extent_List *el = extent_extent_list (e);
1728 int pos = extent_list_locate (el, e, 1, &foundp);
1730 return real_extent_at_forward (el, pos+1, 1);
1735 extent_last (Lisp_Object obj)
1737 Extent_List *el = buffer_or_string_extent_list (obj);
1741 return real_extent_at_backward (el, extent_list_num_els (el) - 1, 0);
1746 extent_e_last (Lisp_Object obj)
1748 Extent_List *el = buffer_or_string_extent_list (obj);
1752 return real_extent_at_backward (el, extent_list_num_els (el) - 1, 1);
1757 extent_previous (EXTENT e)
1759 Extent_List *el = extent_extent_list (e);
1761 int pos = extent_list_locate (el, e, 0, &foundp);
1763 return real_extent_at_backward (el, pos-1, 0);
1768 extent_e_previous (EXTENT e)
1770 Extent_List *el = extent_extent_list (e);
1772 int pos = extent_list_locate (el, e, 1, &foundp);
1774 return real_extent_at_backward (el, pos-1, 1);
1779 extent_attach (EXTENT extent)
1781 Extent_List *el = extent_extent_list (extent);
1783 extent_list_insert (el, extent);
1784 soe_insert (extent_object (extent), extent);
1785 /* only this extent changed */
1786 extent_maybe_changed_for_redisplay (extent, 0,
1787 !NILP (extent_invisible (extent)));
1791 extent_detach (EXTENT extent)
1795 if (extent_detached_p (extent))
1797 el = extent_extent_list (extent);
1799 /* call this before messing with the extent. */
1800 extent_maybe_changed_for_redisplay (extent, 0,
1801 !NILP (extent_invisible (extent)));
1802 extent_list_delete (el, extent);
1803 soe_delete (extent_object (extent), extent);
1804 set_extent_start (extent, -1);
1805 set_extent_end (extent, -1);
1808 /* ------------------------------- */
1809 /* map-extents et al. */
1810 /* ------------------------------- */
1812 /* Returns true iff map_extents() would visit the given extent.
1813 See the comments at map_extents() for info on the overlap rule.
1814 Assumes that all validation on the extent and buffer positions has
1815 already been performed (see Fextent_in_region_p ()).
1818 extent_in_region_p (EXTENT extent, Bytind from, Bytind to,
1821 Lisp_Object obj = extent_object (extent);
1822 Endpoint_Index start, end, exs, exe;
1823 int start_open, end_open;
1824 unsigned int all_extents_flags = flags & ME_ALL_EXTENTS_MASK;
1825 unsigned int in_region_flags = flags & ME_IN_REGION_MASK;
1828 /* A zero-length region is treated as closed-closed. */
1831 flags |= ME_END_CLOSED;
1832 flags &= ~ME_START_OPEN;
1835 switch (all_extents_flags)
1837 case ME_ALL_EXTENTS_CLOSED:
1838 start_open = end_open = 0; break;
1839 case ME_ALL_EXTENTS_OPEN:
1840 start_open = end_open = 1; break;
1841 case ME_ALL_EXTENTS_CLOSED_OPEN:
1842 start_open = 0; end_open = 1; break;
1843 case ME_ALL_EXTENTS_OPEN_CLOSED:
1844 start_open = 1; end_open = 0; break;
1846 start_open = extent_start_open_p (extent);
1847 end_open = extent_end_open_p (extent);
1851 /* So is a zero-length extent. */
1852 if (extent_start (extent) == extent_end (extent))
1853 start_open = end_open = 0;
1855 start = buffer_or_string_bytind_to_startind (obj, from,
1856 flags & ME_START_OPEN);
1857 end = buffer_or_string_bytind_to_endind (obj, to, ! (flags & ME_END_CLOSED));
1858 exs = memind_to_startind (extent_start (extent), start_open);
1859 exe = memind_to_endind (extent_end (extent), end_open);
1861 /* It's easy to determine whether an extent lies *outside* the
1862 region -- just determine whether it's completely before
1863 or completely after the region. Reject all such extents, so
1864 we're now left with only the extents that overlap the region.
1867 if (exs > end || exe < start)
1870 /* See if any further restrictions are called for. */
1871 switch (in_region_flags)
1873 case ME_START_IN_REGION:
1874 retval = start <= exs && exs <= end; break;
1875 case ME_END_IN_REGION:
1876 retval = start <= exe && exe <= end; break;
1877 case ME_START_AND_END_IN_REGION:
1878 retval = start <= exs && exe <= end; break;
1879 case ME_START_OR_END_IN_REGION:
1880 retval = (start <= exs && exs <= end) || (start <= exe && exe <= end);
1885 return flags & ME_NEGATE_IN_REGION ? !retval : retval;
1888 struct map_extents_struct
1891 Extent_List_Marker *mkr;
1896 map_extents_unwind (Lisp_Object obj)
1898 struct map_extents_struct *closure =
1899 (struct map_extents_struct *) get_opaque_ptr (obj);
1900 free_opaque_ptr (obj);
1902 extent_detach (closure->range);
1904 extent_list_delete_marker (closure->el, closure->mkr);
1908 /* This is the guts of `map-extents' and the other functions that
1909 map over extents. In theory the operation of this function is
1910 simple: just figure out what extents we're mapping over, and
1911 call the function on each one of them in the range. Unfortunately
1912 there are a wide variety of things that the mapping function
1913 might do, and we have to be very tricky to avoid getting messed
1914 up. Furthermore, this function needs to be very fast (it is
1915 called multiple times every time text is inserted or deleted
1916 from a buffer), and so we can't always afford the overhead of
1917 dealing with all the possible things that the mapping function
1918 might do; thus, there are many flags that can be specified
1919 indicating what the mapping function might or might not do.
1921 The result of all this is that this is the most complicated
1922 function in this file. Change it at your own risk!
1924 A potential simplification to the logic below is to determine
1925 all the extents that the mapping function should be called on
1926 before any calls are actually made and save them in an array.
1927 That introduces its own complications, however (the array
1928 needs to be marked for garbage-collection, and a static array
1929 cannot be used because map_extents() needs to be reentrant).
1930 Furthermore, the results might be a little less sensible than
1935 map_extents_bytind (Bytind from, Bytind to, map_extents_fun fn, void *arg,
1936 Lisp_Object obj, EXTENT after, unsigned int flags)
1938 Memind st, en; /* range we're mapping over */
1939 EXTENT range = 0; /* extent for this, if ME_MIGHT_MODIFY_TEXT */
1940 Extent_List *el = 0; /* extent list we're iterating over */
1941 Extent_List_Marker *posm = 0; /* marker for extent list,
1942 if ME_MIGHT_MODIFY_EXTENTS */
1943 /* count and struct for unwind-protect, if ME_MIGHT_THROW */
1945 struct map_extents_struct closure;
1947 #ifdef ERROR_CHECK_EXTENTS
1948 assert (from <= to);
1949 assert (from >= buffer_or_string_absolute_begin_byte (obj) &&
1950 from <= buffer_or_string_absolute_end_byte (obj) &&
1951 to >= buffer_or_string_absolute_begin_byte (obj) &&
1952 to <= buffer_or_string_absolute_end_byte (obj));
1957 assert (EQ (obj, extent_object (after)));
1958 assert (!extent_detached_p (after));
1961 el = buffer_or_string_extent_list (obj);
1962 if (!el || !extent_list_num_els(el))
1966 st = buffer_or_string_bytind_to_memind (obj, from);
1967 en = buffer_or_string_bytind_to_memind (obj, to);
1969 if (flags & ME_MIGHT_MODIFY_TEXT)
1971 /* The mapping function might change the text in the buffer,
1972 so make an internal extent to hold the range we're mapping
1974 range = make_extent_detached (obj);
1975 set_extent_start (range, st);
1976 set_extent_end (range, en);
1977 range->flags.start_open = flags & ME_START_OPEN;
1978 range->flags.end_open = !(flags & ME_END_CLOSED);
1979 range->flags.internal = 1;
1980 range->flags.detachable = 0;
1981 extent_attach (range);
1984 if (flags & ME_MIGHT_THROW)
1986 /* The mapping function might throw past us so we need to use an
1987 unwind_protect() to eliminate the internal extent and range
1989 count = specpdl_depth ();
1990 closure.range = range;
1992 record_unwind_protect (map_extents_unwind,
1993 make_opaque_ptr (&closure));
1996 /* ---------- Figure out where we start and what direction
1997 we move in. This is the trickiest part of this
1998 function. ---------- */
2000 /* If ME_START_IN_REGION, ME_END_IN_REGION or ME_START_AND_END_IN_REGION
2001 was specified and ME_NEGATE_IN_REGION was not specified, our job
2002 is simple because of the presence of the display order and e-order.
2003 (Note that theoretically do something similar for
2004 ME_START_OR_END_IN_REGION, but that would require more trickiness
2005 than it's worth to avoid hitting the same extent twice.)
2007 In the general case, all the extents that overlap a range can be
2008 divided into two classes: those whose start position lies within
2009 the range (including the range's end but not including the
2010 range's start), and those that overlap the start position,
2011 i.e. those in the SOE for the start position. Or equivalently,
2012 the extents can be divided into those whose end position lies
2013 within the range and those in the SOE for the end position. Note
2014 that for this purpose we treat both the range and all extents in
2015 the buffer as closed on both ends. If this is not what the ME_
2016 flags specified, then we've mapped over a few too many extents,
2017 but no big deal because extent_in_region_p() will filter them
2018 out. Ideally, we could move the SOE to the closer of the range's
2019 two ends and work forwards or backwards from there. However, in
2020 order to make the semantics of the AFTER argument work out, we
2021 have to always go in the same direction; so we choose to always
2022 move the SOE to the start position.
2024 When it comes time to do the SOE stage, we first call soe_move()
2025 so that the SOE gets set up. Note that the SOE might get
2026 changed while we are mapping over its contents. If we can
2027 guarantee that the SOE won't get moved to a new position, we
2028 simply need to put a marker in the SOE and we will track deletions
2029 and insertions of extents in the SOE. If the SOE might get moved,
2030 however (this would happen as a result of a recursive invocation
2031 of map-extents or a call to a redisplay-type function), then
2032 trying to track its changes is hopeless, so we just keep a
2033 marker to the first (or last) extent in the SOE and use that as
2036 Finally, if DONT_USE_SOE is defined, we don't use the SOE at all
2037 and instead just map from the beginning of the buffer. This is
2038 used for testing purposes and allows the SOE to be calculated
2039 using map_extents() instead of the other way around. */
2042 int range_flag; /* ME_*_IN_REGION subset of flags */
2043 int do_soe_stage = 0; /* Are we mapping over the SOE? */
2044 /* Does the range stage map over start or end positions? */
2046 /* If type == 0, we include the start position in the range stage mapping.
2047 If type == 1, we exclude the start position in the range stage mapping.
2048 If type == 2, we begin at range_start_pos, an extent-list position.
2050 int range_start_type = 0;
2051 int range_start_pos = 0;
2054 range_flag = flags & ME_IN_REGION_MASK;
2055 if ((range_flag == ME_START_IN_REGION ||
2056 range_flag == ME_START_AND_END_IN_REGION) &&
2057 !(flags & ME_NEGATE_IN_REGION))
2059 /* map over start position in [range-start, range-end]. No SOE
2063 else if (range_flag == ME_END_IN_REGION && !(flags & ME_NEGATE_IN_REGION))
2065 /* map over end position in [range-start, range-end]. No SOE
2071 /* Need to include the SOE extents. */
2073 /* Just brute-force it: start from the beginning. */
2075 range_start_type = 2;
2076 range_start_pos = 0;
2078 Stack_Of_Extents *soe = buffer_or_string_stack_of_extents_force (obj);
2081 /* Move the SOE to the closer end of the range. This dictates
2082 whether we map over start positions or end positions. */
2085 numsoe = extent_list_num_els (soe->extents);
2088 if (flags & ME_MIGHT_MOVE_SOE)
2091 /* Can't map over SOE, so just extend range to cover the
2093 EXTENT e = extent_list_at (soe->extents, 0, 0);
2095 extent_list_locate (buffer_or_string_extent_list (obj), e, 0,
2098 range_start_type = 2;
2102 /* We can map over the SOE. */
2104 range_start_type = 1;
2109 /* No extents in the SOE to map over, so we act just as if
2110 ME_START_IN_REGION or ME_END_IN_REGION was specified.
2111 RANGE_ENDP already specified so no need to do anything else. */
2116 /* ---------- Now loop over the extents. ---------- */
2118 /* We combine the code for the two stages because much of it
2120 for (stage = 0; stage < 2; stage++)
2122 int pos = 0; /* Position in extent list */
2124 /* First set up start conditions */
2126 { /* The SOE stage */
2129 el = buffer_or_string_stack_of_extents_force (obj)->extents;
2130 /* We will always be looping over start extents here. */
2131 assert (!range_endp);
2135 { /* The range stage */
2136 el = buffer_or_string_extent_list (obj);
2137 switch (range_start_type)
2140 pos = extent_list_locate_from_pos (el, st, range_endp);
2143 pos = extent_list_locate_from_pos (el, st + 1, range_endp);
2146 pos = range_start_pos;
2151 if (flags & ME_MIGHT_MODIFY_EXTENTS)
2153 /* Create a marker to track changes to the extent list */
2155 /* Delete the marker used in the SOE stage. */
2156 extent_list_delete_marker
2157 (buffer_or_string_stack_of_extents_force (obj)->extents, posm);
2158 posm = extent_list_make_marker (el, pos, range_endp);
2159 /* tell the unwind function about the marker. */
2170 /* ----- update position in extent list
2171 and fetch next extent ----- */
2174 /* fetch POS again to track extent insertions or deletions */
2175 pos = extent_list_marker_pos (el, posm);
2176 if (pos >= extent_list_num_els (el))
2178 e = extent_list_at (el, pos, range_endp);
2181 /* now point the marker to the next one we're going to process.
2182 This ensures graceful behavior if this extent is deleted. */
2183 extent_list_move_marker (el, posm, pos);
2185 /* ----- deal with internal extents ----- */
2187 if (extent_internal_p (e))
2189 if (!(flags & ME_INCLUDE_INTERNAL))
2191 else if (e == range)
2193 /* We're processing internal extents and we've
2194 come across our own special range extent.
2195 (This happens only in adjust_extents*() and
2196 process_extents*(), which handle text
2197 insertion and deletion.) We need to omit
2198 processing of this extent; otherwise
2199 we will probably end up prematurely
2200 terminating this loop. */
2205 /* ----- deal with AFTER condition ----- */
2209 /* if e > after, then we can stop skipping extents. */
2210 if (EXTENT_LESS (after, e))
2212 else /* otherwise, skip this extent. */
2216 /* ----- stop if we're completely outside the range ----- */
2218 /* fetch ST and EN again to track text insertions or deletions */
2221 st = extent_start (range);
2222 en = extent_end (range);
2224 if (extent_endpoint (e, range_endp) > en)
2226 /* Can't be mapping over SOE because all extents in
2227 there should overlap ST */
2228 assert (stage == 1);
2232 /* ----- Now actually call the function ----- */
2234 obj2 = extent_object (e);
2235 if (extent_in_region_p (e,
2236 buffer_or_string_memind_to_bytind (obj2,
2238 buffer_or_string_memind_to_bytind (obj2,
2244 /* Function wants us to stop mapping. */
2245 stage = 1; /* so outer for loop will terminate */
2251 /* ---------- Finished looping. ---------- */
2254 if (flags & ME_MIGHT_THROW)
2255 /* This deletes the range extent and frees the marker. */
2256 unbind_to (count, Qnil);
2259 /* Delete them ourselves */
2261 extent_detach (range);
2263 extent_list_delete_marker (el, posm);
2268 map_extents (Bufpos from, Bufpos to, map_extents_fun fn,
2269 void *arg, Lisp_Object obj, EXTENT after, unsigned int flags)
2271 map_extents_bytind (buffer_or_string_bufpos_to_bytind (obj, from),
2272 buffer_or_string_bufpos_to_bytind (obj, to), fn, arg,
2276 /* ------------------------------- */
2277 /* adjust_extents() */
2278 /* ------------------------------- */
2280 /* Add AMOUNT to all extent endpoints in the range (FROM, TO]. This
2281 happens whenever the gap is moved or (under Mule) a character in a
2282 string is substituted for a different-length one. The reason for
2283 this is that extent endpoints behave just like markers (all memory
2284 indices do) and this adjustment correct for markers -- see
2285 adjust_markers(). Note that it is important that we visit all
2286 extent endpoints in the range, irrespective of whether the
2287 endpoints are open or closed.
2289 We could use map_extents() for this (and in fact the function
2290 was originally written that way), but the gap is in an incoherent
2291 state when this function is called and this function plays
2292 around with extent endpoints without detaching and reattaching
2293 the extents (this is provably correct and saves lots of time),
2294 so for safety we make it just look at the extent lists directly. */
2297 adjust_extents (Lisp_Object obj, Memind from, Memind to, int amount)
2303 Stack_Of_Extents *soe;
2305 #ifdef ERROR_CHECK_EXTENTS
2306 sledgehammer_extent_check (obj);
2308 el = buffer_or_string_extent_list (obj);
2310 if (!el || !extent_list_num_els(el))
2313 /* IMPORTANT! Compute the starting positions of the extents to
2314 modify BEFORE doing any modification! Otherwise the starting
2315 position for the second time through the loop might get
2316 incorrectly calculated (I got bit by this bug real bad). */
2317 startpos[0] = extent_list_locate_from_pos (el, from+1, 0);
2318 startpos[1] = extent_list_locate_from_pos (el, from+1, 1);
2319 for (endp = 0; endp < 2; endp++)
2321 for (pos = startpos[endp]; pos < extent_list_num_els (el);
2324 EXTENT e = extent_list_at (el, pos, endp);
2325 if (extent_endpoint (e, endp) > to)
2327 set_extent_endpoint (e,
2328 do_marker_adjustment (extent_endpoint (e, endp),
2334 /* The index for the buffer's SOE is a memory index and thus
2335 needs to be adjusted like a marker. */
2336 soe = buffer_or_string_stack_of_extents (obj);
2337 if (soe && soe->pos >= 0)
2338 soe->pos = do_marker_adjustment (soe->pos, from, to, amount);
2341 /* ------------------------------- */
2342 /* adjust_extents_for_deletion() */
2343 /* ------------------------------- */
2345 struct adjust_extents_for_deletion_arg
2347 EXTENT_dynarr *list;
2351 adjust_extents_for_deletion_mapper (EXTENT extent, void *arg)
2353 struct adjust_extents_for_deletion_arg *closure =
2354 (struct adjust_extents_for_deletion_arg *) arg;
2356 Dynarr_add (closure->list, extent);
2357 return 0; /* continue mapping */
2360 /* For all extent endpoints in the range (FROM, TO], move them to the beginning
2361 of the new gap. Note that it is important that we visit all extent
2362 endpoints in the range, irrespective of whether the endpoints are open or
2365 This function deals with weird stuff such as the fact that extents
2368 There is no string correspondent for this because you can't
2369 delete characters from a string.
2373 adjust_extents_for_deletion (Lisp_Object object, Bytind from,
2374 Bytind to, int gapsize, int numdel,
2377 struct adjust_extents_for_deletion_arg closure;
2379 Memind adjust_to = (Memind) (to + gapsize);
2380 Bytecount amount = - numdel - movegapsize;
2381 Memind oldsoe = 0, newsoe = 0;
2382 Stack_Of_Extents *soe = buffer_or_string_stack_of_extents (object);
2384 #ifdef ERROR_CHECK_EXTENTS
2385 sledgehammer_extent_check (object);
2387 closure.list = Dynarr_new (EXTENT);
2389 /* We're going to be playing weird games below with extents and the SOE
2390 and such, so compute the list now of all the extents that we're going
2391 to muck with. If we do the mapping and adjusting together, things can
2392 get all screwed up. */
2394 map_extents_bytind (from, to, adjust_extents_for_deletion_mapper,
2395 (void *) &closure, object, 0,
2396 /* extent endpoints move like markers regardless
2397 of their open/closeness. */
2398 ME_ALL_EXTENTS_CLOSED | ME_END_CLOSED |
2399 ME_START_OR_END_IN_REGION | ME_INCLUDE_INTERNAL);
2402 Old and new values for the SOE's position. (It gets adjusted
2403 like a marker, just like extent endpoints.)
2410 newsoe = do_marker_adjustment (soe->pos,
2411 adjust_to, adjust_to,
2417 for (i = 0; i < Dynarr_length (closure.list); i++)
2419 EXTENT extent = Dynarr_at (closure.list, i);
2420 Memind new_start = extent_start (extent);
2421 Memind new_end = extent_end (extent);
2423 /* do_marker_adjustment() will not adjust values that should not be
2424 adjusted. We're passing the same funky arguments to
2425 do_marker_adjustment() as buffer_delete_range() does. */
2427 do_marker_adjustment (new_start,
2428 adjust_to, adjust_to,
2431 do_marker_adjustment (new_end,
2432 adjust_to, adjust_to,
2435 /* We need to be very careful here so that the SOE doesn't get
2436 corrupted. We are shrinking extents out of the deleted region
2437 and simultaneously moving the SOE's pos out of the deleted
2438 region, so the SOE should contain the same extents at the end
2439 as at the beginning. However, extents may get reordered
2440 by this process, so we have to operate by pulling the extents
2441 out of the buffer and SOE, changing their bounds, and then
2442 reinserting them. In order for the SOE not to get screwed up,
2443 we have to make sure that the SOE's pos points to its old
2444 location whenever we pull an extent out, and points to its
2445 new location whenever we put the extent back in.
2448 if (new_start != extent_start (extent) ||
2449 new_end != extent_end (extent))
2451 extent_detach (extent);
2452 set_extent_start (extent, new_start);
2453 set_extent_end (extent, new_end);
2456 extent_attach (extent);
2465 #ifdef ERROR_CHECK_EXTENTS
2466 sledgehammer_extent_check (object);
2468 Dynarr_free (closure.list);
2471 /* ------------------------------- */
2472 /* extent fragments */
2473 /* ------------------------------- */
2475 /* Imagine that the buffer is divided up into contiguous,
2476 nonoverlapping "runs" of text such that no extent
2477 starts or ends within a run (extents that abut the
2480 An extent fragment is a structure that holds data about
2481 the run that contains a particular buffer position (if
2482 the buffer position is at the junction of two runs, the
2483 run after the position is used) -- the beginning and
2484 end of the run, a list of all of the extents in that
2485 run, the "merged face" that results from merging all of
2486 the faces corresponding to those extents, the begin and
2487 end glyphs at the beginning of the run, etc. This is
2488 the information that redisplay needs in order to
2491 Extent fragments have to be very quick to update to
2492 a new buffer position when moving linearly through
2493 the buffer. They rely on the stack-of-extents code,
2494 which does the heavy-duty algorithmic work of determining
2495 which extents overly a particular position. */
2497 /* This function returns the position of the beginning of
2498 the first run that begins after POS, or returns POS if
2499 there are no such runs. */
2502 extent_find_end_of_run (Lisp_Object obj, Bytind pos, int outside_accessible)
2505 Extent_List *bel = buffer_or_string_extent_list (obj);
2508 Memind mempos = buffer_or_string_bytind_to_memind (obj, pos);
2509 Bytind limit = outside_accessible ?
2510 buffer_or_string_absolute_end_byte (obj) :
2511 buffer_or_string_accessible_end_byte (obj);
2513 if (!bel || !extent_list_num_els(bel))
2516 sel = buffer_or_string_stack_of_extents_force (obj)->extents;
2517 soe_move (obj, mempos);
2519 /* Find the first start position after POS. */
2520 elind1 = extent_list_locate_from_pos (bel, mempos+1, 0);
2521 if (elind1 < extent_list_num_els (bel))
2522 pos1 = buffer_or_string_memind_to_bytind
2523 (obj, extent_start (extent_list_at (bel, elind1, 0)));
2527 /* Find the first end position after POS. The extent corresponding
2528 to this position is either in the SOE or is greater than or
2529 equal to POS1, so we just have to look in the SOE. */
2530 elind2 = extent_list_locate_from_pos (sel, mempos+1, 1);
2531 if (elind2 < extent_list_num_els (sel))
2532 pos2 = buffer_or_string_memind_to_bytind
2533 (obj, extent_end (extent_list_at (sel, elind2, 1)));
2537 return min (min (pos1, pos2), limit);
2541 extent_find_beginning_of_run (Lisp_Object obj, Bytind pos,
2542 int outside_accessible)
2545 Extent_List *bel = buffer_or_string_extent_list (obj);
2548 Memind mempos = buffer_or_string_bytind_to_memind (obj, pos);
2549 Bytind limit = outside_accessible ?
2550 buffer_or_string_absolute_begin_byte (obj) :
2551 buffer_or_string_accessible_begin_byte (obj);
2553 if (!bel || !extent_list_num_els(bel))
2556 sel = buffer_or_string_stack_of_extents_force (obj)->extents;
2557 soe_move (obj, mempos);
2559 /* Find the first end position before POS. */
2560 elind1 = extent_list_locate_from_pos (bel, mempos, 1);
2562 pos1 = buffer_or_string_memind_to_bytind
2563 (obj, extent_end (extent_list_at (bel, elind1 - 1, 1)));
2567 /* Find the first start position before POS. The extent corresponding
2568 to this position is either in the SOE or is less than or
2569 equal to POS1, so we just have to look in the SOE. */
2570 elind2 = extent_list_locate_from_pos (sel, mempos, 0);
2572 pos2 = buffer_or_string_memind_to_bytind
2573 (obj, extent_start (extent_list_at (sel, elind2 - 1, 0)));
2577 return max (max (pos1, pos2), limit);
2580 struct extent_fragment *
2581 extent_fragment_new (Lisp_Object buffer_or_string, struct frame *frm)
2583 struct extent_fragment *ef = xnew_and_zero (struct extent_fragment);
2585 ef->object = buffer_or_string;
2587 ef->extents = Dynarr_new (EXTENT);
2588 ef->begin_glyphs = Dynarr_new (glyph_block);
2589 ef->end_glyphs = Dynarr_new (glyph_block);
2595 extent_fragment_delete (struct extent_fragment *ef)
2597 Dynarr_free (ef->extents);
2598 Dynarr_free (ef->begin_glyphs);
2599 Dynarr_free (ef->end_glyphs);
2603 /* Note: CONST is losing, but `const' is part of the interface of qsort() */
2605 extent_priority_sort_function (const void *humpty, const void *dumpty)
2607 CONST EXTENT foo = * (CONST EXTENT *) humpty;
2608 CONST EXTENT bar = * (CONST EXTENT *) dumpty;
2609 if (extent_priority (foo) < extent_priority (bar))
2611 return extent_priority (foo) > extent_priority (bar);
2615 extent_fragment_sort_by_priority (EXTENT_dynarr *extarr)
2619 /* Sort our copy of the stack by extent_priority. We use a bubble
2620 sort here because it's going to be faster than qsort() for small
2621 numbers of extents (less than 10 or so), and 99.999% of the time
2622 there won't ever be more extents than this in the stack. */
2623 if (Dynarr_length (extarr) < 10)
2625 for (i = 1; i < Dynarr_length (extarr); i++)
2629 (extent_priority (Dynarr_at (extarr, j)) >
2630 extent_priority (Dynarr_at (extarr, j+1))))
2632 EXTENT tmp = Dynarr_at (extarr, j);
2633 Dynarr_at (extarr, j) = Dynarr_at (extarr, j+1);
2634 Dynarr_at (extarr, j+1) = tmp;
2640 /* But some loser programs mess up and may create a large number
2641 of extents overlapping the same spot. This will result in
2642 catastrophic behavior if we use the bubble sort above. */
2643 qsort (Dynarr_atp (extarr, 0), Dynarr_length (extarr),
2644 sizeof (EXTENT), extent_priority_sort_function);
2647 /* If PROP is the `invisible' property of an extent,
2648 this is 1 if the extent should be treated as invisible. */
2650 #define EXTENT_PROP_MEANS_INVISIBLE(buf, prop) \
2651 (EQ (buf->invisibility_spec, Qt) \
2653 : invisible_p (prop, buf->invisibility_spec))
2655 /* If PROP is the `invisible' property of a extent,
2656 this is 1 if the extent should be treated as invisible
2657 and should have an ellipsis. */
2659 #define EXTENT_PROP_MEANS_INVISIBLE_WITH_ELLIPSIS(buf, prop) \
2660 (EQ (buf->invisibility_spec, Qt) \
2662 : invisible_ellipsis_p (prop, buf->invisibility_spec))
2664 /* This is like a combination of memq and assq.
2665 Return 1 if PROPVAL appears as an element of LIST
2666 or as the car of an element of LIST.
2667 If PROPVAL is a list, compare each element against LIST
2668 in that way, and return 1 if any element of PROPVAL is found in LIST.
2670 This function cannot quit. */
2673 invisible_p (REGISTER Lisp_Object propval, Lisp_Object list)
2675 REGISTER Lisp_Object tail, proptail;
2676 for (tail = list; CONSP (tail); tail = XCDR (tail))
2678 REGISTER Lisp_Object tem;
2680 if (EQ (propval, tem))
2682 if (CONSP (tem) && EQ (propval, XCAR (tem)))
2685 if (CONSP (propval))
2686 for (proptail = propval; CONSP (proptail);
2687 proptail = XCDR (proptail))
2689 Lisp_Object propelt;
2690 propelt = XCAR (proptail);
2691 for (tail = list; CONSP (tail); tail = XCDR (tail))
2693 REGISTER Lisp_Object tem;
2695 if (EQ (propelt, tem))
2697 if (CONSP (tem) && EQ (propelt, XCAR (tem)))
2704 /* Return 1 if PROPVAL appears as the car of an element of LIST
2705 and the cdr of that element is non-nil.
2706 If PROPVAL is a list, check each element of PROPVAL in that way,
2707 and the first time some element is found,
2708 return 1 if the cdr of that element is non-nil.
2710 This function cannot quit. */
2713 invisible_ellipsis_p (REGISTER Lisp_Object propval, Lisp_Object list)
2715 REGISTER Lisp_Object tail, proptail;
2716 for (tail = list; CONSP (tail); tail = XCDR (tail))
2718 REGISTER Lisp_Object tem;
2720 if (CONSP (tem) && EQ (propval, XCAR (tem)))
2721 return ! NILP (XCDR (tem));
2723 if (CONSP (propval))
2724 for (proptail = propval; CONSP (proptail);
2725 proptail = XCDR (proptail))
2727 Lisp_Object propelt;
2728 propelt = XCAR (proptail);
2729 for (tail = list; CONSP (tail); tail = XCDR (tail))
2731 REGISTER Lisp_Object tem;
2733 if (CONSP (tem) && EQ (propelt, XCAR (tem)))
2734 return ! NILP (XCDR (tem));
2741 extent_fragment_update (struct window *w, struct extent_fragment *ef,
2746 buffer_or_string_stack_of_extents_force (ef->object)->extents;
2748 struct extent dummy_lhe_extent;
2749 Memind mempos = buffer_or_string_bytind_to_memind (ef->object, pos);
2751 #ifdef ERROR_CHECK_EXTENTS
2752 assert (pos >= buffer_or_string_accessible_begin_byte (ef->object)
2753 && pos <= buffer_or_string_accessible_end_byte (ef->object));
2756 Dynarr_reset (ef->extents);
2757 Dynarr_reset (ef->begin_glyphs);
2758 Dynarr_reset (ef->end_glyphs);
2760 ef->previously_invisible = ef->invisible;
2763 if (ef->invisible_ellipses)
2764 ef->invisible_ellipses_already_displayed = 1;
2767 ef->invisible_ellipses_already_displayed = 0;
2769 ef->invisible_ellipses = 0;
2771 /* Set up the begin and end positions. */
2773 ef->end = extent_find_end_of_run (ef->object, pos, 0);
2775 /* Note that extent_find_end_of_run() already moved the SOE for us. */
2776 /* soe_move (ef->object, mempos); */
2778 /* Determine the begin glyphs at POS. */
2779 for (i = 0; i < extent_list_num_els (sel); i++)
2781 EXTENT e = extent_list_at (sel, i, 0);
2782 if (extent_start (e) == mempos && !NILP (extent_begin_glyph (e)))
2784 Lisp_Object glyph = extent_begin_glyph (e);
2785 struct glyph_block gb;
2788 XSETEXTENT (gb.extent, e);
2789 Dynarr_add (ef->begin_glyphs, gb);
2793 /* Determine the end glyphs at POS. */
2794 for (i = 0; i < extent_list_num_els (sel); i++)
2796 EXTENT e = extent_list_at (sel, i, 1);
2797 if (extent_end (e) == mempos && !NILP (extent_end_glyph (e)))
2799 Lisp_Object glyph = extent_end_glyph (e);
2800 struct glyph_block gb;
2803 XSETEXTENT (gb.extent, e);
2804 Dynarr_add (ef->end_glyphs, gb);
2808 /* We tried determining all the charsets used in the run here,
2809 but that fails even if we only do the current line -- display
2810 tables or non-printable characters might cause other charsets
2813 /* Determine whether the last-highlighted-extent is present. */
2814 if (EXTENTP (Vlast_highlighted_extent))
2815 lhe = XEXTENT (Vlast_highlighted_extent);
2817 /* Now add all extents that overlap the character after POS and
2818 have a non-nil face. Also check if the character is invisible. */
2819 for (i = 0; i < extent_list_num_els (sel); i++)
2821 EXTENT e = extent_list_at (sel, i, 0);
2822 if (extent_end (e) > mempos)
2824 Lisp_Object invis_prop = extent_invisible (e);
2826 if (!NILP (invis_prop))
2828 if (!BUFFERP (ef->object))
2829 /* #### no `string-invisibility-spec' */
2833 if (!ef->invisible_ellipses_already_displayed &&
2834 EXTENT_PROP_MEANS_INVISIBLE_WITH_ELLIPSIS
2835 (XBUFFER (ef->object), invis_prop))
2838 ef->invisible_ellipses = 1;
2840 else if (EXTENT_PROP_MEANS_INVISIBLE
2841 (XBUFFER (ef->object), invis_prop))
2846 /* Remember that one of the extents in the list might be our
2847 dummy extent representing the highlighting that is
2848 attached to some other extent that is currently
2849 mouse-highlighted. When an extent is mouse-highlighted,
2850 it is as if there are two extents there, of potentially
2851 different priorities: the extent being highlighted, with
2852 whatever face and priority it has; and an ephemeral
2853 extent in the `mouse-face' face with
2854 `mouse-highlight-priority'.
2857 if (!NILP (extent_face (e)))
2858 Dynarr_add (ef->extents, e);
2862 /* zeroing isn't really necessary; we only deref `priority'
2864 xzero (dummy_lhe_extent);
2865 set_extent_priority (&dummy_lhe_extent,
2866 mouse_highlight_priority);
2867 /* Need to break up thefollowing expression, due to an */
2868 /* error in the Digital UNIX 3.2g C compiler (Digital */
2869 /* UNIX Compiler Driver 3.11). */
2870 f = extent_mouse_face (lhe);
2871 extent_face (&dummy_lhe_extent) = f;
2872 Dynarr_add (ef->extents, &dummy_lhe_extent);
2874 /* since we are looping anyway, we might as well do this here */
2875 if ((!NILP(extent_initial_redisplay_function (e))) &&
2876 !extent_in_red_event_p(e))
2878 Lisp_Object function = extent_initial_redisplay_function (e);
2881 /* printf ("initial redisplay function called!\n "); */
2883 /* print_extent_2 (e);
2886 /* FIXME: One should probably inhibit the displaying of
2887 this extent to reduce flicker */
2888 extent_in_red_event_p(e) = 1;
2890 /* call the function */
2893 Fenqueue_eval_event(function,obj);
2898 extent_fragment_sort_by_priority (ef->extents);
2900 /* Now merge the faces together into a single face. The code to
2901 do this is in faces.c because it involves manipulating faces. */
2902 return get_extent_fragment_face_cache_index (w, ef);
2906 /************************************************************************/
2907 /* extent-object methods */
2908 /************************************************************************/
2910 /* These are the basic helper functions for handling the allocation of
2911 extent objects. They are similar to the functions for other
2912 lrecord objects. allocate_extent() is in alloc.c, not here. */
2914 static Lisp_Object mark_extent (Lisp_Object, void (*) (Lisp_Object));
2915 static int extent_equal (Lisp_Object, Lisp_Object, int depth);
2916 static unsigned long extent_hash (Lisp_Object obj, int depth);
2917 static void print_extent (Lisp_Object obj, Lisp_Object printcharfun,
2919 static Lisp_Object extent_getprop (Lisp_Object obj, Lisp_Object prop);
2920 static int extent_putprop (Lisp_Object obj, Lisp_Object prop,
2922 static int extent_remprop (Lisp_Object obj, Lisp_Object prop);
2923 static Lisp_Object extent_plist (Lisp_Object obj);
2925 DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS ("extent", extent,
2928 /* NOTE: If you declare a
2929 finalization method here,
2930 it will NOT be called.
2933 extent_equal, extent_hash,
2934 extent_getprop, extent_putprop,
2935 extent_remprop, extent_plist,
2939 mark_extent (Lisp_Object obj, void (*markobj) (Lisp_Object))
2941 struct extent *extent = XEXTENT (obj);
2943 ((markobj) (extent_object (extent)));
2944 ((markobj) (extent_no_chase_normal_field (extent, face)));
2945 return extent->plist;
2949 print_extent_1 (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
2951 EXTENT ext = XEXTENT (obj);
2952 EXTENT anc = extent_ancestor (ext);
2954 char buf[64], *bp = buf;
2956 /* Retrieve the ancestor and use it, for faster retrieval of properties */
2958 if (!NILP (extent_begin_glyph (anc))) *bp++ = '*';
2959 *bp++ = (extent_start_open_p (anc) ? '(': '[');
2960 if (extent_detached_p (ext))
2961 strcpy (bp, "detached");
2964 Bufpos from = XINT (Fextent_start_position (obj));
2965 Bufpos to = XINT (Fextent_end_position (obj));
2966 sprintf (bp, "%d, %d", from, to);
2969 *bp++ = (extent_end_open_p (anc) ? ')': ']');
2970 if (!NILP (extent_end_glyph (anc))) *bp++ = '*';
2973 if (!NILP (extent_read_only (anc))) *bp++ = '%';
2974 if (!NILP (extent_mouse_face (anc))) *bp++ = 'H';
2975 if (extent_unique_p (anc)) *bp++ = 'U';
2976 else if (extent_duplicable_p (anc)) *bp++ = 'D';
2977 if (!NILP (extent_invisible (anc))) *bp++ = 'I';
2979 if (!NILP (extent_read_only (anc)) || !NILP (extent_mouse_face (anc)) ||
2980 extent_unique_p (anc) ||
2981 extent_duplicable_p (anc) || !NILP (extent_invisible (anc)))
2984 write_c_string (buf, printcharfun);
2986 tail = extent_plist_slot (anc);
2988 for (; !NILP (tail); tail = Fcdr (Fcdr (tail)))
2990 Lisp_Object v = XCAR (XCDR (tail));
2991 if (NILP (v)) continue;
2992 print_internal (XCAR (tail), printcharfun, escapeflag);
2993 write_c_string (" ", printcharfun);
2996 sprintf (buf, "0x%lx", (unsigned long int) ext);
2997 write_c_string (buf, printcharfun);
3001 print_extent (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
3005 CONST char *title = "";
3006 CONST char *name = "";
3007 CONST char *posttitle = "";
3008 Lisp_Object obj2 = Qnil;
3010 /* Destroyed extents have 't' in the object field, causing
3011 extent_object() to abort (maybe). */
3012 if (EXTENT_LIVE_P (XEXTENT (obj)))
3013 obj2 = extent_object (XEXTENT (obj));
3016 title = "no buffer";
3017 else if (BUFFERP (obj2))
3019 if (BUFFER_LIVE_P (XBUFFER (obj2)))
3022 name = (char *) XSTRING_DATA (XBUFFER (obj2)->name);
3026 title = "Killed Buffer";
3032 assert (STRINGP (obj2));
3033 title = "string \"";
3035 name = (char *) XSTRING_DATA (obj2);
3040 if (!EXTENT_LIVE_P (XEXTENT (obj)))
3041 error ("printing unreadable object #<destroyed extent>");
3043 error ("printing unreadable object #<extent 0x%p>",
3047 if (!EXTENT_LIVE_P (XEXTENT (obj)))
3048 write_c_string ("#<destroyed extent", printcharfun);
3051 char *buf = (char *)
3052 alloca (strlen (title) + strlen (name) + strlen (posttitle) + 1);
3053 write_c_string ("#<extent ", printcharfun);
3054 print_extent_1 (obj, printcharfun, escapeflag);
3055 write_c_string (extent_detached_p (XEXTENT (obj))
3056 ? " from " : " in ", printcharfun);
3057 sprintf (buf, "%s%s%s", title, name, posttitle);
3058 write_c_string (buf, printcharfun);
3064 error ("printing unreadable object #<extent>");
3065 write_c_string ("#<extent", printcharfun);
3067 write_c_string (">", printcharfun);
3071 properties_equal (EXTENT e1, EXTENT e2, int depth)
3073 /* When this function is called, all indirections have been followed.
3074 Thus, the indirection checks in the various macros below will not
3075 amount to anything, and could be removed. However, the time
3076 savings would probably not be significant. */
3077 if (!(EQ (extent_face (e1), extent_face (e2)) &&
3078 extent_priority (e1) == extent_priority (e2) &&
3079 internal_equal (extent_begin_glyph (e1), extent_begin_glyph (e2),
3081 internal_equal (extent_end_glyph (e1), extent_end_glyph (e2),
3085 /* compare the bit flags. */
3087 /* The has_aux field should not be relevant. */
3088 int e1_has_aux = e1->flags.has_aux;
3089 int e2_has_aux = e2->flags.has_aux;
3092 e1->flags.has_aux = e2->flags.has_aux = 0;
3093 value = memcmp (&e1->flags, &e2->flags, sizeof (e1->flags));
3094 e1->flags.has_aux = e1_has_aux;
3095 e2->flags.has_aux = e2_has_aux;
3100 /* compare the random elements of the plists. */
3101 return !plists_differ (extent_no_chase_plist (e1),
3102 extent_no_chase_plist (e2),
3107 extent_equal (Lisp_Object o1, Lisp_Object o2, int depth)
3109 struct extent *e1 = XEXTENT (o1);
3110 struct extent *e2 = XEXTENT (o2);
3112 (extent_start (e1) == extent_start (e2) &&
3113 extent_end (e1) == extent_end (e2) &&
3114 internal_equal (extent_object (e1), extent_object (e2), depth + 1) &&
3115 properties_equal (extent_ancestor (e1), extent_ancestor (e2),
3119 static unsigned long
3120 extent_hash (Lisp_Object obj, int depth)
3122 struct extent *e = XEXTENT (obj);
3123 /* No need to hash all of the elements; that would take too long.
3124 Just hash the most common ones. */
3125 return HASH3 (extent_start (e), extent_end (e),
3126 internal_hash (extent_object (e), depth + 1));
3130 extent_getprop (Lisp_Object obj, Lisp_Object prop)
3132 return Fextent_property (obj, prop, Qunbound);
3136 extent_putprop (Lisp_Object obj, Lisp_Object prop, Lisp_Object value)
3138 Fset_extent_property (obj, prop, value);
3143 extent_remprop (Lisp_Object obj, Lisp_Object prop)
3145 EXTENT ext = XEXTENT (obj);
3147 /* This list is taken from Fset_extent_property, and should be kept
3149 if (EQ (prop, Qread_only)
3150 || EQ (prop, Qunique)
3151 || EQ (prop, Qduplicable)
3152 || EQ (prop, Qinvisible)
3153 || EQ (prop, Qdetachable)
3154 || EQ (prop, Qdetached)
3155 || EQ (prop, Qdestroyed)
3156 || EQ (prop, Qpriority)
3158 || EQ (prop, Qinitial_redisplay_function)
3159 || EQ (prop, Qmouse_face)
3160 || EQ (prop, Qhighlight)
3161 || EQ (prop, Qbegin_glyph_layout)
3162 || EQ (prop, Qend_glyph_layout)
3163 || EQ (prop, Qglyph_layout)
3164 || EQ (prop, Qbegin_glyph)
3165 || EQ (prop, Qend_glyph)
3166 || EQ (prop, Qstart_open)
3167 || EQ (prop, Qend_open)
3168 || EQ (prop, Qstart_closed)
3169 || EQ (prop, Qend_closed)
3170 || EQ (prop, Qkeymap))
3172 /* #### Is this correct, anyway? */
3176 return external_remprop (&ext->plist, prop, 0, ERROR_ME);
3180 extent_plist (Lisp_Object obj)
3182 return Fextent_properties (obj);
3186 /************************************************************************/
3187 /* basic extent accessors */
3188 /************************************************************************/
3190 /* These functions are for checking externally-passed extent objects
3191 and returning an extent's basic properties, which include the
3192 buffer the extent is associated with, the endpoints of the extent's
3193 range, the open/closed-ness of those endpoints, and whether the
3194 extent is detached. Manipulating these properties requires
3195 manipulating the ordered lists that hold extents; thus, functions
3196 to do that are in a later section. */
3198 /* Given a Lisp_Object that is supposed to be an extent, make sure it
3199 is OK and return an extent pointer. Extents can be in one of four
3203 2) detached and not associated with a buffer
3204 3) detached and associated with a buffer
3205 4) attached to a buffer
3207 If FLAGS is 0, types 2-4 are allowed. If FLAGS is DE_MUST_HAVE_BUFFER,
3208 types 3-4 are allowed. If FLAGS is DE_MUST_BE_ATTACHED, only type 4
3213 decode_extent (Lisp_Object extent_obj, unsigned int flags)
3218 CHECK_LIVE_EXTENT (extent_obj);
3219 extent = XEXTENT (extent_obj);
3220 obj = extent_object (extent);
3222 /* the following condition will fail if we're dealing with a freed extent */
3223 assert (NILP (obj) || BUFFERP (obj) || STRINGP (obj));
3225 if (flags & DE_MUST_BE_ATTACHED)
3226 flags |= DE_MUST_HAVE_BUFFER;
3228 /* if buffer is dead, then convert extent to have no buffer. */
3229 if (BUFFERP (obj) && !BUFFER_LIVE_P (XBUFFER (obj)))
3230 obj = extent_object (extent) = Qnil;
3232 assert (!NILP (obj) || extent_detached_p (extent));
3234 if ((NILP (obj) && (flags & DE_MUST_HAVE_BUFFER))
3235 || (extent_detached_p (extent) && (flags & DE_MUST_BE_ATTACHED)))
3237 signal_simple_error ("extent doesn't belong to a buffer or string",
3244 /* Note that the returned value is a buffer position, not a byte index. */
3247 extent_endpoint_external (Lisp_Object extent_obj, int endp)
3249 EXTENT extent = decode_extent (extent_obj, 0);
3251 if (extent_detached_p (extent))
3254 return make_int (extent_endpoint_bufpos (extent, endp));
3257 DEFUN ("extentp", Fextentp, 1, 1, 0, /*
3258 Return t if OBJECT is an extent.
3262 return EXTENTP (object) ? Qt : Qnil;
3265 DEFUN ("extent-live-p", Fextent_live_p, 1, 1, 0, /*
3266 Return t if OBJECT is an extent that has not been destroyed.
3270 return EXTENTP (object) && EXTENT_LIVE_P (XEXTENT (object)) ? Qt : Qnil;
3273 DEFUN ("extent-detached-p", Fextent_detached_p, 1, 1, 0, /*
3274 Return t if EXTENT is detached.
3278 return extent_detached_p (decode_extent (extent, 0)) ? Qt : Qnil;
3281 DEFUN ("extent-object", Fextent_object, 1, 1, 0, /*
3282 Return object (buffer or string) that EXTENT refers to.
3286 return extent_object (decode_extent (extent, 0));
3289 DEFUN ("extent-start-position", Fextent_start_position, 1, 1, 0, /*
3290 Return start position of EXTENT, or nil if EXTENT is detached.
3294 return extent_endpoint_external (extent, 0);
3297 DEFUN ("extent-end-position", Fextent_end_position, 1, 1, 0, /*
3298 Return end position of EXTENT, or nil if EXTENT is detached.
3302 return extent_endpoint_external (extent, 1);
3305 DEFUN ("extent-length", Fextent_length, 1, 1, 0, /*
3306 Return length of EXTENT in characters.
3310 EXTENT e = decode_extent (extent, DE_MUST_BE_ATTACHED);
3311 return make_int (extent_endpoint_bufpos (e, 1)
3312 - extent_endpoint_bufpos (e, 0));
3315 DEFUN ("next-extent", Fnext_extent, 1, 1, 0, /*
3316 Find next extent after EXTENT.
3317 If EXTENT is a buffer return the first extent in the buffer; likewise
3319 Extents in a buffer are ordered in what is called the "display"
3320 order, which sorts by increasing start positions and then by *decreasing*
3322 If you want to perform an operation on a series of extents, use
3323 `map-extents' instead of this function; it is much more efficient.
3324 The primary use of this function should be to enumerate all the
3325 extents in a buffer.
3326 Note: The display order is not necessarily the order that `map-extents'
3327 processes extents in!
3334 if (EXTENTP (extent))
3335 next = extent_next (decode_extent (extent, DE_MUST_BE_ATTACHED));
3337 next = extent_first (decode_buffer_or_string (extent));
3341 XSETEXTENT (val, next);
3345 DEFUN ("previous-extent", Fprevious_extent, 1, 1, 0, /*
3346 Find last extent before EXTENT.
3347 If EXTENT is a buffer return the last extent in the buffer; likewise
3349 This function is analogous to `next-extent'.
3356 if (EXTENTP (extent))
3357 prev = extent_previous (decode_extent (extent, DE_MUST_BE_ATTACHED));
3359 prev = extent_last (decode_buffer_or_string (extent));
3363 XSETEXTENT (val, prev);
3369 DEFUN ("next-e-extent", Fnext_e_extent, 1, 1, 0, /*
3370 Find next extent after EXTENT using the "e" order.
3371 If EXTENT is a buffer return the first extent in the buffer; likewise
3379 if (EXTENTP (extent))
3380 next = extent_e_next (decode_extent (extent, DE_MUST_BE_ATTACHED));
3382 next = extent_e_first (decode_buffer_or_string (extent));
3386 XSETEXTENT (val, next);
3390 DEFUN ("previous-e-extent", Fprevious_e_extent, 1, 1, 0, /*
3391 Find last extent before EXTENT using the "e" order.
3392 If EXTENT is a buffer return the last extent in the buffer; likewise
3394 This function is analogous to `next-e-extent'.
3401 if (EXTENTP (extent))
3402 prev = extent_e_previous (decode_extent (extent, DE_MUST_BE_ATTACHED));
3404 prev = extent_e_last (decode_buffer_or_string (extent));
3408 XSETEXTENT (val, prev);
3414 DEFUN ("next-extent-change", Fnext_extent_change, 1, 2, 0, /*
3415 Return the next position after POS where an extent begins or ends.
3416 If POS is at the end of the buffer or string, POS will be returned;
3417 otherwise a position greater than POS will always be returned.
3418 If BUFFER is nil, the current buffer is assumed.
3422 Lisp_Object obj = decode_buffer_or_string (object);
3425 bpos = get_buffer_or_string_pos_byte (obj, pos, GB_ALLOW_PAST_ACCESSIBLE);
3426 bpos = extent_find_end_of_run (obj, bpos, 1);
3427 return make_int (buffer_or_string_bytind_to_bufpos (obj, bpos));
3430 DEFUN ("previous-extent-change", Fprevious_extent_change, 1, 2, 0, /*
3431 Return the last position before POS where an extent begins or ends.
3432 If POS is at the beginning of the buffer or string, POS will be returned;
3433 otherwise a position less than POS will always be returned.
3434 If OBJECT is nil, the current buffer is assumed.
3438 Lisp_Object obj = decode_buffer_or_string (object);
3441 bpos = get_buffer_or_string_pos_byte (obj, pos, GB_ALLOW_PAST_ACCESSIBLE);
3442 bpos = extent_find_beginning_of_run (obj, bpos, 1);
3443 return make_int (buffer_or_string_bytind_to_bufpos (obj, bpos));
3447 /************************************************************************/
3448 /* parent and children stuff */
3449 /************************************************************************/
3451 DEFUN ("extent-parent", Fextent_parent, 1, 1, 0, /*
3452 Return the parent (if any) of EXTENT.
3453 If an extent has a parent, it derives all its properties from that extent
3454 and has no properties of its own. (The only "properties" that the
3455 extent keeps are the buffer/string it refers to and the start and end
3456 points.) It is possible for an extent's parent to itself have a parent.
3459 /* do I win the prize for the strangest split infinitive? */
3461 EXTENT e = decode_extent (extent, 0);
3462 return extent_parent (e);
3465 DEFUN ("extent-children", Fextent_children, 1, 1, 0, /*
3466 Return a list of the children (if any) of EXTENT.
3467 The children of an extent are all those extents whose parent is that extent.
3468 This function does not recursively trace children of children.
3469 \(To do that, use `extent-descendants'.)
3473 EXTENT e = decode_extent (extent, 0);
3474 Lisp_Object children = extent_children (e);
3476 if (!NILP (children))
3477 return Fcopy_sequence (XWEAK_LIST_LIST (children));
3483 remove_extent_from_children_list (EXTENT e, Lisp_Object child)
3485 Lisp_Object children = extent_children (e);
3487 #ifdef ERROR_CHECK_EXTENTS
3488 assert (!NILP (memq_no_quit (child, XWEAK_LIST_LIST (children))));
3490 XWEAK_LIST_LIST (children) =
3491 delq_no_quit (child, XWEAK_LIST_LIST (children));
3495 add_extent_to_children_list (EXTENT e, Lisp_Object child)
3497 Lisp_Object children = extent_children (e);
3499 if (NILP (children))
3501 children = make_weak_list (WEAK_LIST_SIMPLE);
3502 set_extent_no_chase_aux_field (e, children, children);
3505 #ifdef ERROR_CHECK_EXTENTS
3506 assert (NILP (memq_no_quit (child, XWEAK_LIST_LIST (children))));
3508 XWEAK_LIST_LIST (children) = Fcons (child, XWEAK_LIST_LIST (children));
3511 DEFUN ("set-extent-parent", Fset_extent_parent, 2, 2, 0, /*
3512 Set the parent of EXTENT to PARENT (may be nil).
3513 See `extent-parent'.
3517 EXTENT e = decode_extent (extent, 0);
3518 Lisp_Object cur_parent = extent_parent (e);
3521 XSETEXTENT (extent, e);
3523 CHECK_LIVE_EXTENT (parent);
3524 if (EQ (parent, cur_parent))
3526 for (rest = parent; !NILP (rest); rest = extent_parent (XEXTENT (rest)))
3527 if (EQ (rest, extent))
3528 signal_simple_error ("Circular parent chain would result", extent);
3531 remove_extent_from_children_list (XEXTENT (cur_parent), extent);
3532 set_extent_no_chase_aux_field (e, parent, Qnil);
3533 e->flags.has_parent = 0;
3537 add_extent_to_children_list (XEXTENT (parent), extent);
3538 set_extent_no_chase_aux_field (e, parent, parent);
3539 e->flags.has_parent = 1;
3541 /* changing the parent also changes the properties of all children. */
3543 int old_invis = (!NILP (cur_parent) &&
3544 !NILP (extent_invisible (XEXTENT (cur_parent))));
3545 int new_invis = (!NILP (parent) &&
3546 !NILP (extent_invisible (XEXTENT (parent))));
3548 extent_maybe_changed_for_redisplay (e, 1, new_invis != old_invis);
3555 /************************************************************************/
3556 /* basic extent mutators */
3557 /************************************************************************/
3559 /* Note: If you track non-duplicable extents by undo, you'll get bogus
3560 undo records for transient extents via update-extent.
3561 For example, query-replace will do this.
3565 set_extent_endpoints_1 (EXTENT extent, Memind start, Memind end)
3567 #ifdef ERROR_CHECK_EXTENTS
3568 Lisp_Object obj = extent_object (extent);
3570 assert (start <= end);
3573 assert (valid_memind_p (XBUFFER (obj), start));
3574 assert (valid_memind_p (XBUFFER (obj), end));
3578 /* Optimization: if the extent is already where we want it to be,
3580 if (!extent_detached_p (extent) && extent_start (extent) == start &&
3581 extent_end (extent) == end)
3584 if (extent_detached_p (extent))
3586 if (extent_duplicable_p (extent))
3588 Lisp_Object extent_obj;
3589 XSETEXTENT (extent_obj, extent);
3590 record_extent (extent_obj, 1);
3594 extent_detach (extent);
3596 set_extent_start (extent, start);
3597 set_extent_end (extent, end);
3598 extent_attach (extent);
3601 /* Set extent's endpoints to S and E, and put extent in buffer or string
3602 OBJECT. (If OBJECT is nil, do not change the extent's object.) */
3605 set_extent_endpoints (EXTENT extent, Bytind s, Bytind e, Lisp_Object object)
3611 object = extent_object (extent);
3612 assert (!NILP (object));
3614 else if (!EQ (object, extent_object (extent)))
3616 extent_detach (extent);
3617 extent_object (extent) = object;
3620 start = s < 0 ? extent_start (extent) :
3621 buffer_or_string_bytind_to_memind (object, s);
3622 end = e < 0 ? extent_end (extent) :
3623 buffer_or_string_bytind_to_memind (object, e);
3624 set_extent_endpoints_1 (extent, start, end);
3628 set_extent_openness (EXTENT extent, int start_open, int end_open)
3630 if (start_open != -1)
3631 extent_start_open_p (extent) = start_open;
3633 extent_end_open_p (extent) = end_open;
3634 /* changing the open/closedness of an extent does not affect
3639 make_extent_internal (Lisp_Object object, Bytind from, Bytind to)
3643 extent = make_extent_detached (object);
3644 set_extent_endpoints (extent, from, to, Qnil);
3649 copy_extent (EXTENT original, Bytind from, Bytind to, Lisp_Object object)
3653 e = make_extent_detached (object);
3655 set_extent_endpoints (e, from, to, Qnil);
3657 e->plist = Fcopy_sequence (original->plist);
3658 memcpy (&e->flags, &original->flags, sizeof (e->flags));
3659 if (e->flags.has_aux)
3661 /* also need to copy the aux struct. It won't work for
3662 this extent to share the same aux struct as the original
3664 struct extent_auxiliary *data =
3665 alloc_lcrecord_type (struct extent_auxiliary,
3666 lrecord_extent_auxiliary);
3668 copy_lcrecord (data, XEXTENT_AUXILIARY (XCAR (original->plist)));
3669 XSETEXTENT_AUXILIARY (XCAR (e->plist), data);
3673 /* we may have just added another child to the parent extent. */
3674 Lisp_Object parent = extent_parent (e);
3678 XSETEXTENT (extent, e);
3679 add_extent_to_children_list (XEXTENT (parent), extent);
3687 destroy_extent (EXTENT extent)
3689 Lisp_Object rest, nextrest, children;
3690 Lisp_Object extent_obj;
3692 if (!extent_detached_p (extent))
3693 extent_detach (extent);
3694 /* disassociate the extent from its children and parent */
3695 children = extent_children (extent);
3696 if (!NILP (children))
3698 LIST_LOOP_DELETING (rest, nextrest, XWEAK_LIST_LIST (children))
3699 Fset_extent_parent (XCAR (rest), Qnil);
3701 XSETEXTENT (extent_obj, extent);
3702 Fset_extent_parent (extent_obj, Qnil);
3703 /* mark the extent as destroyed */
3704 extent_object (extent) = Qt;
3707 DEFUN ("make-extent", Fmake_extent, 2, 3, 0, /*
3708 Make an extent for the range [FROM, TO) in BUFFER-OR-STRING.
3709 BUFFER-OR-STRING defaults to the current buffer. Insertions at point
3710 TO will be outside of the extent; insertions at FROM will be inside the
3711 extent, causing the extent to grow. (This is the same way that markers
3712 behave.) You can change the behavior of insertions at the endpoints
3713 using `set-extent-property'. The extent is initially detached if both
3714 FROM and TO are nil, and in this case BUFFER-OR-STRING defaults to nil,
3715 meaning the extent is in no buffer and no string.
3717 (from, to, buffer_or_string))
3719 Lisp_Object extent_obj;
3722 obj = decode_buffer_or_string (buffer_or_string);
3723 if (NILP (from) && NILP (to))
3725 if (NILP (buffer_or_string))
3727 XSETEXTENT (extent_obj, make_extent_detached (obj));
3733 get_buffer_or_string_range_byte (obj, from, to, &start, &end,
3734 GB_ALLOW_PAST_ACCESSIBLE);
3735 XSETEXTENT (extent_obj, make_extent_internal (obj, start, end));
3740 DEFUN ("copy-extent", Fcopy_extent, 1, 2, 0, /*
3741 Make a copy of EXTENT. It is initially detached.
3742 Optional argument BUFFER-OR-STRING defaults to EXTENT's buffer or string.
3744 (extent, buffer_or_string))
3746 EXTENT ext = decode_extent (extent, 0);
3748 if (NILP (buffer_or_string))
3749 buffer_or_string = extent_object (ext);
3751 buffer_or_string = decode_buffer_or_string (buffer_or_string);
3753 XSETEXTENT (extent, copy_extent (ext, -1, -1, buffer_or_string));
3757 DEFUN ("delete-extent", Fdelete_extent, 1, 1, 0, /*
3758 Remove EXTENT from its buffer and destroy it.
3759 This does not modify the buffer's text, only its display properties.
3760 The extent cannot be used thereafter.
3766 /* We do not call decode_extent() here because already-destroyed
3768 CHECK_EXTENT (extent);
3769 ext = XEXTENT (extent);
3771 if (!EXTENT_LIVE_P (ext))
3773 destroy_extent (ext);
3777 DEFUN ("detach-extent", Fdetach_extent, 1, 1, 0, /*
3778 Remove EXTENT from its buffer in such a way that it can be re-inserted.
3779 An extent is also detached when all of its characters are all killed by a
3780 deletion, unless its `detachable' property has been unset.
3782 Extents which have the `duplicable' attribute are tracked by the undo
3783 mechanism. Detachment via `detach-extent' and string deletion is recorded,
3784 as is attachment via `insert-extent' and string insertion. Extent motion,
3785 face changes, and attachment via `make-extent' and `set-extent-endpoints'
3786 are not recorded. This means that extent changes which are to be undo-able
3787 must be performed by character editing, or by insertion and detachment of
3792 EXTENT ext = decode_extent (extent, 0);
3794 if (extent_detached_p (ext))
3796 if (extent_duplicable_p (ext))
3797 record_extent (extent, 0);
3798 extent_detach (ext);
3803 DEFUN ("set-extent-endpoints", Fset_extent_endpoints, 3, 4, 0, /*
3804 Set the endpoints of EXTENT to START, END.
3805 If START and END are null, call detach-extent on EXTENT.
3806 BUFFER-OR-STRING specifies the new buffer or string that the extent should
3807 be in, and defaults to EXTENT's buffer or string. (If nil, and EXTENT
3808 is in no buffer and no string, it defaults to the current buffer.)
3809 See documentation on `detach-extent' for a discussion of undo recording.
3811 (extent, start, end, buffer_or_string))
3816 ext = decode_extent (extent, 0);
3818 if (NILP (buffer_or_string))
3820 buffer_or_string = extent_object (ext);
3821 if (NILP (buffer_or_string))
3822 buffer_or_string = Fcurrent_buffer ();
3825 buffer_or_string = decode_buffer_or_string (buffer_or_string);
3827 if (NILP (start) && NILP (end))
3828 return Fdetach_extent (extent);
3830 get_buffer_or_string_range_byte (buffer_or_string, start, end, &s, &e,
3831 GB_ALLOW_PAST_ACCESSIBLE);
3833 set_extent_endpoints (ext, s, e, buffer_or_string);
3838 /************************************************************************/
3839 /* mapping over extents */
3840 /************************************************************************/
3843 decode_map_extents_flags (Lisp_Object flags)
3845 unsigned int retval = 0;
3846 unsigned int all_extents_specified = 0;
3847 unsigned int in_region_specified = 0;
3849 if (EQ (flags, Qt)) /* obsoleteness compatibility */
3850 return ME_END_CLOSED;
3853 if (SYMBOLP (flags))
3854 flags = Fcons (flags, Qnil);
3855 while (!NILP (flags))
3861 if (EQ (sym, Qall_extents_closed) || EQ (sym, Qall_extents_open) ||
3862 EQ (sym, Qall_extents_closed_open) ||
3863 EQ (sym, Qall_extents_open_closed))
3865 if (all_extents_specified)
3866 error ("Only one `all-extents-*' flag may be specified");
3867 all_extents_specified = 1;
3869 if (EQ (sym, Qstart_in_region) || EQ (sym, Qend_in_region) ||
3870 EQ (sym, Qstart_and_end_in_region) ||
3871 EQ (sym, Qstart_or_end_in_region))
3873 if (in_region_specified)
3874 error ("Only one `*-in-region' flag may be specified");
3875 in_region_specified = 1;
3878 /* I do so love that conditional operator ... */
3880 EQ (sym, Qend_closed) ? ME_END_CLOSED :
3881 EQ (sym, Qstart_open) ? ME_START_OPEN :
3882 EQ (sym, Qall_extents_closed) ? ME_ALL_EXTENTS_CLOSED :
3883 EQ (sym, Qall_extents_open) ? ME_ALL_EXTENTS_OPEN :
3884 EQ (sym, Qall_extents_closed_open) ? ME_ALL_EXTENTS_CLOSED_OPEN :
3885 EQ (sym, Qall_extents_open_closed) ? ME_ALL_EXTENTS_OPEN_CLOSED :
3886 EQ (sym, Qstart_in_region) ? ME_START_IN_REGION :
3887 EQ (sym, Qend_in_region) ? ME_END_IN_REGION :
3888 EQ (sym, Qstart_and_end_in_region) ? ME_START_AND_END_IN_REGION :
3889 EQ (sym, Qstart_or_end_in_region) ? ME_START_OR_END_IN_REGION :
3890 EQ (sym, Qnegate_in_region) ? ME_NEGATE_IN_REGION :
3891 (signal_simple_error ("Invalid `map-extents' flag", sym), 0);
3893 flags = XCDR (flags);
3898 DEFUN ("extent-in-region-p", Fextent_in_region_p, 1, 4, 0, /*
3899 Return whether EXTENT overlaps a specified region.
3900 This is equivalent to whether `map-extents' would visit EXTENT when called
3903 (extent, from, to, flags))
3906 EXTENT ext = decode_extent (extent, DE_MUST_BE_ATTACHED);
3907 Lisp_Object obj = extent_object (ext);
3909 get_buffer_or_string_range_byte (obj, from, to, &start, &end, GB_ALLOW_NIL |
3910 GB_ALLOW_PAST_ACCESSIBLE);
3912 return extent_in_region_p (ext, start, end, decode_map_extents_flags (flags)) ?
3916 struct slow_map_extents_arg
3918 Lisp_Object map_arg;
3919 Lisp_Object map_routine;
3921 Lisp_Object property;
3926 slow_map_extents_function (EXTENT extent, void *arg)
3928 /* This function can GC */
3929 struct slow_map_extents_arg *closure = (struct slow_map_extents_arg *) arg;
3930 Lisp_Object extent_obj;
3932 XSETEXTENT (extent_obj, extent);
3934 /* make sure this extent qualifies according to the PROPERTY
3937 if (!NILP (closure->property))
3939 Lisp_Object value = Fextent_property (extent_obj, closure->property,
3941 if ((NILP (closure->value) && NILP (value)) ||
3942 (!NILP (closure->value) && !EQ (value, closure->value)))
3946 closure->result = call2 (closure->map_routine, extent_obj,
3948 return !NILP (closure->result);
3951 DEFUN ("map-extents", Fmap_extents, 1, 8, 0, /*
3952 Map FUNCTION over the extents which overlap a region in OBJECT.
3953 OBJECT is normally a buffer or string but could be an extent (see below).
3954 The region is normally bounded by [FROM, TO) (i.e. the beginning of the
3955 region is closed and the end of the region is open), but this can be
3956 changed with the FLAGS argument (see below for a complete discussion).
3958 FUNCTION is called with the arguments (extent, MAPARG). The arguments
3959 OBJECT, FROM, TO, MAPARG, and FLAGS are all optional and default to
3960 the current buffer, the beginning of OBJECT, the end of OBJECT, nil,
3961 and nil, respectively. `map-extents' returns the first non-nil result
3962 produced by FUNCTION, and no more calls to FUNCTION are made after it
3965 If OBJECT is an extent, FROM and TO default to the extent's endpoints,
3966 and the mapping omits that extent and its predecessors. This feature
3967 supports restarting a loop based on `map-extents'. Note: OBJECT must
3968 be attached to a buffer or string, and the mapping is done over that
3971 An extent overlaps the region if there is any point in the extent that is
3972 also in the region. (For the purpose of overlap, zero-length extents and
3973 regions are treated as closed on both ends regardless of their endpoints'
3974 specified open/closedness.) Note that the endpoints of an extent or region
3975 are considered to be in that extent or region if and only if the
3976 corresponding end is closed. For example, the extent [5,7] overlaps the
3977 region [2,5] because 5 is in both the extent and the region. However, (5,7]
3978 does not overlap [2,5] because 5 is not in the extent, and neither [5,7] nor
3979 \(5,7] overlaps the region [2,5) because 5 is not in the region.
3981 The optional FLAGS can be a symbol or a list of one or more symbols,
3982 modifying the behavior of `map-extents'. Allowed symbols are:
3984 end-closed The region's end is closed.
3986 start-open The region's start is open.
3988 all-extents-closed Treat all extents as closed on both ends for the
3989 purpose of determining whether they overlap the
3990 region, irrespective of their actual open- or
3992 all-extents-open Treat all extents as open on both ends.
3993 all-extents-closed-open Treat all extents as start-closed, end-open.
3994 all-extents-open-closed Treat all extents as start-open, end-closed.
3996 start-in-region In addition to the above conditions for extent
3997 overlap, the extent's start position must lie within
3998 the specified region. Note that, for this
3999 condition, open start positions are treated as if
4000 0.5 was added to the endpoint's value, and open
4001 end positions are treated as if 0.5 was subtracted
4002 from the endpoint's value.
4003 end-in-region The extent's end position must lie within the
4005 start-and-end-in-region Both the extent's start and end positions must lie
4007 start-or-end-in-region Either the extent's start or end position must lie
4010 negate-in-region The condition specified by a `*-in-region' flag
4011 must NOT hold for the extent to be considered.
4014 At most one of `all-extents-closed', `all-extents-open',
4015 `all-extents-closed-open', and `all-extents-open-closed' may be specified.
4017 At most one of `start-in-region', `end-in-region',
4018 `start-and-end-in-region', and `start-or-end-in-region' may be specified.
4020 If optional arg PROPERTY is non-nil, only extents with that property set
4021 on them will be visited. If optional arg VALUE is non-nil, only extents
4022 whose value for that property is `eq' to VALUE will be visited.
4024 (function, object, from, to, maparg, flags, property, value))
4026 /* This function can GC */
4027 struct slow_map_extents_arg closure;
4028 unsigned int me_flags;
4030 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
4033 if (EXTENTP (object))
4035 after = decode_extent (object, DE_MUST_BE_ATTACHED);
4037 from = Fextent_start_position (object);
4039 to = Fextent_end_position (object);
4040 object = extent_object (after);
4043 object = decode_buffer_or_string (object);
4045 get_buffer_or_string_range_byte (object, from, to, &start, &end,
4046 GB_ALLOW_NIL | GB_ALLOW_PAST_ACCESSIBLE);
4048 me_flags = decode_map_extents_flags (flags);
4050 if (!NILP (property))
4053 value = canonicalize_extent_property (property, value);
4056 GCPRO5 (function, maparg, object, property, value);
4058 closure.map_arg = maparg;
4059 closure.map_routine = function;
4060 closure.result = Qnil;
4061 closure.property = property;
4062 closure.value = value;
4064 map_extents_bytind (start, end, slow_map_extents_function,
4065 (void *) &closure, object, after,
4066 /* You never know what the user might do ... */
4067 me_flags | ME_MIGHT_CALL_ELISP);
4070 return closure.result;
4074 /************************************************************************/
4075 /* mapping over extents -- other functions */
4076 /************************************************************************/
4078 /* ------------------------------- */
4079 /* map-extent-children */
4080 /* ------------------------------- */
4082 struct slow_map_extent_children_arg
4084 Lisp_Object map_arg;
4085 Lisp_Object map_routine;
4087 Lisp_Object property;
4095 slow_map_extent_children_function (EXTENT extent, void *arg)
4097 /* This function can GC */
4098 struct slow_map_extent_children_arg *closure =
4099 (struct slow_map_extent_children_arg *) arg;
4100 Lisp_Object extent_obj;
4101 Bytind start = extent_endpoint_bytind (extent, 0);
4102 Bytind end = extent_endpoint_bytind (extent, 1);
4103 /* Make sure the extent starts inside the region of interest,
4104 rather than just overlaps it.
4106 if (start < closure->start_min)
4108 /* Make sure the extent is not a child of a previous visited one.
4109 We know already, because of extent ordering,
4110 that start >= prev_start, and that if
4111 start == prev_start, then end <= prev_end.
4113 if (start == closure->prev_start)
4115 if (end < closure->prev_end)
4118 else /* start > prev_start */
4120 if (start < closure->prev_end)
4122 /* corner case: prev_end can be -1 if there is no prev */
4124 XSETEXTENT (extent_obj, extent);
4126 /* make sure this extent qualifies according to the PROPERTY
4129 if (!NILP (closure->property))
4131 Lisp_Object value = Fextent_property (extent_obj, closure->property,
4133 if ((NILP (closure->value) && NILP (value)) ||
4134 (!NILP (closure->value) && !EQ (value, closure->value)))
4138 closure->result = call2 (closure->map_routine, extent_obj,
4141 /* Since the callback may change the buffer, compute all stored
4142 buffer positions here.
4144 closure->start_min = -1; /* no need for this any more */
4145 closure->prev_start = extent_endpoint_bytind (extent, 0);
4146 closure->prev_end = extent_endpoint_bytind (extent, 1);
4148 return !NILP (closure->result);
4151 DEFUN ("map-extent-children", Fmap_extent_children, 1, 8, 0, /*
4152 Map FUNCTION over the extents in the region from FROM to TO.
4153 FUNCTION is called with arguments (extent, MAPARG). See `map-extents'
4154 for a full discussion of the arguments FROM, TO, and FLAGS.
4156 The arguments are the same as for `map-extents', but this function differs
4157 in that it only visits extents which start in the given region, and also
4158 in that, after visiting an extent E, it skips all other extents which start
4159 inside E but end before E's end.
4161 Thus, this function may be used to walk a tree of extents in a buffer:
4162 (defun walk-extents (buffer &optional ignore)
4163 (map-extent-children 'walk-extents buffer))
4165 (function, object, from, to, maparg, flags, property, value))
4167 /* This function can GC */
4168 struct slow_map_extent_children_arg closure;
4169 unsigned int me_flags;
4171 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
4174 if (EXTENTP (object))
4176 after = decode_extent (object, DE_MUST_BE_ATTACHED);
4178 from = Fextent_start_position (object);
4180 to = Fextent_end_position (object);
4181 object = extent_object (after);
4184 object = decode_buffer_or_string (object);
4186 get_buffer_or_string_range_byte (object, from, to, &start, &end,
4187 GB_ALLOW_NIL | GB_ALLOW_PAST_ACCESSIBLE);
4189 me_flags = decode_map_extents_flags (flags);
4191 if (!NILP (property))
4194 value = canonicalize_extent_property (property, value);
4197 GCPRO5 (function, maparg, object, property, value);
4199 closure.map_arg = maparg;
4200 closure.map_routine = function;
4201 closure.result = Qnil;
4202 closure.property = property;
4203 closure.value = value;
4204 closure.start_min = start;
4205 closure.prev_start = -1;
4206 closure.prev_end = -1;
4207 map_extents_bytind (start, end, slow_map_extent_children_function,
4208 (void *) &closure, object, after,
4209 /* You never know what the user might do ... */
4210 me_flags | ME_MIGHT_CALL_ELISP);
4213 return closure.result;
4216 /* ------------------------------- */
4218 /* ------------------------------- */
4220 /* find "smallest" matching extent containing pos -- (flag == 0) means
4221 all extents match, else (EXTENT_FLAGS (extent) & flag) must be true;
4222 for more than one matching extent with precisely the same endpoints,
4223 we choose the last extent in the extents_list.
4224 The search stops just before "before", if that is non-null.
4227 struct extent_at_arg
4243 static enum extent_at_flag
4244 decode_extent_at_flag (Lisp_Object at_flag)
4247 return EXTENT_AT_AFTER;
4249 CHECK_SYMBOL (at_flag);
4250 if (EQ (at_flag, Qafter)) return EXTENT_AT_AFTER;
4251 if (EQ (at_flag, Qbefore)) return EXTENT_AT_BEFORE;
4252 if (EQ (at_flag, Qat)) return EXTENT_AT_AT;
4254 signal_simple_error ("Invalid AT-FLAG in `extent-at'", at_flag);
4255 return EXTENT_AT_AFTER; /* unreached */
4259 extent_at_mapper (EXTENT e, void *arg)
4261 struct extent_at_arg *closure = (struct extent_at_arg *) arg;
4263 if (e == closure->before)
4266 /* If closure->prop is non-nil, then the extent is only acceptable
4267 if it has a non-nil value for that property. */
4268 if (!NILP (closure->prop))
4271 XSETEXTENT (extent, e);
4272 if (NILP (Fextent_property (extent, closure->prop, Qnil)))
4277 EXTENT current = closure->best_match;
4281 /* redundant but quick test */
4282 else if (extent_start (current) > extent_start (e))
4285 /* we return the "last" best fit, instead of the first --
4286 this is because then the glyph closest to two equivalent
4287 extents corresponds to the "extent-at" the text just past
4289 else if (!EXTENT_LESS_VALS (e, closure->best_start,
4295 closure->best_match = e;
4296 closure->best_start = extent_start (e);
4297 closure->best_end = extent_end (e);
4304 extent_at_bytind (Bytind position, Lisp_Object object, Lisp_Object property,
4305 EXTENT before, enum extent_at_flag at_flag)
4307 struct extent_at_arg closure;
4308 Lisp_Object extent_obj;
4310 /* it might be argued that invalid positions should cause
4311 errors, but the principle of least surprise dictates that
4312 nil should be returned (extent-at is often used in
4313 response to a mouse event, and in many cases previous events
4314 have changed the buffer contents).
4316 Also, the openness stuff in the text-property code currently
4317 does not check its limits and might go off the end. */
4318 if ((at_flag == EXTENT_AT_BEFORE
4319 ? position <= buffer_or_string_absolute_begin_byte (object)
4320 : position < buffer_or_string_absolute_begin_byte (object))
4321 || (at_flag == EXTENT_AT_AFTER
4322 ? position >= buffer_or_string_absolute_end_byte (object)
4323 : position > buffer_or_string_absolute_end_byte (object)))
4326 closure.best_match = 0;
4327 closure.prop = property;
4328 closure.before = before;
4330 map_extents_bytind (at_flag == EXTENT_AT_BEFORE ? position - 1 : position,
4331 at_flag == EXTENT_AT_AFTER ? position + 1 : position,
4332 extent_at_mapper, (void *) &closure, object, 0,
4333 ME_START_OPEN | ME_ALL_EXTENTS_CLOSED);
4335 if (!closure.best_match)
4338 XSETEXTENT (extent_obj, closure.best_match);
4342 DEFUN ("extent-at", Fextent_at, 1, 5, 0, /*
4343 Find "smallest" extent at POS in OBJECT having PROPERTY set.
4344 Normally, an extent is "at" POS if it overlaps the region (POS, POS+1);
4345 i.e. if it covers the character after POS. (However, see the definition
4346 of AT-FLAG.) "Smallest" means the extent that comes last in the display
4347 order; this normally means the extent whose start position is closest to
4348 POS. See `next-extent' for more information.
4349 OBJECT specifies a buffer or string and defaults to the current buffer.
4350 PROPERTY defaults to nil, meaning that any extent will do.
4351 Properties are attached to extents with `set-extent-property', which see.
4352 Returns nil if POS is invalid or there is no matching extent at POS.
4353 If the fourth argument BEFORE is not nil, it must be an extent; any returned
4354 extent will precede that extent. This feature allows `extent-at' to be
4355 used by a loop over extents.
4356 AT-FLAG controls how end cases are handled, and should be one of:
4358 nil or `after' An extent is at POS if it covers the character
4359 after POS. This is consistent with the way
4360 that text properties work.
4361 `before' An extent is at POS if it covers the character
4363 `at' An extent is at POS if it overlaps or abuts POS.
4364 This includes all zero-length extents at POS.
4366 Note that in all cases, the start-openness and end-openness of the extents
4367 considered is ignored. If you want to pay attention to those properties,
4368 you should use `map-extents', which gives you more control.
4370 (pos, object, property, before, at_flag))
4373 EXTENT before_extent;
4374 enum extent_at_flag fl;
4376 object = decode_buffer_or_string (object);
4377 position = get_buffer_or_string_pos_byte (object, pos, GB_NO_ERROR_IF_BAD);
4381 before_extent = decode_extent (before, DE_MUST_BE_ATTACHED);
4382 if (before_extent && !EQ (object, extent_object (before_extent)))
4383 signal_simple_error ("extent not in specified buffer or string", object);
4384 fl = decode_extent_at_flag (at_flag);
4386 return extent_at_bytind (position, object, property, before_extent, fl);
4389 /* ------------------------------- */
4390 /* verify_extent_modification() */
4391 /* ------------------------------- */
4393 /* verify_extent_modification() is called when a buffer or string is
4394 modified to check whether the modification is occuring inside a
4398 struct verify_extents_arg
4403 Lisp_Object iro; /* value of inhibit-read-only */
4407 verify_extent_mapper (EXTENT extent, void *arg)
4409 struct verify_extents_arg *closure = (struct verify_extents_arg *) arg;
4410 Lisp_Object prop = extent_read_only (extent);
4415 if (CONSP (closure->iro) && !NILP (Fmemq (prop, closure->iro)))
4418 #if 0 /* Nobody seems to care for this any more -sb */
4419 /* Allow deletion if the extent is completely contained in
4420 the region being deleted.
4421 This is important for supporting tokens which are internally
4422 write-protected, but which can be killed and yanked as a whole.
4423 Ignore open/closed distinctions at this point.
4426 if (closure->start != closure->end &&
4427 extent_start (extent) >= closure->start &&
4428 extent_end (extent) <= closure->end)
4433 Fsignal (Qbuffer_read_only, (list1 (closure->object)));
4435 RETURN_NOT_REACHED(0)
4438 /* Value of Vinhibit_read_only is precomputed and passed in for
4442 verify_extent_modification (Lisp_Object object, Bytind from, Bytind to,
4443 Lisp_Object inhibit_read_only_value)
4446 struct verify_extents_arg closure;
4448 /* If insertion, visit closed-endpoint extents touching the insertion
4449 point because the text would go inside those extents. If deletion,
4450 treat the range as open on both ends so that touching extents are not
4451 visited. Note that we assume that an insertion is occurring if the
4452 changed range has zero length, and a deletion otherwise. This
4453 fails if a change (i.e. non-insertion, non-deletion) is happening.
4454 As far as I know, this doesn't currently occur in XEmacs. --ben */
4455 closed = (from==to);
4456 closure.object = object;
4457 closure.start = buffer_or_string_bytind_to_memind (object, from);
4458 closure.end = buffer_or_string_bytind_to_memind (object, to);
4459 closure.iro = inhibit_read_only_value;
4461 map_extents_bytind (from, to, verify_extent_mapper, (void *) &closure,
4462 object, 0, closed ? ME_END_CLOSED : ME_START_OPEN);
4465 /* ------------------------------------ */
4466 /* process_extents_for_insertion() */
4467 /* ------------------------------------ */
4469 struct process_extents_for_insertion_arg
4476 /* A region of length LENGTH was just inserted at OPOINT. Modify all
4477 of the extents as required for the insertion, based on their
4478 start-open/end-open properties.
4482 process_extents_for_insertion_mapper (EXTENT extent, void *arg)
4484 struct process_extents_for_insertion_arg *closure =
4485 (struct process_extents_for_insertion_arg *) arg;
4486 Memind indice = buffer_or_string_bytind_to_memind (closure->object,
4489 /* When this function is called, one end of the newly-inserted text should
4490 be adjacent to some endpoint of the extent, or disjoint from it. If
4491 the insertion overlaps any existing extent, something is wrong.
4493 #ifdef ERROR_CHECK_EXTENTS
4494 if (extent_start (extent) > indice &&
4495 extent_start (extent) < indice + closure->length)
4497 if (extent_end (extent) > indice &&
4498 extent_end (extent) < indice + closure->length)
4502 /* The extent-adjustment code adjusted the extent's endpoints as if
4503 they were markers -- endpoints at the gap (i.e. the insertion
4504 point) go to the left of the insertion point, which is correct
4505 for [) extents. We need to fix the other kinds of extents.
4507 Note that both conditions below will hold for zero-length (]
4508 extents at the gap. Zero-length () extents would get adjusted
4509 such that their start is greater than their end; we treat them
4510 as [) extents. This is unfortunately an inelegant part of the
4511 extent model, but there is no way around it. */
4514 Memind new_start, new_end;
4516 new_start = extent_start (extent);
4517 new_end = extent_end (extent);
4518 if (indice == extent_start (extent) && extent_start_open_p (extent) &&
4519 /* coerce zero-length () extents to [) */
4520 new_start != new_end)
4521 new_start += closure->length;
4522 if (indice == extent_end (extent) && !extent_end_open_p (extent))
4523 new_end += closure->length;
4524 set_extent_endpoints_1 (extent, new_start, new_end);
4531 process_extents_for_insertion (Lisp_Object object, Bytind opoint,
4534 struct process_extents_for_insertion_arg closure;
4536 closure.opoint = opoint;
4537 closure.length = length;
4538 closure.object = object;
4540 map_extents_bytind (opoint, opoint + length,
4541 process_extents_for_insertion_mapper,
4542 (void *) &closure, object, 0,
4543 ME_END_CLOSED | ME_MIGHT_MODIFY_EXTENTS |
4544 ME_INCLUDE_INTERNAL);
4547 /* ------------------------------------ */
4548 /* process_extents_for_deletion() */
4549 /* ------------------------------------ */
4551 struct process_extents_for_deletion_arg
4554 int destroy_included_extents;
4557 /* This function is called when we're about to delete the range [from, to].
4558 Detach all of the extents that are completely inside the range [from, to],
4559 if they're detachable or open-open. */
4562 process_extents_for_deletion_mapper (EXTENT extent, void *arg)
4564 struct process_extents_for_deletion_arg *closure =
4565 (struct process_extents_for_deletion_arg *) arg;
4567 /* If the extent lies completely within the range that
4568 is being deleted, then nuke the extent if it's detachable
4569 (otherwise, it will become a zero-length extent). */
4571 if (closure->start <= extent_start (extent) &&
4572 extent_end (extent) <= closure->end)
4574 if (extent_detachable_p (extent))
4576 if (closure->destroy_included_extents)
4577 destroy_extent (extent);
4579 extent_detach (extent);
4586 /* DESTROY_THEM means destroy the extents instead of just deleting them.
4587 It is unused currently, but perhaps might be used (there used to
4588 be a function process_extents_for_destruction(), #if 0'd out,
4589 that did the equivalent). */
4591 process_extents_for_deletion (Lisp_Object object, Bytind from,
4592 Bytind to, int destroy_them)
4594 struct process_extents_for_deletion_arg closure;
4596 closure.start = buffer_or_string_bytind_to_memind (object, from);
4597 closure.end = buffer_or_string_bytind_to_memind (object, to);
4598 closure.destroy_included_extents = destroy_them;
4600 map_extents_bytind (from, to, process_extents_for_deletion_mapper,
4601 (void *) &closure, object, 0,
4602 ME_END_CLOSED | ME_MIGHT_MODIFY_EXTENTS);
4606 /************************************************************************/
4607 /* extent properties */
4608 /************************************************************************/
4611 set_extent_invisible (EXTENT extent, Lisp_Object value)
4613 if (!EQ (extent_invisible (extent), value))
4615 set_extent_invisible_1 (extent, value);
4616 extent_changed_for_redisplay (extent, 1, 1);
4620 /* This function does "memoization" -- similar to the interning
4621 that happens with symbols. Given a list of faces, an equivalent
4622 list is returned such that if this function is called twice with
4623 input that is `equal', the resulting outputs will be `eq'.
4625 Note that the inputs and outputs are in general *not* `equal' --
4626 faces in symbol form become actual face objects in the output.
4627 This is necessary so that temporary faces stay around. */
4630 memoize_extent_face_internal (Lisp_Object list)
4634 Lisp_Object cons, thecons;
4635 Lisp_Object oldtail, tail;
4636 struct gcpro gcpro1;
4641 return Fget_face (list);
4643 /* To do the memoization, we use a hash table mapping from
4644 external lists to internal lists. We do `equal' comparisons
4645 on the keys so the memoization works correctly.
4647 Note that we canonicalize things so that the keys in the
4648 hashtable (the external lists) always contain symbols and
4649 the values (the internal lists) always contain face objects.
4651 We also maintain a "reverse" table that maps from the internal
4652 lists to the external equivalents. The idea here is twofold:
4654 1) `extent-face' wants to return a list containing face symbols
4655 rather than face objects.
4656 2) We don't want things to get quite so messed up if the user
4657 maliciously side-effects the returned lists.
4660 len = XINT (Flength (list));
4661 thelen = XINT (Flength (Vextent_face_reusable_list));
4666 /* We canonicalize the given list into another list.
4667 We try to avoid consing except when necessary, so we have
4673 cons = Vextent_face_reusable_list;
4674 while (!NILP (XCDR (cons)))
4676 XCDR (cons) = Fmake_list (make_int (len - thelen), Qnil);
4678 else if (thelen > len)
4682 /* Truncate the list temporarily so it's the right length;
4683 remember the old tail. */
4684 cons = Vextent_face_reusable_list;
4685 for (i = 0; i < len - 1; i++)
4688 oldtail = XCDR (cons);
4692 thecons = Vextent_face_reusable_list;
4693 EXTERNAL_LIST_LOOP (cons, list)
4695 Lisp_Object face = Fget_face (XCAR (cons));
4697 XCAR (thecons) = Fface_name (face);
4698 thecons = XCDR (thecons);
4701 list = Fgethash (Vextent_face_reusable_list, Vextent_face_memoize_hash_table,
4705 Lisp_Object symlist = Fcopy_sequence (Vextent_face_reusable_list);
4706 Lisp_Object facelist = Fcopy_sequence (Vextent_face_reusable_list);
4708 LIST_LOOP (cons, facelist)
4710 XCAR (cons) = Fget_face (XCAR (cons));
4712 Fputhash (symlist, facelist, Vextent_face_memoize_hash_table);
4713 Fputhash (facelist, symlist, Vextent_face_reverse_memoize_hash_table);
4717 /* Now restore the truncated tail of the reusable list, if necessary. */
4719 XCDR (tail) = oldtail;
4726 external_of_internal_memoized_face (Lisp_Object face)
4730 else if (!CONSP (face))
4731 return XFACE (face)->name;
4734 face = Fgethash (face, Vextent_face_reverse_memoize_hash_table,
4736 assert (!UNBOUNDP (face));
4742 canonicalize_extent_property (Lisp_Object prop, Lisp_Object value)
4744 if (EQ (prop, Qface) || EQ (prop, Qmouse_face))
4745 value = (external_of_internal_memoized_face
4746 (memoize_extent_face_internal (value)));
4750 /* Do we need a lisp-level function ? */
4751 DEFUN ("set-extent-initial-redisplay-function", Fset_extent_initial_redisplay_function,
4753 Note: This feature is experimental!
4755 Set initial-redisplay-function of EXTENT to the function
4758 The first time the EXTENT is (re)displayed, an eval event will be
4759 dispatched calling FUNCTION with EXTENT as its only argument.
4763 EXTENT e = decode_extent(extent, DE_MUST_BE_ATTACHED);
4765 e = extent_ancestor (e); /* Is this needed? Macro also does chasing!*/
4766 set_extent_initial_redisplay_function(e,function);
4767 extent_in_red_event_p(e) = 0; /* If the function changed we can spawn
4769 extent_changed_for_redisplay(e,1,0); /* Do we need to mark children too ?*/
4774 DEFUN ("extent-face", Fextent_face, 1, 1, 0, /*
4775 Return the name of the face in which EXTENT is displayed, or nil
4776 if the extent's face is unspecified. This might also return a list
4783 CHECK_EXTENT (extent);
4784 face = extent_face (XEXTENT (extent));
4786 return external_of_internal_memoized_face (face);
4789 DEFUN ("set-extent-face", Fset_extent_face, 2, 2, 0, /*
4790 Make the given EXTENT have the graphic attributes specified by FACE.
4791 FACE can also be a list of faces, and all faces listed will apply,
4792 with faces earlier in the list taking priority over those later in the
4797 EXTENT e = decode_extent(extent, 0);
4798 Lisp_Object orig_face = face;
4800 /* retrieve the ancestor for efficiency and proper redisplay noting. */
4801 e = extent_ancestor (e);
4803 face = memoize_extent_face_internal (face);
4805 extent_face (e) = face;
4806 extent_changed_for_redisplay (e, 1, 0);
4812 DEFUN ("extent-mouse-face", Fextent_mouse_face, 1, 1, 0, /*
4813 Return the face used to highlight EXTENT when the mouse passes over it.
4814 The return value will be a face name, a list of face names, or nil
4815 if the extent's mouse face is unspecified.
4821 CHECK_EXTENT (extent);
4822 face = extent_mouse_face (XEXTENT (extent));
4824 return external_of_internal_memoized_face (face);
4827 DEFUN ("set-extent-mouse-face", Fset_extent_mouse_face, 2, 2, 0, /*
4828 Set the face used to highlight EXTENT when the mouse passes over it.
4829 FACE can also be a list of faces, and all faces listed will apply,
4830 with faces earlier in the list taking priority over those later in the
4836 Lisp_Object orig_face = face;
4838 CHECK_EXTENT (extent);
4839 e = XEXTENT (extent);
4840 /* retrieve the ancestor for efficiency and proper redisplay noting. */
4841 e = extent_ancestor (e);
4843 face = memoize_extent_face_internal (face);
4845 set_extent_mouse_face (e, face);
4846 extent_changed_for_redisplay (e, 1, 0);
4852 set_extent_glyph (EXTENT extent, Lisp_Object glyph, int endp,
4853 glyph_layout layout)
4855 extent = extent_ancestor (extent);
4859 set_extent_begin_glyph (extent, glyph);
4860 extent_begin_glyph_layout (extent) = layout;
4864 set_extent_end_glyph (extent, glyph);
4865 extent_end_glyph_layout (extent) = layout;
4868 extent_changed_for_redisplay (extent, 1, 0);
4872 glyph_layout_to_symbol (glyph_layout layout)
4876 case GL_TEXT: return Qtext;
4877 case GL_OUTSIDE_MARGIN: return Qoutside_margin;
4878 case GL_INSIDE_MARGIN: return Qinside_margin;
4879 case GL_WHITESPACE: return Qwhitespace;
4882 return Qnil; /* unreached */
4887 symbol_to_glyph_layout (Lisp_Object layout_obj)
4889 if (NILP (layout_obj))
4892 CHECK_SYMBOL (layout_obj);
4893 if (EQ (layout_obj, Qoutside_margin)) return GL_OUTSIDE_MARGIN;
4894 if (EQ (layout_obj, Qinside_margin)) return GL_INSIDE_MARGIN;
4895 if (EQ (layout_obj, Qwhitespace)) return GL_WHITESPACE;
4896 if (EQ (layout_obj, Qtext)) return GL_TEXT;
4898 signal_simple_error ("unknown glyph layout type", layout_obj);
4899 return GL_TEXT; /* unreached */
4903 set_extent_glyph_1 (Lisp_Object extent_obj, Lisp_Object glyph, int endp,
4904 Lisp_Object layout_obj)
4906 EXTENT extent = decode_extent (extent_obj, DE_MUST_HAVE_BUFFER);
4907 glyph_layout layout = symbol_to_glyph_layout (layout_obj);
4909 /* Make sure we've actually been given a glyph or it's nil (meaning
4910 we're deleting a glyph from an extent). */
4912 CHECK_GLYPH (glyph);
4914 set_extent_glyph (extent, glyph, endp, layout);
4918 DEFUN ("set-extent-begin-glyph", Fset_extent_begin_glyph, 2, 3, 0, /*
4919 Display a bitmap, subwindow or string at the beginning of EXTENT.
4920 BEGIN-GLYPH must be a glyph object. The layout policy defaults to `text'.
4922 (extent, begin_glyph, layout))
4924 return set_extent_glyph_1 (extent, begin_glyph, 0, layout);
4927 DEFUN ("set-extent-end-glyph", Fset_extent_end_glyph, 2, 3, 0, /*
4928 Display a bitmap, subwindow or string at the end of EXTENT.
4929 END-GLYPH must be a glyph object. The layout policy defaults to `text'.
4931 (extent, end_glyph, layout))
4933 return set_extent_glyph_1 (extent, end_glyph, 1, layout);
4936 DEFUN ("extent-begin-glyph", Fextent_begin_glyph, 1, 1, 0, /*
4937 Return the glyph object displayed at the beginning of EXTENT.
4938 If there is none, nil is returned.
4942 return extent_begin_glyph (decode_extent (extent, 0));
4945 DEFUN ("extent-end-glyph", Fextent_end_glyph, 1, 1, 0, /*
4946 Return the glyph object displayed at the end of EXTENT.
4947 If there is none, nil is returned.
4951 return extent_end_glyph (decode_extent (extent, 0));
4954 DEFUN ("set-extent-begin-glyph-layout", Fset_extent_begin_glyph_layout, 2, 2, 0, /*
4955 Set the layout policy of EXTENT's begin glyph.
4956 Access this using the `extent-begin-glyph-layout' function.
4960 EXTENT e = decode_extent (extent, 0);
4961 e = extent_ancestor (e);
4962 extent_begin_glyph_layout (e) = symbol_to_glyph_layout (layout);
4963 extent_maybe_changed_for_redisplay (e, 1, 0);
4967 DEFUN ("set-extent-end-glyph-layout", Fset_extent_end_glyph_layout, 2, 2, 0, /*
4968 Set the layout policy of EXTENT's end glyph.
4969 Access this using the `extent-end-glyph-layout' function.
4973 EXTENT e = decode_extent (extent, 0);
4974 e = extent_ancestor (e);
4975 extent_end_glyph_layout (e) = symbol_to_glyph_layout (layout);
4976 extent_maybe_changed_for_redisplay (e, 1, 0);
4980 DEFUN ("extent-begin-glyph-layout", Fextent_begin_glyph_layout, 1, 1, 0, /*
4981 Return the layout policy associated with EXTENT's begin glyph.
4982 Set this using the `set-extent-begin-glyph-layout' function.
4986 EXTENT e = decode_extent (extent, 0);
4987 return glyph_layout_to_symbol ((glyph_layout) extent_begin_glyph_layout (e));
4990 DEFUN ("extent-end-glyph-layout", Fextent_end_glyph_layout, 1, 1, 0, /*
4991 Return the layout policy associated with EXTENT's end glyph.
4992 Set this using the `set-extent-end-glyph-layout' function.
4996 EXTENT e = decode_extent (extent, 0);
4997 return glyph_layout_to_symbol ((glyph_layout) extent_end_glyph_layout (e));
5000 DEFUN ("set-extent-priority", Fset_extent_priority, 2, 2, 0, /*
5001 Set the display priority of EXTENT to PRIORITY (an integer).
5002 When the extent attributes are being merged for display, the priority
5003 is used to determine which extent takes precedence in the event of a
5004 conflict (two extents whose faces both specify font, for example: the
5005 font of the extent with the higher priority will be used).
5006 Extents are created with priority 0; priorities may be negative.
5010 EXTENT e = decode_extent (extent, 0);
5012 CHECK_INT (priority);
5013 e = extent_ancestor (e);
5014 set_extent_priority (e, XINT (priority));
5015 extent_maybe_changed_for_redisplay (e, 1, 0);
5019 DEFUN ("extent-priority", Fextent_priority, 1, 1, 0, /*
5020 Return the display priority of EXTENT; see `set-extent-priority'.
5024 EXTENT e = decode_extent (extent, 0);
5025 return make_int (extent_priority (e));
5028 DEFUN ("set-extent-property", Fset_extent_property, 3, 3, 0, /*
5029 Change a property of an extent.
5030 PROPERTY may be any symbol; the value stored may be accessed with
5031 the `extent-property' function.
5032 The following symbols have predefined meanings:
5034 detached Removes the extent from its buffer; setting this is
5035 the same as calling `detach-extent'.
5037 destroyed Removes the extent from its buffer, and makes it
5038 unusable in the future; this is the same calling
5041 priority Change redisplay priority; same as `set-extent-priority'.
5043 start-open Whether the set of characters within the extent is
5044 treated being open on the left, that is, whether
5045 the start position is an exclusive, rather than
5046 inclusive, boundary. If true, then characters
5047 inserted exactly at the beginning of the extent
5048 will remain outside of the extent; otherwise they
5049 will go into the extent, extending it.
5051 end-open Whether the set of characters within the extent is
5052 treated being open on the right, that is, whether
5053 the end position is an exclusive, rather than
5054 inclusive, boundary. If true, then characters
5055 inserted exactly at the end of the extent will
5056 remain outside of the extent; otherwise they will
5057 go into the extent, extending it.
5059 By default, extents have the `end-open' but not the
5060 `start-open' property set.
5062 read-only Text within this extent will be unmodifiable.
5064 initial-redisplay-function (EXPERIMENTAL)
5065 function to be called the first time (part of) the extent
5066 is redisplayed. It will be called with the extent as its
5068 Note: The function will not be called immediately
5069 during redisplay, an eval event will be dispatched.
5071 detachable Whether the extent gets detached (as with
5072 `detach-extent') when all the text within the
5073 extent is deleted. This is true by default. If
5074 this property is not set, the extent becomes a
5075 zero-length extent when its text is deleted. (In
5076 such a case, the `start-open' property is
5077 automatically removed if both the `start-open' and
5078 `end-open' properties are set, since zero-length
5079 extents open on both ends are not allowed.)
5081 face The face in which to display the text. Setting
5082 this is the same as calling `set-extent-face'.
5084 mouse-face If non-nil, the extent will be highlighted in this
5085 face when the mouse moves over it.
5087 pointer If non-nil, and a valid pointer glyph, this specifies
5088 the shape of the mouse pointer while over the extent.
5090 highlight Obsolete: Setting this property is equivalent to
5091 setting a `mouse-face' property of `highlight'.
5092 Reading this property returns non-nil if
5093 the extent has a non-nil `mouse-face' property.
5095 duplicable Whether this extent should be copied into strings,
5096 so that kill, yank, and undo commands will restore
5097 or copy it. `duplicable' extents are copied from
5098 an extent into a string when `buffer-substring' or
5099 a similar function creates a string. The extents
5100 in a string are copied into other strings created
5101 from the string using `concat' or `substring'.
5102 When `insert' or a similar function inserts the
5103 string into a buffer, the extents are copied back
5106 unique Meaningful only in conjunction with `duplicable'.
5107 When this is set, there may be only one instance
5108 of this extent attached at a time: if it is copied
5109 to the kill ring and then yanked, the extent is
5110 not copied. If, however, it is killed (removed
5111 from the buffer) and then yanked, it will be
5112 re-attached at the new position.
5114 invisible If the value is non-nil, text under this extent
5115 may be treated as not present for the purpose of
5116 redisplay, or may be displayed using an ellipsis
5117 or other marker; see `buffer-invisibility-spec'
5118 and `invisible-text-glyph'. In all cases,
5119 however, the text is still visible to other
5120 functions that examine a buffer's text.
5122 keymap This keymap is consulted for mouse clicks on this
5123 extent, or keypresses made while point is within the
5126 copy-function This is a hook that is run when a duplicable extent
5127 is about to be copied from a buffer to a string (or
5128 the kill ring). It is called with three arguments,
5129 the extent, and the buffer-positions within it
5130 which are being copied. If this function returns
5131 nil, then the extent will not be copied; otherwise
5134 paste-function This is a hook that is run when a duplicable extent is
5135 about to be copied from a string (or the kill ring)
5136 into a buffer. It is called with three arguments,
5137 the original extent, and the buffer positions which
5138 the copied extent will occupy. (This hook is run
5139 after the corresponding text has already been
5140 inserted into the buffer.) Note that the extent
5141 argument may be detached when this function is run.
5142 If this function returns nil, no extent will be
5143 inserted. Otherwise, there will be an extent
5144 covering the range in question.
5146 If the original extent is not attached to a buffer,
5147 then it will be re-attached at this range.
5148 Otherwise, a copy will be made, and that copy
5151 The copy-function and paste-function are meaningful
5152 only for extents with the `duplicable' flag set,
5153 and if they are not specified, behave as if `t' was
5154 the returned value. When these hooks are invoked,
5155 the current buffer is the buffer which the extent
5156 is being copied from/to, respectively.
5158 begin-glyph A glyph to be displayed at the beginning of the extent,
5161 end-glyph A glyph to be displayed at the end of the extent,
5164 begin-glyph-layout The layout policy (one of `text', `whitespace',
5165 `inside-margin', or `outside-margin') of the extent's
5168 end-glyph-layout The layout policy of the extent's end glyph.
5170 (extent, property, value))
5172 /* This function can GC if property is `keymap' */
5173 EXTENT e = decode_extent (extent, 0);
5175 if (EQ (property, Qread_only))
5176 set_extent_read_only (e, value);
5177 else if (EQ (property, Qunique))
5178 extent_unique_p (e) = !NILP (value);
5179 else if (EQ (property, Qduplicable))
5180 extent_duplicable_p (e) = !NILP (value);
5181 else if (EQ (property, Qinvisible))
5182 set_extent_invisible (e, value);
5183 else if (EQ (property, Qdetachable))
5184 extent_detachable_p (e) = !NILP (value);
5186 else if (EQ (property, Qdetached))
5189 error ("can only set `detached' to t");
5190 Fdetach_extent (extent);
5192 else if (EQ (property, Qdestroyed))
5195 error ("can only set `destroyed' to t");
5196 Fdelete_extent (extent);
5198 else if (EQ (property, Qpriority))
5199 Fset_extent_priority (extent, value);
5200 else if (EQ (property, Qface))
5201 Fset_extent_face (extent, value);
5202 else if (EQ (property, Qinitial_redisplay_function))
5203 Fset_extent_initial_redisplay_function (extent, value);
5204 else if (EQ (property, Qmouse_face))
5205 Fset_extent_mouse_face (extent, value);
5207 else if (EQ (property, Qhighlight))
5208 Fset_extent_mouse_face (extent, Qhighlight);
5209 else if (EQ (property, Qbegin_glyph_layout))
5210 Fset_extent_begin_glyph_layout (extent, value);
5211 else if (EQ (property, Qend_glyph_layout))
5212 Fset_extent_end_glyph_layout (extent, value);
5213 /* For backwards compatibility. We use begin glyph because it is by
5214 far the more used of the two. */
5215 else if (EQ (property, Qglyph_layout))
5216 Fset_extent_begin_glyph_layout (extent, value);
5217 else if (EQ (property, Qbegin_glyph))
5218 Fset_extent_begin_glyph (extent, value, Qnil);
5219 else if (EQ (property, Qend_glyph))
5220 Fset_extent_end_glyph (extent, value, Qnil);
5221 else if (EQ (property, Qstart_open) ||
5222 EQ (property, Qend_open) ||
5223 EQ (property, Qstart_closed) ||
5224 EQ (property, Qend_closed))
5226 int start_open = -1, end_open = -1;
5227 if (EQ (property, Qstart_open))
5228 start_open = !NILP (value);
5229 else if (EQ (property, Qend_open))
5230 end_open = !NILP (value);
5231 /* Support (but don't document...) the obvious antonyms. */
5232 else if (EQ (property, Qstart_closed))
5233 start_open = NILP (value);
5235 end_open = NILP (value);
5236 set_extent_openness (e, start_open, end_open);
5240 if (EQ (property, Qkeymap))
5241 while (!NILP (value) && NILP (Fkeymapp (value)))
5242 value = wrong_type_argument (Qkeymapp, value);
5244 external_plist_put (extent_plist_addr (e), property, value, 0, ERROR_ME);
5250 DEFUN ("set-extent-properties", Fset_extent_properties, 2, 2, 0, /*
5251 Change some properties of EXTENT.
5252 PLIST is a property list.
5253 For a list of built-in properties, see `set-extent-property'.
5257 /* This function can GC, if one of the properties is `keymap' */
5258 Lisp_Object property, value;
5259 struct gcpro gcpro1;
5262 plist = Fcopy_sequence (plist);
5263 Fcanonicalize_plist (plist, Qnil);
5265 while (!NILP (plist))
5267 property = Fcar (plist); plist = Fcdr (plist);
5268 value = Fcar (plist); plist = Fcdr (plist);
5269 Fset_extent_property (extent, property, value);
5275 DEFUN ("extent-property", Fextent_property, 2, 3, 0, /*
5276 Return EXTENT's value for property PROPERTY.
5277 See `set-extent-property' for the built-in property names.
5279 (extent, property, default_))
5281 EXTENT e = decode_extent (extent, 0);
5283 if (EQ (property, Qdetached))
5284 return extent_detached_p (e) ? Qt : Qnil;
5285 else if (EQ (property, Qdestroyed))
5286 return !EXTENT_LIVE_P (e) ? Qt : Qnil;
5287 #define RETURN_FLAG(flag) return extent_normal_field (e, flag) ? Qt : Qnil
5288 else if (EQ (property, Qstart_open)) RETURN_FLAG (start_open);
5289 else if (EQ (property, Qend_open)) RETURN_FLAG (end_open);
5290 else if (EQ (property, Qunique)) RETURN_FLAG (unique);
5291 else if (EQ (property, Qduplicable)) RETURN_FLAG (duplicable);
5292 else if (EQ (property, Qdetachable)) RETURN_FLAG (detachable);
5294 /* Support (but don't document...) the obvious antonyms. */
5295 else if (EQ (property, Qstart_closed))
5296 return extent_start_open_p (e) ? Qnil : Qt;
5297 else if (EQ (property, Qend_closed))
5298 return extent_end_open_p (e) ? Qnil : Qt;
5299 else if (EQ (property, Qpriority))
5300 return make_int (extent_priority (e));
5301 else if (EQ (property, Qread_only))
5302 return extent_read_only (e);
5303 else if (EQ (property, Qinvisible))
5304 return extent_invisible (e);
5305 else if (EQ (property, Qface))
5306 return Fextent_face (extent);
5307 else if (EQ (property, Qinitial_redisplay_function))
5308 return extent_initial_redisplay_function (e);
5309 else if (EQ (property, Qmouse_face))
5310 return Fextent_mouse_face (extent);
5312 else if (EQ (property, Qhighlight))
5313 return !NILP (Fextent_mouse_face (extent)) ? Qt : Qnil;
5314 else if (EQ (property, Qbegin_glyph_layout))
5315 return Fextent_begin_glyph_layout (extent);
5316 else if (EQ (property, Qend_glyph_layout))
5317 return Fextent_end_glyph_layout (extent);
5318 /* For backwards compatibility. We use begin glyph because it is by
5319 far the more used of the two. */
5320 else if (EQ (property, Qglyph_layout))
5321 return Fextent_begin_glyph_layout (extent);
5322 else if (EQ (property, Qbegin_glyph))
5323 return extent_begin_glyph (e);
5324 else if (EQ (property, Qend_glyph))
5325 return extent_end_glyph (e);
5328 Lisp_Object value = external_plist_get (extent_plist_addr (e),
5329 property, 0, ERROR_ME);
5330 return UNBOUNDP (value) ? default_ : value;
5334 DEFUN ("extent-properties", Fextent_properties, 1, 1, 0, /*
5335 Return a property list of the attributes of EXTENT.
5336 Do not modify this list; use `set-extent-property' instead.
5341 Lisp_Object result, face, anc_obj;
5342 glyph_layout layout;
5344 CHECK_EXTENT (extent);
5345 e = XEXTENT (extent);
5346 if (!EXTENT_LIVE_P (e))
5347 return cons3 (Qdestroyed, Qt, Qnil);
5349 anc = extent_ancestor (e);
5350 XSETEXTENT (anc_obj, anc);
5352 /* For efficiency, use the ancestor for all properties except detached */
5354 result = extent_plist_slot (anc);
5356 if (!NILP (face = Fextent_face (anc_obj)))
5357 result = cons3 (Qface, face, result);
5359 if (!NILP (face = Fextent_mouse_face (anc_obj)))
5360 result = cons3 (Qmouse_face, face, result);
5362 if ((layout = (glyph_layout) extent_begin_glyph_layout (anc)) != GL_TEXT)
5364 Lisp_Object sym = glyph_layout_to_symbol (layout);
5365 result = cons3 (Qglyph_layout, sym, result); /* compatibility */
5366 result = cons3 (Qbegin_glyph_layout, sym, result);
5369 if ((layout = (glyph_layout) extent_end_glyph_layout (anc)) != GL_TEXT)
5370 result = cons3 (Qend_glyph_layout, glyph_layout_to_symbol (layout), result);
5372 if (!NILP (extent_end_glyph (anc)))
5373 result = cons3 (Qend_glyph, extent_end_glyph (anc), result);
5375 if (!NILP (extent_begin_glyph (anc)))
5376 result = cons3 (Qbegin_glyph, extent_begin_glyph (anc), result);
5378 if (extent_priority (anc) != 0)
5379 result = cons3 (Qpriority, make_int (extent_priority (anc)), result);
5381 if (!NILP (extent_initial_redisplay_function (anc)))
5382 result = cons3 (Qinitial_redisplay_function,
5383 extent_initial_redisplay_function (anc), result);
5385 if (!NILP (extent_invisible (anc)))
5386 result = cons3 (Qinvisible, extent_invisible (anc), result);
5388 if (!NILP (extent_read_only (anc)))
5389 result = cons3 (Qread_only, extent_read_only (anc), result);
5391 if (extent_normal_field (anc, end_open))
5392 result = cons3 (Qend_open, Qt, result);
5394 if (extent_normal_field (anc, start_open))
5395 result = cons3 (Qstart_open, Qt, result);
5397 if (extent_normal_field (anc, detachable))
5398 result = cons3 (Qdetachable, Qt, result);
5400 if (extent_normal_field (anc, duplicable))
5401 result = cons3 (Qduplicable, Qt, result);
5403 if (extent_normal_field (anc, unique))
5404 result = cons3 (Qunique, Qt, result);
5406 /* detached is not an inherited property */
5407 if (extent_detached_p (e))
5408 result = cons3 (Qdetached, Qt, result);
5414 /************************************************************************/
5416 /************************************************************************/
5418 /* The display code looks into the Vlast_highlighted_extent variable to
5419 correctly display highlighted extents. This updates that variable,
5420 and marks the appropriate buffers as needing some redisplay.
5423 do_highlight (Lisp_Object extent_obj, int highlight_p)
5425 if (( highlight_p && (EQ (Vlast_highlighted_extent, extent_obj))) ||
5426 (!highlight_p && (EQ (Vlast_highlighted_extent, Qnil))))
5428 if (EXTENTP (Vlast_highlighted_extent) &&
5429 EXTENT_LIVE_P (XEXTENT (Vlast_highlighted_extent)))
5431 /* do not recurse on descendants. Only one extent is highlighted
5433 extent_changed_for_redisplay (XEXTENT (Vlast_highlighted_extent), 0, 0);
5435 Vlast_highlighted_extent = Qnil;
5436 if (!NILP (extent_obj)
5437 && BUFFERP (extent_object (XEXTENT (extent_obj)))
5440 extent_changed_for_redisplay (XEXTENT (extent_obj), 0, 0);
5441 Vlast_highlighted_extent = extent_obj;
5445 DEFUN ("force-highlight-extent", Fforce_highlight_extent, 1, 2, 0, /*
5446 Highlight or unhighlight the given extent.
5447 If the second arg is non-nil, it will be highlighted, else dehighlighted.
5448 This is the same as `highlight-extent', except that it will work even
5449 on extents without the `mouse-face' property.
5451 (extent, highlight_p))
5456 XSETEXTENT (extent, decode_extent (extent, DE_MUST_BE_ATTACHED));
5457 do_highlight (extent, !NILP (highlight_p));
5461 DEFUN ("highlight-extent", Fhighlight_extent, 1, 2, 0, /*
5462 Highlight EXTENT, if it is highlightable.
5463 \(that is, if it has the `mouse-face' property).
5464 If the second arg is non-nil, it will be highlighted, else dehighlighted.
5465 Highlighted extents are displayed as if they were merged with the face
5466 or faces specified by the `mouse-face' property.
5468 (extent, highlight_p))
5470 if (EXTENTP (extent) && NILP (extent_mouse_face (XEXTENT (extent))))
5473 return Fforce_highlight_extent (extent, highlight_p);
5477 /************************************************************************/
5478 /* strings and extents */
5479 /************************************************************************/
5481 /* copy/paste hooks */
5484 run_extent_copy_paste_internal (EXTENT e, Bufpos from, Bufpos to,
5488 /* This function can GC */
5490 Lisp_Object copy_fn;
5491 XSETEXTENT (extent, e);
5492 copy_fn = Fextent_property (extent, prop, Qnil);
5493 if (!NILP (copy_fn))
5496 struct gcpro gcpro1, gcpro2, gcpro3;
5497 GCPRO3 (extent, copy_fn, object);
5498 if (BUFFERP (object))
5499 flag = call3_in_buffer (XBUFFER (object), copy_fn, extent,
5500 make_int (from), make_int (to));
5502 flag = call3 (copy_fn, extent, make_int (from), make_int (to));
5504 if (NILP (flag) || !EXTENT_LIVE_P (XEXTENT (extent)))
5511 run_extent_copy_function (EXTENT e, Bytind from, Bytind to)
5513 Lisp_Object object = extent_object (e);
5514 /* This function can GC */
5515 return run_extent_copy_paste_internal
5516 (e, buffer_or_string_bytind_to_bufpos (object, from),
5517 buffer_or_string_bytind_to_bufpos (object, to), object,
5522 run_extent_paste_function (EXTENT e, Bytind from, Bytind to,
5525 /* This function can GC */
5526 return run_extent_copy_paste_internal
5527 (e, buffer_or_string_bytind_to_bufpos (object, from),
5528 buffer_or_string_bytind_to_bufpos (object, to), object,
5533 update_extent (EXTENT extent, Bytind from, Bytind to)
5535 set_extent_endpoints (extent, from, to, Qnil);
5538 /* Insert an extent, usually from the dup_list of a string which
5539 has just been inserted.
5540 This code does not handle the case of undo.
5543 insert_extent (EXTENT extent, Bytind new_start, Bytind new_end,
5544 Lisp_Object object, int run_hooks)
5546 /* This function can GC */
5549 if (!EQ (extent_object (extent), object))
5552 if (extent_detached_p (extent))
5555 !run_extent_paste_function (extent, new_start, new_end, object))
5556 /* The paste-function said don't re-attach this extent here. */
5559 update_extent (extent, new_start, new_end);
5563 Bytind exstart = extent_endpoint_bytind (extent, 0);
5564 Bytind exend = extent_endpoint_bytind (extent, 1);
5566 if (exend < new_start || exstart > new_end)
5570 new_start = min (exstart, new_start);
5571 new_end = max (exend, new_end);
5572 if (exstart != new_start || exend != new_end)
5573 update_extent (extent, new_start, new_end);
5577 XSETEXTENT (tmp, extent);
5582 !run_extent_paste_function (extent, new_start, new_end, object))
5583 /* The paste-function said don't attach a copy of the extent here. */
5587 XSETEXTENT (tmp, copy_extent (extent, new_start, new_end, object));
5592 DEFUN ("insert-extent", Finsert_extent, 1, 5, 0, /*
5593 Insert EXTENT from START to END in BUFFER-OR-STRING.
5594 BUFFER-OR-STRING defaults to the current buffer if omitted.
5595 This operation does not insert any characters,
5596 but otherwise acts as if there were a replicating extent whose
5597 parent is EXTENT in some string that was just inserted.
5598 Returns the newly-inserted extent.
5599 The fourth arg, NO-HOOKS, can be used to inhibit the running of the
5600 extent's `paste-function' property if it has one.
5601 See documentation on `detach-extent' for a discussion of undo recording.
5603 (extent, start, end, no_hooks, buffer_or_string))
5605 EXTENT ext = decode_extent (extent, 0);
5609 buffer_or_string = decode_buffer_or_string (buffer_or_string);
5610 get_buffer_or_string_range_byte (buffer_or_string, start, end, &s, &e,
5611 GB_ALLOW_PAST_ACCESSIBLE);
5613 copy = insert_extent (ext, s, e, buffer_or_string, NILP (no_hooks));
5616 if (extent_duplicable_p (XEXTENT (copy)))
5617 record_extent (copy, 1);
5623 /* adding buffer extents to a string */
5625 struct add_string_extents_arg
5633 add_string_extents_mapper (EXTENT extent, void *arg)
5635 /* This function can GC */
5636 struct add_string_extents_arg *closure =
5637 (struct add_string_extents_arg *) arg;
5638 Bytecount start = extent_endpoint_bytind (extent, 0) - closure->from;
5639 Bytecount end = extent_endpoint_bytind (extent, 1) - closure->from;
5641 if (extent_duplicable_p (extent))
5645 start = max (start, 0);
5646 end = min (end, closure->length);
5648 /* Run the copy-function to give an extent the option of
5649 not being copied into the string (or kill ring).
5651 if (extent_duplicable_p (extent) &&
5652 !run_extent_copy_function (extent, start + closure->from,
5653 end + closure->from))
5655 e = copy_extent (extent, start, end, closure->string);
5661 /* Add the extents in buffer BUF from OPOINT to OPOINT+LENGTH to
5662 the string STRING. */
5664 add_string_extents (Lisp_Object string, struct buffer *buf, Bytind opoint,
5667 /* This function can GC */
5668 struct add_string_extents_arg closure;
5669 struct gcpro gcpro1, gcpro2;
5672 closure.from = opoint;
5673 closure.length = length;
5674 closure.string = string;
5675 buffer = make_buffer (buf);
5676 GCPRO2 (buffer, string);
5677 map_extents_bytind (opoint, opoint + length, add_string_extents_mapper,
5678 (void *) &closure, buffer, 0,
5679 /* ignore extents that just abut the region */
5680 ME_END_CLOSED | ME_ALL_EXTENTS_OPEN |
5681 /* we are calling E-Lisp (the extent's copy function)
5682 so anything might happen */
5683 ME_MIGHT_CALL_ELISP);
5687 struct splice_in_string_extents_arg
5696 splice_in_string_extents_mapper (EXTENT extent, void *arg)
5698 /* This function can GC */
5699 struct splice_in_string_extents_arg *closure =
5700 (struct splice_in_string_extents_arg *) arg;
5701 /* BASE_START and BASE_END are the limits in the buffer of the string
5702 that was just inserted.
5704 NEW_START and NEW_END are the prospective buffer positions of the
5705 extent that is going into the buffer. */
5706 Bytind base_start = closure->opoint;
5707 Bytind base_end = base_start + closure->length;
5708 Bytind new_start = (base_start + extent_endpoint_bytind (extent, 0) -
5710 Bytind new_end = (base_start + extent_endpoint_bytind (extent, 1) -
5713 if (new_start < base_start)
5714 new_start = base_start;
5715 if (new_end > base_end)
5717 if (new_end <= new_start)
5720 if (!extent_duplicable_p (extent))
5724 !run_extent_paste_function (extent, new_start, new_end,
5727 copy_extent (extent, new_start, new_end, closure->buffer);
5732 /* We have just inserted a section of STRING (starting at POS, of
5733 length LENGTH) into buffer BUF at OPOINT. Do whatever is necessary
5734 to get the string's extents into the buffer. */
5737 splice_in_string_extents (Lisp_Object string, struct buffer *buf,
5738 Bytind opoint, Bytecount length, Bytecount pos)
5740 struct splice_in_string_extents_arg closure;
5741 struct gcpro gcpro1, gcpro2;
5744 buffer = make_buffer (buf);
5745 closure.opoint = opoint;
5747 closure.length = length;
5748 closure.buffer = buffer;
5749 GCPRO2 (buffer, string);
5750 map_extents_bytind (pos, pos + length,
5751 splice_in_string_extents_mapper,
5752 (void *) &closure, string, 0,
5753 /* ignore extents that just abut the region */
5754 ME_END_CLOSED | ME_ALL_EXTENTS_OPEN |
5755 /* we are calling E-Lisp (the extent's copy function)
5756 so anything might happen */
5757 ME_MIGHT_CALL_ELISP);
5761 struct copy_string_extents_arg
5766 Lisp_Object new_string;
5769 struct copy_string_extents_1_arg
5771 Lisp_Object parent_in_question;
5772 EXTENT found_extent;
5776 copy_string_extents_mapper (EXTENT extent, void *arg)
5778 struct copy_string_extents_arg *closure =
5779 (struct copy_string_extents_arg *) arg;
5780 Bytecount old_start, old_end;
5781 Bytecount new_start, new_end;
5783 old_start = extent_endpoint_bytind (extent, 0);
5784 old_end = extent_endpoint_bytind (extent, 1);
5786 old_start = max (closure->old_pos, old_start);
5787 old_end = min (closure->old_pos + closure->length, old_end);
5789 if (old_start >= old_end)
5792 new_start = old_start + closure->new_pos - closure->old_pos;
5793 new_end = old_end + closure->new_pos - closure->old_pos;
5795 copy_extent (extent,
5796 old_start + closure->new_pos - closure->old_pos,
5797 old_end + closure->new_pos - closure->old_pos,
5798 closure->new_string);
5802 /* The string NEW_STRING was partially constructed from OLD_STRING.
5803 In particular, the section of length LEN starting at NEW_POS in
5804 NEW_STRING came from the section of the same length starting at
5805 OLD_POS in OLD_STRING. Copy the extents as appropriate. */
5808 copy_string_extents (Lisp_Object new_string, Lisp_Object old_string,
5809 Bytecount new_pos, Bytecount old_pos,
5812 struct copy_string_extents_arg closure;
5813 struct gcpro gcpro1, gcpro2;
5815 closure.new_pos = new_pos;
5816 closure.old_pos = old_pos;
5817 closure.new_string = new_string;
5818 closure.length = length;
5819 GCPRO2 (new_string, old_string);
5820 map_extents_bytind (old_pos, old_pos + length,
5821 copy_string_extents_mapper,
5822 (void *) &closure, old_string, 0,
5823 /* ignore extents that just abut the region */
5824 ME_END_CLOSED | ME_ALL_EXTENTS_OPEN |
5825 /* we are calling E-Lisp (the extent's copy function)
5826 so anything might happen */
5827 ME_MIGHT_CALL_ELISP);
5831 /* Checklist for sanity checking:
5832 - {kill, yank, copy} at {open, closed} {start, end} of {writable, read-only} extent
5833 - {kill, copy} & yank {once, repeatedly} duplicable extent in {same, different} buffer
5837 /************************************************************************/
5838 /* text properties */
5839 /************************************************************************/
5842 Originally this stuff was implemented in lisp (all of the functionality
5843 exists to make that possible) but speed was a problem.
5846 Lisp_Object Qtext_prop;
5847 Lisp_Object Qtext_prop_extent_paste_function;
5850 get_text_property_bytind (Bytind position, Lisp_Object prop,
5851 Lisp_Object object, enum extent_at_flag fl,
5852 int text_props_only)
5856 /* text_props_only specifies whether we only consider text-property
5857 extents (those with the 'text-prop property set) or all extents. */
5858 if (!text_props_only)
5859 extent = extent_at_bytind (position, object, prop, 0, fl);
5865 extent = extent_at_bytind (position, object, Qtext_prop, prior,
5869 if (EQ (prop, Fextent_property (extent, Qtext_prop, Qnil)))
5871 prior = XEXTENT (extent);
5876 return Fextent_property (extent, prop, Qnil);
5877 if (!NILP (Vdefault_text_properties))
5878 return Fplist_get (Vdefault_text_properties, prop, Qnil);
5883 get_text_property_1 (Lisp_Object pos, Lisp_Object prop, Lisp_Object object,
5884 Lisp_Object at_flag, int text_props_only)
5889 object = decode_buffer_or_string (object);
5890 position = get_buffer_or_string_pos_byte (object, pos, GB_NO_ERROR_IF_BAD);
5892 /* We canonicalize the start/end-open/closed properties to the
5893 non-default version -- "adding" the default property really
5894 needs to remove the non-default one. See below for more
5896 if (EQ (prop, Qstart_closed))
5902 if (EQ (prop, Qend_open))
5910 get_text_property_bytind (position, prop, object,
5911 decode_extent_at_flag (at_flag),
5914 val = NILP (val) ? Qt : Qnil;
5919 DEFUN ("get-text-property", Fget_text_property, 2, 4, 0, /*
5920 Return the value of the PROP property at the given position.
5921 Optional arg OBJECT specifies the buffer or string to look in, and
5922 defaults to the current buffer.
5923 Optional arg AT-FLAG controls what it means for a property to be "at"
5924 a position, and has the same meaning as in `extent-at'.
5925 This examines only those properties added with `put-text-property'.
5926 See also `get-char-property'.
5928 (pos, prop, object, at_flag))
5930 return get_text_property_1 (pos, prop, object, at_flag, 1);
5933 DEFUN ("get-char-property", Fget_char_property, 2, 4, 0, /*
5934 Return the value of the PROP property at the given position.
5935 Optional arg OBJECT specifies the buffer or string to look in, and
5936 defaults to the current buffer.
5937 Optional arg AT-FLAG controls what it means for a property to be "at"
5938 a position, and has the same meaning as in `extent-at'.
5939 This examines properties on all extents.
5940 See also `get-text-property'.
5942 (pos, prop, object, at_flag))
5944 return get_text_property_1 (pos, prop, object, at_flag, 0);
5947 /* About start/end-open/closed:
5949 These properties have to be handled specially because of their
5950 strange behavior. If I put the "start-open" property on a region,
5951 then *all* text-property extents in the region have to have their
5952 start be open. This is unlike all other properties, which don't
5953 affect the extents of text properties other than their own.
5957 1) We have to map start-closed to (not start-open) and end-open
5958 to (not end-closed) -- i.e. adding the default is really the
5959 same as remove the non-default property. It won't work, for
5960 example, to have both "start-open" and "start-closed" on
5962 2) Whenever we add one of these properties, we go through all
5963 text-property extents in the region and set the appropriate
5964 open/closedness on them.
5965 3) Whenever we change a text-property extent for a property,
5966 we have to make sure we set the open/closedness properly.
5968 (2) and (3) together rely on, and maintain, the invariant
5969 that the open/closedness of text-property extents is correct
5970 at the beginning and end of each operation.
5973 struct put_text_prop_arg
5975 Lisp_Object prop, value; /* The property and value we are storing */
5976 Bytind start, end; /* The region into which we are storing it */
5978 Lisp_Object the_extent; /* Our chosen extent; this is used for
5979 communication between subsequent passes. */
5980 int changed_p; /* Output: whether we have modified anything */
5984 put_text_prop_mapper (EXTENT e, void *arg)
5986 struct put_text_prop_arg *closure = (struct put_text_prop_arg *) arg;
5988 Lisp_Object object = closure->object;
5989 Lisp_Object value = closure->value;
5990 Bytind e_start, e_end;
5991 Bytind start = closure->start;
5992 Bytind end = closure->end;
5993 Lisp_Object extent, e_val;
5996 XSETEXTENT (extent, e);
5998 /* Note: in some cases when the property itself is 'start-open
5999 or 'end-closed, the checks to set the openness may do a bit
6000 of extra work; but it won't hurt because we then fix up the
6001 openness later on in put_text_prop_openness_mapper(). */
6002 if (!EQ (Fextent_property (extent, Qtext_prop, Qnil), closure->prop))
6003 /* It's not for this property; do nothing. */
6006 e_start = extent_endpoint_bytind (e, 0);
6007 e_end = extent_endpoint_bytind (e, 1);
6008 e_val = Fextent_property (extent, closure->prop, Qnil);
6009 is_eq = EQ (value, e_val);
6011 if (!NILP (value) && NILP (closure->the_extent) && is_eq)
6013 /* We want there to be an extent here at the end, and we haven't picked
6014 one yet, so use this one. Extend it as necessary. We only reuse an
6015 extent which has an EQ value for the prop in question to avoid
6016 side-effecting the kill ring (that is, we never change the property
6017 on an extent after it has been created.)
6019 if (e_start != start || e_end != end)
6021 Bytind new_start = min (e_start, start);
6022 Bytind new_end = max (e_end, end);
6023 set_extent_endpoints (e, new_start, new_end, Qnil);
6024 /* If we changed the endpoint, then we need to set its
6026 set_extent_openness (e, new_start != e_start
6027 ? !NILP (get_text_property_bytind
6028 (start, Qstart_open, object,
6029 EXTENT_AT_AFTER, 1)) : -1,
6031 ? NILP (get_text_property_bytind
6032 (end - 1, Qend_closed, object,
6033 EXTENT_AT_AFTER, 1))
6035 closure->changed_p = 1;
6037 closure->the_extent = extent;
6040 /* Even if we're adding a prop, at this point, we want all other extents of
6041 this prop to go away (as now they overlap). So the theory here is that,
6042 when we are adding a prop to a region that has multiple (disjoint)
6043 occurrences of that prop in it already, we pick one of those and extend
6044 it, and remove the others.
6047 else if (EQ (extent, closure->the_extent))
6049 /* just in case map-extents hits it again (does that happen?) */
6052 else if (e_start >= start && e_end <= end)
6054 /* Extent is contained in region; remove it. Don't destroy or modify
6055 it, because we don't want to change the attributes pointed to by the
6056 duplicates in the kill ring.
6059 closure->changed_p = 1;
6061 else if (!NILP (closure->the_extent) &&
6066 EXTENT te = XEXTENT (closure->the_extent);
6067 /* This extent overlaps, and has the same prop/value as the extent we've
6068 decided to reuse, so we can remove this existing extent as well (the
6069 whole thing, even the part outside of the region) and extend
6070 the-extent to cover it, resulting in the minimum number of extents in
6073 Bytind the_start = extent_endpoint_bytind (te, 0);
6074 Bytind the_end = extent_endpoint_bytind (te, 1);
6075 if (e_start != the_start && /* note AND not OR -- hmm, why is this
6076 the case? I think it's because the
6077 assumption that the text-property
6078 extents don't overlap makes it
6079 OK; changing it to an OR would
6080 result in changed_p sometimes getting
6081 falsely marked. Is this bad? */
6084 Bytind new_start = min (e_start, the_start);
6085 Bytind new_end = max (e_end, the_end);
6086 set_extent_endpoints (te, new_start, new_end, Qnil);
6087 /* If we changed the endpoint, then we need to set its
6088 openness. We are setting the endpoint to be the same as
6089 that of the extent we're about to remove, and we assume
6090 (the invariant mentioned above) that extent has the
6091 proper endpoint setting, so we just use it. */
6092 set_extent_openness (te, new_start != e_start ?
6093 (int) extent_start_open_p (e) : -1,
6095 (int) extent_end_open_p (e) : -1);
6096 closure->changed_p = 1;
6100 else if (e_end <= end)
6102 /* Extent begins before start but ends before end, so we can just
6103 decrease its end position.
6107 set_extent_endpoints (e, e_start, start, Qnil);
6108 set_extent_openness (e, -1, NILP (get_text_property_bytind
6109 (start - 1, Qend_closed, object,
6110 EXTENT_AT_AFTER, 1)));
6111 closure->changed_p = 1;
6114 else if (e_start >= start)
6116 /* Extent ends after end but begins after start, so we can just
6117 increase its start position.
6121 set_extent_endpoints (e, end, e_end, Qnil);
6122 set_extent_openness (e, !NILP (get_text_property_bytind
6123 (end, Qstart_open, object,
6124 EXTENT_AT_AFTER, 1)), -1);
6125 closure->changed_p = 1;
6130 /* Otherwise, `extent' straddles the region. We need to split it.
6132 set_extent_endpoints (e, e_start, start, Qnil);
6133 set_extent_openness (e, -1, NILP (get_text_property_bytind
6134 (start - 1, Qend_closed, object,
6135 EXTENT_AT_AFTER, 1)));
6136 set_extent_openness (copy_extent (e, end, e_end, extent_object (e)),
6137 !NILP (get_text_property_bytind
6138 (end, Qstart_open, object,
6139 EXTENT_AT_AFTER, 1)), -1);
6140 closure->changed_p = 1;
6143 return 0; /* to continue mapping. */
6147 put_text_prop_openness_mapper (EXTENT e, void *arg)
6149 struct put_text_prop_arg *closure = (struct put_text_prop_arg *) arg;
6150 Bytind e_start, e_end;
6151 Bytind start = closure->start;
6152 Bytind end = closure->end;
6154 XSETEXTENT (extent, e);
6155 e_start = extent_endpoint_bytind (e, 0);
6156 e_end = extent_endpoint_bytind (e, 1);
6158 if (NILP (Fextent_property (extent, Qtext_prop, Qnil)))
6160 /* It's not a text-property extent; do nothing. */
6163 /* Note end conditions and NILP/!NILP's carefully. */
6164 else if (EQ (closure->prop, Qstart_open)
6165 && e_start >= start && e_start < end)
6166 set_extent_openness (e, !NILP (closure->value), -1);
6167 else if (EQ (closure->prop, Qend_closed)
6168 && e_end > start && e_end <= end)
6169 set_extent_openness (e, -1, NILP (closure->value));
6171 return 0; /* to continue mapping. */
6175 put_text_prop (Bytind start, Bytind end, Lisp_Object object,
6176 Lisp_Object prop, Lisp_Object value,
6179 /* This function can GC */
6180 struct put_text_prop_arg closure;
6182 if (start == end) /* There are no characters in the region. */
6185 /* convert to the non-default versions, since a nil property is
6186 the same as it not being present. */
6187 if (EQ (prop, Qstart_closed))
6190 value = NILP (value) ? Qt : Qnil;
6192 else if (EQ (prop, Qend_open))
6195 value = NILP (value) ? Qt : Qnil;
6198 value = canonicalize_extent_property (prop, value);
6200 closure.prop = prop;
6201 closure.value = value;
6202 closure.start = start;
6204 closure.object = object;
6205 closure.changed_p = 0;
6206 closure.the_extent = Qnil;
6208 map_extents_bytind (start, end,
6209 put_text_prop_mapper,
6210 (void *) &closure, object, 0,
6211 /* get all extents that abut the region */
6212 ME_ALL_EXTENTS_CLOSED | ME_END_CLOSED |
6213 /* it might QUIT or error if the user has
6214 fucked with the extent plist. */
6215 /* #### dmoore - I think this should include
6216 ME_MIGHT_MOVE_SOE, since the callback function
6217 might recurse back into map_extents_bytind. */
6219 ME_MIGHT_MODIFY_EXTENTS);
6221 /* If we made it through the loop without reusing an extent
6222 (and we want there to be one) make it now.
6224 if (!NILP (value) && NILP (closure.the_extent))
6228 XSETEXTENT (extent, make_extent_internal (object, start, end));
6229 closure.changed_p = 1;
6230 Fset_extent_property (extent, Qtext_prop, prop);
6231 Fset_extent_property (extent, prop, value);
6234 extent_duplicable_p (XEXTENT (extent)) = 1;
6235 Fset_extent_property (extent, Qpaste_function,
6236 Qtext_prop_extent_paste_function);
6238 set_extent_openness (XEXTENT (extent),
6239 !NILP (get_text_property_bytind
6240 (start, Qstart_open, object,
6241 EXTENT_AT_AFTER, 1)),
6242 NILP (get_text_property_bytind
6243 (end - 1, Qend_closed, object,
6244 EXTENT_AT_AFTER, 1)));
6247 if (EQ (prop, Qstart_open) || EQ (prop, Qend_closed))
6249 map_extents_bytind (start, end,
6250 put_text_prop_openness_mapper,
6251 (void *) &closure, object, 0,
6252 /* get all extents that abut the region */
6253 ME_ALL_EXTENTS_CLOSED | ME_END_CLOSED |
6254 ME_MIGHT_MODIFY_EXTENTS);
6257 return closure.changed_p;
6260 DEFUN ("put-text-property", Fput_text_property, 4, 5, 0, /*
6261 Adds the given property/value to all characters in the specified region.
6262 The property is conceptually attached to the characters rather than the
6263 region. The properties are copied when the characters are copied/pasted.
6264 Fifth argument OBJECT is the buffer or string containing the text, and
6265 defaults to the current buffer.
6267 (start, end, prop, value, object))
6269 /* This function can GC */
6272 object = decode_buffer_or_string (object);
6273 get_buffer_or_string_range_byte (object, start, end, &s, &e, 0);
6274 put_text_prop (s, e, object, prop, value, 1);
6278 DEFUN ("put-nonduplicable-text-property", Fput_nonduplicable_text_property,
6280 Adds the given property/value to all characters in the specified region.
6281 The property is conceptually attached to the characters rather than the
6282 region, however the properties will not be copied when the characters
6284 Fifth argument OBJECT is the buffer or string containing the text, and
6285 defaults to the current buffer.
6287 (start, end, prop, value, object))
6289 /* This function can GC */
6292 object = decode_buffer_or_string (object);
6293 get_buffer_or_string_range_byte (object, start, end, &s, &e, 0);
6294 put_text_prop (s, e, object, prop, value, 0);
6298 DEFUN ("add-text-properties", Fadd_text_properties, 3, 4, 0, /*
6299 Add properties to the characters from START to END.
6300 The third argument PROPS is a property list specifying the property values
6301 to add. The optional fourth argument, OBJECT, is the buffer or string
6302 containing the text and defaults to the current buffer. Returns t if
6303 any property was changed, nil otherwise.
6305 (start, end, props, object))
6307 /* This function can GC */
6311 object = decode_buffer_or_string (object);
6312 get_buffer_or_string_range_byte (object, start, end, &s, &e, 0);
6314 for (; !NILP (props); props = Fcdr (Fcdr (props)))
6316 Lisp_Object prop = XCAR (props);
6317 Lisp_Object value = Fcar (XCDR (props));
6318 changed |= put_text_prop (s, e, object, prop, value, 1);
6320 return changed ? Qt : Qnil;
6324 DEFUN ("add-nonduplicable-text-properties", Fadd_nonduplicable_text_properties,
6326 Add nonduplicable properties to the characters from START to END.
6327 \(The properties will not be copied when the characters are copied.)
6328 The third argument PROPS is a property list specifying the property values
6329 to add. The optional fourth argument, OBJECT, is the buffer or string
6330 containing the text and defaults to the current buffer. Returns t if
6331 any property was changed, nil otherwise.
6333 (start, end, props, object))
6335 /* This function can GC */
6339 object = decode_buffer_or_string (object);
6340 get_buffer_or_string_range_byte (object, start, end, &s, &e, 0);
6342 for (; !NILP (props); props = Fcdr (Fcdr (props)))
6344 Lisp_Object prop = XCAR (props);
6345 Lisp_Object value = Fcar (XCDR (props));
6346 changed |= put_text_prop (s, e, object, prop, value, 0);
6348 return changed ? Qt : Qnil;
6351 DEFUN ("remove-text-properties", Fremove_text_properties, 3, 4, 0, /*
6352 Remove the given properties from all characters in the specified region.
6353 PROPS should be a plist, but the values in that plist are ignored (treated
6354 as nil). Returns t if any property was changed, nil otherwise.
6355 Fourth argument OBJECT is the buffer or string containing the text, and
6356 defaults to the current buffer.
6358 (start, end, props, object))
6360 /* This function can GC */
6364 object = decode_buffer_or_string (object);
6365 get_buffer_or_string_range_byte (object, start, end, &s, &e, 0);
6367 for (; !NILP (props); props = Fcdr (Fcdr (props)))
6369 Lisp_Object prop = XCAR (props);
6370 changed |= put_text_prop (s, e, object, prop, Qnil, 1);
6372 return changed ? Qt : Qnil;
6375 /* Whenever a text-prop extent is pasted into a buffer (via `yank' or `insert'
6376 or whatever) we attach the properties to the buffer by calling
6377 `put-text-property' instead of by simply allowing the extent to be copied or
6378 re-attached. Then we return nil, telling the extents code not to attach it
6379 again. By handing the insertion hackery in this way, we make kill/yank
6380 behave consistently with put-text-property and not fragment the extents
6381 (since text-prop extents must partition, not overlap).
6383 The lisp implementation of this was probably fast enough, but since I moved
6384 the rest of the put-text-prop code here, I moved this as well for
6387 DEFUN ("text-prop-extent-paste-function", Ftext_prop_extent_paste_function,
6389 Used as the `paste-function' property of `text-prop' extents.
6393 /* This function can GC */
6394 Lisp_Object prop, val;
6396 prop = Fextent_property (extent, Qtext_prop, Qnil);
6398 signal_simple_error ("internal error: no text-prop", extent);
6399 val = Fextent_property (extent, prop, Qnil);
6401 /* removed by bill perry, 2/9/97
6402 ** This little bit of code would not allow you to have a text property
6403 ** with a value of Qnil. This is bad bad bad.
6406 signal_simple_error_2 ("internal error: no text-prop",
6409 Fput_text_property (from, to, prop, val, Qnil);
6410 return Qnil; /* important! */
6413 /* This function could easily be written in Lisp but the C code wants
6414 to use it in connection with invisible extents (at least currently).
6415 If this changes, consider moving this back into Lisp. */
6417 DEFUN ("next-single-property-change", Fnext_single_property_change,
6419 Return the position of next property change for a specific property.
6420 Scans characters forward from POS till it finds a change in the PROP
6421 property, then returns the position of the change. The optional third
6422 argument OBJECT is the buffer or string to scan (defaults to the current
6424 The property values are compared with `eq'.
6425 Return nil if the property is constant all the way to the end of BUFFER.
6426 If the value is non-nil, it is a position greater than POS, never equal.
6428 If the optional fourth argument LIMIT is non-nil, don't search
6429 past position LIMIT; return LIMIT if nothing is found before LIMIT.
6430 If two or more extents with conflicting non-nil values for PROP overlap
6431 a particular character, it is undefined which value is considered to be
6432 the value of PROP. (Note that this situation will not happen if you always
6433 use the text-property primitives.)
6435 (pos, prop, object, limit))
6439 Lisp_Object extent, value;
6442 object = decode_buffer_or_string (object);
6443 bpos = get_buffer_or_string_pos_char (object, pos, 0);
6446 blim = buffer_or_string_accessible_end_char (object);
6451 blim = get_buffer_or_string_pos_char (object, limit, 0);
6455 extent = Fextent_at (make_int (bpos), object, prop, Qnil, Qnil);
6457 value = Fextent_property (extent, prop, Qnil);
6463 bpos = XINT (Fnext_extent_change (make_int (bpos), object));
6465 break; /* property is the same all the way to the end */
6466 extent = Fextent_at (make_int (bpos), object, prop, Qnil, Qnil);
6467 if ((NILP (extent) && !NILP (value)) ||
6468 (!NILP (extent) && !EQ (value,
6469 Fextent_property (extent, prop, Qnil))))
6470 return make_int (bpos);
6473 /* I think it's more sensible for this function to return nil always
6474 in this situation and it used to do it this way, but it's been changed
6475 for FSF compatibility. */
6479 return make_int (blim);
6482 /* See comment on previous function about why this is written in C. */
6484 DEFUN ("previous-single-property-change", Fprevious_single_property_change,
6486 Return the position of next property change for a specific property.
6487 Scans characters backward from POS till it finds a change in the PROP
6488 property, then returns the position of the change. The optional third
6489 argument OBJECT is the buffer or string to scan (defaults to the current
6491 The property values are compared with `eq'.
6492 Return nil if the property is constant all the way to the start of BUFFER.
6493 If the value is non-nil, it is a position less than POS, never equal.
6495 If the optional fourth argument LIMIT is non-nil, don't search back
6496 past position LIMIT; return LIMIT if nothing is found until LIMIT.
6497 If two or more extents with conflicting non-nil values for PROP overlap
6498 a particular character, it is undefined which value is considered to be
6499 the value of PROP. (Note that this situation will not happen if you always
6500 use the text-property primitives.)
6502 (pos, prop, object, limit))
6506 Lisp_Object extent, value;
6509 object = decode_buffer_or_string (object);
6510 bpos = get_buffer_or_string_pos_char (object, pos, 0);
6513 blim = buffer_or_string_accessible_begin_char (object);
6518 blim = get_buffer_or_string_pos_char (object, limit, 0);
6522 /* extent-at refers to the character AFTER bpos, but we want the
6523 character before bpos. Thus the - 1. extent-at simply
6524 returns nil on bogus positions, so not to worry. */
6525 extent = Fextent_at (make_int (bpos - 1), object, prop, Qnil, Qnil);
6527 value = Fextent_property (extent, prop, Qnil);
6533 bpos = XINT (Fprevious_extent_change (make_int (bpos), object));
6535 break; /* property is the same all the way to the beginning */
6536 extent = Fextent_at (make_int (bpos - 1), object, prop, Qnil, Qnil);
6537 if ((NILP (extent) && !NILP (value)) ||
6538 (!NILP (extent) && !EQ (value,
6539 Fextent_property (extent, prop, Qnil))))
6540 return make_int (bpos);
6543 /* I think it's more sensible for this function to return nil always
6544 in this situation and it used to do it this way, but it's been changed
6545 for FSF compatibility. */
6549 return make_int (blim);
6552 #ifdef MEMORY_USAGE_STATS
6555 compute_buffer_extent_usage (struct buffer *b, struct overhead_stats *ovstats)
6557 /* #### not yet written */
6561 #endif /* MEMORY_USAGE_STATS */
6564 /************************************************************************/
6565 /* initialization */
6566 /************************************************************************/
6569 syms_of_extents (void)
6571 defsymbol (&Qextentp, "extentp");
6572 defsymbol (&Qextent_live_p, "extent-live-p");
6574 defsymbol (&Qall_extents_closed, "all-extents-closed");
6575 defsymbol (&Qall_extents_open, "all-extents-open");
6576 defsymbol (&Qall_extents_closed_open, "all-extents-closed-open");
6577 defsymbol (&Qall_extents_open_closed, "all-extents-open-closed");
6578 defsymbol (&Qstart_in_region, "start-in-region");
6579 defsymbol (&Qend_in_region, "end-in-region");
6580 defsymbol (&Qstart_and_end_in_region, "start-and-end-in-region");
6581 defsymbol (&Qstart_or_end_in_region, "start-or-end-in-region");
6582 defsymbol (&Qnegate_in_region, "negate-in-region");
6584 defsymbol (&Qdetached, "detached");
6585 defsymbol (&Qdestroyed, "destroyed");
6586 defsymbol (&Qbegin_glyph, "begin-glyph");
6587 defsymbol (&Qend_glyph, "end-glyph");
6588 defsymbol (&Qstart_open, "start-open");
6589 defsymbol (&Qend_open, "end-open");
6590 defsymbol (&Qstart_closed, "start-closed");
6591 defsymbol (&Qend_closed, "end-closed");
6592 defsymbol (&Qread_only, "read-only");
6593 /* defsymbol (&Qhighlight, "highlight"); in faces.c */
6594 defsymbol (&Qunique, "unique");
6595 defsymbol (&Qduplicable, "duplicable");
6596 defsymbol (&Qdetachable, "detachable");
6597 defsymbol (&Qpriority, "priority");
6598 defsymbol (&Qmouse_face, "mouse-face");
6599 defsymbol (&Qinitial_redisplay_function,"initial-redisplay-function");
6602 defsymbol (&Qglyph_layout, "glyph-layout"); /* backwards compatibility */
6603 defsymbol (&Qbegin_glyph_layout, "begin-glyph-layout");
6604 defsymbol (&Qend_glyph_layout, "end-glyph-layout");
6605 defsymbol (&Qoutside_margin, "outside-margin");
6606 defsymbol (&Qinside_margin, "inside-margin");
6607 defsymbol (&Qwhitespace, "whitespace");
6608 /* Qtext defined in general.c */
6610 defsymbol (&Qglyph_invisible, "glyph-invisible");
6612 defsymbol (&Qpaste_function, "paste-function");
6613 defsymbol (&Qcopy_function, "copy-function");
6615 defsymbol (&Qtext_prop, "text-prop");
6616 defsymbol (&Qtext_prop_extent_paste_function,
6617 "text-prop-extent-paste-function");
6620 DEFSUBR (Fextent_live_p);
6621 DEFSUBR (Fextent_detached_p);
6622 DEFSUBR (Fextent_start_position);
6623 DEFSUBR (Fextent_end_position);
6624 DEFSUBR (Fextent_object);
6625 DEFSUBR (Fextent_length);
6627 DEFSUBR (Fmake_extent);
6628 DEFSUBR (Fcopy_extent);
6629 DEFSUBR (Fdelete_extent);
6630 DEFSUBR (Fdetach_extent);
6631 DEFSUBR (Fset_extent_endpoints);
6632 DEFSUBR (Fnext_extent);
6633 DEFSUBR (Fprevious_extent);
6635 DEFSUBR (Fnext_e_extent);
6636 DEFSUBR (Fprevious_e_extent);
6638 DEFSUBR (Fnext_extent_change);
6639 DEFSUBR (Fprevious_extent_change);
6641 DEFSUBR (Fextent_parent);
6642 DEFSUBR (Fextent_children);
6643 DEFSUBR (Fset_extent_parent);
6645 DEFSUBR (Fextent_in_region_p);
6646 DEFSUBR (Fmap_extents);
6647 DEFSUBR (Fmap_extent_children);
6648 DEFSUBR (Fextent_at);
6650 DEFSUBR (Fset_extent_initial_redisplay_function);
6651 DEFSUBR (Fextent_face);
6652 DEFSUBR (Fset_extent_face);
6653 DEFSUBR (Fextent_mouse_face);
6654 DEFSUBR (Fset_extent_mouse_face);
6655 DEFSUBR (Fset_extent_begin_glyph);
6656 DEFSUBR (Fset_extent_end_glyph);
6657 DEFSUBR (Fextent_begin_glyph);
6658 DEFSUBR (Fextent_end_glyph);
6659 DEFSUBR (Fset_extent_begin_glyph_layout);
6660 DEFSUBR (Fset_extent_end_glyph_layout);
6661 DEFSUBR (Fextent_begin_glyph_layout);
6662 DEFSUBR (Fextent_end_glyph_layout);
6663 DEFSUBR (Fset_extent_priority);
6664 DEFSUBR (Fextent_priority);
6665 DEFSUBR (Fset_extent_property);
6666 DEFSUBR (Fset_extent_properties);
6667 DEFSUBR (Fextent_property);
6668 DEFSUBR (Fextent_properties);
6670 DEFSUBR (Fhighlight_extent);
6671 DEFSUBR (Fforce_highlight_extent);
6673 DEFSUBR (Finsert_extent);
6675 DEFSUBR (Fget_text_property);
6676 DEFSUBR (Fget_char_property);
6677 DEFSUBR (Fput_text_property);
6678 DEFSUBR (Fput_nonduplicable_text_property);
6679 DEFSUBR (Fadd_text_properties);
6680 DEFSUBR (Fadd_nonduplicable_text_properties);
6681 DEFSUBR (Fremove_text_properties);
6682 DEFSUBR (Ftext_prop_extent_paste_function);
6683 DEFSUBR (Fnext_single_property_change);
6684 DEFSUBR (Fprevious_single_property_change);
6688 vars_of_extents (void)
6690 DEFVAR_INT ("mouse-highlight-priority", &mouse_highlight_priority /*
6691 The priority to use for the mouse-highlighting pseudo-extent
6692 that is used to highlight extents with the `mouse-face' attribute set.
6693 See `set-extent-priority'.
6695 /* Set mouse-highlight-priority (which ends up being used both for the
6696 mouse-highlighting pseudo-extent and the primary selection extent)
6697 to a very high value because very few extents should override it.
6698 1000 gives lots of room below it for different-prioritied extents.
6699 10 doesn't. ediff, for example, likes to use priorities around 100.
6701 mouse_highlight_priority = /* 10 */ 1000;
6703 DEFVAR_LISP ("default-text-properties", &Vdefault_text_properties /*
6704 Property list giving default values for text properties.
6705 Whenever a character does not specify a value for a property, the value
6706 stored in this list is used instead. This only applies when the
6707 functions `get-text-property' or `get-char-property' are called.
6709 Vdefault_text_properties = Qnil;
6711 staticpro (&Vlast_highlighted_extent);
6712 Vlast_highlighted_extent = Qnil;
6714 Vextent_face_reusable_list = Fcons (Qnil, Qnil);
6715 staticpro (&Vextent_face_reusable_list);
6717 extent_auxiliary_defaults.begin_glyph = Qnil;
6718 extent_auxiliary_defaults.end_glyph = Qnil;
6719 extent_auxiliary_defaults.parent = Qnil;
6720 extent_auxiliary_defaults.children = Qnil;
6721 extent_auxiliary_defaults.priority = 0;
6722 extent_auxiliary_defaults.invisible = Qnil;
6723 extent_auxiliary_defaults.read_only = Qnil;
6724 extent_auxiliary_defaults.mouse_face = Qnil;
6725 extent_auxiliary_defaults.initial_redisplay_function = Qnil;
6729 complex_vars_of_extents (void)
6731 staticpro (&Vextent_face_memoize_hash_table);
6732 /* The memoize hash-table maps from lists of symbols to lists of
6733 faces. It needs to be `equal' to implement the memoization.
6734 The reverse table maps in the other direction and just needs
6735 to do `eq' comparison because the lists of faces are already
6737 Vextent_face_memoize_hash_table =
6738 make_lisp_hashtable (100, HASHTABLE_VALUE_WEAK, HASHTABLE_EQUAL);
6739 staticpro (&Vextent_face_reverse_memoize_hash_table);
6740 Vextent_face_reverse_memoize_hash_table =
6741 make_lisp_hashtable (100, HASHTABLE_KEY_WEAK, HASHTABLE_EQ);