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.
229 #include "redisplay.h"
231 /* ------------------------------- */
233 /* ------------------------------- */
235 /* Note that this object is not extent-specific and should perhaps be
236 moved into another file. */
238 /* Holds a marker that moves as elements in the array are inserted and
239 deleted, similar to standard markers. */
241 typedef struct gap_array_marker
244 struct gap_array_marker *next;
247 /* Holds a "gap array", which is an array of elements with a gap located
248 in it. Insertions and deletions with a high degree of locality
249 are very fast, essentially in constant time. Array positions as
250 used and returned in the gap array functions are independent of
253 typedef struct gap_array
260 Gap_Array_Marker *markers;
263 Gap_Array_Marker *gap_array_marker_freelist;
265 /* Convert a "memory position" (i.e. taking the gap into account) into
266 the address of the element at (i.e. after) that position. "Memory
267 positions" are only used internally and are of type Memind.
268 "Array positions" are used externally and are of type int. */
269 #define GAP_ARRAY_MEMEL_ADDR(ga, memel) ((ga)->array + (ga)->elsize*(memel))
271 /* Number of elements currently in a gap array */
272 #define GAP_ARRAY_NUM_ELS(ga) ((ga)->numels)
274 #define GAP_ARRAY_ARRAY_TO_MEMORY_POS(ga, pos) \
275 ((pos) <= (ga)->gap ? (pos) : (pos) + (ga)->gapsize)
277 #define GAP_ARRAY_MEMORY_TO_ARRAY_POS(ga, pos) \
278 ((pos) <= (ga)->gap ? (pos) : (pos) - (ga)->gapsize)
280 /* Convert an array position into the address of the element at
281 (i.e. after) that position. */
282 #define GAP_ARRAY_EL_ADDR(ga, pos) ((pos) < (ga)->gap ? \
283 GAP_ARRAY_MEMEL_ADDR(ga, pos) : \
284 GAP_ARRAY_MEMEL_ADDR(ga, (pos) + (ga)->gapsize))
286 /* ------------------------------- */
288 /* ------------------------------- */
290 typedef struct extent_list_marker
294 struct extent_list_marker *next;
295 } Extent_List_Marker;
297 typedef struct extent_list
301 Extent_List_Marker *markers;
304 Extent_List_Marker *extent_list_marker_freelist;
306 #define EXTENT_LESS_VALS(e,st,nd) ((extent_start (e) < (st)) || \
307 ((extent_start (e) == (st)) && \
308 (extent_end (e) > (nd))))
310 #define EXTENT_EQUAL_VALS(e,st,nd) ((extent_start (e) == (st)) && \
311 (extent_end (e) == (nd)))
313 #define EXTENT_LESS_EQUAL_VALS(e,st,nd) ((extent_start (e) < (st)) || \
314 ((extent_start (e) == (st)) && \
315 (extent_end (e) >= (nd))))
317 /* Is extent E1 less than extent E2 in the display order? */
318 #define EXTENT_LESS(e1,e2) \
319 EXTENT_LESS_VALS (e1, extent_start (e2), extent_end (e2))
321 /* Is extent E1 equal to extent E2? */
322 #define EXTENT_EQUAL(e1,e2) \
323 EXTENT_EQUAL_VALS (e1, extent_start (e2), extent_end (e2))
325 /* Is extent E1 less than or equal to extent E2 in the display order? */
326 #define EXTENT_LESS_EQUAL(e1,e2) \
327 EXTENT_LESS_EQUAL_VALS (e1, extent_start (e2), extent_end (e2))
329 #define EXTENT_E_LESS_VALS(e,st,nd) ((extent_end (e) < (nd)) || \
330 ((extent_end (e) == (nd)) && \
331 (extent_start (e) > (st))))
333 #define EXTENT_E_LESS_EQUAL_VALS(e,st,nd) ((extent_end (e) < (nd)) || \
334 ((extent_end (e) == (nd)) && \
335 (extent_start (e) >= (st))))
337 /* Is extent E1 less than extent E2 in the e-order? */
338 #define EXTENT_E_LESS(e1,e2) \
339 EXTENT_E_LESS_VALS(e1, extent_start (e2), extent_end (e2))
341 /* Is extent E1 less than or equal to extent E2 in the e-order? */
342 #define EXTENT_E_LESS_EQUAL(e1,e2) \
343 EXTENT_E_LESS_EQUAL_VALS (e1, extent_start (e2), extent_end (e2))
345 #define EXTENT_GAP_ARRAY_AT(ga, pos) (* (EXTENT *) GAP_ARRAY_EL_ADDR(ga, pos))
347 /* ------------------------------- */
348 /* auxiliary extent structure */
349 /* ------------------------------- */
351 struct extent_auxiliary extent_auxiliary_defaults;
353 /* ------------------------------- */
354 /* buffer-extent primitives */
355 /* ------------------------------- */
357 typedef struct stack_of_extents
359 Extent_List *extents;
360 Memind pos; /* Position of stack of extents. EXTENTS is the list of
361 all extents that overlap this position. This position
362 can be -1 if the stack of extents is invalid (this
363 happens when a buffer is first created or a string's
364 stack of extents is created [a string's stack of extents
365 is nuked when a GC occurs, to conserve memory]). */
368 /* ------------------------------- */
370 /* ------------------------------- */
372 typedef int Endpoint_Index;
374 #define memind_to_startind(x, start_open) \
375 ((Endpoint_Index) (((x) << 1) + !!(start_open)))
376 #define memind_to_endind(x, end_open) \
377 ((Endpoint_Index) (((x) << 1) - !!(end_open)))
379 /* Combination macros */
380 #define bytind_to_startind(buf, x, start_open) \
381 memind_to_startind (bytind_to_memind (buf, x), start_open)
382 #define bytind_to_endind(buf, x, end_open) \
383 memind_to_endind (bytind_to_memind (buf, x), end_open)
385 /* ------------------------------- */
386 /* buffer-or-string primitives */
387 /* ------------------------------- */
389 /* Similar for Bytinds and start/end indices. */
391 #define buffer_or_string_bytind_to_startind(obj, ind, start_open) \
392 memind_to_startind (buffer_or_string_bytind_to_memind (obj, ind), \
395 #define buffer_or_string_bytind_to_endind(obj, ind, end_open) \
396 memind_to_endind (buffer_or_string_bytind_to_memind (obj, ind), \
399 /* ------------------------------- */
400 /* Lisp-level functions */
401 /* ------------------------------- */
403 /* flags for decode_extent() */
404 #define DE_MUST_HAVE_BUFFER 1
405 #define DE_MUST_BE_ATTACHED 2
407 Lisp_Object Vlast_highlighted_extent;
408 int mouse_highlight_priority;
410 Lisp_Object Qextentp;
411 Lisp_Object Qextent_live_p;
413 Lisp_Object Qall_extents_closed;
414 Lisp_Object Qall_extents_open;
415 Lisp_Object Qall_extents_closed_open;
416 Lisp_Object Qall_extents_open_closed;
417 Lisp_Object Qstart_in_region;
418 Lisp_Object Qend_in_region;
419 Lisp_Object Qstart_and_end_in_region;
420 Lisp_Object Qstart_or_end_in_region;
421 Lisp_Object Qnegate_in_region;
423 Lisp_Object Qdetached;
424 Lisp_Object Qdestroyed;
425 Lisp_Object Qbegin_glyph;
426 Lisp_Object Qend_glyph;
427 Lisp_Object Qstart_open;
428 Lisp_Object Qend_open;
429 Lisp_Object Qstart_closed;
430 Lisp_Object Qend_closed;
431 Lisp_Object Qread_only;
432 /* Qhighlight defined in general.c */
434 Lisp_Object Qduplicable;
435 Lisp_Object Qdetachable;
436 Lisp_Object Qpriority;
437 Lisp_Object Qmouse_face;
438 Lisp_Object Qinitial_redisplay_function;
440 Lisp_Object Qglyph_layout; /* This exists only for backwards compatibility. */
441 Lisp_Object Qbegin_glyph_layout, Qend_glyph_layout;
442 Lisp_Object Qoutside_margin;
443 Lisp_Object Qinside_margin;
444 Lisp_Object Qwhitespace;
445 /* Qtext defined in general.c */
447 /* partially used in redisplay */
448 Lisp_Object Qglyph_invisible;
450 Lisp_Object Qcopy_function;
451 Lisp_Object Qpaste_function;
453 /* The idea here is that if we're given a list of faces, we
454 need to "memoize" this so that two lists of faces that are `equal'
455 turn into the same object. When `set-extent-face' is called, we
456 "memoize" into a list of actual faces; when `extent-face' is called,
457 we do a reverse lookup to get the list of symbols. */
459 static Lisp_Object canonicalize_extent_property (Lisp_Object prop,
461 Lisp_Object Vextent_face_memoize_hash_table;
462 Lisp_Object Vextent_face_reverse_memoize_hash_table;
463 Lisp_Object Vextent_face_reusable_list;
464 /* FSFmacs bogosity */
465 Lisp_Object Vdefault_text_properties;
468 EXFUN (Fextent_properties, 1);
469 EXFUN (Fset_extent_property, 3);
472 /************************************************************************/
473 /* Generalized gap array */
474 /************************************************************************/
476 /* This generalizes the "array with a gap" model used to store buffer
477 characters. This is based on the stuff in insdel.c and should
478 probably be merged with it. This is not extent-specific and should
479 perhaps be moved into a separate file. */
481 /* ------------------------------- */
482 /* internal functions */
483 /* ------------------------------- */
485 /* Adjust the gap array markers in the range (FROM, TO]. Parallel to
486 adjust_markers() in insdel.c. */
489 gap_array_adjust_markers (Gap_Array *ga, Memind from,
490 Memind to, int amount)
494 for (m = ga->markers; m; m = m->next)
495 m->pos = do_marker_adjustment (m->pos, from, to, amount);
498 /* Move the gap to array position POS. Parallel to move_gap() in
499 insdel.c but somewhat simplified. */
502 gap_array_move_gap (Gap_Array *ga, int pos)
505 int gapsize = ga->gapsize;
510 memmove (GAP_ARRAY_MEMEL_ADDR (ga, pos + gapsize),
511 GAP_ARRAY_MEMEL_ADDR (ga, pos),
512 (gap - pos)*ga->elsize);
513 gap_array_adjust_markers (ga, (Memind) pos, (Memind) gap,
518 memmove (GAP_ARRAY_MEMEL_ADDR (ga, gap),
519 GAP_ARRAY_MEMEL_ADDR (ga, gap + gapsize),
520 (pos - gap)*ga->elsize);
521 gap_array_adjust_markers (ga, (Memind) (gap + gapsize),
522 (Memind) (pos + gapsize), - gapsize);
527 /* Make the gap INCREMENT characters longer. Parallel to make_gap() in
531 gap_array_make_gap (Gap_Array *ga, int increment)
533 char *ptr = ga->array;
537 /* If we have to get more space, get enough to last a while. We use
538 a geometric progression that saves on realloc space. */
539 increment += 100 + ga->numels / 8;
541 ptr = (char *) xrealloc (ptr,
542 (ga->numels + ga->gapsize + increment)*ga->elsize);
547 real_gap_loc = ga->gap;
548 old_gap_size = ga->gapsize;
550 /* Call the newly allocated space a gap at the end of the whole space. */
551 ga->gap = ga->numels + ga->gapsize;
552 ga->gapsize = increment;
554 /* Move the new gap down to be consecutive with the end of the old one.
555 This adjusts the markers properly too. */
556 gap_array_move_gap (ga, real_gap_loc + old_gap_size);
558 /* Now combine the two into one large gap. */
559 ga->gapsize += old_gap_size;
560 ga->gap = real_gap_loc;
563 /* ------------------------------- */
564 /* external functions */
565 /* ------------------------------- */
567 /* Insert NUMELS elements (pointed to by ELPTR) into the specified
571 gap_array_insert_els (Gap_Array *ga, int pos, void *elptr, int numels)
573 assert (pos >= 0 && pos <= ga->numels);
574 if (ga->gapsize < numels)
575 gap_array_make_gap (ga, numels - ga->gapsize);
577 gap_array_move_gap (ga, pos);
579 memcpy (GAP_ARRAY_MEMEL_ADDR (ga, ga->gap), (char *) elptr,
581 ga->gapsize -= numels;
583 ga->numels += numels;
584 /* This is the equivalent of insert-before-markers.
586 #### Should only happen if marker is "moves forward at insert" type.
589 gap_array_adjust_markers (ga, pos - 1, pos, numels);
592 /* Delete NUMELS elements from the specified gap array, starting at FROM. */
595 gap_array_delete_els (Gap_Array *ga, int from, int numdel)
597 int to = from + numdel;
598 int gapsize = ga->gapsize;
601 assert (numdel >= 0);
602 assert (to <= ga->numels);
604 /* Make sure the gap is somewhere in or next to what we are deleting. */
606 gap_array_move_gap (ga, to);
608 gap_array_move_gap (ga, from);
610 /* Relocate all markers pointing into the new, larger gap
611 to point at the end of the text before the gap. */
612 gap_array_adjust_markers (ga, to + gapsize, to + gapsize,
615 ga->gapsize += numdel;
616 ga->numels -= numdel;
620 static Gap_Array_Marker *
621 gap_array_make_marker (Gap_Array *ga, int pos)
625 assert (pos >= 0 && pos <= ga->numels);
626 if (gap_array_marker_freelist)
628 m = gap_array_marker_freelist;
629 gap_array_marker_freelist = gap_array_marker_freelist->next;
632 m = xnew (Gap_Array_Marker);
634 m->pos = GAP_ARRAY_ARRAY_TO_MEMORY_POS (ga, pos);
635 m->next = ga->markers;
641 gap_array_delete_marker (Gap_Array *ga, Gap_Array_Marker *m)
643 Gap_Array_Marker *p, *prev;
645 for (prev = 0, p = ga->markers; p && p != m; prev = p, p = p->next)
649 prev->next = p->next;
651 ga->markers = p->next;
652 m->next = gap_array_marker_freelist;
653 m->pos = 0xDEADBEEF; /* -559038737 as an int */
654 gap_array_marker_freelist = m;
658 gap_array_delete_all_markers (Gap_Array *ga)
660 Gap_Array_Marker *p, *next;
662 for (p = ga->markers; p; p = next)
665 p->next = gap_array_marker_freelist;
666 p->pos = 0xDEADBEEF; /* -559038737 as an int */
667 gap_array_marker_freelist = p;
672 gap_array_move_marker (Gap_Array *ga, Gap_Array_Marker *m, int pos)
674 assert (pos >= 0 && pos <= ga->numels);
675 m->pos = GAP_ARRAY_ARRAY_TO_MEMORY_POS (ga, pos);
678 #define gap_array_marker_pos(ga, m) \
679 GAP_ARRAY_MEMORY_TO_ARRAY_POS (ga, (m)->pos)
682 make_gap_array (int elsize)
684 Gap_Array *ga = xnew_and_zero (Gap_Array);
690 free_gap_array (Gap_Array *ga)
694 gap_array_delete_all_markers (ga);
699 /************************************************************************/
700 /* Extent list primitives */
701 /************************************************************************/
703 /* A list of extents is maintained as a double gap array: one gap array
704 is ordered by start index (the "display order") and the other is
705 ordered by end index (the "e-order"). Note that positions in an
706 extent list should logically be conceived of as referring *to*
707 a particular extent (as is the norm in programs) rather than
708 sitting between two extents. Note also that callers of these
709 functions should not be aware of the fact that the extent list is
710 implemented as an array, except for the fact that positions are
711 integers (this should be generalized to handle integers and linked
715 /* Number of elements in an extent list */
716 #define extent_list_num_els(el) GAP_ARRAY_NUM_ELS(el->start)
718 /* Return the position at which EXTENT is located in the specified extent
719 list (in the display order if ENDP is 0, in the e-order otherwise).
720 If the extent is not found, the position where the extent would
721 be inserted is returned. If ENDP is 0, the insertion would go after
722 all other equal extents. If ENDP is not 0, the insertion would go
723 before all other equal extents. If FOUNDP is not 0, then whether
724 the extent was found will get written into it. */
727 extent_list_locate (Extent_List *el, EXTENT extent, int endp, int *foundp)
729 Gap_Array *ga = endp ? el->end : el->start;
730 int left = 0, right = GAP_ARRAY_NUM_ELS (ga);
731 int oldfoundpos, foundpos;
734 while (left != right)
736 /* RIGHT might not point to a valid extent (i.e. it's at the end
737 of the list), so NEWPOS must round down. */
738 unsigned int newpos = (left + right) >> 1;
739 EXTENT e = EXTENT_GAP_ARRAY_AT (ga, (int) newpos);
741 if (endp ? EXTENT_E_LESS (e, extent) : EXTENT_LESS (e, extent))
747 /* Now we're at the beginning of all equal extents. */
749 oldfoundpos = foundpos = left;
750 while (foundpos < GAP_ARRAY_NUM_ELS (ga))
752 EXTENT e = EXTENT_GAP_ARRAY_AT (ga, foundpos);
758 if (!EXTENT_EQUAL (e, extent))
770 /* Return the position of the first extent that begins at or after POS
771 (or ends at or after POS, if ENDP is not 0).
773 An out-of-range value for POS is allowed, and guarantees that the
774 position at the beginning or end of the extent list is returned. */
777 extent_list_locate_from_pos (Extent_List *el, Memind pos, int endp)
779 struct extent fake_extent;
782 Note that if we search for [POS, POS], then we get the following:
784 -- if ENDP is 0, then all extents whose start position is <= POS
785 lie before the returned position, and all extents whose start
786 position is > POS lie at or after the returned position.
788 -- if ENDP is not 0, then all extents whose end position is < POS
789 lie before the returned position, and all extents whose end
790 position is >= POS lie at or after the returned position.
793 set_extent_start (&fake_extent, endp ? pos : pos-1);
794 set_extent_end (&fake_extent, endp ? pos : pos-1);
795 return extent_list_locate (el, &fake_extent, endp, 0);
798 /* Return the extent at POS. */
801 extent_list_at (Extent_List *el, Memind pos, int endp)
803 Gap_Array *ga = endp ? el->end : el->start;
805 assert (pos >= 0 && pos < GAP_ARRAY_NUM_ELS (ga));
806 return EXTENT_GAP_ARRAY_AT (ga, pos);
809 /* Insert an extent into an extent list. */
812 extent_list_insert (Extent_List *el, EXTENT extent)
816 pos = extent_list_locate (el, extent, 0, &foundp);
818 gap_array_insert_els (el->start, pos, &extent, 1);
819 pos = extent_list_locate (el, extent, 1, &foundp);
821 gap_array_insert_els (el->end, pos, &extent, 1);
824 /* Delete an extent from an extent list. */
827 extent_list_delete (Extent_List *el, EXTENT extent)
831 pos = extent_list_locate (el, extent, 0, &foundp);
833 gap_array_delete_els (el->start, pos, 1);
834 pos = extent_list_locate (el, extent, 1, &foundp);
836 gap_array_delete_els (el->end, pos, 1);
840 extent_list_delete_all (Extent_List *el)
842 gap_array_delete_els (el->start, 0, GAP_ARRAY_NUM_ELS (el->start));
843 gap_array_delete_els (el->end, 0, GAP_ARRAY_NUM_ELS (el->end));
846 static Extent_List_Marker *
847 extent_list_make_marker (Extent_List *el, int pos, int endp)
849 Extent_List_Marker *m;
851 if (extent_list_marker_freelist)
853 m = extent_list_marker_freelist;
854 extent_list_marker_freelist = extent_list_marker_freelist->next;
857 m = xnew (Extent_List_Marker);
859 m->m = gap_array_make_marker (endp ? el->end : el->start, pos);
861 m->next = el->markers;
866 #define extent_list_move_marker(el, mkr, pos) \
867 gap_array_move_marker((mkr)->endp ? (el)->end : (el)->start, (mkr)->m, pos)
870 extent_list_delete_marker (Extent_List *el, Extent_List_Marker *m)
872 Extent_List_Marker *p, *prev;
874 for (prev = 0, p = el->markers; p && p != m; prev = p, p = p->next)
878 prev->next = p->next;
880 el->markers = p->next;
881 m->next = extent_list_marker_freelist;
882 extent_list_marker_freelist = m;
883 gap_array_delete_marker (m->endp ? el->end : el->start, m->m);
886 #define extent_list_marker_pos(el, mkr) \
887 gap_array_marker_pos ((mkr)->endp ? (el)->end : (el)->start, (mkr)->m)
890 allocate_extent_list (void)
892 Extent_List *el = xnew (Extent_List);
893 el->start = make_gap_array (sizeof(EXTENT));
894 el->end = make_gap_array (sizeof(EXTENT));
900 free_extent_list (Extent_List *el)
902 free_gap_array (el->start);
903 free_gap_array (el->end);
908 /************************************************************************/
909 /* Auxiliary extent structure */
910 /************************************************************************/
913 mark_extent_auxiliary (Lisp_Object obj, void (*markobj) (Lisp_Object))
915 struct extent_auxiliary *data = XEXTENT_AUXILIARY (obj);
916 markobj (data->begin_glyph);
917 markobj (data->end_glyph);
918 markobj (data->invisible);
919 markobj (data->children);
920 markobj (data->read_only);
921 markobj (data->mouse_face);
922 markobj (data->initial_redisplay_function);
923 markobj (data->before_change_functions);
924 markobj (data->after_change_functions);
928 DEFINE_LRECORD_IMPLEMENTATION ("extent-auxiliary", extent_auxiliary,
929 mark_extent_auxiliary, internal_object_printer,
930 0, 0, 0, struct extent_auxiliary);
933 allocate_extent_auxiliary (EXTENT ext)
935 Lisp_Object extent_aux;
936 struct extent_auxiliary *data =
937 alloc_lcrecord_type (struct extent_auxiliary, lrecord_extent_auxiliary);
939 copy_lcrecord (data, &extent_auxiliary_defaults);
940 XSETEXTENT_AUXILIARY (extent_aux, data);
941 ext->plist = Fcons (extent_aux, ext->plist);
942 ext->flags.has_aux = 1;
946 /************************************************************************/
947 /* Extent info structure */
948 /************************************************************************/
950 /* An extent-info structure consists of a list of the buffer or string's
951 extents and a "stack of extents" that lists all of the extents over
952 a particular position. The stack-of-extents info is used for
953 optimization purposes -- it basically caches some info that might
954 be expensive to compute. Certain otherwise hard computations are easy
955 given the stack of extents over a particular position, and if the
956 stack of extents over a nearby position is known (because it was
957 calculated at some prior point in time), it's easy to move the stack
958 of extents to the proper position.
960 Given that the stack of extents is an optimization, and given that
961 it requires memory, a string's stack of extents is wiped out each
962 time a garbage collection occurs. Therefore, any time you retrieve
963 the stack of extents, it might not be there. If you need it to
964 be there, use the _force version.
966 Similarly, a string may or may not have an extent_info structure.
967 (Generally it won't if there haven't been any extents added to the
968 string.) So use the _force version if you need the extent_info
969 structure to be there. */
971 static struct stack_of_extents *allocate_soe (void);
972 static void free_soe (struct stack_of_extents *soe);
973 static void soe_invalidate (Lisp_Object obj);
976 mark_extent_info (Lisp_Object obj, void (*markobj) (Lisp_Object))
978 struct extent_info *data = (struct extent_info *) XEXTENT_INFO (obj);
980 Extent_List *list = data->extents;
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
993 for (i = 0; i < extent_list_num_els (list); i++)
995 struct extent *extent = extent_list_at (list, i, 0);
998 XSETEXTENT (exobj, extent);
1007 finalize_extent_info (void *header, int for_disksave)
1009 struct extent_info *data = (struct extent_info *) header;
1016 free_soe (data->soe);
1021 free_extent_list (data->extents);
1026 DEFINE_LRECORD_IMPLEMENTATION ("extent-info", extent_info,
1027 mark_extent_info, internal_object_printer,
1028 finalize_extent_info, 0, 0,
1029 struct extent_info);
1032 allocate_extent_info (void)
1034 Lisp_Object extent_info;
1035 struct extent_info *data =
1036 alloc_lcrecord_type (struct extent_info, lrecord_extent_info);
1038 XSETEXTENT_INFO (extent_info, data);
1039 data->extents = allocate_extent_list ();
1045 flush_cached_extent_info (Lisp_Object extent_info)
1047 struct extent_info *data = XEXTENT_INFO (extent_info);
1051 free_soe (data->soe);
1057 /************************************************************************/
1058 /* Buffer/string extent primitives */
1059 /************************************************************************/
1061 /* The functions in this section are the ONLY ones that should know
1062 about the internal implementation of the extent lists. Other functions
1063 should only know that there are two orderings on extents, the "display"
1064 order (sorted by start position, basically) and the e-order (sorted
1065 by end position, basically), and that certain operations are provided
1066 to manipulate the list. */
1068 /* ------------------------------- */
1069 /* basic primitives */
1070 /* ------------------------------- */
1073 decode_buffer_or_string (Lisp_Object object)
1076 XSETBUFFER (object, current_buffer);
1077 else if (BUFFERP (object))
1078 CHECK_LIVE_BUFFER (object);
1079 else if (STRINGP (object))
1082 dead_wrong_type_argument (Qbuffer_or_string_p, object);
1088 extent_ancestor_1 (EXTENT e)
1090 while (e->flags.has_parent)
1092 /* There should be no circularities except in case of a logic
1093 error somewhere in the extent code */
1094 e = XEXTENT (XEXTENT_AUXILIARY (XCAR (e->plist))->parent);
1099 /* Given an extent object (string or buffer or nil), return its extent info.
1100 This may be 0 for a string. */
1102 static struct extent_info *
1103 buffer_or_string_extent_info (Lisp_Object object)
1105 if (STRINGP (object))
1107 Lisp_Object plist = XSTRING (object)->plist;
1108 if (!CONSP (plist) || !EXTENT_INFOP (XCAR (plist)))
1110 return XEXTENT_INFO (XCAR (plist));
1112 else if (NILP (object))
1115 return XEXTENT_INFO (XBUFFER (object)->extent_info);
1118 /* Given a string or buffer, return its extent list. This may be
1121 static Extent_List *
1122 buffer_or_string_extent_list (Lisp_Object object)
1124 struct extent_info *info = buffer_or_string_extent_info (object);
1128 return info->extents;
1131 /* Given a string or buffer, return its extent info. If it's not there,
1134 static struct extent_info *
1135 buffer_or_string_extent_info_force (Lisp_Object object)
1137 struct extent_info *info = buffer_or_string_extent_info (object);
1141 Lisp_Object extent_info;
1143 assert (STRINGP (object)); /* should never happen for buffers --
1144 the only buffers without an extent
1145 info are those after finalization,
1146 destroyed buffers, or special
1147 Lisp-inaccessible buffer objects. */
1148 extent_info = allocate_extent_info ();
1149 XSTRING (object)->plist = Fcons (extent_info, XSTRING (object)->plist);
1150 return XEXTENT_INFO (extent_info);
1156 /* Detach all the extents in OBJECT. Called from redisplay. */
1159 detach_all_extents (Lisp_Object object)
1161 struct extent_info *data = buffer_or_string_extent_info (object);
1169 for (i = 0; i < extent_list_num_els (data->extents); i++)
1171 EXTENT e = extent_list_at (data->extents, i, 0);
1172 /* No need to do detach_extent(). Just nuke the damn things,
1173 which results in the equivalent but faster. */
1174 set_extent_start (e, -1);
1175 set_extent_end (e, -1);
1179 /* But we need to clear all the lists containing extents or
1180 havoc will result. */
1181 extent_list_delete_all (data->extents);
1182 soe_invalidate (object);
1188 init_buffer_extents (struct buffer *b)
1190 b->extent_info = allocate_extent_info ();
1194 uninit_buffer_extents (struct buffer *b)
1196 struct extent_info *data = XEXTENT_INFO (b->extent_info);
1198 /* Don't destroy the extents here -- there may still be children
1199 extents pointing to the extents. */
1200 detach_all_extents (make_buffer (b));
1201 finalize_extent_info (data, 0);
1204 /* Retrieve the extent list that an extent is a member of; the
1205 return value will never be 0 except in destroyed buffers (in which
1206 case the only extents that can refer to this buffer are detached
1209 #define extent_extent_list(e) buffer_or_string_extent_list (extent_object (e))
1211 /* ------------------------------- */
1212 /* stack of extents */
1213 /* ------------------------------- */
1215 #ifdef ERROR_CHECK_EXTENTS
1218 sledgehammer_extent_check (Lisp_Object object)
1222 Extent_List *el = buffer_or_string_extent_list (object);
1223 struct buffer *buf = 0;
1228 if (BUFFERP (object))
1229 buf = XBUFFER (object);
1231 for (endp = 0; endp < 2; endp++)
1232 for (i = 1; i < extent_list_num_els (el); i++)
1234 EXTENT e1 = extent_list_at (el, i-1, endp);
1235 EXTENT e2 = extent_list_at (el, i, endp);
1238 assert (extent_start (e1) <= buf->text->gpt ||
1239 extent_start (e1) > buf->text->gpt + buf->text->gap_size);
1240 assert (extent_end (e1) <= buf->text->gpt ||
1241 extent_end (e1) > buf->text->gpt + buf->text->gap_size);
1243 assert (extent_start (e1) <= extent_end (e1));
1244 assert (endp ? (EXTENT_E_LESS_EQUAL (e1, e2)) :
1245 (EXTENT_LESS_EQUAL (e1, e2)));
1251 static Stack_Of_Extents *
1252 buffer_or_string_stack_of_extents (Lisp_Object object)
1254 struct extent_info *info = buffer_or_string_extent_info (object);
1260 static Stack_Of_Extents *
1261 buffer_or_string_stack_of_extents_force (Lisp_Object object)
1263 struct extent_info *info = buffer_or_string_extent_info_force (object);
1265 info->soe = allocate_soe ();
1269 /* #define SOE_DEBUG */
1273 static void print_extent_1 (char *buf, Lisp_Object extent);
1276 print_extent_2 (EXTENT e)
1281 XSETEXTENT (extent, e);
1282 print_extent_1 (buf, extent);
1283 fputs (buf, stdout);
1287 soe_dump (Lisp_Object obj)
1290 Stack_Of_Extents *soe = buffer_or_string_stack_of_extents (obj);
1300 printf ("SOE pos is %d (memind %d)\n",
1301 soe->pos < 0 ? soe->pos :
1302 buffer_or_string_memind_to_bytind (obj, soe->pos),
1304 for (endp = 0; endp < 2; endp++)
1306 printf (endp ? "SOE end:" : "SOE start:");
1307 for (i = 0; i < extent_list_num_els (sel); i++)
1309 EXTENT e = extent_list_at (sel, i, endp);
1320 /* Insert EXTENT into OBJ's stack of extents, if necessary. */
1323 soe_insert (Lisp_Object obj, EXTENT extent)
1325 Stack_Of_Extents *soe = buffer_or_string_stack_of_extents (obj);
1328 printf ("Inserting into SOE: ");
1329 print_extent_2 (extent);
1332 if (!soe || soe->pos < extent_start (extent) ||
1333 soe->pos > extent_end (extent))
1336 printf ("(not needed)\n\n");
1340 extent_list_insert (soe->extents, extent);
1342 puts ("SOE afterwards is:");
1347 /* Delete EXTENT from OBJ's stack of extents, if necessary. */
1350 soe_delete (Lisp_Object obj, EXTENT extent)
1352 Stack_Of_Extents *soe = buffer_or_string_stack_of_extents (obj);
1355 printf ("Deleting from SOE: ");
1356 print_extent_2 (extent);
1359 if (!soe || soe->pos < extent_start (extent) ||
1360 soe->pos > extent_end (extent))
1363 puts ("(not needed)\n");
1367 extent_list_delete (soe->extents, extent);
1369 puts ("SOE afterwards is:");
1374 /* Move OBJ's stack of extents to lie over the specified position. */
1377 soe_move (Lisp_Object obj, Memind pos)
1379 Stack_Of_Extents *soe = buffer_or_string_stack_of_extents_force (obj);
1380 Extent_List *sel = soe->extents;
1381 int numsoe = extent_list_num_els (sel);
1382 Extent_List *bel = buffer_or_string_extent_list (obj);
1386 #ifdef ERROR_CHECK_EXTENTS
1391 printf ("Moving SOE from %d (memind %d) to %d (memind %d)\n",
1392 soe->pos < 0 ? soe->pos :
1393 buffer_or_string_memind_to_bytind (obj, soe->pos), soe->pos,
1394 buffer_or_string_memind_to_bytind (obj, pos), pos);
1401 else if (soe->pos > pos)
1409 puts ("(not needed)\n");
1414 /* For DIRECTION = 1: Any extent that overlaps POS is either in the
1415 SOE (if the extent starts at or before SOE->POS) or is greater
1416 (in the display order) than any extent in the SOE (if it starts
1419 For DIRECTION = -1: Any extent that overlaps POS is either in the
1420 SOE (if the extent ends at or after SOE->POS) or is less (in the
1421 e-order) than any extent in the SOE (if it ends before SOE->POS).
1423 We proceed in two stages:
1425 1) delete all extents in the SOE that don't overlap POS.
1426 2) insert all extents into the SOE that start (or end, when
1427 DIRECTION = -1) in (SOE->POS, POS] and that overlap
1428 POS. (Don't include SOE->POS in the range because those
1429 extents would already be in the SOE.)
1436 /* Delete all extents in the SOE that don't overlap POS.
1437 This is all extents that end before (or start after,
1438 if DIRECTION = -1) POS.
1441 /* Deleting extents from the SOE is tricky because it changes
1442 the positions of extents. If we are deleting in the forward
1443 direction we have to call extent_list_at() on the same position
1444 over and over again because positions after the deleted element
1445 get shifted back by 1. To make life simplest, we delete forward
1446 irrespective of DIRECTION.
1454 end = extent_list_locate_from_pos (sel, pos, 1);
1458 start = extent_list_locate_from_pos (sel, pos+1, 0);
1462 for (i = start; i < end; i++)
1463 extent_list_delete (sel, extent_list_at (sel, start /* see above */,
1473 start_pos = extent_list_locate_from_pos (bel, soe->pos, endp) - 1;
1475 start_pos = extent_list_locate_from_pos (bel, soe->pos + 1, endp);
1477 for (; start_pos >= 0 && start_pos < extent_list_num_els (bel);
1478 start_pos += direction)
1480 EXTENT e = extent_list_at (bel, start_pos, endp);
1481 if ((direction > 0) ?
1482 (extent_start (e) > pos) :
1483 (extent_end (e) < pos))
1484 break; /* All further extents lie on the far side of POS
1485 and thus can't overlap. */
1486 if ((direction > 0) ?
1487 (extent_end (e) >= pos) :
1488 (extent_start (e) <= pos))
1489 extent_list_insert (sel, e);
1495 puts ("SOE afterwards is:");
1501 soe_invalidate (Lisp_Object obj)
1503 Stack_Of_Extents *soe = buffer_or_string_stack_of_extents (obj);
1507 extent_list_delete_all (soe->extents);
1512 static struct stack_of_extents *
1515 struct stack_of_extents *soe = xnew_and_zero (struct stack_of_extents);
1516 soe->extents = allocate_extent_list ();
1522 free_soe (struct stack_of_extents *soe)
1524 free_extent_list (soe->extents);
1528 /* ------------------------------- */
1529 /* other primitives */
1530 /* ------------------------------- */
1532 /* Return the start (endp == 0) or end (endp == 1) of an extent as
1533 a byte index. If you want the value as a memory index, use
1534 extent_endpoint(). If you want the value as a buffer position,
1535 use extent_endpoint_bufpos(). */
1538 extent_endpoint_bytind (EXTENT extent, int endp)
1540 assert (EXTENT_LIVE_P (extent));
1541 assert (!extent_detached_p (extent));
1543 Memind i = (endp) ? (extent_end (extent)) :
1544 (extent_start (extent));
1545 Lisp_Object obj = extent_object (extent);
1546 return buffer_or_string_memind_to_bytind (obj, i);
1551 extent_endpoint_bufpos (EXTENT extent, int endp)
1553 assert (EXTENT_LIVE_P (extent));
1554 assert (!extent_detached_p (extent));
1556 Memind i = (endp) ? (extent_end (extent)) :
1557 (extent_start (extent));
1558 Lisp_Object obj = extent_object (extent);
1559 return buffer_or_string_memind_to_bufpos (obj, i);
1563 /* A change to an extent occurred that will change the display, so
1564 notify redisplay. Maybe also recurse over all the extent's
1568 extent_changed_for_redisplay (EXTENT extent, int descendants_too,
1569 int invisibility_change)
1574 /* we could easily encounter a detached extent while traversing the
1575 children, but we should never be able to encounter a dead extent. */
1576 assert (EXTENT_LIVE_P (extent));
1578 if (descendants_too)
1580 Lisp_Object children = extent_children (extent);
1582 if (!NILP (children))
1584 /* first mark all of the extent's children. We will lose big-time
1585 if there are any circularities here, so we sure as hell better
1586 ensure that there aren't. */
1587 LIST_LOOP (rest, XWEAK_LIST_LIST (children))
1588 extent_changed_for_redisplay (XEXTENT (XCAR (rest)), 1,
1589 invisibility_change);
1593 /* now mark the extent itself. */
1595 object = extent_object (extent);
1597 if (!BUFFERP (object) || extent_detached_p (extent))
1598 /* #### Can changes to string extents affect redisplay?
1599 I will have to think about this. What about string glyphs?
1600 Things in the modeline? etc. */
1601 /* #### changes to string extents can certainly affect redisplay
1602 if the extent is in some generated-modeline-string: when
1603 we change an extent in generated-modeline-string, this changes
1604 its parent, which is in `modeline-format', so we should
1605 force the modeline to be updated. But how to determine whether
1606 a string is a `generated-modeline-string'? Looping through
1607 all buffers is not very efficient. Should we add all
1608 `generated-modeline-string' strings to a hash table?
1609 Maybe efficiency is not the greatest concern here and there's
1610 no big loss in looping over the buffers. */
1615 b = XBUFFER (object);
1616 BUF_FACECHANGE (b)++;
1617 MARK_EXTENTS_CHANGED;
1618 if (invisibility_change)
1620 buffer_extent_signal_changed_region (b,
1621 extent_endpoint_bufpos (extent, 0),
1622 extent_endpoint_bufpos (extent, 1));
1626 /* A change to an extent occurred that might affect redisplay.
1627 This is called when properties such as the endpoints, the layout,
1628 or the priority changes. Redisplay will be affected only if
1629 the extent has any displayable attributes. */
1632 extent_maybe_changed_for_redisplay (EXTENT extent, int descendants_too,
1633 int invisibility_change)
1635 /* Retrieve the ancestor for efficiency */
1636 EXTENT anc = extent_ancestor (extent);
1637 if (!NILP (extent_face (anc)) ||
1638 !NILP (extent_begin_glyph (anc)) ||
1639 !NILP (extent_end_glyph (anc)) ||
1640 !NILP (extent_mouse_face (anc)) ||
1641 !NILP (extent_invisible (anc)) ||
1642 !NILP (extent_initial_redisplay_function (anc)) ||
1643 invisibility_change)
1644 extent_changed_for_redisplay (extent, descendants_too,
1645 invisibility_change);
1649 make_extent_detached (Lisp_Object object)
1651 EXTENT extent = allocate_extent ();
1653 assert (NILP (object) || STRINGP (object) ||
1654 (BUFFERP (object) && BUFFER_LIVE_P (XBUFFER (object))));
1655 extent_object (extent) = object;
1656 /* Now make sure the extent info exists. */
1658 buffer_or_string_extent_info_force (object);
1662 /* A "real" extent is any extent other than the internal (not-user-visible)
1663 extents used by `map-extents'. */
1666 real_extent_at_forward (Extent_List *el, int pos, int endp)
1668 for (; pos < extent_list_num_els (el); pos++)
1670 EXTENT e = extent_list_at (el, pos, endp);
1671 if (!extent_internal_p (e))
1678 real_extent_at_backward (Extent_List *el, int pos, int endp)
1680 for (; pos >= 0; pos--)
1682 EXTENT e = extent_list_at (el, pos, endp);
1683 if (!extent_internal_p (e))
1690 extent_first (Lisp_Object obj)
1692 Extent_List *el = buffer_or_string_extent_list (obj);
1696 return real_extent_at_forward (el, 0, 0);
1701 extent_e_first (Lisp_Object obj)
1703 Extent_List *el = buffer_or_string_extent_list (obj);
1707 return real_extent_at_forward (el, 0, 1);
1712 extent_next (EXTENT e)
1714 Extent_List *el = extent_extent_list (e);
1716 int pos = extent_list_locate (el, e, 0, &foundp);
1718 return real_extent_at_forward (el, pos+1, 0);
1723 extent_e_next (EXTENT e)
1725 Extent_List *el = extent_extent_list (e);
1727 int pos = extent_list_locate (el, e, 1, &foundp);
1729 return real_extent_at_forward (el, pos+1, 1);
1734 extent_last (Lisp_Object obj)
1736 Extent_List *el = buffer_or_string_extent_list (obj);
1740 return real_extent_at_backward (el, extent_list_num_els (el) - 1, 0);
1745 extent_e_last (Lisp_Object obj)
1747 Extent_List *el = buffer_or_string_extent_list (obj);
1751 return real_extent_at_backward (el, extent_list_num_els (el) - 1, 1);
1756 extent_previous (EXTENT e)
1758 Extent_List *el = extent_extent_list (e);
1760 int pos = extent_list_locate (el, e, 0, &foundp);
1762 return real_extent_at_backward (el, pos-1, 0);
1767 extent_e_previous (EXTENT e)
1769 Extent_List *el = extent_extent_list (e);
1771 int pos = extent_list_locate (el, e, 1, &foundp);
1773 return real_extent_at_backward (el, pos-1, 1);
1778 extent_attach (EXTENT extent)
1780 Extent_List *el = extent_extent_list (extent);
1782 extent_list_insert (el, extent);
1783 soe_insert (extent_object (extent), extent);
1784 /* only this extent changed */
1785 extent_maybe_changed_for_redisplay (extent, 0,
1786 !NILP (extent_invisible (extent)));
1790 extent_detach (EXTENT extent)
1794 if (extent_detached_p (extent))
1796 el = extent_extent_list (extent);
1798 /* call this before messing with the extent. */
1799 extent_maybe_changed_for_redisplay (extent, 0,
1800 !NILP (extent_invisible (extent)));
1801 extent_list_delete (el, extent);
1802 soe_delete (extent_object (extent), extent);
1803 set_extent_start (extent, -1);
1804 set_extent_end (extent, -1);
1807 /* ------------------------------- */
1808 /* map-extents et al. */
1809 /* ------------------------------- */
1811 /* Returns true iff map_extents() would visit the given extent.
1812 See the comments at map_extents() for info on the overlap rule.
1813 Assumes that all validation on the extent and buffer positions has
1814 already been performed (see Fextent_in_region_p ()).
1817 extent_in_region_p (EXTENT extent, Bytind from, Bytind to,
1820 Lisp_Object obj = extent_object (extent);
1821 Endpoint_Index start, end, exs, exe;
1822 int start_open, end_open;
1823 unsigned int all_extents_flags = flags & ME_ALL_EXTENTS_MASK;
1824 unsigned int in_region_flags = flags & ME_IN_REGION_MASK;
1827 /* A zero-length region is treated as closed-closed. */
1830 flags |= ME_END_CLOSED;
1831 flags &= ~ME_START_OPEN;
1834 /* So is a zero-length extent. */
1835 if (extent_start (extent) == extent_end (extent))
1836 start_open = 0, end_open = 0;
1837 /* `all_extents_flags' will almost always be zero. */
1838 else if (all_extents_flags == 0)
1840 start_open = extent_start_open_p (extent);
1841 end_open = extent_end_open_p (extent);
1844 switch (all_extents_flags)
1846 case ME_ALL_EXTENTS_CLOSED: start_open = 0, end_open = 0; break;
1847 case ME_ALL_EXTENTS_OPEN: start_open = 1, end_open = 1; break;
1848 case ME_ALL_EXTENTS_CLOSED_OPEN: start_open = 0, end_open = 1; break;
1849 case ME_ALL_EXTENTS_OPEN_CLOSED: start_open = 1, end_open = 0; break;
1850 default: abort(); break;
1853 start = buffer_or_string_bytind_to_startind (obj, from,
1854 flags & ME_START_OPEN);
1855 end = buffer_or_string_bytind_to_endind (obj, to, ! (flags & ME_END_CLOSED));
1856 exs = memind_to_startind (extent_start (extent), start_open);
1857 exe = memind_to_endind (extent_end (extent), end_open);
1859 /* It's easy to determine whether an extent lies *outside* the
1860 region -- just determine whether it's completely before
1861 or completely after the region. Reject all such extents, so
1862 we're now left with only the extents that overlap the region.
1865 if (exs > end || exe < start)
1868 /* See if any further restrictions are called for. */
1869 /* in_region_flags will almost always be zero. */
1870 if (in_region_flags == 0)
1873 switch (in_region_flags)
1875 case ME_START_IN_REGION:
1876 retval = start <= exs && exs <= end; break;
1877 case ME_END_IN_REGION:
1878 retval = start <= exe && exe <= end; break;
1879 case ME_START_AND_END_IN_REGION:
1880 retval = start <= exs && exe <= end; break;
1881 case ME_START_OR_END_IN_REGION:
1882 retval = (start <= exs && exs <= end) || (start <= exe && exe <= end);
1887 return flags & ME_NEGATE_IN_REGION ? !retval : retval;
1890 struct map_extents_struct
1893 Extent_List_Marker *mkr;
1898 map_extents_unwind (Lisp_Object obj)
1900 struct map_extents_struct *closure =
1901 (struct map_extents_struct *) get_opaque_ptr (obj);
1902 free_opaque_ptr (obj);
1904 extent_detach (closure->range);
1906 extent_list_delete_marker (closure->el, closure->mkr);
1910 /* This is the guts of `map-extents' and the other functions that
1911 map over extents. In theory the operation of this function is
1912 simple: just figure out what extents we're mapping over, and
1913 call the function on each one of them in the range. Unfortunately
1914 there are a wide variety of things that the mapping function
1915 might do, and we have to be very tricky to avoid getting messed
1916 up. Furthermore, this function needs to be very fast (it is
1917 called multiple times every time text is inserted or deleted
1918 from a buffer), and so we can't always afford the overhead of
1919 dealing with all the possible things that the mapping function
1920 might do; thus, there are many flags that can be specified
1921 indicating what the mapping function might or might not do.
1923 The result of all this is that this is the most complicated
1924 function in this file. Change it at your own risk!
1926 A potential simplification to the logic below is to determine
1927 all the extents that the mapping function should be called on
1928 before any calls are actually made and save them in an array.
1929 That introduces its own complications, however (the array
1930 needs to be marked for garbage-collection, and a static array
1931 cannot be used because map_extents() needs to be reentrant).
1932 Furthermore, the results might be a little less sensible than
1937 map_extents_bytind (Bytind from, Bytind to, map_extents_fun fn, void *arg,
1938 Lisp_Object obj, EXTENT after, unsigned int flags)
1940 Memind st, en; /* range we're mapping over */
1941 EXTENT range = 0; /* extent for this, if ME_MIGHT_MODIFY_TEXT */
1942 Extent_List *el = 0; /* extent list we're iterating over */
1943 Extent_List_Marker *posm = 0; /* marker for extent list,
1944 if ME_MIGHT_MODIFY_EXTENTS */
1945 /* count and struct for unwind-protect, if ME_MIGHT_THROW */
1947 struct map_extents_struct closure;
1949 #ifdef ERROR_CHECK_EXTENTS
1950 assert (from <= to);
1951 assert (from >= buffer_or_string_absolute_begin_byte (obj) &&
1952 from <= buffer_or_string_absolute_end_byte (obj) &&
1953 to >= buffer_or_string_absolute_begin_byte (obj) &&
1954 to <= buffer_or_string_absolute_end_byte (obj));
1959 assert (EQ (obj, extent_object (after)));
1960 assert (!extent_detached_p (after));
1963 el = buffer_or_string_extent_list (obj);
1964 if (!el || !extent_list_num_els(el))
1968 st = buffer_or_string_bytind_to_memind (obj, from);
1969 en = buffer_or_string_bytind_to_memind (obj, to);
1971 if (flags & ME_MIGHT_MODIFY_TEXT)
1973 /* The mapping function might change the text in the buffer,
1974 so make an internal extent to hold the range we're mapping
1976 range = make_extent_detached (obj);
1977 set_extent_start (range, st);
1978 set_extent_end (range, en);
1979 range->flags.start_open = flags & ME_START_OPEN;
1980 range->flags.end_open = !(flags & ME_END_CLOSED);
1981 range->flags.internal = 1;
1982 range->flags.detachable = 0;
1983 extent_attach (range);
1986 if (flags & ME_MIGHT_THROW)
1988 /* The mapping function might throw past us so we need to use an
1989 unwind_protect() to eliminate the internal extent and range
1991 count = specpdl_depth ();
1992 closure.range = range;
1994 record_unwind_protect (map_extents_unwind,
1995 make_opaque_ptr (&closure));
1998 /* ---------- Figure out where we start and what direction
1999 we move in. This is the trickiest part of this
2000 function. ---------- */
2002 /* If ME_START_IN_REGION, ME_END_IN_REGION or ME_START_AND_END_IN_REGION
2003 was specified and ME_NEGATE_IN_REGION was not specified, our job
2004 is simple because of the presence of the display order and e-order.
2005 (Note that theoretically do something similar for
2006 ME_START_OR_END_IN_REGION, but that would require more trickiness
2007 than it's worth to avoid hitting the same extent twice.)
2009 In the general case, all the extents that overlap a range can be
2010 divided into two classes: those whose start position lies within
2011 the range (including the range's end but not including the
2012 range's start), and those that overlap the start position,
2013 i.e. those in the SOE for the start position. Or equivalently,
2014 the extents can be divided into those whose end position lies
2015 within the range and those in the SOE for the end position. Note
2016 that for this purpose we treat both the range and all extents in
2017 the buffer as closed on both ends. If this is not what the ME_
2018 flags specified, then we've mapped over a few too many extents,
2019 but no big deal because extent_in_region_p() will filter them
2020 out. Ideally, we could move the SOE to the closer of the range's
2021 two ends and work forwards or backwards from there. However, in
2022 order to make the semantics of the AFTER argument work out, we
2023 have to always go in the same direction; so we choose to always
2024 move the SOE to the start position.
2026 When it comes time to do the SOE stage, we first call soe_move()
2027 so that the SOE gets set up. Note that the SOE might get
2028 changed while we are mapping over its contents. If we can
2029 guarantee that the SOE won't get moved to a new position, we
2030 simply need to put a marker in the SOE and we will track deletions
2031 and insertions of extents in the SOE. If the SOE might get moved,
2032 however (this would happen as a result of a recursive invocation
2033 of map-extents or a call to a redisplay-type function), then
2034 trying to track its changes is hopeless, so we just keep a
2035 marker to the first (or last) extent in the SOE and use that as
2038 Finally, if DONT_USE_SOE is defined, we don't use the SOE at all
2039 and instead just map from the beginning of the buffer. This is
2040 used for testing purposes and allows the SOE to be calculated
2041 using map_extents() instead of the other way around. */
2044 int range_flag; /* ME_*_IN_REGION subset of flags */
2045 int do_soe_stage = 0; /* Are we mapping over the SOE? */
2046 /* Does the range stage map over start or end positions? */
2048 /* If type == 0, we include the start position in the range stage mapping.
2049 If type == 1, we exclude the start position in the range stage mapping.
2050 If type == 2, we begin at range_start_pos, an extent-list position.
2052 int range_start_type = 0;
2053 int range_start_pos = 0;
2056 range_flag = flags & ME_IN_REGION_MASK;
2057 if ((range_flag == ME_START_IN_REGION ||
2058 range_flag == ME_START_AND_END_IN_REGION) &&
2059 !(flags & ME_NEGATE_IN_REGION))
2061 /* map over start position in [range-start, range-end]. No SOE
2065 else if (range_flag == ME_END_IN_REGION && !(flags & ME_NEGATE_IN_REGION))
2067 /* map over end position in [range-start, range-end]. No SOE
2073 /* Need to include the SOE extents. */
2075 /* Just brute-force it: start from the beginning. */
2077 range_start_type = 2;
2078 range_start_pos = 0;
2080 Stack_Of_Extents *soe = buffer_or_string_stack_of_extents_force (obj);
2083 /* Move the SOE to the closer end of the range. This dictates
2084 whether we map over start positions or end positions. */
2087 numsoe = extent_list_num_els (soe->extents);
2090 if (flags & ME_MIGHT_MOVE_SOE)
2093 /* Can't map over SOE, so just extend range to cover the
2095 EXTENT e = extent_list_at (soe->extents, 0, 0);
2097 extent_list_locate (buffer_or_string_extent_list (obj), e, 0,
2100 range_start_type = 2;
2104 /* We can map over the SOE. */
2106 range_start_type = 1;
2111 /* No extents in the SOE to map over, so we act just as if
2112 ME_START_IN_REGION or ME_END_IN_REGION was specified.
2113 RANGE_ENDP already specified so no need to do anything else. */
2118 /* ---------- Now loop over the extents. ---------- */
2120 /* We combine the code for the two stages because much of it
2122 for (stage = 0; stage < 2; stage++)
2124 int pos = 0; /* Position in extent list */
2126 /* First set up start conditions */
2128 { /* The SOE stage */
2131 el = buffer_or_string_stack_of_extents_force (obj)->extents;
2132 /* We will always be looping over start extents here. */
2133 assert (!range_endp);
2137 { /* The range stage */
2138 el = buffer_or_string_extent_list (obj);
2139 switch (range_start_type)
2142 pos = extent_list_locate_from_pos (el, st, range_endp);
2145 pos = extent_list_locate_from_pos (el, st + 1, range_endp);
2148 pos = range_start_pos;
2153 if (flags & ME_MIGHT_MODIFY_EXTENTS)
2155 /* Create a marker to track changes to the extent list */
2157 /* Delete the marker used in the SOE stage. */
2158 extent_list_delete_marker
2159 (buffer_or_string_stack_of_extents_force (obj)->extents, posm);
2160 posm = extent_list_make_marker (el, pos, range_endp);
2161 /* tell the unwind function about the marker. */
2172 /* ----- update position in extent list
2173 and fetch next extent ----- */
2176 /* fetch POS again to track extent insertions or deletions */
2177 pos = extent_list_marker_pos (el, posm);
2178 if (pos >= extent_list_num_els (el))
2180 e = extent_list_at (el, pos, range_endp);
2183 /* now point the marker to the next one we're going to process.
2184 This ensures graceful behavior if this extent is deleted. */
2185 extent_list_move_marker (el, posm, pos);
2187 /* ----- deal with internal extents ----- */
2189 if (extent_internal_p (e))
2191 if (!(flags & ME_INCLUDE_INTERNAL))
2193 else if (e == range)
2195 /* We're processing internal extents and we've
2196 come across our own special range extent.
2197 (This happens only in adjust_extents*() and
2198 process_extents*(), which handle text
2199 insertion and deletion.) We need to omit
2200 processing of this extent; otherwise
2201 we will probably end up prematurely
2202 terminating this loop. */
2207 /* ----- deal with AFTER condition ----- */
2211 /* if e > after, then we can stop skipping extents. */
2212 if (EXTENT_LESS (after, e))
2214 else /* otherwise, skip this extent. */
2218 /* ----- stop if we're completely outside the range ----- */
2220 /* fetch ST and EN again to track text insertions or deletions */
2223 st = extent_start (range);
2224 en = extent_end (range);
2226 if (extent_endpoint (e, range_endp) > en)
2228 /* Can't be mapping over SOE because all extents in
2229 there should overlap ST */
2230 assert (stage == 1);
2234 /* ----- Now actually call the function ----- */
2236 obj2 = extent_object (e);
2237 if (extent_in_region_p (e,
2238 buffer_or_string_memind_to_bytind (obj2,
2240 buffer_or_string_memind_to_bytind (obj2,
2246 /* Function wants us to stop mapping. */
2247 stage = 1; /* so outer for loop will terminate */
2253 /* ---------- Finished looping. ---------- */
2256 if (flags & ME_MIGHT_THROW)
2257 /* This deletes the range extent and frees the marker. */
2258 unbind_to (count, Qnil);
2261 /* Delete them ourselves */
2263 extent_detach (range);
2265 extent_list_delete_marker (el, posm);
2270 map_extents (Bufpos from, Bufpos to, map_extents_fun fn,
2271 void *arg, Lisp_Object obj, EXTENT after, unsigned int flags)
2273 map_extents_bytind (buffer_or_string_bufpos_to_bytind (obj, from),
2274 buffer_or_string_bufpos_to_bytind (obj, to), fn, arg,
2278 /* ------------------------------- */
2279 /* adjust_extents() */
2280 /* ------------------------------- */
2282 /* Add AMOUNT to all extent endpoints in the range (FROM, TO]. This
2283 happens whenever the gap is moved or (under Mule) a character in a
2284 string is substituted for a different-length one. The reason for
2285 this is that extent endpoints behave just like markers (all memory
2286 indices do) and this adjustment correct for markers -- see
2287 adjust_markers(). Note that it is important that we visit all
2288 extent endpoints in the range, irrespective of whether the
2289 endpoints are open or closed.
2291 We could use map_extents() for this (and in fact the function
2292 was originally written that way), but the gap is in an incoherent
2293 state when this function is called and this function plays
2294 around with extent endpoints without detaching and reattaching
2295 the extents (this is provably correct and saves lots of time),
2296 so for safety we make it just look at the extent lists directly. */
2299 adjust_extents (Lisp_Object obj, Memind from, Memind to, int amount)
2305 Stack_Of_Extents *soe;
2307 #ifdef ERROR_CHECK_EXTENTS
2308 sledgehammer_extent_check (obj);
2310 el = buffer_or_string_extent_list (obj);
2312 if (!el || !extent_list_num_els(el))
2315 /* IMPORTANT! Compute the starting positions of the extents to
2316 modify BEFORE doing any modification! Otherwise the starting
2317 position for the second time through the loop might get
2318 incorrectly calculated (I got bit by this bug real bad). */
2319 startpos[0] = extent_list_locate_from_pos (el, from+1, 0);
2320 startpos[1] = extent_list_locate_from_pos (el, from+1, 1);
2321 for (endp = 0; endp < 2; endp++)
2323 for (pos = startpos[endp]; pos < extent_list_num_els (el);
2326 EXTENT e = extent_list_at (el, pos, endp);
2327 if (extent_endpoint (e, endp) > to)
2329 set_extent_endpoint (e,
2330 do_marker_adjustment (extent_endpoint (e, endp),
2336 /* The index for the buffer's SOE is a memory index and thus
2337 needs to be adjusted like a marker. */
2338 soe = buffer_or_string_stack_of_extents (obj);
2339 if (soe && soe->pos >= 0)
2340 soe->pos = do_marker_adjustment (soe->pos, from, to, amount);
2343 /* ------------------------------- */
2344 /* adjust_extents_for_deletion() */
2345 /* ------------------------------- */
2347 struct adjust_extents_for_deletion_arg
2349 EXTENT_dynarr *list;
2353 adjust_extents_for_deletion_mapper (EXTENT extent, void *arg)
2355 struct adjust_extents_for_deletion_arg *closure =
2356 (struct adjust_extents_for_deletion_arg *) arg;
2358 Dynarr_add (closure->list, extent);
2359 return 0; /* continue mapping */
2362 /* For all extent endpoints in the range (FROM, TO], move them to the beginning
2363 of the new gap. Note that it is important that we visit all extent
2364 endpoints in the range, irrespective of whether the endpoints are open or
2367 This function deals with weird stuff such as the fact that extents
2370 There is no string correspondent for this because you can't
2371 delete characters from a string.
2375 adjust_extents_for_deletion (Lisp_Object object, Bytind from,
2376 Bytind to, int gapsize, int numdel,
2379 struct adjust_extents_for_deletion_arg closure;
2381 Memind adjust_to = (Memind) (to + gapsize);
2382 Bytecount amount = - numdel - movegapsize;
2383 Memind oldsoe = 0, newsoe = 0;
2384 Stack_Of_Extents *soe = buffer_or_string_stack_of_extents (object);
2386 #ifdef ERROR_CHECK_EXTENTS
2387 sledgehammer_extent_check (object);
2389 closure.list = Dynarr_new (EXTENT);
2391 /* We're going to be playing weird games below with extents and the SOE
2392 and such, so compute the list now of all the extents that we're going
2393 to muck with. If we do the mapping and adjusting together, things can
2394 get all screwed up. */
2396 map_extents_bytind (from, to, adjust_extents_for_deletion_mapper,
2397 (void *) &closure, object, 0,
2398 /* extent endpoints move like markers regardless
2399 of their open/closeness. */
2400 ME_ALL_EXTENTS_CLOSED | ME_END_CLOSED |
2401 ME_START_OR_END_IN_REGION | ME_INCLUDE_INTERNAL);
2404 Old and new values for the SOE's position. (It gets adjusted
2405 like a marker, just like extent endpoints.)
2412 newsoe = do_marker_adjustment (soe->pos,
2413 adjust_to, adjust_to,
2419 for (i = 0; i < Dynarr_length (closure.list); i++)
2421 EXTENT extent = Dynarr_at (closure.list, i);
2422 Memind new_start = extent_start (extent);
2423 Memind new_end = extent_end (extent);
2425 /* do_marker_adjustment() will not adjust values that should not be
2426 adjusted. We're passing the same funky arguments to
2427 do_marker_adjustment() as buffer_delete_range() does. */
2429 do_marker_adjustment (new_start,
2430 adjust_to, adjust_to,
2433 do_marker_adjustment (new_end,
2434 adjust_to, adjust_to,
2437 /* We need to be very careful here so that the SOE doesn't get
2438 corrupted. We are shrinking extents out of the deleted region
2439 and simultaneously moving the SOE's pos out of the deleted
2440 region, so the SOE should contain the same extents at the end
2441 as at the beginning. However, extents may get reordered
2442 by this process, so we have to operate by pulling the extents
2443 out of the buffer and SOE, changing their bounds, and then
2444 reinserting them. In order for the SOE not to get screwed up,
2445 we have to make sure that the SOE's pos points to its old
2446 location whenever we pull an extent out, and points to its
2447 new location whenever we put the extent back in.
2450 if (new_start != extent_start (extent) ||
2451 new_end != extent_end (extent))
2453 extent_detach (extent);
2454 set_extent_start (extent, new_start);
2455 set_extent_end (extent, new_end);
2458 extent_attach (extent);
2467 #ifdef ERROR_CHECK_EXTENTS
2468 sledgehammer_extent_check (object);
2470 Dynarr_free (closure.list);
2473 /* ------------------------------- */
2474 /* extent fragments */
2475 /* ------------------------------- */
2477 /* Imagine that the buffer is divided up into contiguous,
2478 nonoverlapping "runs" of text such that no extent
2479 starts or ends within a run (extents that abut the
2482 An extent fragment is a structure that holds data about
2483 the run that contains a particular buffer position (if
2484 the buffer position is at the junction of two runs, the
2485 run after the position is used) -- the beginning and
2486 end of the run, a list of all of the extents in that
2487 run, the "merged face" that results from merging all of
2488 the faces corresponding to those extents, the begin and
2489 end glyphs at the beginning of the run, etc. This is
2490 the information that redisplay needs in order to
2493 Extent fragments have to be very quick to update to
2494 a new buffer position when moving linearly through
2495 the buffer. They rely on the stack-of-extents code,
2496 which does the heavy-duty algorithmic work of determining
2497 which extents overly a particular position. */
2499 /* This function returns the position of the beginning of
2500 the first run that begins after POS, or returns POS if
2501 there are no such runs. */
2504 extent_find_end_of_run (Lisp_Object obj, Bytind pos, int outside_accessible)
2507 Extent_List *bel = buffer_or_string_extent_list (obj);
2510 Memind mempos = buffer_or_string_bytind_to_memind (obj, pos);
2511 Bytind limit = outside_accessible ?
2512 buffer_or_string_absolute_end_byte (obj) :
2513 buffer_or_string_accessible_end_byte (obj);
2515 if (!bel || !extent_list_num_els(bel))
2518 sel = buffer_or_string_stack_of_extents_force (obj)->extents;
2519 soe_move (obj, mempos);
2521 /* Find the first start position after POS. */
2522 elind1 = extent_list_locate_from_pos (bel, mempos+1, 0);
2523 if (elind1 < extent_list_num_els (bel))
2524 pos1 = buffer_or_string_memind_to_bytind
2525 (obj, extent_start (extent_list_at (bel, elind1, 0)));
2529 /* Find the first end position after POS. The extent corresponding
2530 to this position is either in the SOE or is greater than or
2531 equal to POS1, so we just have to look in the SOE. */
2532 elind2 = extent_list_locate_from_pos (sel, mempos+1, 1);
2533 if (elind2 < extent_list_num_els (sel))
2534 pos2 = buffer_or_string_memind_to_bytind
2535 (obj, extent_end (extent_list_at (sel, elind2, 1)));
2539 return min (min (pos1, pos2), limit);
2543 extent_find_beginning_of_run (Lisp_Object obj, Bytind pos,
2544 int outside_accessible)
2547 Extent_List *bel = buffer_or_string_extent_list (obj);
2550 Memind mempos = buffer_or_string_bytind_to_memind (obj, pos);
2551 Bytind limit = outside_accessible ?
2552 buffer_or_string_absolute_begin_byte (obj) :
2553 buffer_or_string_accessible_begin_byte (obj);
2555 if (!bel || !extent_list_num_els(bel))
2558 sel = buffer_or_string_stack_of_extents_force (obj)->extents;
2559 soe_move (obj, mempos);
2561 /* Find the first end position before POS. */
2562 elind1 = extent_list_locate_from_pos (bel, mempos, 1);
2564 pos1 = buffer_or_string_memind_to_bytind
2565 (obj, extent_end (extent_list_at (bel, elind1 - 1, 1)));
2569 /* Find the first start position before POS. The extent corresponding
2570 to this position is either in the SOE or is less than or
2571 equal to POS1, so we just have to look in the SOE. */
2572 elind2 = extent_list_locate_from_pos (sel, mempos, 0);
2574 pos2 = buffer_or_string_memind_to_bytind
2575 (obj, extent_start (extent_list_at (sel, elind2 - 1, 0)));
2579 return max (max (pos1, pos2), limit);
2582 struct extent_fragment *
2583 extent_fragment_new (Lisp_Object buffer_or_string, struct frame *frm)
2585 struct extent_fragment *ef = xnew_and_zero (struct extent_fragment);
2587 ef->object = buffer_or_string;
2589 ef->extents = Dynarr_new (EXTENT);
2590 ef->begin_glyphs = Dynarr_new (glyph_block);
2591 ef->end_glyphs = Dynarr_new (glyph_block);
2597 extent_fragment_delete (struct extent_fragment *ef)
2599 Dynarr_free (ef->extents);
2600 Dynarr_free (ef->begin_glyphs);
2601 Dynarr_free (ef->end_glyphs);
2605 /* Note: CONST is losing, but `const' is part of the interface of qsort() */
2607 extent_priority_sort_function (const void *humpty, const void *dumpty)
2609 CONST EXTENT foo = * (CONST EXTENT *) humpty;
2610 CONST EXTENT bar = * (CONST EXTENT *) dumpty;
2611 if (extent_priority (foo) < extent_priority (bar))
2613 return extent_priority (foo) > extent_priority (bar);
2617 extent_fragment_sort_by_priority (EXTENT_dynarr *extarr)
2621 /* Sort our copy of the stack by extent_priority. We use a bubble
2622 sort here because it's going to be faster than qsort() for small
2623 numbers of extents (less than 10 or so), and 99.999% of the time
2624 there won't ever be more extents than this in the stack. */
2625 if (Dynarr_length (extarr) < 10)
2627 for (i = 1; i < Dynarr_length (extarr); i++)
2631 (extent_priority (Dynarr_at (extarr, j)) >
2632 extent_priority (Dynarr_at (extarr, j+1))))
2634 EXTENT tmp = Dynarr_at (extarr, j);
2635 Dynarr_at (extarr, j) = Dynarr_at (extarr, j+1);
2636 Dynarr_at (extarr, j+1) = tmp;
2642 /* But some loser programs mess up and may create a large number
2643 of extents overlapping the same spot. This will result in
2644 catastrophic behavior if we use the bubble sort above. */
2645 qsort (Dynarr_atp (extarr, 0), Dynarr_length (extarr),
2646 sizeof (EXTENT), extent_priority_sort_function);
2649 /* If PROP is the `invisible' property of an extent,
2650 this is 1 if the extent should be treated as invisible. */
2652 #define EXTENT_PROP_MEANS_INVISIBLE(buf, prop) \
2653 (EQ (buf->invisibility_spec, Qt) \
2655 : invisible_p (prop, buf->invisibility_spec))
2657 /* If PROP is the `invisible' property of a extent,
2658 this is 1 if the extent should be treated as invisible
2659 and should have an ellipsis. */
2661 #define EXTENT_PROP_MEANS_INVISIBLE_WITH_ELLIPSIS(buf, prop) \
2662 (EQ (buf->invisibility_spec, Qt) \
2664 : invisible_ellipsis_p (prop, buf->invisibility_spec))
2666 /* This is like a combination of memq and assq.
2667 Return 1 if PROPVAL appears as an element of LIST
2668 or as the car of an element of LIST.
2669 If PROPVAL is a list, compare each element against LIST
2670 in that way, and return 1 if any element of PROPVAL is found in LIST.
2672 This function cannot quit. */
2675 invisible_p (REGISTER Lisp_Object propval, Lisp_Object list)
2677 REGISTER Lisp_Object tail, proptail;
2678 for (tail = list; CONSP (tail); tail = XCDR (tail))
2680 REGISTER Lisp_Object tem;
2682 if (EQ (propval, tem))
2684 if (CONSP (tem) && EQ (propval, XCAR (tem)))
2687 if (CONSP (propval))
2688 for (proptail = propval; CONSP (proptail);
2689 proptail = XCDR (proptail))
2691 Lisp_Object propelt;
2692 propelt = XCAR (proptail);
2693 for (tail = list; CONSP (tail); tail = XCDR (tail))
2695 REGISTER Lisp_Object tem;
2697 if (EQ (propelt, tem))
2699 if (CONSP (tem) && EQ (propelt, XCAR (tem)))
2706 /* Return 1 if PROPVAL appears as the car of an element of LIST
2707 and the cdr of that element is non-nil.
2708 If PROPVAL is a list, check each element of PROPVAL in that way,
2709 and the first time some element is found,
2710 return 1 if the cdr of that element is non-nil.
2712 This function cannot quit. */
2715 invisible_ellipsis_p (REGISTER Lisp_Object propval, Lisp_Object list)
2717 REGISTER Lisp_Object tail, proptail;
2718 for (tail = list; CONSP (tail); tail = XCDR (tail))
2720 REGISTER Lisp_Object tem;
2722 if (CONSP (tem) && EQ (propval, XCAR (tem)))
2723 return ! NILP (XCDR (tem));
2725 if (CONSP (propval))
2726 for (proptail = propval; CONSP (proptail);
2727 proptail = XCDR (proptail))
2729 Lisp_Object propelt;
2730 propelt = XCAR (proptail);
2731 for (tail = list; CONSP (tail); tail = XCDR (tail))
2733 REGISTER Lisp_Object tem;
2735 if (CONSP (tem) && EQ (propelt, XCAR (tem)))
2736 return ! NILP (XCDR (tem));
2743 extent_fragment_update (struct window *w, struct extent_fragment *ef,
2748 buffer_or_string_stack_of_extents_force (ef->object)->extents;
2750 struct extent dummy_lhe_extent;
2751 Memind mempos = buffer_or_string_bytind_to_memind (ef->object, pos);
2753 #ifdef ERROR_CHECK_EXTENTS
2754 assert (pos >= buffer_or_string_accessible_begin_byte (ef->object)
2755 && pos <= buffer_or_string_accessible_end_byte (ef->object));
2758 Dynarr_reset (ef->extents);
2759 Dynarr_reset (ef->begin_glyphs);
2760 Dynarr_reset (ef->end_glyphs);
2762 ef->previously_invisible = ef->invisible;
2765 if (ef->invisible_ellipses)
2766 ef->invisible_ellipses_already_displayed = 1;
2769 ef->invisible_ellipses_already_displayed = 0;
2771 ef->invisible_ellipses = 0;
2773 /* Set up the begin and end positions. */
2775 ef->end = extent_find_end_of_run (ef->object, pos, 0);
2777 /* Note that extent_find_end_of_run() already moved the SOE for us. */
2778 /* soe_move (ef->object, mempos); */
2780 /* Determine the begin glyphs at POS. */
2781 for (i = 0; i < extent_list_num_els (sel); i++)
2783 EXTENT e = extent_list_at (sel, i, 0);
2784 if (extent_start (e) == mempos && !NILP (extent_begin_glyph (e)))
2786 Lisp_Object glyph = extent_begin_glyph (e);
2787 struct glyph_block gb;
2790 XSETEXTENT (gb.extent, e);
2791 Dynarr_add (ef->begin_glyphs, gb);
2795 /* Determine the end glyphs at POS. */
2796 for (i = 0; i < extent_list_num_els (sel); i++)
2798 EXTENT e = extent_list_at (sel, i, 1);
2799 if (extent_end (e) == mempos && !NILP (extent_end_glyph (e)))
2801 Lisp_Object glyph = extent_end_glyph (e);
2802 struct glyph_block gb;
2805 XSETEXTENT (gb.extent, e);
2806 Dynarr_add (ef->end_glyphs, gb);
2810 /* We tried determining all the charsets used in the run here,
2811 but that fails even if we only do the current line -- display
2812 tables or non-printable characters might cause other charsets
2815 /* Determine whether the last-highlighted-extent is present. */
2816 if (EXTENTP (Vlast_highlighted_extent))
2817 lhe = XEXTENT (Vlast_highlighted_extent);
2819 /* Now add all extents that overlap the character after POS and
2820 have a non-nil face. Also check if the character is invisible. */
2821 for (i = 0; i < extent_list_num_els (sel); i++)
2823 EXTENT e = extent_list_at (sel, i, 0);
2824 if (extent_end (e) > mempos)
2826 Lisp_Object invis_prop = extent_invisible (e);
2828 if (!NILP (invis_prop))
2830 if (!BUFFERP (ef->object))
2831 /* #### no `string-invisibility-spec' */
2835 if (!ef->invisible_ellipses_already_displayed &&
2836 EXTENT_PROP_MEANS_INVISIBLE_WITH_ELLIPSIS
2837 (XBUFFER (ef->object), invis_prop))
2840 ef->invisible_ellipses = 1;
2842 else if (EXTENT_PROP_MEANS_INVISIBLE
2843 (XBUFFER (ef->object), invis_prop))
2848 /* Remember that one of the extents in the list might be our
2849 dummy extent representing the highlighting that is
2850 attached to some other extent that is currently
2851 mouse-highlighted. When an extent is mouse-highlighted,
2852 it is as if there are two extents there, of potentially
2853 different priorities: the extent being highlighted, with
2854 whatever face and priority it has; and an ephemeral
2855 extent in the `mouse-face' face with
2856 `mouse-highlight-priority'.
2859 if (!NILP (extent_face (e)))
2860 Dynarr_add (ef->extents, e);
2864 /* zeroing isn't really necessary; we only deref `priority'
2866 xzero (dummy_lhe_extent);
2867 set_extent_priority (&dummy_lhe_extent,
2868 mouse_highlight_priority);
2869 /* Need to break up the following expression, due to an */
2870 /* error in the Digital UNIX 3.2g C compiler (Digital */
2871 /* UNIX Compiler Driver 3.11). */
2872 f = extent_mouse_face (lhe);
2873 extent_face (&dummy_lhe_extent) = f;
2874 Dynarr_add (ef->extents, &dummy_lhe_extent);
2876 /* since we are looping anyway, we might as well do this here */
2877 if ((!NILP(extent_initial_redisplay_function (e))) &&
2878 !extent_in_red_event_p(e))
2880 Lisp_Object function = extent_initial_redisplay_function (e);
2883 /* printf ("initial redisplay function called!\n "); */
2885 /* print_extent_2 (e);
2888 /* FIXME: One should probably inhibit the displaying of
2889 this extent to reduce flicker */
2890 extent_in_red_event_p(e) = 1;
2892 /* call the function */
2895 Fenqueue_eval_event(function,obj);
2900 extent_fragment_sort_by_priority (ef->extents);
2902 /* Now merge the faces together into a single face. The code to
2903 do this is in faces.c because it involves manipulating faces. */
2904 return get_extent_fragment_face_cache_index (w, ef);
2908 /************************************************************************/
2909 /* extent-object methods */
2910 /************************************************************************/
2912 /* These are the basic helper functions for handling the allocation of
2913 extent objects. They are similar to the functions for other
2914 lrecord objects. allocate_extent() is in alloc.c, not here. */
2916 static Lisp_Object mark_extent (Lisp_Object, void (*) (Lisp_Object));
2917 static int extent_equal (Lisp_Object, Lisp_Object, int depth);
2918 static unsigned long extent_hash (Lisp_Object obj, int depth);
2919 static void print_extent (Lisp_Object obj, Lisp_Object printcharfun,
2921 static Lisp_Object extent_getprop (Lisp_Object obj, Lisp_Object prop);
2922 static int extent_putprop (Lisp_Object obj, Lisp_Object prop,
2924 static int extent_remprop (Lisp_Object obj, Lisp_Object prop);
2925 static Lisp_Object extent_plist (Lisp_Object obj);
2927 DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS ("extent", extent,
2930 /* NOTE: If you declare a
2931 finalization method here,
2932 it will NOT be called.
2935 extent_equal, extent_hash,
2936 extent_getprop, extent_putprop,
2937 extent_remprop, extent_plist,
2941 mark_extent (Lisp_Object obj, void (*markobj) (Lisp_Object))
2943 struct extent *extent = XEXTENT (obj);
2945 markobj (extent_object (extent));
2946 markobj (extent_no_chase_normal_field (extent, face));
2947 return extent->plist;
2951 print_extent_1 (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
2953 EXTENT ext = XEXTENT (obj);
2954 EXTENT anc = extent_ancestor (ext);
2956 char buf[64], *bp = buf;
2958 /* Retrieve the ancestor and use it, for faster retrieval of properties */
2960 if (!NILP (extent_begin_glyph (anc))) *bp++ = '*';
2961 *bp++ = (extent_start_open_p (anc) ? '(': '[');
2962 if (extent_detached_p (ext))
2963 strcpy (bp, "detached");
2966 Bufpos from = XINT (Fextent_start_position (obj));
2967 Bufpos to = XINT (Fextent_end_position (obj));
2968 sprintf (bp, "%d, %d", from, to);
2971 *bp++ = (extent_end_open_p (anc) ? ')': ']');
2972 if (!NILP (extent_end_glyph (anc))) *bp++ = '*';
2975 if (!NILP (extent_read_only (anc))) *bp++ = '%';
2976 if (!NILP (extent_mouse_face (anc))) *bp++ = 'H';
2977 if (extent_unique_p (anc)) *bp++ = 'U';
2978 else if (extent_duplicable_p (anc)) *bp++ = 'D';
2979 if (!NILP (extent_invisible (anc))) *bp++ = 'I';
2981 if (!NILP (extent_read_only (anc)) || !NILP (extent_mouse_face (anc)) ||
2982 extent_unique_p (anc) ||
2983 extent_duplicable_p (anc) || !NILP (extent_invisible (anc)))
2986 write_c_string (buf, printcharfun);
2988 tail = extent_plist_slot (anc);
2990 for (; !NILP (tail); tail = Fcdr (Fcdr (tail)))
2992 Lisp_Object v = XCAR (XCDR (tail));
2993 if (NILP (v)) continue;
2994 print_internal (XCAR (tail), printcharfun, escapeflag);
2995 write_c_string (" ", printcharfun);
2998 sprintf (buf, "0x%lx", (long) ext);
2999 write_c_string (buf, printcharfun);
3003 print_extent (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
3007 CONST char *title = "";
3008 CONST char *name = "";
3009 CONST char *posttitle = "";
3010 Lisp_Object obj2 = Qnil;
3012 /* Destroyed extents have 't' in the object field, causing
3013 extent_object() to abort (maybe). */
3014 if (EXTENT_LIVE_P (XEXTENT (obj)))
3015 obj2 = extent_object (XEXTENT (obj));
3018 title = "no buffer";
3019 else if (BUFFERP (obj2))
3021 if (BUFFER_LIVE_P (XBUFFER (obj2)))
3024 name = (char *) XSTRING_DATA (XBUFFER (obj2)->name);
3028 title = "Killed Buffer";
3034 assert (STRINGP (obj2));
3035 title = "string \"";
3037 name = (char *) XSTRING_DATA (obj2);
3042 if (!EXTENT_LIVE_P (XEXTENT (obj)))
3043 error ("printing unreadable object #<destroyed extent>");
3045 error ("printing unreadable object #<extent 0x%lx>",
3046 (long) XEXTENT (obj));
3049 if (!EXTENT_LIVE_P (XEXTENT (obj)))
3050 write_c_string ("#<destroyed extent", printcharfun);
3053 char *buf = (char *)
3054 alloca (strlen (title) + strlen (name) + strlen (posttitle) + 1);
3055 write_c_string ("#<extent ", printcharfun);
3056 print_extent_1 (obj, printcharfun, escapeflag);
3057 write_c_string (extent_detached_p (XEXTENT (obj))
3058 ? " from " : " in ", printcharfun);
3059 sprintf (buf, "%s%s%s", title, name, posttitle);
3060 write_c_string (buf, printcharfun);
3066 error ("printing unreadable object #<extent>");
3067 write_c_string ("#<extent", printcharfun);
3069 write_c_string (">", printcharfun);
3073 properties_equal (EXTENT e1, EXTENT e2, int depth)
3075 /* When this function is called, all indirections have been followed.
3076 Thus, the indirection checks in the various macros below will not
3077 amount to anything, and could be removed. However, the time
3078 savings would probably not be significant. */
3079 if (!(EQ (extent_face (e1), extent_face (e2)) &&
3080 extent_priority (e1) == extent_priority (e2) &&
3081 internal_equal (extent_begin_glyph (e1), extent_begin_glyph (e2),
3083 internal_equal (extent_end_glyph (e1), extent_end_glyph (e2),
3087 /* compare the bit flags. */
3089 /* The has_aux field should not be relevant. */
3090 int e1_has_aux = e1->flags.has_aux;
3091 int e2_has_aux = e2->flags.has_aux;
3094 e1->flags.has_aux = e2->flags.has_aux = 0;
3095 value = memcmp (&e1->flags, &e2->flags, sizeof (e1->flags));
3096 e1->flags.has_aux = e1_has_aux;
3097 e2->flags.has_aux = e2_has_aux;
3102 /* compare the random elements of the plists. */
3103 return !plists_differ (extent_no_chase_plist (e1),
3104 extent_no_chase_plist (e2),
3109 extent_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
3111 struct extent *e1 = XEXTENT (obj1);
3112 struct extent *e2 = XEXTENT (obj2);
3114 (extent_start (e1) == extent_start (e2) &&
3115 extent_end (e1) == extent_end (e2) &&
3116 internal_equal (extent_object (e1), extent_object (e2), depth + 1) &&
3117 properties_equal (extent_ancestor (e1), extent_ancestor (e2),
3121 static unsigned long
3122 extent_hash (Lisp_Object obj, int depth)
3124 struct extent *e = XEXTENT (obj);
3125 /* No need to hash all of the elements; that would take too long.
3126 Just hash the most common ones. */
3127 return HASH3 (extent_start (e), extent_end (e),
3128 internal_hash (extent_object (e), depth + 1));
3132 extent_getprop (Lisp_Object obj, Lisp_Object prop)
3134 return Fextent_property (obj, prop, Qunbound);
3138 extent_putprop (Lisp_Object obj, Lisp_Object prop, Lisp_Object value)
3140 Fset_extent_property (obj, prop, value);
3145 extent_remprop (Lisp_Object obj, Lisp_Object prop)
3147 EXTENT ext = XEXTENT (obj);
3149 /* This list is taken from Fset_extent_property, and should be kept
3151 if (EQ (prop, Qread_only)
3152 || EQ (prop, Qunique)
3153 || EQ (prop, Qduplicable)
3154 || EQ (prop, Qinvisible)
3155 || EQ (prop, Qdetachable)
3156 || EQ (prop, Qdetached)
3157 || EQ (prop, Qdestroyed)
3158 || EQ (prop, Qpriority)
3160 || EQ (prop, Qinitial_redisplay_function)
3161 || EQ (prop, Qafter_change_functions)
3162 || EQ (prop, Qbefore_change_functions)
3163 || EQ (prop, Qmouse_face)
3164 || EQ (prop, Qhighlight)
3165 || EQ (prop, Qbegin_glyph_layout)
3166 || EQ (prop, Qend_glyph_layout)
3167 || EQ (prop, Qglyph_layout)
3168 || EQ (prop, Qbegin_glyph)
3169 || EQ (prop, Qend_glyph)
3170 || EQ (prop, Qstart_open)
3171 || EQ (prop, Qend_open)
3172 || EQ (prop, Qstart_closed)
3173 || EQ (prop, Qend_closed)
3174 || EQ (prop, Qkeymap))
3176 /* #### Is this correct, anyway? */
3180 return external_remprop (&ext->plist, prop, 0, ERROR_ME);
3184 extent_plist (Lisp_Object obj)
3186 return Fextent_properties (obj);
3190 /************************************************************************/
3191 /* basic extent accessors */
3192 /************************************************************************/
3194 /* These functions are for checking externally-passed extent objects
3195 and returning an extent's basic properties, which include the
3196 buffer the extent is associated with, the endpoints of the extent's
3197 range, the open/closed-ness of those endpoints, and whether the
3198 extent is detached. Manipulating these properties requires
3199 manipulating the ordered lists that hold extents; thus, functions
3200 to do that are in a later section. */
3202 /* Given a Lisp_Object that is supposed to be an extent, make sure it
3203 is OK and return an extent pointer. Extents can be in one of four
3207 2) detached and not associated with a buffer
3208 3) detached and associated with a buffer
3209 4) attached to a buffer
3211 If FLAGS is 0, types 2-4 are allowed. If FLAGS is DE_MUST_HAVE_BUFFER,
3212 types 3-4 are allowed. If FLAGS is DE_MUST_BE_ATTACHED, only type 4
3217 decode_extent (Lisp_Object extent_obj, unsigned int flags)
3222 CHECK_LIVE_EXTENT (extent_obj);
3223 extent = XEXTENT (extent_obj);
3224 obj = extent_object (extent);
3226 /* the following condition will fail if we're dealing with a freed extent */
3227 assert (NILP (obj) || BUFFERP (obj) || STRINGP (obj));
3229 if (flags & DE_MUST_BE_ATTACHED)
3230 flags |= DE_MUST_HAVE_BUFFER;
3232 /* if buffer is dead, then convert extent to have no buffer. */
3233 if (BUFFERP (obj) && !BUFFER_LIVE_P (XBUFFER (obj)))
3234 obj = extent_object (extent) = Qnil;
3236 assert (!NILP (obj) || extent_detached_p (extent));
3238 if ((NILP (obj) && (flags & DE_MUST_HAVE_BUFFER))
3239 || (extent_detached_p (extent) && (flags & DE_MUST_BE_ATTACHED)))
3241 signal_simple_error ("extent doesn't belong to a buffer or string",
3248 /* Note that the returned value is a buffer position, not a byte index. */
3251 extent_endpoint_external (Lisp_Object extent_obj, int endp)
3253 EXTENT extent = decode_extent (extent_obj, 0);
3255 if (extent_detached_p (extent))
3258 return make_int (extent_endpoint_bufpos (extent, endp));
3261 DEFUN ("extentp", Fextentp, 1, 1, 0, /*
3262 Return t if OBJECT is an extent.
3266 return EXTENTP (object) ? Qt : Qnil;
3269 DEFUN ("extent-live-p", Fextent_live_p, 1, 1, 0, /*
3270 Return t if OBJECT is an extent that has not been destroyed.
3274 return EXTENTP (object) && EXTENT_LIVE_P (XEXTENT (object)) ? Qt : Qnil;
3277 DEFUN ("extent-detached-p", Fextent_detached_p, 1, 1, 0, /*
3278 Return t if EXTENT is detached.
3282 return extent_detached_p (decode_extent (extent, 0)) ? Qt : Qnil;
3285 DEFUN ("extent-object", Fextent_object, 1, 1, 0, /*
3286 Return object (buffer or string) that EXTENT refers to.
3290 return extent_object (decode_extent (extent, 0));
3293 DEFUN ("extent-start-position", Fextent_start_position, 1, 1, 0, /*
3294 Return start position of EXTENT, or nil if EXTENT is detached.
3298 return extent_endpoint_external (extent, 0);
3301 DEFUN ("extent-end-position", Fextent_end_position, 1, 1, 0, /*
3302 Return end position of EXTENT, or nil if EXTENT is detached.
3306 return extent_endpoint_external (extent, 1);
3309 DEFUN ("extent-length", Fextent_length, 1, 1, 0, /*
3310 Return length of EXTENT in characters.
3314 EXTENT e = decode_extent (extent, DE_MUST_BE_ATTACHED);
3315 return make_int (extent_endpoint_bufpos (e, 1)
3316 - extent_endpoint_bufpos (e, 0));
3319 DEFUN ("next-extent", Fnext_extent, 1, 1, 0, /*
3320 Find next extent after EXTENT.
3321 If EXTENT is a buffer return the first extent in the buffer; likewise
3323 Extents in a buffer are ordered in what is called the "display"
3324 order, which sorts by increasing start positions and then by *decreasing*
3326 If you want to perform an operation on a series of extents, use
3327 `map-extents' instead of this function; it is much more efficient.
3328 The primary use of this function should be to enumerate all the
3329 extents in a buffer.
3330 Note: The display order is not necessarily the order that `map-extents'
3331 processes extents in!
3338 if (EXTENTP (extent))
3339 next = extent_next (decode_extent (extent, DE_MUST_BE_ATTACHED));
3341 next = extent_first (decode_buffer_or_string (extent));
3345 XSETEXTENT (val, next);
3349 DEFUN ("previous-extent", Fprevious_extent, 1, 1, 0, /*
3350 Find last extent before EXTENT.
3351 If EXTENT is a buffer return the last extent in the buffer; likewise
3353 This function is analogous to `next-extent'.
3360 if (EXTENTP (extent))
3361 prev = extent_previous (decode_extent (extent, DE_MUST_BE_ATTACHED));
3363 prev = extent_last (decode_buffer_or_string (extent));
3367 XSETEXTENT (val, prev);
3373 DEFUN ("next-e-extent", Fnext_e_extent, 1, 1, 0, /*
3374 Find next extent after EXTENT using the "e" order.
3375 If EXTENT is a buffer return the first extent in the buffer; likewise
3383 if (EXTENTP (extent))
3384 next = extent_e_next (decode_extent (extent, DE_MUST_BE_ATTACHED));
3386 next = extent_e_first (decode_buffer_or_string (extent));
3390 XSETEXTENT (val, next);
3394 DEFUN ("previous-e-extent", Fprevious_e_extent, 1, 1, 0, /*
3395 Find last extent before EXTENT using the "e" order.
3396 If EXTENT is a buffer return the last extent in the buffer; likewise
3398 This function is analogous to `next-e-extent'.
3405 if (EXTENTP (extent))
3406 prev = extent_e_previous (decode_extent (extent, DE_MUST_BE_ATTACHED));
3408 prev = extent_e_last (decode_buffer_or_string (extent));
3412 XSETEXTENT (val, prev);
3418 DEFUN ("next-extent-change", Fnext_extent_change, 1, 2, 0, /*
3419 Return the next position after POS where an extent begins or ends.
3420 If POS is at the end of the buffer or string, POS will be returned;
3421 otherwise a position greater than POS will always be returned.
3422 If BUFFER is nil, the current buffer is assumed.
3426 Lisp_Object obj = decode_buffer_or_string (object);
3429 bpos = get_buffer_or_string_pos_byte (obj, pos, GB_ALLOW_PAST_ACCESSIBLE);
3430 bpos = extent_find_end_of_run (obj, bpos, 1);
3431 return make_int (buffer_or_string_bytind_to_bufpos (obj, bpos));
3434 DEFUN ("previous-extent-change", Fprevious_extent_change, 1, 2, 0, /*
3435 Return the last position before POS where an extent begins or ends.
3436 If POS is at the beginning of the buffer or string, POS will be returned;
3437 otherwise a position less than POS will always be returned.
3438 If OBJECT is nil, the current buffer is assumed.
3442 Lisp_Object obj = decode_buffer_or_string (object);
3445 bpos = get_buffer_or_string_pos_byte (obj, pos, GB_ALLOW_PAST_ACCESSIBLE);
3446 bpos = extent_find_beginning_of_run (obj, bpos, 1);
3447 return make_int (buffer_or_string_bytind_to_bufpos (obj, bpos));
3451 /************************************************************************/
3452 /* parent and children stuff */
3453 /************************************************************************/
3455 DEFUN ("extent-parent", Fextent_parent, 1, 1, 0, /*
3456 Return the parent (if any) of EXTENT.
3457 If an extent has a parent, it derives all its properties from that extent
3458 and has no properties of its own. (The only "properties" that the
3459 extent keeps are the buffer/string it refers to and the start and end
3460 points.) It is possible for an extent's parent to itself have a parent.
3463 /* do I win the prize for the strangest split infinitive? */
3465 EXTENT e = decode_extent (extent, 0);
3466 return extent_parent (e);
3469 DEFUN ("extent-children", Fextent_children, 1, 1, 0, /*
3470 Return a list of the children (if any) of EXTENT.
3471 The children of an extent are all those extents whose parent is that extent.
3472 This function does not recursively trace children of children.
3473 \(To do that, use `extent-descendants'.)
3477 EXTENT e = decode_extent (extent, 0);
3478 Lisp_Object children = extent_children (e);
3480 if (!NILP (children))
3481 return Fcopy_sequence (XWEAK_LIST_LIST (children));
3487 remove_extent_from_children_list (EXTENT e, Lisp_Object child)
3489 Lisp_Object children = extent_children (e);
3491 #ifdef ERROR_CHECK_EXTENTS
3492 assert (!NILP (memq_no_quit (child, XWEAK_LIST_LIST (children))));
3494 XWEAK_LIST_LIST (children) =
3495 delq_no_quit (child, XWEAK_LIST_LIST (children));
3499 add_extent_to_children_list (EXTENT e, Lisp_Object child)
3501 Lisp_Object children = extent_children (e);
3503 if (NILP (children))
3505 children = make_weak_list (WEAK_LIST_SIMPLE);
3506 set_extent_no_chase_aux_field (e, children, children);
3509 #ifdef ERROR_CHECK_EXTENTS
3510 assert (NILP (memq_no_quit (child, XWEAK_LIST_LIST (children))));
3512 XWEAK_LIST_LIST (children) = Fcons (child, XWEAK_LIST_LIST (children));
3515 DEFUN ("set-extent-parent", Fset_extent_parent, 2, 2, 0, /*
3516 Set the parent of EXTENT to PARENT (may be nil).
3517 See `extent-parent'.
3521 EXTENT e = decode_extent (extent, 0);
3522 Lisp_Object cur_parent = extent_parent (e);
3525 XSETEXTENT (extent, e);
3527 CHECK_LIVE_EXTENT (parent);
3528 if (EQ (parent, cur_parent))
3530 for (rest = parent; !NILP (rest); rest = extent_parent (XEXTENT (rest)))
3531 if (EQ (rest, extent))
3532 signal_simple_error ("Circular parent chain would result", extent);
3535 remove_extent_from_children_list (XEXTENT (cur_parent), extent);
3536 set_extent_no_chase_aux_field (e, parent, Qnil);
3537 e->flags.has_parent = 0;
3541 add_extent_to_children_list (XEXTENT (parent), extent);
3542 set_extent_no_chase_aux_field (e, parent, parent);
3543 e->flags.has_parent = 1;
3545 /* changing the parent also changes the properties of all children. */
3547 int old_invis = (!NILP (cur_parent) &&
3548 !NILP (extent_invisible (XEXTENT (cur_parent))));
3549 int new_invis = (!NILP (parent) &&
3550 !NILP (extent_invisible (XEXTENT (parent))));
3552 extent_maybe_changed_for_redisplay (e, 1, new_invis != old_invis);
3559 /************************************************************************/
3560 /* basic extent mutators */
3561 /************************************************************************/
3563 /* Note: If you track non-duplicable extents by undo, you'll get bogus
3564 undo records for transient extents via update-extent.
3565 For example, query-replace will do this.
3569 set_extent_endpoints_1 (EXTENT extent, Memind start, Memind end)
3571 #ifdef ERROR_CHECK_EXTENTS
3572 Lisp_Object obj = extent_object (extent);
3574 assert (start <= end);
3577 assert (valid_memind_p (XBUFFER (obj), start));
3578 assert (valid_memind_p (XBUFFER (obj), end));
3582 /* Optimization: if the extent is already where we want it to be,
3584 if (!extent_detached_p (extent) && extent_start (extent) == start &&
3585 extent_end (extent) == end)
3588 if (extent_detached_p (extent))
3590 if (extent_duplicable_p (extent))
3592 Lisp_Object extent_obj;
3593 XSETEXTENT (extent_obj, extent);
3594 record_extent (extent_obj, 1);
3598 extent_detach (extent);
3600 set_extent_start (extent, start);
3601 set_extent_end (extent, end);
3602 extent_attach (extent);
3605 /* Set extent's endpoints to S and E, and put extent in buffer or string
3606 OBJECT. (If OBJECT is nil, do not change the extent's object.) */
3609 set_extent_endpoints (EXTENT extent, Bytind s, Bytind e, Lisp_Object object)
3615 object = extent_object (extent);
3616 assert (!NILP (object));
3618 else if (!EQ (object, extent_object (extent)))
3620 extent_detach (extent);
3621 extent_object (extent) = object;
3624 start = s < 0 ? extent_start (extent) :
3625 buffer_or_string_bytind_to_memind (object, s);
3626 end = e < 0 ? extent_end (extent) :
3627 buffer_or_string_bytind_to_memind (object, e);
3628 set_extent_endpoints_1 (extent, start, end);
3632 set_extent_openness (EXTENT extent, int start_open, int end_open)
3634 if (start_open != -1)
3635 extent_start_open_p (extent) = start_open;
3637 extent_end_open_p (extent) = end_open;
3638 /* changing the open/closedness of an extent does not affect
3643 make_extent_internal (Lisp_Object object, Bytind from, Bytind to)
3647 extent = make_extent_detached (object);
3648 set_extent_endpoints (extent, from, to, Qnil);
3653 copy_extent (EXTENT original, Bytind from, Bytind to, Lisp_Object object)
3657 e = make_extent_detached (object);
3659 set_extent_endpoints (e, from, to, Qnil);
3661 e->plist = Fcopy_sequence (original->plist);
3662 memcpy (&e->flags, &original->flags, sizeof (e->flags));
3663 if (e->flags.has_aux)
3665 /* also need to copy the aux struct. It won't work for
3666 this extent to share the same aux struct as the original
3668 struct extent_auxiliary *data =
3669 alloc_lcrecord_type (struct extent_auxiliary,
3670 lrecord_extent_auxiliary);
3672 copy_lcrecord (data, XEXTENT_AUXILIARY (XCAR (original->plist)));
3673 XSETEXTENT_AUXILIARY (XCAR (e->plist), data);
3677 /* we may have just added another child to the parent extent. */
3678 Lisp_Object parent = extent_parent (e);
3682 XSETEXTENT (extent, e);
3683 add_extent_to_children_list (XEXTENT (parent), extent);
3691 destroy_extent (EXTENT extent)
3693 Lisp_Object rest, nextrest, children;
3694 Lisp_Object extent_obj;
3696 if (!extent_detached_p (extent))
3697 extent_detach (extent);
3698 /* disassociate the extent from its children and parent */
3699 children = extent_children (extent);
3700 if (!NILP (children))
3702 LIST_LOOP_DELETING (rest, nextrest, XWEAK_LIST_LIST (children))
3703 Fset_extent_parent (XCAR (rest), Qnil);
3705 XSETEXTENT (extent_obj, extent);
3706 Fset_extent_parent (extent_obj, Qnil);
3707 /* mark the extent as destroyed */
3708 extent_object (extent) = Qt;
3711 DEFUN ("make-extent", Fmake_extent, 2, 3, 0, /*
3712 Make an extent for the range [FROM, TO) in BUFFER-OR-STRING.
3713 BUFFER-OR-STRING defaults to the current buffer. Insertions at point
3714 TO will be outside of the extent; insertions at FROM will be inside the
3715 extent, causing the extent to grow. (This is the same way that markers
3716 behave.) You can change the behavior of insertions at the endpoints
3717 using `set-extent-property'. The extent is initially detached if both
3718 FROM and TO are nil, and in this case BUFFER-OR-STRING defaults to nil,
3719 meaning the extent is in no buffer and no string.
3721 (from, to, buffer_or_string))
3723 Lisp_Object extent_obj;
3726 obj = decode_buffer_or_string (buffer_or_string);
3727 if (NILP (from) && NILP (to))
3729 if (NILP (buffer_or_string))
3731 XSETEXTENT (extent_obj, make_extent_detached (obj));
3737 get_buffer_or_string_range_byte (obj, from, to, &start, &end,
3738 GB_ALLOW_PAST_ACCESSIBLE);
3739 XSETEXTENT (extent_obj, make_extent_internal (obj, start, end));
3744 DEFUN ("copy-extent", Fcopy_extent, 1, 2, 0, /*
3745 Make a copy of EXTENT. It is initially detached.
3746 Optional argument BUFFER-OR-STRING defaults to EXTENT's buffer or string.
3748 (extent, buffer_or_string))
3750 EXTENT ext = decode_extent (extent, 0);
3752 if (NILP (buffer_or_string))
3753 buffer_or_string = extent_object (ext);
3755 buffer_or_string = decode_buffer_or_string (buffer_or_string);
3757 XSETEXTENT (extent, copy_extent (ext, -1, -1, buffer_or_string));
3761 DEFUN ("delete-extent", Fdelete_extent, 1, 1, 0, /*
3762 Remove EXTENT from its buffer and destroy it.
3763 This does not modify the buffer's text, only its display properties.
3764 The extent cannot be used thereafter.
3770 /* We do not call decode_extent() here because already-destroyed
3772 CHECK_EXTENT (extent);
3773 ext = XEXTENT (extent);
3775 if (!EXTENT_LIVE_P (ext))
3777 destroy_extent (ext);
3781 DEFUN ("detach-extent", Fdetach_extent, 1, 1, 0, /*
3782 Remove EXTENT from its buffer in such a way that it can be re-inserted.
3783 An extent is also detached when all of its characters are all killed by a
3784 deletion, unless its `detachable' property has been unset.
3786 Extents which have the `duplicable' attribute are tracked by the undo
3787 mechanism. Detachment via `detach-extent' and string deletion is recorded,
3788 as is attachment via `insert-extent' and string insertion. Extent motion,
3789 face changes, and attachment via `make-extent' and `set-extent-endpoints'
3790 are not recorded. This means that extent changes which are to be undo-able
3791 must be performed by character editing, or by insertion and detachment of
3796 EXTENT ext = decode_extent (extent, 0);
3798 if (extent_detached_p (ext))
3800 if (extent_duplicable_p (ext))
3801 record_extent (extent, 0);
3802 extent_detach (ext);
3807 DEFUN ("set-extent-endpoints", Fset_extent_endpoints, 3, 4, 0, /*
3808 Set the endpoints of EXTENT to START, END.
3809 If START and END are null, call detach-extent on EXTENT.
3810 BUFFER-OR-STRING specifies the new buffer or string that the extent should
3811 be in, and defaults to EXTENT's buffer or string. (If nil, and EXTENT
3812 is in no buffer and no string, it defaults to the current buffer.)
3813 See documentation on `detach-extent' for a discussion of undo recording.
3815 (extent, start, end, buffer_or_string))
3820 ext = decode_extent (extent, 0);
3822 if (NILP (buffer_or_string))
3824 buffer_or_string = extent_object (ext);
3825 if (NILP (buffer_or_string))
3826 buffer_or_string = Fcurrent_buffer ();
3829 buffer_or_string = decode_buffer_or_string (buffer_or_string);
3831 if (NILP (start) && NILP (end))
3832 return Fdetach_extent (extent);
3834 get_buffer_or_string_range_byte (buffer_or_string, start, end, &s, &e,
3835 GB_ALLOW_PAST_ACCESSIBLE);
3837 set_extent_endpoints (ext, s, e, buffer_or_string);
3842 /************************************************************************/
3843 /* mapping over extents */
3844 /************************************************************************/
3847 decode_map_extents_flags (Lisp_Object flags)
3849 unsigned int retval = 0;
3850 unsigned int all_extents_specified = 0;
3851 unsigned int in_region_specified = 0;
3853 if (EQ (flags, Qt)) /* obsoleteness compatibility */
3854 return ME_END_CLOSED;
3857 if (SYMBOLP (flags))
3858 flags = Fcons (flags, Qnil);
3859 while (!NILP (flags))
3865 if (EQ (sym, Qall_extents_closed) || EQ (sym, Qall_extents_open) ||
3866 EQ (sym, Qall_extents_closed_open) ||
3867 EQ (sym, Qall_extents_open_closed))
3869 if (all_extents_specified)
3870 error ("Only one `all-extents-*' flag may be specified");
3871 all_extents_specified = 1;
3873 if (EQ (sym, Qstart_in_region) || EQ (sym, Qend_in_region) ||
3874 EQ (sym, Qstart_and_end_in_region) ||
3875 EQ (sym, Qstart_or_end_in_region))
3877 if (in_region_specified)
3878 error ("Only one `*-in-region' flag may be specified");
3879 in_region_specified = 1;
3882 /* I do so love that conditional operator ... */
3884 EQ (sym, Qend_closed) ? ME_END_CLOSED :
3885 EQ (sym, Qstart_open) ? ME_START_OPEN :
3886 EQ (sym, Qall_extents_closed) ? ME_ALL_EXTENTS_CLOSED :
3887 EQ (sym, Qall_extents_open) ? ME_ALL_EXTENTS_OPEN :
3888 EQ (sym, Qall_extents_closed_open) ? ME_ALL_EXTENTS_CLOSED_OPEN :
3889 EQ (sym, Qall_extents_open_closed) ? ME_ALL_EXTENTS_OPEN_CLOSED :
3890 EQ (sym, Qstart_in_region) ? ME_START_IN_REGION :
3891 EQ (sym, Qend_in_region) ? ME_END_IN_REGION :
3892 EQ (sym, Qstart_and_end_in_region) ? ME_START_AND_END_IN_REGION :
3893 EQ (sym, Qstart_or_end_in_region) ? ME_START_OR_END_IN_REGION :
3894 EQ (sym, Qnegate_in_region) ? ME_NEGATE_IN_REGION :
3895 (signal_simple_error ("Invalid `map-extents' flag", sym), 0);
3897 flags = XCDR (flags);
3902 DEFUN ("extent-in-region-p", Fextent_in_region_p, 1, 4, 0, /*
3903 Return whether EXTENT overlaps a specified region.
3904 This is equivalent to whether `map-extents' would visit EXTENT when called
3907 (extent, from, to, flags))
3910 EXTENT ext = decode_extent (extent, DE_MUST_BE_ATTACHED);
3911 Lisp_Object obj = extent_object (ext);
3913 get_buffer_or_string_range_byte (obj, from, to, &start, &end, GB_ALLOW_NIL |
3914 GB_ALLOW_PAST_ACCESSIBLE);
3916 return extent_in_region_p (ext, start, end, decode_map_extents_flags (flags)) ?
3920 struct slow_map_extents_arg
3922 Lisp_Object map_arg;
3923 Lisp_Object map_routine;
3925 Lisp_Object property;
3930 slow_map_extents_function (EXTENT extent, void *arg)
3932 /* This function can GC */
3933 struct slow_map_extents_arg *closure = (struct slow_map_extents_arg *) arg;
3934 Lisp_Object extent_obj;
3936 XSETEXTENT (extent_obj, extent);
3938 /* make sure this extent qualifies according to the PROPERTY
3941 if (!NILP (closure->property))
3943 Lisp_Object value = Fextent_property (extent_obj, closure->property,
3945 if ((NILP (closure->value) && NILP (value)) ||
3946 (!NILP (closure->value) && !EQ (value, closure->value)))
3950 closure->result = call2 (closure->map_routine, extent_obj,
3952 return !NILP (closure->result);
3955 DEFUN ("map-extents", Fmap_extents, 1, 8, 0, /*
3956 Map FUNCTION over the extents which overlap a region in OBJECT.
3957 OBJECT is normally a buffer or string but could be an extent (see below).
3958 The region is normally bounded by [FROM, TO) (i.e. the beginning of the
3959 region is closed and the end of the region is open), but this can be
3960 changed with the FLAGS argument (see below for a complete discussion).
3962 FUNCTION is called with the arguments (extent, MAPARG). The arguments
3963 OBJECT, FROM, TO, MAPARG, and FLAGS are all optional and default to
3964 the current buffer, the beginning of OBJECT, the end of OBJECT, nil,
3965 and nil, respectively. `map-extents' returns the first non-nil result
3966 produced by FUNCTION, and no more calls to FUNCTION are made after it
3969 If OBJECT is an extent, FROM and TO default to the extent's endpoints,
3970 and the mapping omits that extent and its predecessors. This feature
3971 supports restarting a loop based on `map-extents'. Note: OBJECT must
3972 be attached to a buffer or string, and the mapping is done over that
3975 An extent overlaps the region if there is any point in the extent that is
3976 also in the region. (For the purpose of overlap, zero-length extents and
3977 regions are treated as closed on both ends regardless of their endpoints'
3978 specified open/closedness.) Note that the endpoints of an extent or region
3979 are considered to be in that extent or region if and only if the
3980 corresponding end is closed. For example, the extent [5,7] overlaps the
3981 region [2,5] because 5 is in both the extent and the region. However, (5,7]
3982 does not overlap [2,5] because 5 is not in the extent, and neither [5,7] nor
3983 \(5,7] overlaps the region [2,5) because 5 is not in the region.
3985 The optional FLAGS can be a symbol or a list of one or more symbols,
3986 modifying the behavior of `map-extents'. Allowed symbols are:
3988 end-closed The region's end is closed.
3990 start-open The region's start is open.
3992 all-extents-closed Treat all extents as closed on both ends for the
3993 purpose of determining whether they overlap the
3994 region, irrespective of their actual open- or
3996 all-extents-open Treat all extents as open on both ends.
3997 all-extents-closed-open Treat all extents as start-closed, end-open.
3998 all-extents-open-closed Treat all extents as start-open, end-closed.
4000 start-in-region In addition to the above conditions for extent
4001 overlap, the extent's start position must lie within
4002 the specified region. Note that, for this
4003 condition, open start positions are treated as if
4004 0.5 was added to the endpoint's value, and open
4005 end positions are treated as if 0.5 was subtracted
4006 from the endpoint's value.
4007 end-in-region The extent's end position must lie within the
4009 start-and-end-in-region Both the extent's start and end positions must lie
4011 start-or-end-in-region Either the extent's start or end position must lie
4014 negate-in-region The condition specified by a `*-in-region' flag
4015 must NOT hold for the extent to be considered.
4018 At most one of `all-extents-closed', `all-extents-open',
4019 `all-extents-closed-open', and `all-extents-open-closed' may be specified.
4021 At most one of `start-in-region', `end-in-region',
4022 `start-and-end-in-region', and `start-or-end-in-region' may be specified.
4024 If optional arg PROPERTY is non-nil, only extents with that property set
4025 on them will be visited. If optional arg VALUE is non-nil, only extents
4026 whose value for that property is `eq' to VALUE will be visited.
4028 (function, object, from, to, maparg, flags, property, value))
4030 /* This function can GC */
4031 struct slow_map_extents_arg closure;
4032 unsigned int me_flags;
4034 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
4037 if (EXTENTP (object))
4039 after = decode_extent (object, DE_MUST_BE_ATTACHED);
4041 from = Fextent_start_position (object);
4043 to = Fextent_end_position (object);
4044 object = extent_object (after);
4047 object = decode_buffer_or_string (object);
4049 get_buffer_or_string_range_byte (object, from, to, &start, &end,
4050 GB_ALLOW_NIL | GB_ALLOW_PAST_ACCESSIBLE);
4052 me_flags = decode_map_extents_flags (flags);
4054 if (!NILP (property))
4057 value = canonicalize_extent_property (property, value);
4060 GCPRO5 (function, maparg, object, property, value);
4062 closure.map_arg = maparg;
4063 closure.map_routine = function;
4064 closure.result = Qnil;
4065 closure.property = property;
4066 closure.value = value;
4068 map_extents_bytind (start, end, slow_map_extents_function,
4069 (void *) &closure, object, after,
4070 /* You never know what the user might do ... */
4071 me_flags | ME_MIGHT_CALL_ELISP);
4074 return closure.result;
4078 /************************************************************************/
4079 /* mapping over extents -- other functions */
4080 /************************************************************************/
4082 /* ------------------------------- */
4083 /* map-extent-children */
4084 /* ------------------------------- */
4086 struct slow_map_extent_children_arg
4088 Lisp_Object map_arg;
4089 Lisp_Object map_routine;
4091 Lisp_Object property;
4099 slow_map_extent_children_function (EXTENT extent, void *arg)
4101 /* This function can GC */
4102 struct slow_map_extent_children_arg *closure =
4103 (struct slow_map_extent_children_arg *) arg;
4104 Lisp_Object extent_obj;
4105 Bytind start = extent_endpoint_bytind (extent, 0);
4106 Bytind end = extent_endpoint_bytind (extent, 1);
4107 /* Make sure the extent starts inside the region of interest,
4108 rather than just overlaps it.
4110 if (start < closure->start_min)
4112 /* Make sure the extent is not a child of a previous visited one.
4113 We know already, because of extent ordering,
4114 that start >= prev_start, and that if
4115 start == prev_start, then end <= prev_end.
4117 if (start == closure->prev_start)
4119 if (end < closure->prev_end)
4122 else /* start > prev_start */
4124 if (start < closure->prev_end)
4126 /* corner case: prev_end can be -1 if there is no prev */
4128 XSETEXTENT (extent_obj, extent);
4130 /* make sure this extent qualifies according to the PROPERTY
4133 if (!NILP (closure->property))
4135 Lisp_Object value = Fextent_property (extent_obj, closure->property,
4137 if ((NILP (closure->value) && NILP (value)) ||
4138 (!NILP (closure->value) && !EQ (value, closure->value)))
4142 closure->result = call2 (closure->map_routine, extent_obj,
4145 /* Since the callback may change the buffer, compute all stored
4146 buffer positions here.
4148 closure->start_min = -1; /* no need for this any more */
4149 closure->prev_start = extent_endpoint_bytind (extent, 0);
4150 closure->prev_end = extent_endpoint_bytind (extent, 1);
4152 return !NILP (closure->result);
4155 DEFUN ("map-extent-children", Fmap_extent_children, 1, 8, 0, /*
4156 Map FUNCTION over the extents in the region from FROM to TO.
4157 FUNCTION is called with arguments (extent, MAPARG). See `map-extents'
4158 for a full discussion of the arguments FROM, TO, and FLAGS.
4160 The arguments are the same as for `map-extents', but this function differs
4161 in that it only visits extents which start in the given region, and also
4162 in that, after visiting an extent E, it skips all other extents which start
4163 inside E but end before E's end.
4165 Thus, this function may be used to walk a tree of extents in a buffer:
4166 (defun walk-extents (buffer &optional ignore)
4167 (map-extent-children 'walk-extents buffer))
4169 (function, object, from, to, maparg, flags, property, value))
4171 /* This function can GC */
4172 struct slow_map_extent_children_arg closure;
4173 unsigned int me_flags;
4175 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
4178 if (EXTENTP (object))
4180 after = decode_extent (object, DE_MUST_BE_ATTACHED);
4182 from = Fextent_start_position (object);
4184 to = Fextent_end_position (object);
4185 object = extent_object (after);
4188 object = decode_buffer_or_string (object);
4190 get_buffer_or_string_range_byte (object, from, to, &start, &end,
4191 GB_ALLOW_NIL | GB_ALLOW_PAST_ACCESSIBLE);
4193 me_flags = decode_map_extents_flags (flags);
4195 if (!NILP (property))
4198 value = canonicalize_extent_property (property, value);
4201 GCPRO5 (function, maparg, object, property, value);
4203 closure.map_arg = maparg;
4204 closure.map_routine = function;
4205 closure.result = Qnil;
4206 closure.property = property;
4207 closure.value = value;
4208 closure.start_min = start;
4209 closure.prev_start = -1;
4210 closure.prev_end = -1;
4211 map_extents_bytind (start, end, slow_map_extent_children_function,
4212 (void *) &closure, object, after,
4213 /* You never know what the user might do ... */
4214 me_flags | ME_MIGHT_CALL_ELISP);
4217 return closure.result;
4220 /* ------------------------------- */
4222 /* ------------------------------- */
4224 /* find "smallest" matching extent containing pos -- (flag == 0) means
4225 all extents match, else (EXTENT_FLAGS (extent) & flag) must be true;
4226 for more than one matching extent with precisely the same endpoints,
4227 we choose the last extent in the extents_list.
4228 The search stops just before "before", if that is non-null.
4231 struct extent_at_arg
4247 static enum extent_at_flag
4248 decode_extent_at_flag (Lisp_Object at_flag)
4251 return EXTENT_AT_AFTER;
4253 CHECK_SYMBOL (at_flag);
4254 if (EQ (at_flag, Qafter)) return EXTENT_AT_AFTER;
4255 if (EQ (at_flag, Qbefore)) return EXTENT_AT_BEFORE;
4256 if (EQ (at_flag, Qat)) return EXTENT_AT_AT;
4258 signal_simple_error ("Invalid AT-FLAG in `extent-at'", at_flag);
4259 return EXTENT_AT_AFTER; /* unreached */
4263 extent_at_mapper (EXTENT e, void *arg)
4265 struct extent_at_arg *closure = (struct extent_at_arg *) arg;
4267 if (e == closure->before)
4270 /* If closure->prop is non-nil, then the extent is only acceptable
4271 if it has a non-nil value for that property. */
4272 if (!NILP (closure->prop))
4275 XSETEXTENT (extent, e);
4276 if (NILP (Fextent_property (extent, closure->prop, Qnil)))
4281 EXTENT current = closure->best_match;
4285 /* redundant but quick test */
4286 else if (extent_start (current) > extent_start (e))
4289 /* we return the "last" best fit, instead of the first --
4290 this is because then the glyph closest to two equivalent
4291 extents corresponds to the "extent-at" the text just past
4293 else if (!EXTENT_LESS_VALS (e, closure->best_start,
4299 closure->best_match = e;
4300 closure->best_start = extent_start (e);
4301 closure->best_end = extent_end (e);
4308 extent_at_bytind (Bytind position, Lisp_Object object, Lisp_Object property,
4309 EXTENT before, enum extent_at_flag at_flag)
4311 struct extent_at_arg closure;
4312 Lisp_Object extent_obj;
4314 /* it might be argued that invalid positions should cause
4315 errors, but the principle of least surprise dictates that
4316 nil should be returned (extent-at is often used in
4317 response to a mouse event, and in many cases previous events
4318 have changed the buffer contents).
4320 Also, the openness stuff in the text-property code currently
4321 does not check its limits and might go off the end. */
4322 if ((at_flag == EXTENT_AT_BEFORE
4323 ? position <= buffer_or_string_absolute_begin_byte (object)
4324 : position < buffer_or_string_absolute_begin_byte (object))
4325 || (at_flag == EXTENT_AT_AFTER
4326 ? position >= buffer_or_string_absolute_end_byte (object)
4327 : position > buffer_or_string_absolute_end_byte (object)))
4330 closure.best_match = 0;
4331 closure.prop = property;
4332 closure.before = before;
4334 map_extents_bytind (at_flag == EXTENT_AT_BEFORE ? position - 1 : position,
4335 at_flag == EXTENT_AT_AFTER ? position + 1 : position,
4336 extent_at_mapper, (void *) &closure, object, 0,
4337 ME_START_OPEN | ME_ALL_EXTENTS_CLOSED);
4339 if (!closure.best_match)
4342 XSETEXTENT (extent_obj, closure.best_match);
4346 DEFUN ("extent-at", Fextent_at, 1, 5, 0, /*
4347 Find "smallest" extent at POS in OBJECT having PROPERTY set.
4348 Normally, an extent is "at" POS if it overlaps the region (POS, POS+1);
4349 i.e. if it covers the character after POS. (However, see the definition
4350 of AT-FLAG.) "Smallest" means the extent that comes last in the display
4351 order; this normally means the extent whose start position is closest to
4352 POS. See `next-extent' for more information.
4353 OBJECT specifies a buffer or string and defaults to the current buffer.
4354 PROPERTY defaults to nil, meaning that any extent will do.
4355 Properties are attached to extents with `set-extent-property', which see.
4356 Returns nil if POS is invalid or there is no matching extent at POS.
4357 If the fourth argument BEFORE is not nil, it must be an extent; any returned
4358 extent will precede that extent. This feature allows `extent-at' to be
4359 used by a loop over extents.
4360 AT-FLAG controls how end cases are handled, and should be one of:
4362 nil or `after' An extent is at POS if it covers the character
4363 after POS. This is consistent with the way
4364 that text properties work.
4365 `before' An extent is at POS if it covers the character
4367 `at' An extent is at POS if it overlaps or abuts POS.
4368 This includes all zero-length extents at POS.
4370 Note that in all cases, the start-openness and end-openness of the extents
4371 considered is ignored. If you want to pay attention to those properties,
4372 you should use `map-extents', which gives you more control.
4374 (pos, object, property, before, at_flag))
4377 EXTENT before_extent;
4378 enum extent_at_flag fl;
4380 object = decode_buffer_or_string (object);
4381 position = get_buffer_or_string_pos_byte (object, pos, GB_NO_ERROR_IF_BAD);
4385 before_extent = decode_extent (before, DE_MUST_BE_ATTACHED);
4386 if (before_extent && !EQ (object, extent_object (before_extent)))
4387 signal_simple_error ("extent not in specified buffer or string", object);
4388 fl = decode_extent_at_flag (at_flag);
4390 return extent_at_bytind (position, object, property, before_extent, fl);
4393 /* ------------------------------- */
4394 /* verify_extent_modification() */
4395 /* ------------------------------- */
4397 /* verify_extent_modification() is called when a buffer or string is
4398 modified to check whether the modification is occuring inside a
4402 struct verify_extents_arg
4407 Lisp_Object iro; /* value of inhibit-read-only */
4411 verify_extent_mapper (EXTENT extent, void *arg)
4413 struct verify_extents_arg *closure = (struct verify_extents_arg *) arg;
4414 Lisp_Object prop = extent_read_only (extent);
4419 if (CONSP (closure->iro) && !NILP (Fmemq (prop, closure->iro)))
4422 #if 0 /* Nobody seems to care for this any more -sb */
4423 /* Allow deletion if the extent is completely contained in
4424 the region being deleted.
4425 This is important for supporting tokens which are internally
4426 write-protected, but which can be killed and yanked as a whole.
4427 Ignore open/closed distinctions at this point.
4430 if (closure->start != closure->end &&
4431 extent_start (extent) >= closure->start &&
4432 extent_end (extent) <= closure->end)
4437 Fsignal (Qbuffer_read_only, (list1 (closure->object)));
4439 RETURN_NOT_REACHED(0)
4442 /* Value of Vinhibit_read_only is precomputed and passed in for
4446 verify_extent_modification (Lisp_Object object, Bytind from, Bytind to,
4447 Lisp_Object inhibit_read_only_value)
4450 struct verify_extents_arg closure;
4452 /* If insertion, visit closed-endpoint extents touching the insertion
4453 point because the text would go inside those extents. If deletion,
4454 treat the range as open on both ends so that touching extents are not
4455 visited. Note that we assume that an insertion is occurring if the
4456 changed range has zero length, and a deletion otherwise. This
4457 fails if a change (i.e. non-insertion, non-deletion) is happening.
4458 As far as I know, this doesn't currently occur in XEmacs. --ben */
4459 closed = (from==to);
4460 closure.object = object;
4461 closure.start = buffer_or_string_bytind_to_memind (object, from);
4462 closure.end = buffer_or_string_bytind_to_memind (object, to);
4463 closure.iro = inhibit_read_only_value;
4465 map_extents_bytind (from, to, verify_extent_mapper, (void *) &closure,
4466 object, 0, closed ? ME_END_CLOSED : ME_START_OPEN);
4469 /* ------------------------------------ */
4470 /* process_extents_for_insertion() */
4471 /* ------------------------------------ */
4473 struct process_extents_for_insertion_arg
4480 /* A region of length LENGTH was just inserted at OPOINT. Modify all
4481 of the extents as required for the insertion, based on their
4482 start-open/end-open properties.
4486 process_extents_for_insertion_mapper (EXTENT extent, void *arg)
4488 struct process_extents_for_insertion_arg *closure =
4489 (struct process_extents_for_insertion_arg *) arg;
4490 Memind indice = buffer_or_string_bytind_to_memind (closure->object,
4493 /* When this function is called, one end of the newly-inserted text should
4494 be adjacent to some endpoint of the extent, or disjoint from it. If
4495 the insertion overlaps any existing extent, something is wrong.
4497 #ifdef ERROR_CHECK_EXTENTS
4498 if (extent_start (extent) > indice &&
4499 extent_start (extent) < indice + closure->length)
4501 if (extent_end (extent) > indice &&
4502 extent_end (extent) < indice + closure->length)
4506 /* The extent-adjustment code adjusted the extent's endpoints as if
4507 they were markers -- endpoints at the gap (i.e. the insertion
4508 point) go to the left of the insertion point, which is correct
4509 for [) extents. We need to fix the other kinds of extents.
4511 Note that both conditions below will hold for zero-length (]
4512 extents at the gap. Zero-length () extents would get adjusted
4513 such that their start is greater than their end; we treat them
4514 as [) extents. This is unfortunately an inelegant part of the
4515 extent model, but there is no way around it. */
4518 Memind new_start, new_end;
4520 new_start = extent_start (extent);
4521 new_end = extent_end (extent);
4522 if (indice == extent_start (extent) && extent_start_open_p (extent) &&
4523 /* coerce zero-length () extents to [) */
4524 new_start != new_end)
4525 new_start += closure->length;
4526 if (indice == extent_end (extent) && !extent_end_open_p (extent))
4527 new_end += closure->length;
4528 set_extent_endpoints_1 (extent, new_start, new_end);
4535 process_extents_for_insertion (Lisp_Object object, Bytind opoint,
4538 struct process_extents_for_insertion_arg closure;
4540 closure.opoint = opoint;
4541 closure.length = length;
4542 closure.object = object;
4544 map_extents_bytind (opoint, opoint + length,
4545 process_extents_for_insertion_mapper,
4546 (void *) &closure, object, 0,
4547 ME_END_CLOSED | ME_MIGHT_MODIFY_EXTENTS |
4548 ME_INCLUDE_INTERNAL);
4551 /* ------------------------------------ */
4552 /* process_extents_for_deletion() */
4553 /* ------------------------------------ */
4555 struct process_extents_for_deletion_arg
4558 int destroy_included_extents;
4561 /* This function is called when we're about to delete the range [from, to].
4562 Detach all of the extents that are completely inside the range [from, to],
4563 if they're detachable or open-open. */
4566 process_extents_for_deletion_mapper (EXTENT extent, void *arg)
4568 struct process_extents_for_deletion_arg *closure =
4569 (struct process_extents_for_deletion_arg *) arg;
4571 /* If the extent lies completely within the range that
4572 is being deleted, then nuke the extent if it's detachable
4573 (otherwise, it will become a zero-length extent). */
4575 if (closure->start <= extent_start (extent) &&
4576 extent_end (extent) <= closure->end)
4578 if (extent_detachable_p (extent))
4580 if (closure->destroy_included_extents)
4581 destroy_extent (extent);
4583 extent_detach (extent);
4590 /* DESTROY_THEM means destroy the extents instead of just deleting them.
4591 It is unused currently, but perhaps might be used (there used to
4592 be a function process_extents_for_destruction(), #if 0'd out,
4593 that did the equivalent). */
4595 process_extents_for_deletion (Lisp_Object object, Bytind from,
4596 Bytind to, int destroy_them)
4598 struct process_extents_for_deletion_arg closure;
4600 closure.start = buffer_or_string_bytind_to_memind (object, from);
4601 closure.end = buffer_or_string_bytind_to_memind (object, to);
4602 closure.destroy_included_extents = destroy_them;
4604 map_extents_bytind (from, to, process_extents_for_deletion_mapper,
4605 (void *) &closure, object, 0,
4606 ME_END_CLOSED | ME_MIGHT_MODIFY_EXTENTS);
4609 /* ------------------------------- */
4610 /* report_extent_modification() */
4611 /* ------------------------------- */
4612 struct report_extent_modification_closure {
4619 /* This juggling with the pointer to another file's global variable is
4620 kind of yucky. Perhaps I should just export the variable. */
4621 static int *inside_change_hook_pointer;
4624 report_extent_modification_restore (Lisp_Object buffer)
4626 *inside_change_hook_pointer = 0;
4627 if (current_buffer != XBUFFER (buffer))
4628 Fset_buffer (buffer);
4633 report_extent_modification_mapper (EXTENT extent, void *arg)
4635 struct report_extent_modification_closure *closure =
4636 (struct report_extent_modification_closure *)arg;
4637 Lisp_Object exobj, startobj, endobj;
4638 Lisp_Object hook = (closure->afterp
4639 ? extent_after_change_functions (extent)
4640 : extent_before_change_functions (extent));
4644 XSETEXTENT (exobj, extent);
4645 XSETINT (startobj, closure->start);
4646 XSETINT (endobj, closure->end);
4648 /* Now that we are sure to call elisp, set up an unwind-protect so
4649 inside_change_hook gets restored in case we throw. Also record
4650 the current buffer, in case we change it. Do the recording only
4652 if (closure->speccount == -1)
4654 closure->speccount = specpdl_depth ();
4655 record_unwind_protect (report_extent_modification_restore,
4656 Fcurrent_buffer ());
4659 /* The functions will expect closure->buffer to be the current
4660 buffer, so change it if it isn't. */
4661 if (current_buffer != XBUFFER (closure->buffer))
4662 Fset_buffer (closure->buffer);
4664 /* #### It's a shame that we can't use any of the existing run_hook*
4665 functions here. This is so because all of them work with
4666 symbols, to be able to retrieve default values of local hooks.
4669 if (!CONSP (hook) || EQ (XCAR (hook), Qlambda))
4670 call3 (hook, exobj, startobj, endobj);
4674 EXTERNAL_LIST_LOOP (tail, hook)
4675 call3 (XCAR (tail), exobj, startobj, endobj);
4681 report_extent_modification (Lisp_Object buffer, Bufpos start, Bufpos end,
4682 int *inside, int afterp)
4684 struct report_extent_modification_closure closure;
4686 closure.buffer = buffer;
4687 closure.start = start;
4689 closure.afterp = afterp;
4690 closure.speccount = -1;
4692 inside_change_hook_pointer = inside;
4695 map_extents (start, end, report_extent_modification_mapper, (void *)&closure,
4696 buffer, NULL, ME_MIGHT_CALL_ELISP);
4698 if (closure.speccount == -1)
4702 /* We mustn't unbind when closure.speccount != -1 because
4703 map_extents_bytind has already done that. */
4704 assert (*inside == 0);
4709 /************************************************************************/
4710 /* extent properties */
4711 /************************************************************************/
4714 set_extent_invisible (EXTENT extent, Lisp_Object value)
4716 if (!EQ (extent_invisible (extent), value))
4718 set_extent_invisible_1 (extent, value);
4719 extent_changed_for_redisplay (extent, 1, 1);
4723 /* This function does "memoization" -- similar to the interning
4724 that happens with symbols. Given a list of faces, an equivalent
4725 list is returned such that if this function is called twice with
4726 input that is `equal', the resulting outputs will be `eq'.
4728 Note that the inputs and outputs are in general *not* `equal' --
4729 faces in symbol form become actual face objects in the output.
4730 This is necessary so that temporary faces stay around. */
4733 memoize_extent_face_internal (Lisp_Object list)
4737 Lisp_Object cons, thecons;
4738 Lisp_Object oldtail, tail;
4739 struct gcpro gcpro1;
4744 return Fget_face (list);
4746 /* To do the memoization, we use a hash table mapping from
4747 external lists to internal lists. We do `equal' comparisons
4748 on the keys so the memoization works correctly.
4750 Note that we canonicalize things so that the keys in the
4751 hash table (the external lists) always contain symbols and
4752 the values (the internal lists) always contain face objects.
4754 We also maintain a "reverse" table that maps from the internal
4755 lists to the external equivalents. The idea here is twofold:
4757 1) `extent-face' wants to return a list containing face symbols
4758 rather than face objects.
4759 2) We don't want things to get quite so messed up if the user
4760 maliciously side-effects the returned lists.
4763 len = XINT (Flength (list));
4764 thelen = XINT (Flength (Vextent_face_reusable_list));
4769 /* We canonicalize the given list into another list.
4770 We try to avoid consing except when necessary, so we have
4776 cons = Vextent_face_reusable_list;
4777 while (!NILP (XCDR (cons)))
4779 XCDR (cons) = Fmake_list (make_int (len - thelen), Qnil);
4781 else if (thelen > len)
4785 /* Truncate the list temporarily so it's the right length;
4786 remember the old tail. */
4787 cons = Vextent_face_reusable_list;
4788 for (i = 0; i < len - 1; i++)
4791 oldtail = XCDR (cons);
4795 thecons = Vextent_face_reusable_list;
4796 EXTERNAL_LIST_LOOP (cons, list)
4798 Lisp_Object face = Fget_face (XCAR (cons));
4800 XCAR (thecons) = Fface_name (face);
4801 thecons = XCDR (thecons);
4804 list = Fgethash (Vextent_face_reusable_list, Vextent_face_memoize_hash_table,
4808 Lisp_Object symlist = Fcopy_sequence (Vextent_face_reusable_list);
4809 Lisp_Object facelist = Fcopy_sequence (Vextent_face_reusable_list);
4811 LIST_LOOP (cons, facelist)
4813 XCAR (cons) = Fget_face (XCAR (cons));
4815 Fputhash (symlist, facelist, Vextent_face_memoize_hash_table);
4816 Fputhash (facelist, symlist, Vextent_face_reverse_memoize_hash_table);
4820 /* Now restore the truncated tail of the reusable list, if necessary. */
4822 XCDR (tail) = oldtail;
4829 external_of_internal_memoized_face (Lisp_Object face)
4833 else if (!CONSP (face))
4834 return XFACE (face)->name;
4837 face = Fgethash (face, Vextent_face_reverse_memoize_hash_table,
4839 assert (!UNBOUNDP (face));
4845 canonicalize_extent_property (Lisp_Object prop, Lisp_Object value)
4847 if (EQ (prop, Qface) || EQ (prop, Qmouse_face))
4848 value = (external_of_internal_memoized_face
4849 (memoize_extent_face_internal (value)));
4853 /* Do we need a lisp-level function ? */
4854 DEFUN ("set-extent-initial-redisplay-function", Fset_extent_initial_redisplay_function,
4856 Note: This feature is experimental!
4858 Set initial-redisplay-function of EXTENT to the function
4861 The first time the EXTENT is (re)displayed, an eval event will be
4862 dispatched calling FUNCTION with EXTENT as its only argument.
4866 EXTENT e = decode_extent(extent, DE_MUST_BE_ATTACHED);
4868 e = extent_ancestor (e); /* Is this needed? Macro also does chasing!*/
4869 set_extent_initial_redisplay_function(e,function);
4870 extent_in_red_event_p(e) = 0; /* If the function changed we can spawn
4872 extent_changed_for_redisplay(e,1,0); /* Do we need to mark children too ?*/
4877 DEFUN ("extent-face", Fextent_face, 1, 1, 0, /*
4878 Return the name of the face in which EXTENT is displayed, or nil
4879 if the extent's face is unspecified. This might also return a list
4886 CHECK_EXTENT (extent);
4887 face = extent_face (XEXTENT (extent));
4889 return external_of_internal_memoized_face (face);
4892 DEFUN ("set-extent-face", Fset_extent_face, 2, 2, 0, /*
4893 Make the given EXTENT have the graphic attributes specified by FACE.
4894 FACE can also be a list of faces, and all faces listed will apply,
4895 with faces earlier in the list taking priority over those later in the
4900 EXTENT e = decode_extent(extent, 0);
4901 Lisp_Object orig_face = face;
4903 /* retrieve the ancestor for efficiency and proper redisplay noting. */
4904 e = extent_ancestor (e);
4906 face = memoize_extent_face_internal (face);
4908 extent_face (e) = face;
4909 extent_changed_for_redisplay (e, 1, 0);
4915 DEFUN ("extent-mouse-face", Fextent_mouse_face, 1, 1, 0, /*
4916 Return the face used to highlight EXTENT when the mouse passes over it.
4917 The return value will be a face name, a list of face names, or nil
4918 if the extent's mouse face is unspecified.
4924 CHECK_EXTENT (extent);
4925 face = extent_mouse_face (XEXTENT (extent));
4927 return external_of_internal_memoized_face (face);
4930 DEFUN ("set-extent-mouse-face", Fset_extent_mouse_face, 2, 2, 0, /*
4931 Set the face used to highlight EXTENT when the mouse passes over it.
4932 FACE can also be a list of faces, and all faces listed will apply,
4933 with faces earlier in the list taking priority over those later in the
4939 Lisp_Object orig_face = face;
4941 CHECK_EXTENT (extent);
4942 e = XEXTENT (extent);
4943 /* retrieve the ancestor for efficiency and proper redisplay noting. */
4944 e = extent_ancestor (e);
4946 face = memoize_extent_face_internal (face);
4948 set_extent_mouse_face (e, face);
4949 extent_changed_for_redisplay (e, 1, 0);
4955 set_extent_glyph (EXTENT extent, Lisp_Object glyph, int endp,
4956 glyph_layout layout)
4958 extent = extent_ancestor (extent);
4962 set_extent_begin_glyph (extent, glyph);
4963 extent_begin_glyph_layout (extent) = layout;
4967 set_extent_end_glyph (extent, glyph);
4968 extent_end_glyph_layout (extent) = layout;
4971 extent_changed_for_redisplay (extent, 1, 0);
4975 glyph_layout_to_symbol (glyph_layout layout)
4979 case GL_TEXT: return Qtext;
4980 case GL_OUTSIDE_MARGIN: return Qoutside_margin;
4981 case GL_INSIDE_MARGIN: return Qinside_margin;
4982 case GL_WHITESPACE: return Qwhitespace;
4985 return Qnil; /* unreached */
4990 symbol_to_glyph_layout (Lisp_Object layout_obj)
4992 if (NILP (layout_obj))
4995 CHECK_SYMBOL (layout_obj);
4996 if (EQ (layout_obj, Qoutside_margin)) return GL_OUTSIDE_MARGIN;
4997 if (EQ (layout_obj, Qinside_margin)) return GL_INSIDE_MARGIN;
4998 if (EQ (layout_obj, Qwhitespace)) return GL_WHITESPACE;
4999 if (EQ (layout_obj, Qtext)) return GL_TEXT;
5001 signal_simple_error ("Unknown glyph layout type", layout_obj);
5002 return GL_TEXT; /* unreached */
5006 set_extent_glyph_1 (Lisp_Object extent_obj, Lisp_Object glyph, int endp,
5007 Lisp_Object layout_obj)
5009 EXTENT extent = decode_extent (extent_obj, DE_MUST_HAVE_BUFFER);
5010 glyph_layout layout = symbol_to_glyph_layout (layout_obj);
5012 /* Make sure we've actually been given a glyph or it's nil (meaning
5013 we're deleting a glyph from an extent). */
5015 CHECK_GLYPH (glyph);
5017 set_extent_glyph (extent, glyph, endp, layout);
5021 DEFUN ("set-extent-begin-glyph", Fset_extent_begin_glyph, 2, 3, 0, /*
5022 Display a bitmap, subwindow or string at the beginning of EXTENT.
5023 BEGIN-GLYPH must be a glyph object. The layout policy defaults to `text'.
5025 (extent, begin_glyph, layout))
5027 return set_extent_glyph_1 (extent, begin_glyph, 0, layout);
5030 DEFUN ("set-extent-end-glyph", Fset_extent_end_glyph, 2, 3, 0, /*
5031 Display a bitmap, subwindow or string at the end of EXTENT.
5032 END-GLYPH must be a glyph object. The layout policy defaults to `text'.
5034 (extent, end_glyph, layout))
5036 return set_extent_glyph_1 (extent, end_glyph, 1, layout);
5039 DEFUN ("extent-begin-glyph", Fextent_begin_glyph, 1, 1, 0, /*
5040 Return the glyph object displayed at the beginning of EXTENT.
5041 If there is none, nil is returned.
5045 return extent_begin_glyph (decode_extent (extent, 0));
5048 DEFUN ("extent-end-glyph", Fextent_end_glyph, 1, 1, 0, /*
5049 Return the glyph object displayed at the end of EXTENT.
5050 If there is none, nil is returned.
5054 return extent_end_glyph (decode_extent (extent, 0));
5057 DEFUN ("set-extent-begin-glyph-layout", Fset_extent_begin_glyph_layout, 2, 2, 0, /*
5058 Set the layout policy of EXTENT's begin glyph.
5059 Access this using the `extent-begin-glyph-layout' function.
5063 EXTENT e = decode_extent (extent, 0);
5064 e = extent_ancestor (e);
5065 extent_begin_glyph_layout (e) = symbol_to_glyph_layout (layout);
5066 extent_maybe_changed_for_redisplay (e, 1, 0);
5070 DEFUN ("set-extent-end-glyph-layout", Fset_extent_end_glyph_layout, 2, 2, 0, /*
5071 Set the layout policy of EXTENT's end glyph.
5072 Access this using the `extent-end-glyph-layout' function.
5076 EXTENT e = decode_extent (extent, 0);
5077 e = extent_ancestor (e);
5078 extent_end_glyph_layout (e) = symbol_to_glyph_layout (layout);
5079 extent_maybe_changed_for_redisplay (e, 1, 0);
5083 DEFUN ("extent-begin-glyph-layout", Fextent_begin_glyph_layout, 1, 1, 0, /*
5084 Return the layout policy associated with EXTENT's begin glyph.
5085 Set this using the `set-extent-begin-glyph-layout' function.
5089 EXTENT e = decode_extent (extent, 0);
5090 return glyph_layout_to_symbol ((glyph_layout) extent_begin_glyph_layout (e));
5093 DEFUN ("extent-end-glyph-layout", Fextent_end_glyph_layout, 1, 1, 0, /*
5094 Return the layout policy associated with EXTENT's end glyph.
5095 Set this using the `set-extent-end-glyph-layout' function.
5099 EXTENT e = decode_extent (extent, 0);
5100 return glyph_layout_to_symbol ((glyph_layout) extent_end_glyph_layout (e));
5103 DEFUN ("set-extent-priority", Fset_extent_priority, 2, 2, 0, /*
5104 Set the display priority of EXTENT to PRIORITY (an integer).
5105 When the extent attributes are being merged for display, the priority
5106 is used to determine which extent takes precedence in the event of a
5107 conflict (two extents whose faces both specify font, for example: the
5108 font of the extent with the higher priority will be used).
5109 Extents are created with priority 0; priorities may be negative.
5113 EXTENT e = decode_extent (extent, 0);
5115 CHECK_INT (priority);
5116 e = extent_ancestor (e);
5117 set_extent_priority (e, XINT (priority));
5118 extent_maybe_changed_for_redisplay (e, 1, 0);
5122 DEFUN ("extent-priority", Fextent_priority, 1, 1, 0, /*
5123 Return the display priority of EXTENT; see `set-extent-priority'.
5127 EXTENT e = decode_extent (extent, 0);
5128 return make_int (extent_priority (e));
5131 DEFUN ("set-extent-property", Fset_extent_property, 3, 3, 0, /*
5132 Change a property of an extent.
5133 PROPERTY may be any symbol; the value stored may be accessed with
5134 the `extent-property' function.
5135 The following symbols have predefined meanings:
5137 detached Removes the extent from its buffer; setting this is
5138 the same as calling `detach-extent'.
5140 destroyed Removes the extent from its buffer, and makes it
5141 unusable in the future; this is the same calling
5144 priority Change redisplay priority; same as `set-extent-priority'.
5146 start-open Whether the set of characters within the extent is
5147 treated being open on the left, that is, whether
5148 the start position is an exclusive, rather than
5149 inclusive, boundary. If true, then characters
5150 inserted exactly at the beginning of the extent
5151 will remain outside of the extent; otherwise they
5152 will go into the extent, extending it.
5154 end-open Whether the set of characters within the extent is
5155 treated being open on the right, that is, whether
5156 the end position is an exclusive, rather than
5157 inclusive, boundary. If true, then characters
5158 inserted exactly at the end of the extent will
5159 remain outside of the extent; otherwise they will
5160 go into the extent, extending it.
5162 By default, extents have the `end-open' but not the
5163 `start-open' property set.
5165 read-only Text within this extent will be unmodifiable.
5167 initial-redisplay-function (EXPERIMENTAL)
5168 function to be called the first time (part of) the extent
5169 is redisplayed. It will be called with the extent as its
5171 Note: The function will not be called immediately
5172 during redisplay, an eval event will be dispatched.
5174 detachable Whether the extent gets detached (as with
5175 `detach-extent') when all the text within the
5176 extent is deleted. This is true by default. If
5177 this property is not set, the extent becomes a
5178 zero-length extent when its text is deleted. (In
5179 such a case, the `start-open' property is
5180 automatically removed if both the `start-open' and
5181 `end-open' properties are set, since zero-length
5182 extents open on both ends are not allowed.)
5184 face The face in which to display the text. Setting
5185 this is the same as calling `set-extent-face'.
5187 mouse-face If non-nil, the extent will be highlighted in this
5188 face when the mouse moves over it.
5190 pointer If non-nil, and a valid pointer glyph, this specifies
5191 the shape of the mouse pointer while over the extent.
5193 highlight Obsolete: Setting this property is equivalent to
5194 setting a `mouse-face' property of `highlight'.
5195 Reading this property returns non-nil if
5196 the extent has a non-nil `mouse-face' property.
5198 duplicable Whether this extent should be copied into strings,
5199 so that kill, yank, and undo commands will restore
5200 or copy it. `duplicable' extents are copied from
5201 an extent into a string when `buffer-substring' or
5202 a similar function creates a string. The extents
5203 in a string are copied into other strings created
5204 from the string using `concat' or `substring'.
5205 When `insert' or a similar function inserts the
5206 string into a buffer, the extents are copied back
5209 unique Meaningful only in conjunction with `duplicable'.
5210 When this is set, there may be only one instance
5211 of this extent attached at a time: if it is copied
5212 to the kill ring and then yanked, the extent is
5213 not copied. If, however, it is killed (removed
5214 from the buffer) and then yanked, it will be
5215 re-attached at the new position.
5217 invisible If the value is non-nil, text under this extent
5218 may be treated as not present for the purpose of
5219 redisplay, or may be displayed using an ellipsis
5220 or other marker; see `buffer-invisibility-spec'
5221 and `invisible-text-glyph'. In all cases,
5222 however, the text is still visible to other
5223 functions that examine a buffer's text.
5225 keymap This keymap is consulted for mouse clicks on this
5226 extent, or keypresses made while point is within the
5229 copy-function This is a hook that is run when a duplicable extent
5230 is about to be copied from a buffer to a string (or
5231 the kill ring). It is called with three arguments,
5232 the extent, and the buffer-positions within it
5233 which are being copied. If this function returns
5234 nil, then the extent will not be copied; otherwise
5237 paste-function This is a hook that is run when a duplicable extent is
5238 about to be copied from a string (or the kill ring)
5239 into a buffer. It is called with three arguments,
5240 the original extent, and the buffer positions which
5241 the copied extent will occupy. (This hook is run
5242 after the corresponding text has already been
5243 inserted into the buffer.) Note that the extent
5244 argument may be detached when this function is run.
5245 If this function returns nil, no extent will be
5246 inserted. Otherwise, there will be an extent
5247 covering the range in question.
5249 If the original extent is not attached to a buffer,
5250 then it will be re-attached at this range.
5251 Otherwise, a copy will be made, and that copy
5254 The copy-function and paste-function are meaningful
5255 only for extents with the `duplicable' flag set,
5256 and if they are not specified, behave as if `t' was
5257 the returned value. When these hooks are invoked,
5258 the current buffer is the buffer which the extent
5259 is being copied from/to, respectively.
5261 begin-glyph A glyph to be displayed at the beginning of the extent,
5264 end-glyph A glyph to be displayed at the end of the extent,
5267 begin-glyph-layout The layout policy (one of `text', `whitespace',
5268 `inside-margin', or `outside-margin') of the extent's
5271 end-glyph-layout The layout policy of the extent's end glyph.
5273 (extent, property, value))
5275 /* This function can GC if property is `keymap' */
5276 EXTENT e = decode_extent (extent, 0);
5278 if (EQ (property, Qread_only))
5279 set_extent_read_only (e, value);
5280 else if (EQ (property, Qunique))
5281 extent_unique_p (e) = !NILP (value);
5282 else if (EQ (property, Qduplicable))
5283 extent_duplicable_p (e) = !NILP (value);
5284 else if (EQ (property, Qinvisible))
5285 set_extent_invisible (e, value);
5286 else if (EQ (property, Qdetachable))
5287 extent_detachable_p (e) = !NILP (value);
5289 else if (EQ (property, Qdetached))
5292 error ("can only set `detached' to t");
5293 Fdetach_extent (extent);
5295 else if (EQ (property, Qdestroyed))
5298 error ("can only set `destroyed' to t");
5299 Fdelete_extent (extent);
5301 else if (EQ (property, Qpriority))
5302 Fset_extent_priority (extent, value);
5303 else if (EQ (property, Qface))
5304 Fset_extent_face (extent, value);
5305 else if (EQ (property, Qinitial_redisplay_function))
5306 Fset_extent_initial_redisplay_function (extent, value);
5307 else if (EQ (property, Qbefore_change_functions))
5308 set_extent_before_change_functions (e, value);
5309 else if (EQ (property, Qafter_change_functions))
5310 set_extent_after_change_functions (e, value);
5311 else if (EQ (property, Qmouse_face))
5312 Fset_extent_mouse_face (extent, value);
5314 else if (EQ (property, Qhighlight))
5315 Fset_extent_mouse_face (extent, Qhighlight);
5316 else if (EQ (property, Qbegin_glyph_layout))
5317 Fset_extent_begin_glyph_layout (extent, value);
5318 else if (EQ (property, Qend_glyph_layout))
5319 Fset_extent_end_glyph_layout (extent, value);
5320 /* For backwards compatibility. We use begin glyph because it is by
5321 far the more used of the two. */
5322 else if (EQ (property, Qglyph_layout))
5323 Fset_extent_begin_glyph_layout (extent, value);
5324 else if (EQ (property, Qbegin_glyph))
5325 Fset_extent_begin_glyph (extent, value, Qnil);
5326 else if (EQ (property, Qend_glyph))
5327 Fset_extent_end_glyph (extent, value, Qnil);
5328 else if (EQ (property, Qstart_open))
5329 set_extent_openness (e, !NILP (value), -1);
5330 else if (EQ (property, Qend_open))
5331 set_extent_openness (e, -1, !NILP (value));
5332 /* Support (but don't document...) the obvious *_closed antonyms. */
5333 else if (EQ (property, Qstart_closed))
5334 set_extent_openness (e, NILP (value), -1);
5335 else if (EQ (property, Qend_closed))
5336 set_extent_openness (e, -1, NILP (value));
5339 if (EQ (property, Qkeymap))
5340 while (!NILP (value) && NILP (Fkeymapp (value)))
5341 value = wrong_type_argument (Qkeymapp, value);
5343 external_plist_put (extent_plist_addr (e), property, value, 0, ERROR_ME);
5349 DEFUN ("set-extent-properties", Fset_extent_properties, 2, 2, 0, /*
5350 Change some properties of EXTENT.
5351 PLIST is a property list.
5352 For a list of built-in properties, see `set-extent-property'.
5356 /* This function can GC, if one of the properties is `keymap' */
5357 Lisp_Object property, value;
5358 struct gcpro gcpro1;
5361 plist = Fcopy_sequence (plist);
5362 Fcanonicalize_plist (plist, Qnil);
5364 while (!NILP (plist))
5366 property = Fcar (plist); plist = Fcdr (plist);
5367 value = Fcar (plist); plist = Fcdr (plist);
5368 Fset_extent_property (extent, property, value);
5374 DEFUN ("extent-property", Fextent_property, 2, 3, 0, /*
5375 Return EXTENT's value for property PROPERTY.
5376 See `set-extent-property' for the built-in property names.
5378 (extent, property, default_))
5380 EXTENT e = decode_extent (extent, 0);
5382 if (EQ (property, Qdetached))
5383 return extent_detached_p (e) ? Qt : Qnil;
5384 else if (EQ (property, Qdestroyed))
5385 return !EXTENT_LIVE_P (e) ? Qt : Qnil;
5386 else if (EQ (property, Qstart_open))
5387 return extent_normal_field (e, start_open) ? Qt : Qnil;
5388 else if (EQ (property, Qend_open))
5389 return extent_normal_field (e, end_open) ? Qt : Qnil;
5390 else if (EQ (property, Qunique))
5391 return extent_normal_field (e, unique) ? Qt : Qnil;
5392 else if (EQ (property, Qduplicable))
5393 return extent_normal_field (e, duplicable) ? Qt : Qnil;
5394 else if (EQ (property, Qdetachable))
5395 return extent_normal_field (e, detachable) ? Qt : Qnil;
5396 /* Support (but don't document...) the obvious *_closed antonyms. */
5397 else if (EQ (property, Qstart_closed))
5398 return extent_start_open_p (e) ? Qnil : Qt;
5399 else if (EQ (property, Qend_closed))
5400 return extent_end_open_p (e) ? Qnil : Qt;
5401 else if (EQ (property, Qpriority))
5402 return make_int (extent_priority (e));
5403 else if (EQ (property, Qread_only))
5404 return extent_read_only (e);
5405 else if (EQ (property, Qinvisible))
5406 return extent_invisible (e);
5407 else if (EQ (property, Qface))
5408 return Fextent_face (extent);
5409 else if (EQ (property, Qinitial_redisplay_function))
5410 return extent_initial_redisplay_function (e);
5411 else if (EQ (property, Qbefore_change_functions))
5412 return extent_before_change_functions (e);
5413 else if (EQ (property, Qafter_change_functions))
5414 return extent_after_change_functions (e);
5415 else if (EQ (property, Qmouse_face))
5416 return Fextent_mouse_face (extent);
5418 else if (EQ (property, Qhighlight))
5419 return !NILP (Fextent_mouse_face (extent)) ? Qt : Qnil;
5420 else if (EQ (property, Qbegin_glyph_layout))
5421 return Fextent_begin_glyph_layout (extent);
5422 else if (EQ (property, Qend_glyph_layout))
5423 return Fextent_end_glyph_layout (extent);
5424 /* For backwards compatibility. We use begin glyph because it is by
5425 far the more used of the two. */
5426 else if (EQ (property, Qglyph_layout))
5427 return Fextent_begin_glyph_layout (extent);
5428 else if (EQ (property, Qbegin_glyph))
5429 return extent_begin_glyph (e);
5430 else if (EQ (property, Qend_glyph))
5431 return extent_end_glyph (e);
5434 Lisp_Object value = external_plist_get (extent_plist_addr (e),
5435 property, 0, ERROR_ME);
5436 return UNBOUNDP (value) ? default_ : value;
5440 DEFUN ("extent-properties", Fextent_properties, 1, 1, 0, /*
5441 Return a property list of the attributes of EXTENT.
5442 Do not modify this list; use `set-extent-property' instead.
5447 Lisp_Object result, face, anc_obj;
5448 glyph_layout layout;
5450 CHECK_EXTENT (extent);
5451 e = XEXTENT (extent);
5452 if (!EXTENT_LIVE_P (e))
5453 return cons3 (Qdestroyed, Qt, Qnil);
5455 anc = extent_ancestor (e);
5456 XSETEXTENT (anc_obj, anc);
5458 /* For efficiency, use the ancestor for all properties except detached */
5460 result = extent_plist_slot (anc);
5462 if (!NILP (face = Fextent_face (anc_obj)))
5463 result = cons3 (Qface, face, result);
5465 if (!NILP (face = Fextent_mouse_face (anc_obj)))
5466 result = cons3 (Qmouse_face, face, result);
5468 if ((layout = (glyph_layout) extent_begin_glyph_layout (anc)) != GL_TEXT)
5470 Lisp_Object sym = glyph_layout_to_symbol (layout);
5471 result = cons3 (Qglyph_layout, sym, result); /* compatibility */
5472 result = cons3 (Qbegin_glyph_layout, sym, result);
5475 if ((layout = (glyph_layout) extent_end_glyph_layout (anc)) != GL_TEXT)
5476 result = cons3 (Qend_glyph_layout, glyph_layout_to_symbol (layout), result);
5478 if (!NILP (extent_end_glyph (anc)))
5479 result = cons3 (Qend_glyph, extent_end_glyph (anc), result);
5481 if (!NILP (extent_begin_glyph (anc)))
5482 result = cons3 (Qbegin_glyph, extent_begin_glyph (anc), result);
5484 if (extent_priority (anc) != 0)
5485 result = cons3 (Qpriority, make_int (extent_priority (anc)), result);
5487 if (!NILP (extent_initial_redisplay_function (anc)))
5488 result = cons3 (Qinitial_redisplay_function,
5489 extent_initial_redisplay_function (anc), result);
5491 if (!NILP (extent_before_change_functions (anc)))
5492 result = cons3 (Qbefore_change_functions,
5493 extent_before_change_functions (anc), result);
5495 if (!NILP (extent_after_change_functions (anc)))
5496 result = cons3 (Qafter_change_functions,
5497 extent_after_change_functions (anc), result);
5499 if (!NILP (extent_invisible (anc)))
5500 result = cons3 (Qinvisible, extent_invisible (anc), result);
5502 if (!NILP (extent_read_only (anc)))
5503 result = cons3 (Qread_only, extent_read_only (anc), result);
5505 if (extent_normal_field (anc, end_open))
5506 result = cons3 (Qend_open, Qt, result);
5508 if (extent_normal_field (anc, start_open))
5509 result = cons3 (Qstart_open, Qt, result);
5511 if (extent_normal_field (anc, detachable))
5512 result = cons3 (Qdetachable, Qt, result);
5514 if (extent_normal_field (anc, duplicable))
5515 result = cons3 (Qduplicable, Qt, result);
5517 if (extent_normal_field (anc, unique))
5518 result = cons3 (Qunique, Qt, result);
5520 /* detached is not an inherited property */
5521 if (extent_detached_p (e))
5522 result = cons3 (Qdetached, Qt, result);
5528 /************************************************************************/
5530 /************************************************************************/
5532 /* The display code looks into the Vlast_highlighted_extent variable to
5533 correctly display highlighted extents. This updates that variable,
5534 and marks the appropriate buffers as needing some redisplay.
5537 do_highlight (Lisp_Object extent_obj, int highlight_p)
5539 if (( highlight_p && (EQ (Vlast_highlighted_extent, extent_obj))) ||
5540 (!highlight_p && (EQ (Vlast_highlighted_extent, Qnil))))
5542 if (EXTENTP (Vlast_highlighted_extent) &&
5543 EXTENT_LIVE_P (XEXTENT (Vlast_highlighted_extent)))
5545 /* do not recurse on descendants. Only one extent is highlighted
5547 extent_changed_for_redisplay (XEXTENT (Vlast_highlighted_extent), 0, 0);
5549 Vlast_highlighted_extent = Qnil;
5550 if (!NILP (extent_obj)
5551 && BUFFERP (extent_object (XEXTENT (extent_obj)))
5554 extent_changed_for_redisplay (XEXTENT (extent_obj), 0, 0);
5555 Vlast_highlighted_extent = extent_obj;
5559 DEFUN ("force-highlight-extent", Fforce_highlight_extent, 1, 2, 0, /*
5560 Highlight or unhighlight the given extent.
5561 If the second arg is non-nil, it will be highlighted, else dehighlighted.
5562 This is the same as `highlight-extent', except that it will work even
5563 on extents without the `mouse-face' property.
5565 (extent, highlight_p))
5570 XSETEXTENT (extent, decode_extent (extent, DE_MUST_BE_ATTACHED));
5571 do_highlight (extent, !NILP (highlight_p));
5575 DEFUN ("highlight-extent", Fhighlight_extent, 1, 2, 0, /*
5576 Highlight EXTENT, if it is highlightable.
5577 \(that is, if it has the `mouse-face' property).
5578 If the second arg is non-nil, it will be highlighted, else dehighlighted.
5579 Highlighted extents are displayed as if they were merged with the face
5580 or faces specified by the `mouse-face' property.
5582 (extent, highlight_p))
5584 if (EXTENTP (extent) && NILP (extent_mouse_face (XEXTENT (extent))))
5587 return Fforce_highlight_extent (extent, highlight_p);
5591 /************************************************************************/
5592 /* strings and extents */
5593 /************************************************************************/
5595 /* copy/paste hooks */
5598 run_extent_copy_paste_internal (EXTENT e, Bufpos from, Bufpos to,
5602 /* This function can GC */
5604 Lisp_Object copy_fn;
5605 XSETEXTENT (extent, e);
5606 copy_fn = Fextent_property (extent, prop, Qnil);
5607 if (!NILP (copy_fn))
5610 struct gcpro gcpro1, gcpro2, gcpro3;
5611 GCPRO3 (extent, copy_fn, object);
5612 if (BUFFERP (object))
5613 flag = call3_in_buffer (XBUFFER (object), copy_fn, extent,
5614 make_int (from), make_int (to));
5616 flag = call3 (copy_fn, extent, make_int (from), make_int (to));
5618 if (NILP (flag) || !EXTENT_LIVE_P (XEXTENT (extent)))
5625 run_extent_copy_function (EXTENT e, Bytind from, Bytind to)
5627 Lisp_Object object = extent_object (e);
5628 /* This function can GC */
5629 return run_extent_copy_paste_internal
5630 (e, buffer_or_string_bytind_to_bufpos (object, from),
5631 buffer_or_string_bytind_to_bufpos (object, to), object,
5636 run_extent_paste_function (EXTENT e, Bytind from, Bytind to,
5639 /* This function can GC */
5640 return run_extent_copy_paste_internal
5641 (e, buffer_or_string_bytind_to_bufpos (object, from),
5642 buffer_or_string_bytind_to_bufpos (object, to), object,
5647 update_extent (EXTENT extent, Bytind from, Bytind to)
5649 set_extent_endpoints (extent, from, to, Qnil);
5652 /* Insert an extent, usually from the dup_list of a string which
5653 has just been inserted.
5654 This code does not handle the case of undo.
5657 insert_extent (EXTENT extent, Bytind new_start, Bytind new_end,
5658 Lisp_Object object, int run_hooks)
5660 /* This function can GC */
5663 if (!EQ (extent_object (extent), object))
5666 if (extent_detached_p (extent))
5669 !run_extent_paste_function (extent, new_start, new_end, object))
5670 /* The paste-function said don't re-attach this extent here. */
5673 update_extent (extent, new_start, new_end);
5677 Bytind exstart = extent_endpoint_bytind (extent, 0);
5678 Bytind exend = extent_endpoint_bytind (extent, 1);
5680 if (exend < new_start || exstart > new_end)
5684 new_start = min (exstart, new_start);
5685 new_end = max (exend, new_end);
5686 if (exstart != new_start || exend != new_end)
5687 update_extent (extent, new_start, new_end);
5691 XSETEXTENT (tmp, extent);
5696 !run_extent_paste_function (extent, new_start, new_end, object))
5697 /* The paste-function said don't attach a copy of the extent here. */
5701 XSETEXTENT (tmp, copy_extent (extent, new_start, new_end, object));
5706 DEFUN ("insert-extent", Finsert_extent, 1, 5, 0, /*
5707 Insert EXTENT from START to END in BUFFER-OR-STRING.
5708 BUFFER-OR-STRING defaults to the current buffer if omitted.
5709 This operation does not insert any characters,
5710 but otherwise acts as if there were a replicating extent whose
5711 parent is EXTENT in some string that was just inserted.
5712 Returns the newly-inserted extent.
5713 The fourth arg, NO-HOOKS, can be used to inhibit the running of the
5714 extent's `paste-function' property if it has one.
5715 See documentation on `detach-extent' for a discussion of undo recording.
5717 (extent, start, end, no_hooks, buffer_or_string))
5719 EXTENT ext = decode_extent (extent, 0);
5723 buffer_or_string = decode_buffer_or_string (buffer_or_string);
5724 get_buffer_or_string_range_byte (buffer_or_string, start, end, &s, &e,
5725 GB_ALLOW_PAST_ACCESSIBLE);
5727 copy = insert_extent (ext, s, e, buffer_or_string, NILP (no_hooks));
5730 if (extent_duplicable_p (XEXTENT (copy)))
5731 record_extent (copy, 1);
5737 /* adding buffer extents to a string */
5739 struct add_string_extents_arg
5747 add_string_extents_mapper (EXTENT extent, void *arg)
5749 /* This function can GC */
5750 struct add_string_extents_arg *closure =
5751 (struct add_string_extents_arg *) arg;
5752 Bytecount start = extent_endpoint_bytind (extent, 0) - closure->from;
5753 Bytecount end = extent_endpoint_bytind (extent, 1) - closure->from;
5755 if (extent_duplicable_p (extent))
5757 start = max (start, 0);
5758 end = min (end, closure->length);
5760 /* Run the copy-function to give an extent the option of
5761 not being copied into the string (or kill ring).
5763 if (extent_duplicable_p (extent) &&
5764 !run_extent_copy_function (extent, start + closure->from,
5765 end + closure->from))
5767 copy_extent (extent, start, end, closure->string);
5773 /* Add the extents in buffer BUF from OPOINT to OPOINT+LENGTH to
5774 the string STRING. */
5776 add_string_extents (Lisp_Object string, struct buffer *buf, Bytind opoint,
5779 /* This function can GC */
5780 struct add_string_extents_arg closure;
5781 struct gcpro gcpro1, gcpro2;
5784 closure.from = opoint;
5785 closure.length = length;
5786 closure.string = string;
5787 buffer = make_buffer (buf);
5788 GCPRO2 (buffer, string);
5789 map_extents_bytind (opoint, opoint + length, add_string_extents_mapper,
5790 (void *) &closure, buffer, 0,
5791 /* ignore extents that just abut the region */
5792 ME_END_CLOSED | ME_ALL_EXTENTS_OPEN |
5793 /* we are calling E-Lisp (the extent's copy function)
5794 so anything might happen */
5795 ME_MIGHT_CALL_ELISP);
5799 struct splice_in_string_extents_arg
5808 splice_in_string_extents_mapper (EXTENT extent, void *arg)
5810 /* This function can GC */
5811 struct splice_in_string_extents_arg *closure =
5812 (struct splice_in_string_extents_arg *) arg;
5813 /* BASE_START and BASE_END are the limits in the buffer of the string
5814 that was just inserted.
5816 NEW_START and NEW_END are the prospective buffer positions of the
5817 extent that is going into the buffer. */
5818 Bytind base_start = closure->opoint;
5819 Bytind base_end = base_start + closure->length;
5820 Bytind new_start = (base_start + extent_endpoint_bytind (extent, 0) -
5822 Bytind new_end = (base_start + extent_endpoint_bytind (extent, 1) -
5825 if (new_start < base_start)
5826 new_start = base_start;
5827 if (new_end > base_end)
5829 if (new_end <= new_start)
5832 if (!extent_duplicable_p (extent))
5836 !run_extent_paste_function (extent, new_start, new_end,
5839 copy_extent (extent, new_start, new_end, closure->buffer);
5844 /* We have just inserted a section of STRING (starting at POS, of
5845 length LENGTH) into buffer BUF at OPOINT. Do whatever is necessary
5846 to get the string's extents into the buffer. */
5849 splice_in_string_extents (Lisp_Object string, struct buffer *buf,
5850 Bytind opoint, Bytecount length, Bytecount pos)
5852 struct splice_in_string_extents_arg closure;
5853 struct gcpro gcpro1, gcpro2;
5856 buffer = make_buffer (buf);
5857 closure.opoint = opoint;
5859 closure.length = length;
5860 closure.buffer = buffer;
5861 GCPRO2 (buffer, string);
5862 map_extents_bytind (pos, pos + length,
5863 splice_in_string_extents_mapper,
5864 (void *) &closure, string, 0,
5865 /* ignore extents that just abut the region */
5866 ME_END_CLOSED | ME_ALL_EXTENTS_OPEN |
5867 /* we are calling E-Lisp (the extent's copy function)
5868 so anything might happen */
5869 ME_MIGHT_CALL_ELISP);
5873 struct copy_string_extents_arg
5878 Lisp_Object new_string;
5881 struct copy_string_extents_1_arg
5883 Lisp_Object parent_in_question;
5884 EXTENT found_extent;
5888 copy_string_extents_mapper (EXTENT extent, void *arg)
5890 struct copy_string_extents_arg *closure =
5891 (struct copy_string_extents_arg *) arg;
5892 Bytecount old_start, old_end, new_start, new_end;
5894 old_start = extent_endpoint_bytind (extent, 0);
5895 old_end = extent_endpoint_bytind (extent, 1);
5897 old_start = max (closure->old_pos, old_start);
5898 old_end = min (closure->old_pos + closure->length, old_end);
5900 if (old_start >= old_end)
5903 new_start = old_start + closure->new_pos - closure->old_pos;
5904 new_end = old_end + closure->new_pos - closure->old_pos;
5906 copy_extent (extent, new_start, new_end, closure->new_string);
5910 /* The string NEW_STRING was partially constructed from OLD_STRING.
5911 In particular, the section of length LEN starting at NEW_POS in
5912 NEW_STRING came from the section of the same length starting at
5913 OLD_POS in OLD_STRING. Copy the extents as appropriate. */
5916 copy_string_extents (Lisp_Object new_string, Lisp_Object old_string,
5917 Bytecount new_pos, Bytecount old_pos,
5920 struct copy_string_extents_arg closure;
5921 struct gcpro gcpro1, gcpro2;
5923 closure.new_pos = new_pos;
5924 closure.old_pos = old_pos;
5925 closure.new_string = new_string;
5926 closure.length = length;
5927 GCPRO2 (new_string, old_string);
5928 map_extents_bytind (old_pos, old_pos + length,
5929 copy_string_extents_mapper,
5930 (void *) &closure, old_string, 0,
5931 /* ignore extents that just abut the region */
5932 ME_END_CLOSED | ME_ALL_EXTENTS_OPEN |
5933 /* we are calling E-Lisp (the extent's copy function)
5934 so anything might happen */
5935 ME_MIGHT_CALL_ELISP);
5939 /* Checklist for sanity checking:
5940 - {kill, yank, copy} at {open, closed} {start, end} of {writable, read-only} extent
5941 - {kill, copy} & yank {once, repeatedly} duplicable extent in {same, different} buffer
5945 /************************************************************************/
5946 /* text properties */
5947 /************************************************************************/
5950 Originally this stuff was implemented in lisp (all of the functionality
5951 exists to make that possible) but speed was a problem.
5954 Lisp_Object Qtext_prop;
5955 Lisp_Object Qtext_prop_extent_paste_function;
5958 get_text_property_bytind (Bytind position, Lisp_Object prop,
5959 Lisp_Object object, enum extent_at_flag fl,
5960 int text_props_only)
5964 /* text_props_only specifies whether we only consider text-property
5965 extents (those with the 'text-prop property set) or all extents. */
5966 if (!text_props_only)
5967 extent = extent_at_bytind (position, object, prop, 0, fl);
5973 extent = extent_at_bytind (position, object, Qtext_prop, prior,
5977 if (EQ (prop, Fextent_property (extent, Qtext_prop, Qnil)))
5979 prior = XEXTENT (extent);
5984 return Fextent_property (extent, prop, Qnil);
5985 if (!NILP (Vdefault_text_properties))
5986 return Fplist_get (Vdefault_text_properties, prop, Qnil);
5991 get_text_property_1 (Lisp_Object pos, Lisp_Object prop, Lisp_Object object,
5992 Lisp_Object at_flag, int text_props_only)
5997 object = decode_buffer_or_string (object);
5998 position = get_buffer_or_string_pos_byte (object, pos, GB_NO_ERROR_IF_BAD);
6000 /* We canonicalize the start/end-open/closed properties to the
6001 non-default version -- "adding" the default property really
6002 needs to remove the non-default one. See below for more
6004 if (EQ (prop, Qstart_closed))
6010 if (EQ (prop, Qend_open))
6018 get_text_property_bytind (position, prop, object,
6019 decode_extent_at_flag (at_flag),
6022 val = NILP (val) ? Qt : Qnil;
6027 DEFUN ("get-text-property", Fget_text_property, 2, 4, 0, /*
6028 Return the value of the PROP property at the given position.
6029 Optional arg OBJECT specifies the buffer or string to look in, and
6030 defaults to the current buffer.
6031 Optional arg AT-FLAG controls what it means for a property to be "at"
6032 a position, and has the same meaning as in `extent-at'.
6033 This examines only those properties added with `put-text-property'.
6034 See also `get-char-property'.
6036 (pos, prop, object, at_flag))
6038 return get_text_property_1 (pos, prop, object, at_flag, 1);
6041 DEFUN ("get-char-property", Fget_char_property, 2, 4, 0, /*
6042 Return the value of the PROP property at the given position.
6043 Optional arg OBJECT specifies the buffer or string to look in, and
6044 defaults to the current buffer.
6045 Optional arg AT-FLAG controls what it means for a property to be "at"
6046 a position, and has the same meaning as in `extent-at'.
6047 This examines properties on all extents.
6048 See also `get-text-property'.
6050 (pos, prop, object, at_flag))
6052 return get_text_property_1 (pos, prop, object, at_flag, 0);
6055 /* About start/end-open/closed:
6057 These properties have to be handled specially because of their
6058 strange behavior. If I put the "start-open" property on a region,
6059 then *all* text-property extents in the region have to have their
6060 start be open. This is unlike all other properties, which don't
6061 affect the extents of text properties other than their own.
6065 1) We have to map start-closed to (not start-open) and end-open
6066 to (not end-closed) -- i.e. adding the default is really the
6067 same as remove the non-default property. It won't work, for
6068 example, to have both "start-open" and "start-closed" on
6070 2) Whenever we add one of these properties, we go through all
6071 text-property extents in the region and set the appropriate
6072 open/closedness on them.
6073 3) Whenever we change a text-property extent for a property,
6074 we have to make sure we set the open/closedness properly.
6076 (2) and (3) together rely on, and maintain, the invariant
6077 that the open/closedness of text-property extents is correct
6078 at the beginning and end of each operation.
6081 struct put_text_prop_arg
6083 Lisp_Object prop, value; /* The property and value we are storing */
6084 Bytind start, end; /* The region into which we are storing it */
6086 Lisp_Object the_extent; /* Our chosen extent; this is used for
6087 communication between subsequent passes. */
6088 int changed_p; /* Output: whether we have modified anything */
6092 put_text_prop_mapper (EXTENT e, void *arg)
6094 struct put_text_prop_arg *closure = (struct put_text_prop_arg *) arg;
6096 Lisp_Object object = closure->object;
6097 Lisp_Object value = closure->value;
6098 Bytind e_start, e_end;
6099 Bytind start = closure->start;
6100 Bytind end = closure->end;
6101 Lisp_Object extent, e_val;
6104 XSETEXTENT (extent, e);
6106 /* Note: in some cases when the property itself is 'start-open
6107 or 'end-closed, the checks to set the openness may do a bit
6108 of extra work; but it won't hurt because we then fix up the
6109 openness later on in put_text_prop_openness_mapper(). */
6110 if (!EQ (Fextent_property (extent, Qtext_prop, Qnil), closure->prop))
6111 /* It's not for this property; do nothing. */
6114 e_start = extent_endpoint_bytind (e, 0);
6115 e_end = extent_endpoint_bytind (e, 1);
6116 e_val = Fextent_property (extent, closure->prop, Qnil);
6117 is_eq = EQ (value, e_val);
6119 if (!NILP (value) && NILP (closure->the_extent) && is_eq)
6121 /* We want there to be an extent here at the end, and we haven't picked
6122 one yet, so use this one. Extend it as necessary. We only reuse an
6123 extent which has an EQ value for the prop in question to avoid
6124 side-effecting the kill ring (that is, we never change the property
6125 on an extent after it has been created.)
6127 if (e_start != start || e_end != end)
6129 Bytind new_start = min (e_start, start);
6130 Bytind new_end = max (e_end, end);
6131 set_extent_endpoints (e, new_start, new_end, Qnil);
6132 /* If we changed the endpoint, then we need to set its
6134 set_extent_openness (e, new_start != e_start
6135 ? !NILP (get_text_property_bytind
6136 (start, Qstart_open, object,
6137 EXTENT_AT_AFTER, 1)) : -1,
6139 ? NILP (get_text_property_bytind
6140 (end - 1, Qend_closed, object,
6141 EXTENT_AT_AFTER, 1))
6143 closure->changed_p = 1;
6145 closure->the_extent = extent;
6148 /* Even if we're adding a prop, at this point, we want all other extents of
6149 this prop to go away (as now they overlap). So the theory here is that,
6150 when we are adding a prop to a region that has multiple (disjoint)
6151 occurrences of that prop in it already, we pick one of those and extend
6152 it, and remove the others.
6155 else if (EQ (extent, closure->the_extent))
6157 /* just in case map-extents hits it again (does that happen?) */
6160 else if (e_start >= start && e_end <= end)
6162 /* Extent is contained in region; remove it. Don't destroy or modify
6163 it, because we don't want to change the attributes pointed to by the
6164 duplicates in the kill ring.
6167 closure->changed_p = 1;
6169 else if (!NILP (closure->the_extent) &&
6174 EXTENT te = XEXTENT (closure->the_extent);
6175 /* This extent overlaps, and has the same prop/value as the extent we've
6176 decided to reuse, so we can remove this existing extent as well (the
6177 whole thing, even the part outside of the region) and extend
6178 the-extent to cover it, resulting in the minimum number of extents in
6181 Bytind the_start = extent_endpoint_bytind (te, 0);
6182 Bytind the_end = extent_endpoint_bytind (te, 1);
6183 if (e_start != the_start && /* note AND not OR -- hmm, why is this
6184 the case? I think it's because the
6185 assumption that the text-property
6186 extents don't overlap makes it
6187 OK; changing it to an OR would
6188 result in changed_p sometimes getting
6189 falsely marked. Is this bad? */
6192 Bytind new_start = min (e_start, the_start);
6193 Bytind new_end = max (e_end, the_end);
6194 set_extent_endpoints (te, new_start, new_end, Qnil);
6195 /* If we changed the endpoint, then we need to set its
6196 openness. We are setting the endpoint to be the same as
6197 that of the extent we're about to remove, and we assume
6198 (the invariant mentioned above) that extent has the
6199 proper endpoint setting, so we just use it. */
6200 set_extent_openness (te, new_start != e_start ?
6201 (int) extent_start_open_p (e) : -1,
6203 (int) extent_end_open_p (e) : -1);
6204 closure->changed_p = 1;
6208 else if (e_end <= end)
6210 /* Extent begins before start but ends before end, so we can just
6211 decrease its end position.
6215 set_extent_endpoints (e, e_start, start, Qnil);
6216 set_extent_openness (e, -1, NILP (get_text_property_bytind
6217 (start - 1, Qend_closed, object,
6218 EXTENT_AT_AFTER, 1)));
6219 closure->changed_p = 1;
6222 else if (e_start >= start)
6224 /* Extent ends after end but begins after start, so we can just
6225 increase its start position.
6229 set_extent_endpoints (e, end, e_end, Qnil);
6230 set_extent_openness (e, !NILP (get_text_property_bytind
6231 (end, Qstart_open, object,
6232 EXTENT_AT_AFTER, 1)), -1);
6233 closure->changed_p = 1;
6238 /* Otherwise, `extent' straddles the region. We need to split it.
6240 set_extent_endpoints (e, e_start, start, Qnil);
6241 set_extent_openness (e, -1, NILP (get_text_property_bytind
6242 (start - 1, Qend_closed, object,
6243 EXTENT_AT_AFTER, 1)));
6244 set_extent_openness (copy_extent (e, end, e_end, extent_object (e)),
6245 !NILP (get_text_property_bytind
6246 (end, Qstart_open, object,
6247 EXTENT_AT_AFTER, 1)), -1);
6248 closure->changed_p = 1;
6251 return 0; /* to continue mapping. */
6255 put_text_prop_openness_mapper (EXTENT e, void *arg)
6257 struct put_text_prop_arg *closure = (struct put_text_prop_arg *) arg;
6258 Bytind e_start, e_end;
6259 Bytind start = closure->start;
6260 Bytind end = closure->end;
6262 XSETEXTENT (extent, e);
6263 e_start = extent_endpoint_bytind (e, 0);
6264 e_end = extent_endpoint_bytind (e, 1);
6266 if (NILP (Fextent_property (extent, Qtext_prop, Qnil)))
6268 /* It's not a text-property extent; do nothing. */
6271 /* Note end conditions and NILP/!NILP's carefully. */
6272 else if (EQ (closure->prop, Qstart_open)
6273 && e_start >= start && e_start < end)
6274 set_extent_openness (e, !NILP (closure->value), -1);
6275 else if (EQ (closure->prop, Qend_closed)
6276 && e_end > start && e_end <= end)
6277 set_extent_openness (e, -1, NILP (closure->value));
6279 return 0; /* to continue mapping. */
6283 put_text_prop (Bytind start, Bytind end, Lisp_Object object,
6284 Lisp_Object prop, Lisp_Object value,
6287 /* This function can GC */
6288 struct put_text_prop_arg closure;
6290 if (start == end) /* There are no characters in the region. */
6293 /* convert to the non-default versions, since a nil property is
6294 the same as it not being present. */
6295 if (EQ (prop, Qstart_closed))
6298 value = NILP (value) ? Qt : Qnil;
6300 else if (EQ (prop, Qend_open))
6303 value = NILP (value) ? Qt : Qnil;
6306 value = canonicalize_extent_property (prop, value);
6308 closure.prop = prop;
6309 closure.value = value;
6310 closure.start = start;
6312 closure.object = object;
6313 closure.changed_p = 0;
6314 closure.the_extent = Qnil;
6316 map_extents_bytind (start, end,
6317 put_text_prop_mapper,
6318 (void *) &closure, object, 0,
6319 /* get all extents that abut the region */
6320 ME_ALL_EXTENTS_CLOSED | ME_END_CLOSED |
6321 /* it might QUIT or error if the user has
6322 fucked with the extent plist. */
6323 /* #### dmoore - I think this should include
6324 ME_MIGHT_MOVE_SOE, since the callback function
6325 might recurse back into map_extents_bytind. */
6327 ME_MIGHT_MODIFY_EXTENTS);
6329 /* If we made it through the loop without reusing an extent
6330 (and we want there to be one) make it now.
6332 if (!NILP (value) && NILP (closure.the_extent))
6336 XSETEXTENT (extent, make_extent_internal (object, start, end));
6337 closure.changed_p = 1;
6338 Fset_extent_property (extent, Qtext_prop, prop);
6339 Fset_extent_property (extent, prop, value);
6342 extent_duplicable_p (XEXTENT (extent)) = 1;
6343 Fset_extent_property (extent, Qpaste_function,
6344 Qtext_prop_extent_paste_function);
6346 set_extent_openness (XEXTENT (extent),
6347 !NILP (get_text_property_bytind
6348 (start, Qstart_open, object,
6349 EXTENT_AT_AFTER, 1)),
6350 NILP (get_text_property_bytind
6351 (end - 1, Qend_closed, object,
6352 EXTENT_AT_AFTER, 1)));
6355 if (EQ (prop, Qstart_open) || EQ (prop, Qend_closed))
6357 map_extents_bytind (start, end,
6358 put_text_prop_openness_mapper,
6359 (void *) &closure, object, 0,
6360 /* get all extents that abut the region */
6361 ME_ALL_EXTENTS_CLOSED | ME_END_CLOSED |
6362 ME_MIGHT_MODIFY_EXTENTS);
6365 return closure.changed_p;
6368 DEFUN ("put-text-property", Fput_text_property, 4, 5, 0, /*
6369 Adds the given property/value to all characters in the specified region.
6370 The property is conceptually attached to the characters rather than the
6371 region. The properties are copied when the characters are copied/pasted.
6372 Fifth argument OBJECT is the buffer or string containing the text, and
6373 defaults to the current buffer.
6375 (start, end, prop, value, object))
6377 /* This function can GC */
6380 object = decode_buffer_or_string (object);
6381 get_buffer_or_string_range_byte (object, start, end, &s, &e, 0);
6382 put_text_prop (s, e, object, prop, value, 1);
6386 DEFUN ("put-nonduplicable-text-property", Fput_nonduplicable_text_property,
6388 Adds the given property/value to all characters in the specified region.
6389 The property is conceptually attached to the characters rather than the
6390 region, however the properties will not be copied when the characters
6392 Fifth argument OBJECT is the buffer or string containing the text, and
6393 defaults to the current buffer.
6395 (start, end, prop, value, object))
6397 /* This function can GC */
6400 object = decode_buffer_or_string (object);
6401 get_buffer_or_string_range_byte (object, start, end, &s, &e, 0);
6402 put_text_prop (s, e, object, prop, value, 0);
6406 DEFUN ("add-text-properties", Fadd_text_properties, 3, 4, 0, /*
6407 Add properties to the characters from START to END.
6408 The third argument PROPS is a property list specifying the property values
6409 to add. The optional fourth argument, OBJECT, is the buffer or string
6410 containing the text and defaults to the current buffer. Returns t if
6411 any property was changed, nil otherwise.
6413 (start, end, props, object))
6415 /* This function can GC */
6419 object = decode_buffer_or_string (object);
6420 get_buffer_or_string_range_byte (object, start, end, &s, &e, 0);
6422 for (; !NILP (props); props = Fcdr (Fcdr (props)))
6424 Lisp_Object prop = XCAR (props);
6425 Lisp_Object value = Fcar (XCDR (props));
6426 changed |= put_text_prop (s, e, object, prop, value, 1);
6428 return changed ? Qt : Qnil;
6432 DEFUN ("add-nonduplicable-text-properties", Fadd_nonduplicable_text_properties,
6434 Add nonduplicable properties to the characters from START to END.
6435 \(The properties will not be copied when the characters are copied.)
6436 The third argument PROPS is a property list specifying the property values
6437 to add. The optional fourth argument, OBJECT, is the buffer or string
6438 containing the text and defaults to the current buffer. Returns t if
6439 any property was changed, nil otherwise.
6441 (start, end, props, object))
6443 /* This function can GC */
6447 object = decode_buffer_or_string (object);
6448 get_buffer_or_string_range_byte (object, start, end, &s, &e, 0);
6450 for (; !NILP (props); props = Fcdr (Fcdr (props)))
6452 Lisp_Object prop = XCAR (props);
6453 Lisp_Object value = Fcar (XCDR (props));
6454 changed |= put_text_prop (s, e, object, prop, value, 0);
6456 return changed ? Qt : Qnil;
6459 DEFUN ("remove-text-properties", Fremove_text_properties, 3, 4, 0, /*
6460 Remove the given properties from all characters in the specified region.
6461 PROPS should be a plist, but the values in that plist are ignored (treated
6462 as nil). Returns t if any property was changed, nil otherwise.
6463 Fourth argument OBJECT is the buffer or string containing the text, and
6464 defaults to the current buffer.
6466 (start, end, props, object))
6468 /* This function can GC */
6472 object = decode_buffer_or_string (object);
6473 get_buffer_or_string_range_byte (object, start, end, &s, &e, 0);
6475 for (; !NILP (props); props = Fcdr (Fcdr (props)))
6477 Lisp_Object prop = XCAR (props);
6478 changed |= put_text_prop (s, e, object, prop, Qnil, 1);
6480 return changed ? Qt : Qnil;
6483 /* Whenever a text-prop extent is pasted into a buffer (via `yank' or `insert'
6484 or whatever) we attach the properties to the buffer by calling
6485 `put-text-property' instead of by simply allowing the extent to be copied or
6486 re-attached. Then we return nil, telling the extents code not to attach it
6487 again. By handing the insertion hackery in this way, we make kill/yank
6488 behave consistently with put-text-property and not fragment the extents
6489 (since text-prop extents must partition, not overlap).
6491 The lisp implementation of this was probably fast enough, but since I moved
6492 the rest of the put-text-prop code here, I moved this as well for
6495 DEFUN ("text-prop-extent-paste-function", Ftext_prop_extent_paste_function,
6497 Used as the `paste-function' property of `text-prop' extents.
6501 /* This function can GC */
6502 Lisp_Object prop, val;
6504 prop = Fextent_property (extent, Qtext_prop, Qnil);
6506 signal_simple_error ("Internal error: no text-prop", extent);
6507 val = Fextent_property (extent, prop, Qnil);
6509 /* removed by bill perry, 2/9/97
6510 ** This little bit of code would not allow you to have a text property
6511 ** with a value of Qnil. This is bad bad bad.
6514 signal_simple_error_2 ("Internal error: no text-prop",
6517 Fput_text_property (from, to, prop, val, Qnil);
6518 return Qnil; /* important! */
6521 /* This function could easily be written in Lisp but the C code wants
6522 to use it in connection with invisible extents (at least currently).
6523 If this changes, consider moving this back into Lisp. */
6525 DEFUN ("next-single-property-change", Fnext_single_property_change,
6527 Return the position of next property change for a specific property.
6528 Scans characters forward from POS till it finds a change in the PROP
6529 property, then returns the position of the change. The optional third
6530 argument OBJECT is the buffer or string to scan (defaults to the current
6532 The property values are compared with `eq'.
6533 Return nil if the property is constant all the way to the end of BUFFER.
6534 If the value is non-nil, it is a position greater than POS, never equal.
6536 If the optional fourth argument LIMIT is non-nil, don't search
6537 past position LIMIT; return LIMIT if nothing is found before LIMIT.
6538 If two or more extents with conflicting non-nil values for PROP overlap
6539 a particular character, it is undefined which value is considered to be
6540 the value of PROP. (Note that this situation will not happen if you always
6541 use the text-property primitives.)
6543 (pos, prop, object, limit))
6547 Lisp_Object extent, value;
6550 object = decode_buffer_or_string (object);
6551 bpos = get_buffer_or_string_pos_char (object, pos, 0);
6554 blim = buffer_or_string_accessible_end_char (object);
6559 blim = get_buffer_or_string_pos_char (object, limit, 0);
6563 extent = Fextent_at (make_int (bpos), object, prop, Qnil, Qnil);
6565 value = Fextent_property (extent, prop, Qnil);
6571 bpos = XINT (Fnext_extent_change (make_int (bpos), object));
6573 break; /* property is the same all the way to the end */
6574 extent = Fextent_at (make_int (bpos), object, prop, Qnil, Qnil);
6575 if ((NILP (extent) && !NILP (value)) ||
6576 (!NILP (extent) && !EQ (value,
6577 Fextent_property (extent, prop, Qnil))))
6578 return make_int (bpos);
6581 /* I think it's more sensible for this function to return nil always
6582 in this situation and it used to do it this way, but it's been changed
6583 for FSF compatibility. */
6587 return make_int (blim);
6590 /* See comment on previous function about why this is written in C. */
6592 DEFUN ("previous-single-property-change", Fprevious_single_property_change,
6594 Return the position of next property change for a specific property.
6595 Scans characters backward from POS till it finds a change in the PROP
6596 property, then returns the position of the change. The optional third
6597 argument OBJECT is the buffer or string to scan (defaults to the current
6599 The property values are compared with `eq'.
6600 Return nil if the property is constant all the way to the start of BUFFER.
6601 If the value is non-nil, it is a position less than POS, never equal.
6603 If the optional fourth argument LIMIT is non-nil, don't search back
6604 past position LIMIT; return LIMIT if nothing is found until LIMIT.
6605 If two or more extents with conflicting non-nil values for PROP overlap
6606 a particular character, it is undefined which value is considered to be
6607 the value of PROP. (Note that this situation will not happen if you always
6608 use the text-property primitives.)
6610 (pos, prop, object, limit))
6614 Lisp_Object extent, value;
6617 object = decode_buffer_or_string (object);
6618 bpos = get_buffer_or_string_pos_char (object, pos, 0);
6621 blim = buffer_or_string_accessible_begin_char (object);
6626 blim = get_buffer_or_string_pos_char (object, limit, 0);
6630 /* extent-at refers to the character AFTER bpos, but we want the
6631 character before bpos. Thus the - 1. extent-at simply
6632 returns nil on bogus positions, so not to worry. */
6633 extent = Fextent_at (make_int (bpos - 1), object, prop, Qnil, Qnil);
6635 value = Fextent_property (extent, prop, Qnil);
6641 bpos = XINT (Fprevious_extent_change (make_int (bpos), object));
6643 break; /* property is the same all the way to the beginning */
6644 extent = Fextent_at (make_int (bpos - 1), object, prop, Qnil, Qnil);
6645 if ((NILP (extent) && !NILP (value)) ||
6646 (!NILP (extent) && !EQ (value,
6647 Fextent_property (extent, prop, Qnil))))
6648 return make_int (bpos);
6651 /* I think it's more sensible for this function to return nil always
6652 in this situation and it used to do it this way, but it's been changed
6653 for FSF compatibility. */
6657 return make_int (blim);
6660 #ifdef MEMORY_USAGE_STATS
6663 compute_buffer_extent_usage (struct buffer *b, struct overhead_stats *ovstats)
6665 /* #### not yet written */
6669 #endif /* MEMORY_USAGE_STATS */
6672 /************************************************************************/
6673 /* initialization */
6674 /************************************************************************/
6677 syms_of_extents (void)
6679 defsymbol (&Qextentp, "extentp");
6680 defsymbol (&Qextent_live_p, "extent-live-p");
6682 defsymbol (&Qall_extents_closed, "all-extents-closed");
6683 defsymbol (&Qall_extents_open, "all-extents-open");
6684 defsymbol (&Qall_extents_closed_open, "all-extents-closed-open");
6685 defsymbol (&Qall_extents_open_closed, "all-extents-open-closed");
6686 defsymbol (&Qstart_in_region, "start-in-region");
6687 defsymbol (&Qend_in_region, "end-in-region");
6688 defsymbol (&Qstart_and_end_in_region, "start-and-end-in-region");
6689 defsymbol (&Qstart_or_end_in_region, "start-or-end-in-region");
6690 defsymbol (&Qnegate_in_region, "negate-in-region");
6692 defsymbol (&Qdetached, "detached");
6693 defsymbol (&Qdestroyed, "destroyed");
6694 defsymbol (&Qbegin_glyph, "begin-glyph");
6695 defsymbol (&Qend_glyph, "end-glyph");
6696 defsymbol (&Qstart_open, "start-open");
6697 defsymbol (&Qend_open, "end-open");
6698 defsymbol (&Qstart_closed, "start-closed");
6699 defsymbol (&Qend_closed, "end-closed");
6700 defsymbol (&Qread_only, "read-only");
6701 /* defsymbol (&Qhighlight, "highlight"); in faces.c */
6702 defsymbol (&Qunique, "unique");
6703 defsymbol (&Qduplicable, "duplicable");
6704 defsymbol (&Qdetachable, "detachable");
6705 defsymbol (&Qpriority, "priority");
6706 defsymbol (&Qmouse_face, "mouse-face");
6707 defsymbol (&Qinitial_redisplay_function,"initial-redisplay-function");
6710 defsymbol (&Qglyph_layout, "glyph-layout"); /* backwards compatibility */
6711 defsymbol (&Qbegin_glyph_layout, "begin-glyph-layout");
6712 defsymbol (&Qend_glyph_layout, "end-glyph-layout");
6713 defsymbol (&Qoutside_margin, "outside-margin");
6714 defsymbol (&Qinside_margin, "inside-margin");
6715 defsymbol (&Qwhitespace, "whitespace");
6716 /* Qtext defined in general.c */
6718 defsymbol (&Qglyph_invisible, "glyph-invisible");
6720 defsymbol (&Qpaste_function, "paste-function");
6721 defsymbol (&Qcopy_function, "copy-function");
6723 defsymbol (&Qtext_prop, "text-prop");
6724 defsymbol (&Qtext_prop_extent_paste_function,
6725 "text-prop-extent-paste-function");
6728 DEFSUBR (Fextent_live_p);
6729 DEFSUBR (Fextent_detached_p);
6730 DEFSUBR (Fextent_start_position);
6731 DEFSUBR (Fextent_end_position);
6732 DEFSUBR (Fextent_object);
6733 DEFSUBR (Fextent_length);
6735 DEFSUBR (Fmake_extent);
6736 DEFSUBR (Fcopy_extent);
6737 DEFSUBR (Fdelete_extent);
6738 DEFSUBR (Fdetach_extent);
6739 DEFSUBR (Fset_extent_endpoints);
6740 DEFSUBR (Fnext_extent);
6741 DEFSUBR (Fprevious_extent);
6743 DEFSUBR (Fnext_e_extent);
6744 DEFSUBR (Fprevious_e_extent);
6746 DEFSUBR (Fnext_extent_change);
6747 DEFSUBR (Fprevious_extent_change);
6749 DEFSUBR (Fextent_parent);
6750 DEFSUBR (Fextent_children);
6751 DEFSUBR (Fset_extent_parent);
6753 DEFSUBR (Fextent_in_region_p);
6754 DEFSUBR (Fmap_extents);
6755 DEFSUBR (Fmap_extent_children);
6756 DEFSUBR (Fextent_at);
6758 DEFSUBR (Fset_extent_initial_redisplay_function);
6759 DEFSUBR (Fextent_face);
6760 DEFSUBR (Fset_extent_face);
6761 DEFSUBR (Fextent_mouse_face);
6762 DEFSUBR (Fset_extent_mouse_face);
6763 DEFSUBR (Fset_extent_begin_glyph);
6764 DEFSUBR (Fset_extent_end_glyph);
6765 DEFSUBR (Fextent_begin_glyph);
6766 DEFSUBR (Fextent_end_glyph);
6767 DEFSUBR (Fset_extent_begin_glyph_layout);
6768 DEFSUBR (Fset_extent_end_glyph_layout);
6769 DEFSUBR (Fextent_begin_glyph_layout);
6770 DEFSUBR (Fextent_end_glyph_layout);
6771 DEFSUBR (Fset_extent_priority);
6772 DEFSUBR (Fextent_priority);
6773 DEFSUBR (Fset_extent_property);
6774 DEFSUBR (Fset_extent_properties);
6775 DEFSUBR (Fextent_property);
6776 DEFSUBR (Fextent_properties);
6778 DEFSUBR (Fhighlight_extent);
6779 DEFSUBR (Fforce_highlight_extent);
6781 DEFSUBR (Finsert_extent);
6783 DEFSUBR (Fget_text_property);
6784 DEFSUBR (Fget_char_property);
6785 DEFSUBR (Fput_text_property);
6786 DEFSUBR (Fput_nonduplicable_text_property);
6787 DEFSUBR (Fadd_text_properties);
6788 DEFSUBR (Fadd_nonduplicable_text_properties);
6789 DEFSUBR (Fremove_text_properties);
6790 DEFSUBR (Ftext_prop_extent_paste_function);
6791 DEFSUBR (Fnext_single_property_change);
6792 DEFSUBR (Fprevious_single_property_change);
6796 vars_of_extents (void)
6798 DEFVAR_INT ("mouse-highlight-priority", &mouse_highlight_priority /*
6799 The priority to use for the mouse-highlighting pseudo-extent
6800 that is used to highlight extents with the `mouse-face' attribute set.
6801 See `set-extent-priority'.
6803 /* Set mouse-highlight-priority (which ends up being used both for the
6804 mouse-highlighting pseudo-extent and the primary selection extent)
6805 to a very high value because very few extents should override it.
6806 1000 gives lots of room below it for different-prioritized extents.
6807 10 doesn't. ediff, for example, likes to use priorities around 100.
6809 mouse_highlight_priority = /* 10 */ 1000;
6811 DEFVAR_LISP ("default-text-properties", &Vdefault_text_properties /*
6812 Property list giving default values for text properties.
6813 Whenever a character does not specify a value for a property, the value
6814 stored in this list is used instead. This only applies when the
6815 functions `get-text-property' or `get-char-property' are called.
6817 Vdefault_text_properties = Qnil;
6819 staticpro (&Vlast_highlighted_extent);
6820 Vlast_highlighted_extent = Qnil;
6822 Vextent_face_reusable_list = Fcons (Qnil, Qnil);
6823 staticpro (&Vextent_face_reusable_list);
6825 extent_auxiliary_defaults.begin_glyph = Qnil;
6826 extent_auxiliary_defaults.end_glyph = Qnil;
6827 extent_auxiliary_defaults.parent = Qnil;
6828 extent_auxiliary_defaults.children = Qnil;
6829 extent_auxiliary_defaults.priority = 0;
6830 extent_auxiliary_defaults.invisible = Qnil;
6831 extent_auxiliary_defaults.read_only = Qnil;
6832 extent_auxiliary_defaults.mouse_face = Qnil;
6833 extent_auxiliary_defaults.initial_redisplay_function = Qnil;
6834 extent_auxiliary_defaults.before_change_functions = Qnil;
6835 extent_auxiliary_defaults.after_change_functions = Qnil;
6839 complex_vars_of_extents (void)
6841 staticpro (&Vextent_face_memoize_hash_table);
6842 /* The memoize hash table maps from lists of symbols to lists of
6843 faces. It needs to be `equal' to implement the memoization.
6844 The reverse table maps in the other direction and just needs
6845 to do `eq' comparison because the lists of faces are already
6847 Vextent_face_memoize_hash_table =
6848 make_lisp_hash_table (100, HASH_TABLE_VALUE_WEAK, HASH_TABLE_EQUAL);
6849 staticpro (&Vextent_face_reverse_memoize_hash_table);
6850 Vextent_face_reverse_memoize_hash_table =
6851 make_lisp_hash_table (100, HASH_TABLE_KEY_WEAK, HASH_TABLE_EQ);