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, 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, 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 static const struct lrecord_description extent_description[] = {
2928 { XD_LISP_OBJECT, offsetof(struct extent, object), 2 },
2929 { XD_LISP_OBJECT, offsetof(struct extent, plist), 1 },
2933 DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS ("extent", extent,
2936 /* NOTE: If you declare a
2937 finalization method here,
2938 it will NOT be called.
2941 extent_equal, extent_hash,
2943 extent_getprop, extent_putprop,
2944 extent_remprop, extent_plist,
2948 mark_extent (Lisp_Object obj, void (*markobj) (Lisp_Object))
2950 struct extent *extent = XEXTENT (obj);
2952 markobj (extent_object (extent));
2953 markobj (extent_no_chase_normal_field (extent, face));
2954 return extent->plist;
2958 print_extent_1 (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
2960 EXTENT ext = XEXTENT (obj);
2961 EXTENT anc = extent_ancestor (ext);
2963 char buf[64], *bp = buf;
2965 /* Retrieve the ancestor and use it, for faster retrieval of properties */
2967 if (!NILP (extent_begin_glyph (anc))) *bp++ = '*';
2968 *bp++ = (extent_start_open_p (anc) ? '(': '[');
2969 if (extent_detached_p (ext))
2970 strcpy (bp, "detached");
2973 Bufpos from = XINT (Fextent_start_position (obj));
2974 Bufpos to = XINT (Fextent_end_position (obj));
2975 sprintf (bp, "%d, %d", from, to);
2978 *bp++ = (extent_end_open_p (anc) ? ')': ']');
2979 if (!NILP (extent_end_glyph (anc))) *bp++ = '*';
2982 if (!NILP (extent_read_only (anc))) *bp++ = '%';
2983 if (!NILP (extent_mouse_face (anc))) *bp++ = 'H';
2984 if (extent_unique_p (anc)) *bp++ = 'U';
2985 else if (extent_duplicable_p (anc)) *bp++ = 'D';
2986 if (!NILP (extent_invisible (anc))) *bp++ = 'I';
2988 if (!NILP (extent_read_only (anc)) || !NILP (extent_mouse_face (anc)) ||
2989 extent_unique_p (anc) ||
2990 extent_duplicable_p (anc) || !NILP (extent_invisible (anc)))
2993 write_c_string (buf, printcharfun);
2995 tail = extent_plist_slot (anc);
2997 for (; !NILP (tail); tail = Fcdr (Fcdr (tail)))
2999 Lisp_Object v = XCAR (XCDR (tail));
3000 if (NILP (v)) continue;
3001 print_internal (XCAR (tail), printcharfun, escapeflag);
3002 write_c_string (" ", printcharfun);
3005 sprintf (buf, "0x%lx", (long) ext);
3006 write_c_string (buf, printcharfun);
3010 print_extent (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
3014 CONST char *title = "";
3015 CONST char *name = "";
3016 CONST char *posttitle = "";
3017 Lisp_Object obj2 = Qnil;
3019 /* Destroyed extents have 't' in the object field, causing
3020 extent_object() to abort (maybe). */
3021 if (EXTENT_LIVE_P (XEXTENT (obj)))
3022 obj2 = extent_object (XEXTENT (obj));
3025 title = "no buffer";
3026 else if (BUFFERP (obj2))
3028 if (BUFFER_LIVE_P (XBUFFER (obj2)))
3031 name = (char *) XSTRING_DATA (XBUFFER (obj2)->name);
3035 title = "Killed Buffer";
3041 assert (STRINGP (obj2));
3042 title = "string \"";
3044 name = (char *) XSTRING_DATA (obj2);
3049 if (!EXTENT_LIVE_P (XEXTENT (obj)))
3050 error ("printing unreadable object #<destroyed extent>");
3052 error ("printing unreadable object #<extent 0x%lx>",
3053 (long) XEXTENT (obj));
3056 if (!EXTENT_LIVE_P (XEXTENT (obj)))
3057 write_c_string ("#<destroyed extent", printcharfun);
3060 char *buf = (char *)
3061 alloca (strlen (title) + strlen (name) + strlen (posttitle) + 1);
3062 write_c_string ("#<extent ", printcharfun);
3063 print_extent_1 (obj, printcharfun, escapeflag);
3064 write_c_string (extent_detached_p (XEXTENT (obj))
3065 ? " from " : " in ", printcharfun);
3066 sprintf (buf, "%s%s%s", title, name, posttitle);
3067 write_c_string (buf, printcharfun);
3073 error ("printing unreadable object #<extent>");
3074 write_c_string ("#<extent", printcharfun);
3076 write_c_string (">", printcharfun);
3080 properties_equal (EXTENT e1, EXTENT e2, int depth)
3082 /* When this function is called, all indirections have been followed.
3083 Thus, the indirection checks in the various macros below will not
3084 amount to anything, and could be removed. However, the time
3085 savings would probably not be significant. */
3086 if (!(EQ (extent_face (e1), extent_face (e2)) &&
3087 extent_priority (e1) == extent_priority (e2) &&
3088 internal_equal (extent_begin_glyph (e1), extent_begin_glyph (e2),
3090 internal_equal (extent_end_glyph (e1), extent_end_glyph (e2),
3094 /* compare the bit flags. */
3096 /* The has_aux field should not be relevant. */
3097 int e1_has_aux = e1->flags.has_aux;
3098 int e2_has_aux = e2->flags.has_aux;
3101 e1->flags.has_aux = e2->flags.has_aux = 0;
3102 value = memcmp (&e1->flags, &e2->flags, sizeof (e1->flags));
3103 e1->flags.has_aux = e1_has_aux;
3104 e2->flags.has_aux = e2_has_aux;
3109 /* compare the random elements of the plists. */
3110 return !plists_differ (extent_no_chase_plist (e1),
3111 extent_no_chase_plist (e2),
3116 extent_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
3118 struct extent *e1 = XEXTENT (obj1);
3119 struct extent *e2 = XEXTENT (obj2);
3121 (extent_start (e1) == extent_start (e2) &&
3122 extent_end (e1) == extent_end (e2) &&
3123 internal_equal (extent_object (e1), extent_object (e2), depth + 1) &&
3124 properties_equal (extent_ancestor (e1), extent_ancestor (e2),
3128 static unsigned long
3129 extent_hash (Lisp_Object obj, int depth)
3131 struct extent *e = XEXTENT (obj);
3132 /* No need to hash all of the elements; that would take too long.
3133 Just hash the most common ones. */
3134 return HASH3 (extent_start (e), extent_end (e),
3135 internal_hash (extent_object (e), depth + 1));
3139 extent_getprop (Lisp_Object obj, Lisp_Object prop)
3141 return Fextent_property (obj, prop, Qunbound);
3145 extent_putprop (Lisp_Object obj, Lisp_Object prop, Lisp_Object value)
3147 Fset_extent_property (obj, prop, value);
3152 extent_remprop (Lisp_Object obj, Lisp_Object prop)
3154 EXTENT ext = XEXTENT (obj);
3156 /* This list is taken from Fset_extent_property, and should be kept
3158 if (EQ (prop, Qread_only)
3159 || EQ (prop, Qunique)
3160 || EQ (prop, Qduplicable)
3161 || EQ (prop, Qinvisible)
3162 || EQ (prop, Qdetachable)
3163 || EQ (prop, Qdetached)
3164 || EQ (prop, Qdestroyed)
3165 || EQ (prop, Qpriority)
3167 || EQ (prop, Qinitial_redisplay_function)
3168 || EQ (prop, Qafter_change_functions)
3169 || EQ (prop, Qbefore_change_functions)
3170 || EQ (prop, Qmouse_face)
3171 || EQ (prop, Qhighlight)
3172 || EQ (prop, Qbegin_glyph_layout)
3173 || EQ (prop, Qend_glyph_layout)
3174 || EQ (prop, Qglyph_layout)
3175 || EQ (prop, Qbegin_glyph)
3176 || EQ (prop, Qend_glyph)
3177 || EQ (prop, Qstart_open)
3178 || EQ (prop, Qend_open)
3179 || EQ (prop, Qstart_closed)
3180 || EQ (prop, Qend_closed)
3181 || EQ (prop, Qkeymap))
3183 /* #### Is this correct, anyway? */
3187 return external_remprop (&ext->plist, prop, 0, ERROR_ME);
3191 extent_plist (Lisp_Object obj)
3193 return Fextent_properties (obj);
3197 /************************************************************************/
3198 /* basic extent accessors */
3199 /************************************************************************/
3201 /* These functions are for checking externally-passed extent objects
3202 and returning an extent's basic properties, which include the
3203 buffer the extent is associated with, the endpoints of the extent's
3204 range, the open/closed-ness of those endpoints, and whether the
3205 extent is detached. Manipulating these properties requires
3206 manipulating the ordered lists that hold extents; thus, functions
3207 to do that are in a later section. */
3209 /* Given a Lisp_Object that is supposed to be an extent, make sure it
3210 is OK and return an extent pointer. Extents can be in one of four
3214 2) detached and not associated with a buffer
3215 3) detached and associated with a buffer
3216 4) attached to a buffer
3218 If FLAGS is 0, types 2-4 are allowed. If FLAGS is DE_MUST_HAVE_BUFFER,
3219 types 3-4 are allowed. If FLAGS is DE_MUST_BE_ATTACHED, only type 4
3224 decode_extent (Lisp_Object extent_obj, unsigned int flags)
3229 CHECK_LIVE_EXTENT (extent_obj);
3230 extent = XEXTENT (extent_obj);
3231 obj = extent_object (extent);
3233 /* the following condition will fail if we're dealing with a freed extent */
3234 assert (NILP (obj) || BUFFERP (obj) || STRINGP (obj));
3236 if (flags & DE_MUST_BE_ATTACHED)
3237 flags |= DE_MUST_HAVE_BUFFER;
3239 /* if buffer is dead, then convert extent to have no buffer. */
3240 if (BUFFERP (obj) && !BUFFER_LIVE_P (XBUFFER (obj)))
3241 obj = extent_object (extent) = Qnil;
3243 assert (!NILP (obj) || extent_detached_p (extent));
3245 if ((NILP (obj) && (flags & DE_MUST_HAVE_BUFFER))
3246 || (extent_detached_p (extent) && (flags & DE_MUST_BE_ATTACHED)))
3248 signal_simple_error ("extent doesn't belong to a buffer or string",
3255 /* Note that the returned value is a buffer position, not a byte index. */
3258 extent_endpoint_external (Lisp_Object extent_obj, int endp)
3260 EXTENT extent = decode_extent (extent_obj, 0);
3262 if (extent_detached_p (extent))
3265 return make_int (extent_endpoint_bufpos (extent, endp));
3268 DEFUN ("extentp", Fextentp, 1, 1, 0, /*
3269 Return t if OBJECT is an extent.
3273 return EXTENTP (object) ? Qt : Qnil;
3276 DEFUN ("extent-live-p", Fextent_live_p, 1, 1, 0, /*
3277 Return t if OBJECT is an extent that has not been destroyed.
3281 return EXTENTP (object) && EXTENT_LIVE_P (XEXTENT (object)) ? Qt : Qnil;
3284 DEFUN ("extent-detached-p", Fextent_detached_p, 1, 1, 0, /*
3285 Return t if EXTENT is detached.
3289 return extent_detached_p (decode_extent (extent, 0)) ? Qt : Qnil;
3292 DEFUN ("extent-object", Fextent_object, 1, 1, 0, /*
3293 Return object (buffer or string) that EXTENT refers to.
3297 return extent_object (decode_extent (extent, 0));
3300 DEFUN ("extent-start-position", Fextent_start_position, 1, 1, 0, /*
3301 Return start position of EXTENT, or nil if EXTENT is detached.
3305 return extent_endpoint_external (extent, 0);
3308 DEFUN ("extent-end-position", Fextent_end_position, 1, 1, 0, /*
3309 Return end position of EXTENT, or nil if EXTENT is detached.
3313 return extent_endpoint_external (extent, 1);
3316 DEFUN ("extent-length", Fextent_length, 1, 1, 0, /*
3317 Return length of EXTENT in characters.
3321 EXTENT e = decode_extent (extent, DE_MUST_BE_ATTACHED);
3322 return make_int (extent_endpoint_bufpos (e, 1)
3323 - extent_endpoint_bufpos (e, 0));
3326 DEFUN ("next-extent", Fnext_extent, 1, 1, 0, /*
3327 Find next extent after EXTENT.
3328 If EXTENT is a buffer return the first extent in the buffer; likewise
3330 Extents in a buffer are ordered in what is called the "display"
3331 order, which sorts by increasing start positions and then by *decreasing*
3333 If you want to perform an operation on a series of extents, use
3334 `map-extents' instead of this function; it is much more efficient.
3335 The primary use of this function should be to enumerate all the
3336 extents in a buffer.
3337 Note: The display order is not necessarily the order that `map-extents'
3338 processes extents in!
3345 if (EXTENTP (extent))
3346 next = extent_next (decode_extent (extent, DE_MUST_BE_ATTACHED));
3348 next = extent_first (decode_buffer_or_string (extent));
3352 XSETEXTENT (val, next);
3356 DEFUN ("previous-extent", Fprevious_extent, 1, 1, 0, /*
3357 Find last extent before EXTENT.
3358 If EXTENT is a buffer return the last extent in the buffer; likewise
3360 This function is analogous to `next-extent'.
3367 if (EXTENTP (extent))
3368 prev = extent_previous (decode_extent (extent, DE_MUST_BE_ATTACHED));
3370 prev = extent_last (decode_buffer_or_string (extent));
3374 XSETEXTENT (val, prev);
3380 DEFUN ("next-e-extent", Fnext_e_extent, 1, 1, 0, /*
3381 Find next extent after EXTENT using the "e" order.
3382 If EXTENT is a buffer return the first extent in the buffer; likewise
3390 if (EXTENTP (extent))
3391 next = extent_e_next (decode_extent (extent, DE_MUST_BE_ATTACHED));
3393 next = extent_e_first (decode_buffer_or_string (extent));
3397 XSETEXTENT (val, next);
3401 DEFUN ("previous-e-extent", Fprevious_e_extent, 1, 1, 0, /*
3402 Find last extent before EXTENT using the "e" order.
3403 If EXTENT is a buffer return the last extent in the buffer; likewise
3405 This function is analogous to `next-e-extent'.
3412 if (EXTENTP (extent))
3413 prev = extent_e_previous (decode_extent (extent, DE_MUST_BE_ATTACHED));
3415 prev = extent_e_last (decode_buffer_or_string (extent));
3419 XSETEXTENT (val, prev);
3425 DEFUN ("next-extent-change", Fnext_extent_change, 1, 2, 0, /*
3426 Return the next position after POS where an extent begins or ends.
3427 If POS is at the end of the buffer or string, POS will be returned;
3428 otherwise a position greater than POS will always be returned.
3429 If BUFFER is nil, the current buffer is assumed.
3433 Lisp_Object obj = decode_buffer_or_string (object);
3436 bpos = get_buffer_or_string_pos_byte (obj, pos, GB_ALLOW_PAST_ACCESSIBLE);
3437 bpos = extent_find_end_of_run (obj, bpos, 1);
3438 return make_int (buffer_or_string_bytind_to_bufpos (obj, bpos));
3441 DEFUN ("previous-extent-change", Fprevious_extent_change, 1, 2, 0, /*
3442 Return the last position before POS where an extent begins or ends.
3443 If POS is at the beginning of the buffer or string, POS will be returned;
3444 otherwise a position less than POS will always be returned.
3445 If OBJECT is nil, the current buffer is assumed.
3449 Lisp_Object obj = decode_buffer_or_string (object);
3452 bpos = get_buffer_or_string_pos_byte (obj, pos, GB_ALLOW_PAST_ACCESSIBLE);
3453 bpos = extent_find_beginning_of_run (obj, bpos, 1);
3454 return make_int (buffer_or_string_bytind_to_bufpos (obj, bpos));
3458 /************************************************************************/
3459 /* parent and children stuff */
3460 /************************************************************************/
3462 DEFUN ("extent-parent", Fextent_parent, 1, 1, 0, /*
3463 Return the parent (if any) of EXTENT.
3464 If an extent has a parent, it derives all its properties from that extent
3465 and has no properties of its own. (The only "properties" that the
3466 extent keeps are the buffer/string it refers to and the start and end
3467 points.) It is possible for an extent's parent to itself have a parent.
3470 /* do I win the prize for the strangest split infinitive? */
3472 EXTENT e = decode_extent (extent, 0);
3473 return extent_parent (e);
3476 DEFUN ("extent-children", Fextent_children, 1, 1, 0, /*
3477 Return a list of the children (if any) of EXTENT.
3478 The children of an extent are all those extents whose parent is that extent.
3479 This function does not recursively trace children of children.
3480 \(To do that, use `extent-descendants'.)
3484 EXTENT e = decode_extent (extent, 0);
3485 Lisp_Object children = extent_children (e);
3487 if (!NILP (children))
3488 return Fcopy_sequence (XWEAK_LIST_LIST (children));
3494 remove_extent_from_children_list (EXTENT e, Lisp_Object child)
3496 Lisp_Object children = extent_children (e);
3498 #ifdef ERROR_CHECK_EXTENTS
3499 assert (!NILP (memq_no_quit (child, XWEAK_LIST_LIST (children))));
3501 XWEAK_LIST_LIST (children) =
3502 delq_no_quit (child, XWEAK_LIST_LIST (children));
3506 add_extent_to_children_list (EXTENT e, Lisp_Object child)
3508 Lisp_Object children = extent_children (e);
3510 if (NILP (children))
3512 children = make_weak_list (WEAK_LIST_SIMPLE);
3513 set_extent_no_chase_aux_field (e, children, children);
3516 #ifdef ERROR_CHECK_EXTENTS
3517 assert (NILP (memq_no_quit (child, XWEAK_LIST_LIST (children))));
3519 XWEAK_LIST_LIST (children) = Fcons (child, XWEAK_LIST_LIST (children));
3522 DEFUN ("set-extent-parent", Fset_extent_parent, 2, 2, 0, /*
3523 Set the parent of EXTENT to PARENT (may be nil).
3524 See `extent-parent'.
3528 EXTENT e = decode_extent (extent, 0);
3529 Lisp_Object cur_parent = extent_parent (e);
3532 XSETEXTENT (extent, e);
3534 CHECK_LIVE_EXTENT (parent);
3535 if (EQ (parent, cur_parent))
3537 for (rest = parent; !NILP (rest); rest = extent_parent (XEXTENT (rest)))
3538 if (EQ (rest, extent))
3539 signal_simple_error ("Circular parent chain would result", extent);
3542 remove_extent_from_children_list (XEXTENT (cur_parent), extent);
3543 set_extent_no_chase_aux_field (e, parent, Qnil);
3544 e->flags.has_parent = 0;
3548 add_extent_to_children_list (XEXTENT (parent), extent);
3549 set_extent_no_chase_aux_field (e, parent, parent);
3550 e->flags.has_parent = 1;
3552 /* changing the parent also changes the properties of all children. */
3554 int old_invis = (!NILP (cur_parent) &&
3555 !NILP (extent_invisible (XEXTENT (cur_parent))));
3556 int new_invis = (!NILP (parent) &&
3557 !NILP (extent_invisible (XEXTENT (parent))));
3559 extent_maybe_changed_for_redisplay (e, 1, new_invis != old_invis);
3566 /************************************************************************/
3567 /* basic extent mutators */
3568 /************************************************************************/
3570 /* Note: If you track non-duplicable extents by undo, you'll get bogus
3571 undo records for transient extents via update-extent.
3572 For example, query-replace will do this.
3576 set_extent_endpoints_1 (EXTENT extent, Memind start, Memind end)
3578 #ifdef ERROR_CHECK_EXTENTS
3579 Lisp_Object obj = extent_object (extent);
3581 assert (start <= end);
3584 assert (valid_memind_p (XBUFFER (obj), start));
3585 assert (valid_memind_p (XBUFFER (obj), end));
3589 /* Optimization: if the extent is already where we want it to be,
3591 if (!extent_detached_p (extent) && extent_start (extent) == start &&
3592 extent_end (extent) == end)
3595 if (extent_detached_p (extent))
3597 if (extent_duplicable_p (extent))
3599 Lisp_Object extent_obj;
3600 XSETEXTENT (extent_obj, extent);
3601 record_extent (extent_obj, 1);
3605 extent_detach (extent);
3607 set_extent_start (extent, start);
3608 set_extent_end (extent, end);
3609 extent_attach (extent);
3612 /* Set extent's endpoints to S and E, and put extent in buffer or string
3613 OBJECT. (If OBJECT is nil, do not change the extent's object.) */
3616 set_extent_endpoints (EXTENT extent, Bytind s, Bytind e, Lisp_Object object)
3622 object = extent_object (extent);
3623 assert (!NILP (object));
3625 else if (!EQ (object, extent_object (extent)))
3627 extent_detach (extent);
3628 extent_object (extent) = object;
3631 start = s < 0 ? extent_start (extent) :
3632 buffer_or_string_bytind_to_memind (object, s);
3633 end = e < 0 ? extent_end (extent) :
3634 buffer_or_string_bytind_to_memind (object, e);
3635 set_extent_endpoints_1 (extent, start, end);
3639 set_extent_openness (EXTENT extent, int start_open, int end_open)
3641 if (start_open != -1)
3642 extent_start_open_p (extent) = start_open;
3644 extent_end_open_p (extent) = end_open;
3645 /* changing the open/closedness of an extent does not affect
3650 make_extent_internal (Lisp_Object object, Bytind from, Bytind to)
3654 extent = make_extent_detached (object);
3655 set_extent_endpoints (extent, from, to, Qnil);
3660 copy_extent (EXTENT original, Bytind from, Bytind to, Lisp_Object object)
3664 e = make_extent_detached (object);
3666 set_extent_endpoints (e, from, to, Qnil);
3668 e->plist = Fcopy_sequence (original->plist);
3669 memcpy (&e->flags, &original->flags, sizeof (e->flags));
3670 if (e->flags.has_aux)
3672 /* also need to copy the aux struct. It won't work for
3673 this extent to share the same aux struct as the original
3675 struct extent_auxiliary *data =
3676 alloc_lcrecord_type (struct extent_auxiliary,
3677 &lrecord_extent_auxiliary);
3679 copy_lcrecord (data, XEXTENT_AUXILIARY (XCAR (original->plist)));
3680 XSETEXTENT_AUXILIARY (XCAR (e->plist), data);
3684 /* we may have just added another child to the parent extent. */
3685 Lisp_Object parent = extent_parent (e);
3689 XSETEXTENT (extent, e);
3690 add_extent_to_children_list (XEXTENT (parent), extent);
3698 destroy_extent (EXTENT extent)
3700 Lisp_Object rest, nextrest, children;
3701 Lisp_Object extent_obj;
3703 if (!extent_detached_p (extent))
3704 extent_detach (extent);
3705 /* disassociate the extent from its children and parent */
3706 children = extent_children (extent);
3707 if (!NILP (children))
3709 LIST_LOOP_DELETING (rest, nextrest, XWEAK_LIST_LIST (children))
3710 Fset_extent_parent (XCAR (rest), Qnil);
3712 XSETEXTENT (extent_obj, extent);
3713 Fset_extent_parent (extent_obj, Qnil);
3714 /* mark the extent as destroyed */
3715 extent_object (extent) = Qt;
3718 DEFUN ("make-extent", Fmake_extent, 2, 3, 0, /*
3719 Make an extent for the range [FROM, TO) in BUFFER-OR-STRING.
3720 BUFFER-OR-STRING defaults to the current buffer. Insertions at point
3721 TO will be outside of the extent; insertions at FROM will be inside the
3722 extent, causing the extent to grow. (This is the same way that markers
3723 behave.) You can change the behavior of insertions at the endpoints
3724 using `set-extent-property'. The extent is initially detached if both
3725 FROM and TO are nil, and in this case BUFFER-OR-STRING defaults to nil,
3726 meaning the extent is in no buffer and no string.
3728 (from, to, buffer_or_string))
3730 Lisp_Object extent_obj;
3733 obj = decode_buffer_or_string (buffer_or_string);
3734 if (NILP (from) && NILP (to))
3736 if (NILP (buffer_or_string))
3738 XSETEXTENT (extent_obj, make_extent_detached (obj));
3744 get_buffer_or_string_range_byte (obj, from, to, &start, &end,
3745 GB_ALLOW_PAST_ACCESSIBLE);
3746 XSETEXTENT (extent_obj, make_extent_internal (obj, start, end));
3751 DEFUN ("copy-extent", Fcopy_extent, 1, 2, 0, /*
3752 Make a copy of EXTENT. It is initially detached.
3753 Optional argument BUFFER-OR-STRING defaults to EXTENT's buffer or string.
3755 (extent, buffer_or_string))
3757 EXTENT ext = decode_extent (extent, 0);
3759 if (NILP (buffer_or_string))
3760 buffer_or_string = extent_object (ext);
3762 buffer_or_string = decode_buffer_or_string (buffer_or_string);
3764 XSETEXTENT (extent, copy_extent (ext, -1, -1, buffer_or_string));
3768 DEFUN ("delete-extent", Fdelete_extent, 1, 1, 0, /*
3769 Remove EXTENT from its buffer and destroy it.
3770 This does not modify the buffer's text, only its display properties.
3771 The extent cannot be used thereafter.
3777 /* We do not call decode_extent() here because already-destroyed
3779 CHECK_EXTENT (extent);
3780 ext = XEXTENT (extent);
3782 if (!EXTENT_LIVE_P (ext))
3784 destroy_extent (ext);
3788 DEFUN ("detach-extent", Fdetach_extent, 1, 1, 0, /*
3789 Remove EXTENT from its buffer in such a way that it can be re-inserted.
3790 An extent is also detached when all of its characters are all killed by a
3791 deletion, unless its `detachable' property has been unset.
3793 Extents which have the `duplicable' attribute are tracked by the undo
3794 mechanism. Detachment via `detach-extent' and string deletion is recorded,
3795 as is attachment via `insert-extent' and string insertion. Extent motion,
3796 face changes, and attachment via `make-extent' and `set-extent-endpoints'
3797 are not recorded. This means that extent changes which are to be undo-able
3798 must be performed by character editing, or by insertion and detachment of
3803 EXTENT ext = decode_extent (extent, 0);
3805 if (extent_detached_p (ext))
3807 if (extent_duplicable_p (ext))
3808 record_extent (extent, 0);
3809 extent_detach (ext);
3814 DEFUN ("set-extent-endpoints", Fset_extent_endpoints, 3, 4, 0, /*
3815 Set the endpoints of EXTENT to START, END.
3816 If START and END are null, call detach-extent on EXTENT.
3817 BUFFER-OR-STRING specifies the new buffer or string that the extent should
3818 be in, and defaults to EXTENT's buffer or string. (If nil, and EXTENT
3819 is in no buffer and no string, it defaults to the current buffer.)
3820 See documentation on `detach-extent' for a discussion of undo recording.
3822 (extent, start, end, buffer_or_string))
3827 ext = decode_extent (extent, 0);
3829 if (NILP (buffer_or_string))
3831 buffer_or_string = extent_object (ext);
3832 if (NILP (buffer_or_string))
3833 buffer_or_string = Fcurrent_buffer ();
3836 buffer_or_string = decode_buffer_or_string (buffer_or_string);
3838 if (NILP (start) && NILP (end))
3839 return Fdetach_extent (extent);
3841 get_buffer_or_string_range_byte (buffer_or_string, start, end, &s, &e,
3842 GB_ALLOW_PAST_ACCESSIBLE);
3844 set_extent_endpoints (ext, s, e, buffer_or_string);
3849 /************************************************************************/
3850 /* mapping over extents */
3851 /************************************************************************/
3854 decode_map_extents_flags (Lisp_Object flags)
3856 unsigned int retval = 0;
3857 unsigned int all_extents_specified = 0;
3858 unsigned int in_region_specified = 0;
3860 if (EQ (flags, Qt)) /* obsoleteness compatibility */
3861 return ME_END_CLOSED;
3864 if (SYMBOLP (flags))
3865 flags = Fcons (flags, Qnil);
3866 while (!NILP (flags))
3872 if (EQ (sym, Qall_extents_closed) || EQ (sym, Qall_extents_open) ||
3873 EQ (sym, Qall_extents_closed_open) ||
3874 EQ (sym, Qall_extents_open_closed))
3876 if (all_extents_specified)
3877 error ("Only one `all-extents-*' flag may be specified");
3878 all_extents_specified = 1;
3880 if (EQ (sym, Qstart_in_region) || EQ (sym, Qend_in_region) ||
3881 EQ (sym, Qstart_and_end_in_region) ||
3882 EQ (sym, Qstart_or_end_in_region))
3884 if (in_region_specified)
3885 error ("Only one `*-in-region' flag may be specified");
3886 in_region_specified = 1;
3889 /* I do so love that conditional operator ... */
3891 EQ (sym, Qend_closed) ? ME_END_CLOSED :
3892 EQ (sym, Qstart_open) ? ME_START_OPEN :
3893 EQ (sym, Qall_extents_closed) ? ME_ALL_EXTENTS_CLOSED :
3894 EQ (sym, Qall_extents_open) ? ME_ALL_EXTENTS_OPEN :
3895 EQ (sym, Qall_extents_closed_open) ? ME_ALL_EXTENTS_CLOSED_OPEN :
3896 EQ (sym, Qall_extents_open_closed) ? ME_ALL_EXTENTS_OPEN_CLOSED :
3897 EQ (sym, Qstart_in_region) ? ME_START_IN_REGION :
3898 EQ (sym, Qend_in_region) ? ME_END_IN_REGION :
3899 EQ (sym, Qstart_and_end_in_region) ? ME_START_AND_END_IN_REGION :
3900 EQ (sym, Qstart_or_end_in_region) ? ME_START_OR_END_IN_REGION :
3901 EQ (sym, Qnegate_in_region) ? ME_NEGATE_IN_REGION :
3902 (signal_simple_error ("Invalid `map-extents' flag", sym), 0);
3904 flags = XCDR (flags);
3909 DEFUN ("extent-in-region-p", Fextent_in_region_p, 1, 4, 0, /*
3910 Return whether EXTENT overlaps a specified region.
3911 This is equivalent to whether `map-extents' would visit EXTENT when called
3914 (extent, from, to, flags))
3917 EXTENT ext = decode_extent (extent, DE_MUST_BE_ATTACHED);
3918 Lisp_Object obj = extent_object (ext);
3920 get_buffer_or_string_range_byte (obj, from, to, &start, &end, GB_ALLOW_NIL |
3921 GB_ALLOW_PAST_ACCESSIBLE);
3923 return extent_in_region_p (ext, start, end, decode_map_extents_flags (flags)) ?
3927 struct slow_map_extents_arg
3929 Lisp_Object map_arg;
3930 Lisp_Object map_routine;
3932 Lisp_Object property;
3937 slow_map_extents_function (EXTENT extent, void *arg)
3939 /* This function can GC */
3940 struct slow_map_extents_arg *closure = (struct slow_map_extents_arg *) arg;
3941 Lisp_Object extent_obj;
3943 XSETEXTENT (extent_obj, extent);
3945 /* make sure this extent qualifies according to the PROPERTY
3948 if (!NILP (closure->property))
3950 Lisp_Object value = Fextent_property (extent_obj, closure->property,
3952 if ((NILP (closure->value) && NILP (value)) ||
3953 (!NILP (closure->value) && !EQ (value, closure->value)))
3957 closure->result = call2 (closure->map_routine, extent_obj,
3959 return !NILP (closure->result);
3962 DEFUN ("map-extents", Fmap_extents, 1, 8, 0, /*
3963 Map FUNCTION over the extents which overlap a region in OBJECT.
3964 OBJECT is normally a buffer or string but could be an extent (see below).
3965 The region is normally bounded by [FROM, TO) (i.e. the beginning of the
3966 region is closed and the end of the region is open), but this can be
3967 changed with the FLAGS argument (see below for a complete discussion).
3969 FUNCTION is called with the arguments (extent, MAPARG). The arguments
3970 OBJECT, FROM, TO, MAPARG, and FLAGS are all optional and default to
3971 the current buffer, the beginning of OBJECT, the end of OBJECT, nil,
3972 and nil, respectively. `map-extents' returns the first non-nil result
3973 produced by FUNCTION, and no more calls to FUNCTION are made after it
3976 If OBJECT is an extent, FROM and TO default to the extent's endpoints,
3977 and the mapping omits that extent and its predecessors. This feature
3978 supports restarting a loop based on `map-extents'. Note: OBJECT must
3979 be attached to a buffer or string, and the mapping is done over that
3982 An extent overlaps the region if there is any point in the extent that is
3983 also in the region. (For the purpose of overlap, zero-length extents and
3984 regions are treated as closed on both ends regardless of their endpoints'
3985 specified open/closedness.) Note that the endpoints of an extent or region
3986 are considered to be in that extent or region if and only if the
3987 corresponding end is closed. For example, the extent [5,7] overlaps the
3988 region [2,5] because 5 is in both the extent and the region. However, (5,7]
3989 does not overlap [2,5] because 5 is not in the extent, and neither [5,7] nor
3990 \(5,7] overlaps the region [2,5) because 5 is not in the region.
3992 The optional FLAGS can be a symbol or a list of one or more symbols,
3993 modifying the behavior of `map-extents'. Allowed symbols are:
3995 end-closed The region's end is closed.
3997 start-open The region's start is open.
3999 all-extents-closed Treat all extents as closed on both ends for the
4000 purpose of determining whether they overlap the
4001 region, irrespective of their actual open- or
4003 all-extents-open Treat all extents as open on both ends.
4004 all-extents-closed-open Treat all extents as start-closed, end-open.
4005 all-extents-open-closed Treat all extents as start-open, end-closed.
4007 start-in-region In addition to the above conditions for extent
4008 overlap, the extent's start position must lie within
4009 the specified region. Note that, for this
4010 condition, open start positions are treated as if
4011 0.5 was added to the endpoint's value, and open
4012 end positions are treated as if 0.5 was subtracted
4013 from the endpoint's value.
4014 end-in-region The extent's end position must lie within the
4016 start-and-end-in-region Both the extent's start and end positions must lie
4018 start-or-end-in-region Either the extent's start or end position must lie
4021 negate-in-region The condition specified by a `*-in-region' flag
4022 must NOT hold for the extent to be considered.
4025 At most one of `all-extents-closed', `all-extents-open',
4026 `all-extents-closed-open', and `all-extents-open-closed' may be specified.
4028 At most one of `start-in-region', `end-in-region',
4029 `start-and-end-in-region', and `start-or-end-in-region' may be specified.
4031 If optional arg PROPERTY is non-nil, only extents with that property set
4032 on them will be visited. If optional arg VALUE is non-nil, only extents
4033 whose value for that property is `eq' to VALUE will be visited.
4035 (function, object, from, to, maparg, flags, property, value))
4037 /* This function can GC */
4038 struct slow_map_extents_arg closure;
4039 unsigned int me_flags;
4041 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
4044 if (EXTENTP (object))
4046 after = decode_extent (object, DE_MUST_BE_ATTACHED);
4048 from = Fextent_start_position (object);
4050 to = Fextent_end_position (object);
4051 object = extent_object (after);
4054 object = decode_buffer_or_string (object);
4056 get_buffer_or_string_range_byte (object, from, to, &start, &end,
4057 GB_ALLOW_NIL | GB_ALLOW_PAST_ACCESSIBLE);
4059 me_flags = decode_map_extents_flags (flags);
4061 if (!NILP (property))
4064 value = canonicalize_extent_property (property, value);
4067 GCPRO5 (function, maparg, object, property, value);
4069 closure.map_arg = maparg;
4070 closure.map_routine = function;
4071 closure.result = Qnil;
4072 closure.property = property;
4073 closure.value = value;
4075 map_extents_bytind (start, end, slow_map_extents_function,
4076 (void *) &closure, object, after,
4077 /* You never know what the user might do ... */
4078 me_flags | ME_MIGHT_CALL_ELISP);
4081 return closure.result;
4085 /************************************************************************/
4086 /* mapping over extents -- other functions */
4087 /************************************************************************/
4089 /* ------------------------------- */
4090 /* map-extent-children */
4091 /* ------------------------------- */
4093 struct slow_map_extent_children_arg
4095 Lisp_Object map_arg;
4096 Lisp_Object map_routine;
4098 Lisp_Object property;
4106 slow_map_extent_children_function (EXTENT extent, void *arg)
4108 /* This function can GC */
4109 struct slow_map_extent_children_arg *closure =
4110 (struct slow_map_extent_children_arg *) arg;
4111 Lisp_Object extent_obj;
4112 Bytind start = extent_endpoint_bytind (extent, 0);
4113 Bytind end = extent_endpoint_bytind (extent, 1);
4114 /* Make sure the extent starts inside the region of interest,
4115 rather than just overlaps it.
4117 if (start < closure->start_min)
4119 /* Make sure the extent is not a child of a previous visited one.
4120 We know already, because of extent ordering,
4121 that start >= prev_start, and that if
4122 start == prev_start, then end <= prev_end.
4124 if (start == closure->prev_start)
4126 if (end < closure->prev_end)
4129 else /* start > prev_start */
4131 if (start < closure->prev_end)
4133 /* corner case: prev_end can be -1 if there is no prev */
4135 XSETEXTENT (extent_obj, extent);
4137 /* make sure this extent qualifies according to the PROPERTY
4140 if (!NILP (closure->property))
4142 Lisp_Object value = Fextent_property (extent_obj, closure->property,
4144 if ((NILP (closure->value) && NILP (value)) ||
4145 (!NILP (closure->value) && !EQ (value, closure->value)))
4149 closure->result = call2 (closure->map_routine, extent_obj,
4152 /* Since the callback may change the buffer, compute all stored
4153 buffer positions here.
4155 closure->start_min = -1; /* no need for this any more */
4156 closure->prev_start = extent_endpoint_bytind (extent, 0);
4157 closure->prev_end = extent_endpoint_bytind (extent, 1);
4159 return !NILP (closure->result);
4162 DEFUN ("map-extent-children", Fmap_extent_children, 1, 8, 0, /*
4163 Map FUNCTION over the extents in the region from FROM to TO.
4164 FUNCTION is called with arguments (extent, MAPARG). See `map-extents'
4165 for a full discussion of the arguments FROM, TO, and FLAGS.
4167 The arguments are the same as for `map-extents', but this function differs
4168 in that it only visits extents which start in the given region, and also
4169 in that, after visiting an extent E, it skips all other extents which start
4170 inside E but end before E's end.
4172 Thus, this function may be used to walk a tree of extents in a buffer:
4173 (defun walk-extents (buffer &optional ignore)
4174 (map-extent-children 'walk-extents buffer))
4176 (function, object, from, to, maparg, flags, property, value))
4178 /* This function can GC */
4179 struct slow_map_extent_children_arg closure;
4180 unsigned int me_flags;
4182 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
4185 if (EXTENTP (object))
4187 after = decode_extent (object, DE_MUST_BE_ATTACHED);
4189 from = Fextent_start_position (object);
4191 to = Fextent_end_position (object);
4192 object = extent_object (after);
4195 object = decode_buffer_or_string (object);
4197 get_buffer_or_string_range_byte (object, from, to, &start, &end,
4198 GB_ALLOW_NIL | GB_ALLOW_PAST_ACCESSIBLE);
4200 me_flags = decode_map_extents_flags (flags);
4202 if (!NILP (property))
4205 value = canonicalize_extent_property (property, value);
4208 GCPRO5 (function, maparg, object, property, value);
4210 closure.map_arg = maparg;
4211 closure.map_routine = function;
4212 closure.result = Qnil;
4213 closure.property = property;
4214 closure.value = value;
4215 closure.start_min = start;
4216 closure.prev_start = -1;
4217 closure.prev_end = -1;
4218 map_extents_bytind (start, end, slow_map_extent_children_function,
4219 (void *) &closure, object, after,
4220 /* You never know what the user might do ... */
4221 me_flags | ME_MIGHT_CALL_ELISP);
4224 return closure.result;
4227 /* ------------------------------- */
4229 /* ------------------------------- */
4231 /* find "smallest" matching extent containing pos -- (flag == 0) means
4232 all extents match, else (EXTENT_FLAGS (extent) & flag) must be true;
4233 for more than one matching extent with precisely the same endpoints,
4234 we choose the last extent in the extents_list.
4235 The search stops just before "before", if that is non-null.
4238 struct extent_at_arg
4254 static enum extent_at_flag
4255 decode_extent_at_flag (Lisp_Object at_flag)
4258 return EXTENT_AT_AFTER;
4260 CHECK_SYMBOL (at_flag);
4261 if (EQ (at_flag, Qafter)) return EXTENT_AT_AFTER;
4262 if (EQ (at_flag, Qbefore)) return EXTENT_AT_BEFORE;
4263 if (EQ (at_flag, Qat)) return EXTENT_AT_AT;
4265 signal_simple_error ("Invalid AT-FLAG in `extent-at'", at_flag);
4266 return EXTENT_AT_AFTER; /* unreached */
4270 extent_at_mapper (EXTENT e, void *arg)
4272 struct extent_at_arg *closure = (struct extent_at_arg *) arg;
4274 if (e == closure->before)
4277 /* If closure->prop is non-nil, then the extent is only acceptable
4278 if it has a non-nil value for that property. */
4279 if (!NILP (closure->prop))
4282 XSETEXTENT (extent, e);
4283 if (NILP (Fextent_property (extent, closure->prop, Qnil)))
4288 EXTENT current = closure->best_match;
4292 /* redundant but quick test */
4293 else if (extent_start (current) > extent_start (e))
4296 /* we return the "last" best fit, instead of the first --
4297 this is because then the glyph closest to two equivalent
4298 extents corresponds to the "extent-at" the text just past
4300 else if (!EXTENT_LESS_VALS (e, closure->best_start,
4306 closure->best_match = e;
4307 closure->best_start = extent_start (e);
4308 closure->best_end = extent_end (e);
4315 extent_at_bytind (Bytind position, Lisp_Object object, Lisp_Object property,
4316 EXTENT before, enum extent_at_flag at_flag)
4318 struct extent_at_arg closure;
4319 Lisp_Object extent_obj;
4321 /* it might be argued that invalid positions should cause
4322 errors, but the principle of least surprise dictates that
4323 nil should be returned (extent-at is often used in
4324 response to a mouse event, and in many cases previous events
4325 have changed the buffer contents).
4327 Also, the openness stuff in the text-property code currently
4328 does not check its limits and might go off the end. */
4329 if ((at_flag == EXTENT_AT_BEFORE
4330 ? position <= buffer_or_string_absolute_begin_byte (object)
4331 : position < buffer_or_string_absolute_begin_byte (object))
4332 || (at_flag == EXTENT_AT_AFTER
4333 ? position >= buffer_or_string_absolute_end_byte (object)
4334 : position > buffer_or_string_absolute_end_byte (object)))
4337 closure.best_match = 0;
4338 closure.prop = property;
4339 closure.before = before;
4341 map_extents_bytind (at_flag == EXTENT_AT_BEFORE ? position - 1 : position,
4342 at_flag == EXTENT_AT_AFTER ? position + 1 : position,
4343 extent_at_mapper, (void *) &closure, object, 0,
4344 ME_START_OPEN | ME_ALL_EXTENTS_CLOSED);
4346 if (!closure.best_match)
4349 XSETEXTENT (extent_obj, closure.best_match);
4353 DEFUN ("extent-at", Fextent_at, 1, 5, 0, /*
4354 Find "smallest" extent at POS in OBJECT having PROPERTY set.
4355 Normally, an extent is "at" POS if it overlaps the region (POS, POS+1);
4356 i.e. if it covers the character after POS. (However, see the definition
4357 of AT-FLAG.) "Smallest" means the extent that comes last in the display
4358 order; this normally means the extent whose start position is closest to
4359 POS. See `next-extent' for more information.
4360 OBJECT specifies a buffer or string and defaults to the current buffer.
4361 PROPERTY defaults to nil, meaning that any extent will do.
4362 Properties are attached to extents with `set-extent-property', which see.
4363 Returns nil if POS is invalid or there is no matching extent at POS.
4364 If the fourth argument BEFORE is not nil, it must be an extent; any returned
4365 extent will precede that extent. This feature allows `extent-at' to be
4366 used by a loop over extents.
4367 AT-FLAG controls how end cases are handled, and should be one of:
4369 nil or `after' An extent is at POS if it covers the character
4370 after POS. This is consistent with the way
4371 that text properties work.
4372 `before' An extent is at POS if it covers the character
4374 `at' An extent is at POS if it overlaps or abuts POS.
4375 This includes all zero-length extents at POS.
4377 Note that in all cases, the start-openness and end-openness of the extents
4378 considered is ignored. If you want to pay attention to those properties,
4379 you should use `map-extents', which gives you more control.
4381 (pos, object, property, before, at_flag))
4384 EXTENT before_extent;
4385 enum extent_at_flag fl;
4387 object = decode_buffer_or_string (object);
4388 position = get_buffer_or_string_pos_byte (object, pos, GB_NO_ERROR_IF_BAD);
4392 before_extent = decode_extent (before, DE_MUST_BE_ATTACHED);
4393 if (before_extent && !EQ (object, extent_object (before_extent)))
4394 signal_simple_error ("extent not in specified buffer or string", object);
4395 fl = decode_extent_at_flag (at_flag);
4397 return extent_at_bytind (position, object, property, before_extent, fl);
4400 /* ------------------------------- */
4401 /* verify_extent_modification() */
4402 /* ------------------------------- */
4404 /* verify_extent_modification() is called when a buffer or string is
4405 modified to check whether the modification is occuring inside a
4409 struct verify_extents_arg
4414 Lisp_Object iro; /* value of inhibit-read-only */
4418 verify_extent_mapper (EXTENT extent, void *arg)
4420 struct verify_extents_arg *closure = (struct verify_extents_arg *) arg;
4421 Lisp_Object prop = extent_read_only (extent);
4426 if (CONSP (closure->iro) && !NILP (Fmemq (prop, closure->iro)))
4429 #if 0 /* Nobody seems to care for this any more -sb */
4430 /* Allow deletion if the extent is completely contained in
4431 the region being deleted.
4432 This is important for supporting tokens which are internally
4433 write-protected, but which can be killed and yanked as a whole.
4434 Ignore open/closed distinctions at this point.
4437 if (closure->start != closure->end &&
4438 extent_start (extent) >= closure->start &&
4439 extent_end (extent) <= closure->end)
4444 Fsignal (Qbuffer_read_only, (list1 (closure->object)));
4446 RETURN_NOT_REACHED(0)
4449 /* Value of Vinhibit_read_only is precomputed and passed in for
4453 verify_extent_modification (Lisp_Object object, Bytind from, Bytind to,
4454 Lisp_Object inhibit_read_only_value)
4457 struct verify_extents_arg closure;
4459 /* If insertion, visit closed-endpoint extents touching the insertion
4460 point because the text would go inside those extents. If deletion,
4461 treat the range as open on both ends so that touching extents are not
4462 visited. Note that we assume that an insertion is occurring if the
4463 changed range has zero length, and a deletion otherwise. This
4464 fails if a change (i.e. non-insertion, non-deletion) is happening.
4465 As far as I know, this doesn't currently occur in XEmacs. --ben */
4466 closed = (from==to);
4467 closure.object = object;
4468 closure.start = buffer_or_string_bytind_to_memind (object, from);
4469 closure.end = buffer_or_string_bytind_to_memind (object, to);
4470 closure.iro = inhibit_read_only_value;
4472 map_extents_bytind (from, to, verify_extent_mapper, (void *) &closure,
4473 object, 0, closed ? ME_END_CLOSED : ME_START_OPEN);
4476 /* ------------------------------------ */
4477 /* process_extents_for_insertion() */
4478 /* ------------------------------------ */
4480 struct process_extents_for_insertion_arg
4487 /* A region of length LENGTH was just inserted at OPOINT. Modify all
4488 of the extents as required for the insertion, based on their
4489 start-open/end-open properties.
4493 process_extents_for_insertion_mapper (EXTENT extent, void *arg)
4495 struct process_extents_for_insertion_arg *closure =
4496 (struct process_extents_for_insertion_arg *) arg;
4497 Memind indice = buffer_or_string_bytind_to_memind (closure->object,
4500 /* When this function is called, one end of the newly-inserted text should
4501 be adjacent to some endpoint of the extent, or disjoint from it. If
4502 the insertion overlaps any existing extent, something is wrong.
4504 #ifdef ERROR_CHECK_EXTENTS
4505 if (extent_start (extent) > indice &&
4506 extent_start (extent) < indice + closure->length)
4508 if (extent_end (extent) > indice &&
4509 extent_end (extent) < indice + closure->length)
4513 /* The extent-adjustment code adjusted the extent's endpoints as if
4514 they were markers -- endpoints at the gap (i.e. the insertion
4515 point) go to the left of the insertion point, which is correct
4516 for [) extents. We need to fix the other kinds of extents.
4518 Note that both conditions below will hold for zero-length (]
4519 extents at the gap. Zero-length () extents would get adjusted
4520 such that their start is greater than their end; we treat them
4521 as [) extents. This is unfortunately an inelegant part of the
4522 extent model, but there is no way around it. */
4525 Memind new_start, new_end;
4527 new_start = extent_start (extent);
4528 new_end = extent_end (extent);
4529 if (indice == extent_start (extent) && extent_start_open_p (extent) &&
4530 /* coerce zero-length () extents to [) */
4531 new_start != new_end)
4532 new_start += closure->length;
4533 if (indice == extent_end (extent) && !extent_end_open_p (extent))
4534 new_end += closure->length;
4535 set_extent_endpoints_1 (extent, new_start, new_end);
4542 process_extents_for_insertion (Lisp_Object object, Bytind opoint,
4545 struct process_extents_for_insertion_arg closure;
4547 closure.opoint = opoint;
4548 closure.length = length;
4549 closure.object = object;
4551 map_extents_bytind (opoint, opoint + length,
4552 process_extents_for_insertion_mapper,
4553 (void *) &closure, object, 0,
4554 ME_END_CLOSED | ME_MIGHT_MODIFY_EXTENTS |
4555 ME_INCLUDE_INTERNAL);
4558 /* ------------------------------------ */
4559 /* process_extents_for_deletion() */
4560 /* ------------------------------------ */
4562 struct process_extents_for_deletion_arg
4565 int destroy_included_extents;
4568 /* This function is called when we're about to delete the range [from, to].
4569 Detach all of the extents that are completely inside the range [from, to],
4570 if they're detachable or open-open. */
4573 process_extents_for_deletion_mapper (EXTENT extent, void *arg)
4575 struct process_extents_for_deletion_arg *closure =
4576 (struct process_extents_for_deletion_arg *) arg;
4578 /* If the extent lies completely within the range that
4579 is being deleted, then nuke the extent if it's detachable
4580 (otherwise, it will become a zero-length extent). */
4582 if (closure->start <= extent_start (extent) &&
4583 extent_end (extent) <= closure->end)
4585 if (extent_detachable_p (extent))
4587 if (closure->destroy_included_extents)
4588 destroy_extent (extent);
4590 extent_detach (extent);
4597 /* DESTROY_THEM means destroy the extents instead of just deleting them.
4598 It is unused currently, but perhaps might be used (there used to
4599 be a function process_extents_for_destruction(), #if 0'd out,
4600 that did the equivalent). */
4602 process_extents_for_deletion (Lisp_Object object, Bytind from,
4603 Bytind to, int destroy_them)
4605 struct process_extents_for_deletion_arg closure;
4607 closure.start = buffer_or_string_bytind_to_memind (object, from);
4608 closure.end = buffer_or_string_bytind_to_memind (object, to);
4609 closure.destroy_included_extents = destroy_them;
4611 map_extents_bytind (from, to, process_extents_for_deletion_mapper,
4612 (void *) &closure, object, 0,
4613 ME_END_CLOSED | ME_MIGHT_MODIFY_EXTENTS);
4616 /* ------------------------------- */
4617 /* report_extent_modification() */
4618 /* ------------------------------- */
4619 struct report_extent_modification_closure {
4626 /* This juggling with the pointer to another file's global variable is
4627 kind of yucky. Perhaps I should just export the variable. */
4628 static int *inside_change_hook_pointer;
4631 report_extent_modification_restore (Lisp_Object buffer)
4633 *inside_change_hook_pointer = 0;
4634 if (current_buffer != XBUFFER (buffer))
4635 Fset_buffer (buffer);
4640 report_extent_modification_mapper (EXTENT extent, void *arg)
4642 struct report_extent_modification_closure *closure =
4643 (struct report_extent_modification_closure *)arg;
4644 Lisp_Object exobj, startobj, endobj;
4645 Lisp_Object hook = (closure->afterp
4646 ? extent_after_change_functions (extent)
4647 : extent_before_change_functions (extent));
4651 XSETEXTENT (exobj, extent);
4652 XSETINT (startobj, closure->start);
4653 XSETINT (endobj, closure->end);
4655 /* Now that we are sure to call elisp, set up an unwind-protect so
4656 inside_change_hook gets restored in case we throw. Also record
4657 the current buffer, in case we change it. Do the recording only
4659 if (closure->speccount == -1)
4661 closure->speccount = specpdl_depth ();
4662 record_unwind_protect (report_extent_modification_restore,
4663 Fcurrent_buffer ());
4666 /* The functions will expect closure->buffer to be the current
4667 buffer, so change it if it isn't. */
4668 if (current_buffer != XBUFFER (closure->buffer))
4669 Fset_buffer (closure->buffer);
4671 /* #### It's a shame that we can't use any of the existing run_hook*
4672 functions here. This is so because all of them work with
4673 symbols, to be able to retrieve default values of local hooks.
4676 if (!CONSP (hook) || EQ (XCAR (hook), Qlambda))
4677 call3 (hook, exobj, startobj, endobj);
4681 EXTERNAL_LIST_LOOP (tail, hook)
4682 call3 (XCAR (tail), exobj, startobj, endobj);
4688 report_extent_modification (Lisp_Object buffer, Bufpos start, Bufpos end,
4689 int *inside, int afterp)
4691 struct report_extent_modification_closure closure;
4693 closure.buffer = buffer;
4694 closure.start = start;
4696 closure.afterp = afterp;
4697 closure.speccount = -1;
4699 inside_change_hook_pointer = inside;
4702 map_extents (start, end, report_extent_modification_mapper, (void *)&closure,
4703 buffer, NULL, ME_MIGHT_CALL_ELISP);
4705 if (closure.speccount == -1)
4709 /* We mustn't unbind when closure.speccount != -1 because
4710 map_extents_bytind has already done that. */
4711 assert (*inside == 0);
4716 /************************************************************************/
4717 /* extent properties */
4718 /************************************************************************/
4721 set_extent_invisible (EXTENT extent, Lisp_Object value)
4723 if (!EQ (extent_invisible (extent), value))
4725 set_extent_invisible_1 (extent, value);
4726 extent_changed_for_redisplay (extent, 1, 1);
4730 /* This function does "memoization" -- similar to the interning
4731 that happens with symbols. Given a list of faces, an equivalent
4732 list is returned such that if this function is called twice with
4733 input that is `equal', the resulting outputs will be `eq'.
4735 Note that the inputs and outputs are in general *not* `equal' --
4736 faces in symbol form become actual face objects in the output.
4737 This is necessary so that temporary faces stay around. */
4740 memoize_extent_face_internal (Lisp_Object list)
4744 Lisp_Object cons, thecons;
4745 Lisp_Object oldtail, tail;
4746 struct gcpro gcpro1;
4751 return Fget_face (list);
4753 /* To do the memoization, we use a hash table mapping from
4754 external lists to internal lists. We do `equal' comparisons
4755 on the keys so the memoization works correctly.
4757 Note that we canonicalize things so that the keys in the
4758 hash table (the external lists) always contain symbols and
4759 the values (the internal lists) always contain face objects.
4761 We also maintain a "reverse" table that maps from the internal
4762 lists to the external equivalents. The idea here is twofold:
4764 1) `extent-face' wants to return a list containing face symbols
4765 rather than face objects.
4766 2) We don't want things to get quite so messed up if the user
4767 maliciously side-effects the returned lists.
4770 len = XINT (Flength (list));
4771 thelen = XINT (Flength (Vextent_face_reusable_list));
4776 /* We canonicalize the given list into another list.
4777 We try to avoid consing except when necessary, so we have
4783 cons = Vextent_face_reusable_list;
4784 while (!NILP (XCDR (cons)))
4786 XCDR (cons) = Fmake_list (make_int (len - thelen), Qnil);
4788 else if (thelen > len)
4792 /* Truncate the list temporarily so it's the right length;
4793 remember the old tail. */
4794 cons = Vextent_face_reusable_list;
4795 for (i = 0; i < len - 1; i++)
4798 oldtail = XCDR (cons);
4802 thecons = Vextent_face_reusable_list;
4803 EXTERNAL_LIST_LOOP (cons, list)
4805 Lisp_Object face = Fget_face (XCAR (cons));
4807 XCAR (thecons) = Fface_name (face);
4808 thecons = XCDR (thecons);
4811 list = Fgethash (Vextent_face_reusable_list, Vextent_face_memoize_hash_table,
4815 Lisp_Object symlist = Fcopy_sequence (Vextent_face_reusable_list);
4816 Lisp_Object facelist = Fcopy_sequence (Vextent_face_reusable_list);
4818 LIST_LOOP (cons, facelist)
4820 XCAR (cons) = Fget_face (XCAR (cons));
4822 Fputhash (symlist, facelist, Vextent_face_memoize_hash_table);
4823 Fputhash (facelist, symlist, Vextent_face_reverse_memoize_hash_table);
4827 /* Now restore the truncated tail of the reusable list, if necessary. */
4829 XCDR (tail) = oldtail;
4836 external_of_internal_memoized_face (Lisp_Object face)
4840 else if (!CONSP (face))
4841 return XFACE (face)->name;
4844 face = Fgethash (face, Vextent_face_reverse_memoize_hash_table,
4846 assert (!UNBOUNDP (face));
4852 canonicalize_extent_property (Lisp_Object prop, Lisp_Object value)
4854 if (EQ (prop, Qface) || EQ (prop, Qmouse_face))
4855 value = (external_of_internal_memoized_face
4856 (memoize_extent_face_internal (value)));
4860 /* Do we need a lisp-level function ? */
4861 DEFUN ("set-extent-initial-redisplay-function", Fset_extent_initial_redisplay_function,
4863 Note: This feature is experimental!
4865 Set initial-redisplay-function of EXTENT to the function
4868 The first time the EXTENT is (re)displayed, an eval event will be
4869 dispatched calling FUNCTION with EXTENT as its only argument.
4873 EXTENT e = decode_extent(extent, DE_MUST_BE_ATTACHED);
4875 e = extent_ancestor (e); /* Is this needed? Macro also does chasing!*/
4876 set_extent_initial_redisplay_function(e,function);
4877 extent_in_red_event_p(e) = 0; /* If the function changed we can spawn
4879 extent_changed_for_redisplay(e,1,0); /* Do we need to mark children too ?*/
4884 DEFUN ("extent-face", Fextent_face, 1, 1, 0, /*
4885 Return the name of the face in which EXTENT is displayed, or nil
4886 if the extent's face is unspecified. This might also return a list
4893 CHECK_EXTENT (extent);
4894 face = extent_face (XEXTENT (extent));
4896 return external_of_internal_memoized_face (face);
4899 DEFUN ("set-extent-face", Fset_extent_face, 2, 2, 0, /*
4900 Make the given EXTENT have the graphic attributes specified by FACE.
4901 FACE can also be a list of faces, and all faces listed will apply,
4902 with faces earlier in the list taking priority over those later in the
4907 EXTENT e = decode_extent(extent, 0);
4908 Lisp_Object orig_face = face;
4910 /* retrieve the ancestor for efficiency and proper redisplay noting. */
4911 e = extent_ancestor (e);
4913 face = memoize_extent_face_internal (face);
4915 extent_face (e) = face;
4916 extent_changed_for_redisplay (e, 1, 0);
4922 DEFUN ("extent-mouse-face", Fextent_mouse_face, 1, 1, 0, /*
4923 Return the face used to highlight EXTENT when the mouse passes over it.
4924 The return value will be a face name, a list of face names, or nil
4925 if the extent's mouse face is unspecified.
4931 CHECK_EXTENT (extent);
4932 face = extent_mouse_face (XEXTENT (extent));
4934 return external_of_internal_memoized_face (face);
4937 DEFUN ("set-extent-mouse-face", Fset_extent_mouse_face, 2, 2, 0, /*
4938 Set the face used to highlight EXTENT when the mouse passes over it.
4939 FACE can also be a list of faces, and all faces listed will apply,
4940 with faces earlier in the list taking priority over those later in the
4946 Lisp_Object orig_face = face;
4948 CHECK_EXTENT (extent);
4949 e = XEXTENT (extent);
4950 /* retrieve the ancestor for efficiency and proper redisplay noting. */
4951 e = extent_ancestor (e);
4953 face = memoize_extent_face_internal (face);
4955 set_extent_mouse_face (e, face);
4956 extent_changed_for_redisplay (e, 1, 0);
4962 set_extent_glyph (EXTENT extent, Lisp_Object glyph, int endp,
4963 glyph_layout layout)
4965 extent = extent_ancestor (extent);
4969 set_extent_begin_glyph (extent, glyph);
4970 extent_begin_glyph_layout (extent) = layout;
4974 set_extent_end_glyph (extent, glyph);
4975 extent_end_glyph_layout (extent) = layout;
4978 extent_changed_for_redisplay (extent, 1, 0);
4982 glyph_layout_to_symbol (glyph_layout layout)
4986 case GL_TEXT: return Qtext;
4987 case GL_OUTSIDE_MARGIN: return Qoutside_margin;
4988 case GL_INSIDE_MARGIN: return Qinside_margin;
4989 case GL_WHITESPACE: return Qwhitespace;
4992 return Qnil; /* unreached */
4997 symbol_to_glyph_layout (Lisp_Object layout_obj)
4999 if (NILP (layout_obj))
5002 CHECK_SYMBOL (layout_obj);
5003 if (EQ (layout_obj, Qoutside_margin)) return GL_OUTSIDE_MARGIN;
5004 if (EQ (layout_obj, Qinside_margin)) return GL_INSIDE_MARGIN;
5005 if (EQ (layout_obj, Qwhitespace)) return GL_WHITESPACE;
5006 if (EQ (layout_obj, Qtext)) return GL_TEXT;
5008 signal_simple_error ("Unknown glyph layout type", layout_obj);
5009 return GL_TEXT; /* unreached */
5013 set_extent_glyph_1 (Lisp_Object extent_obj, Lisp_Object glyph, int endp,
5014 Lisp_Object layout_obj)
5016 EXTENT extent = decode_extent (extent_obj, DE_MUST_HAVE_BUFFER);
5017 glyph_layout layout = symbol_to_glyph_layout (layout_obj);
5019 /* Make sure we've actually been given a valid glyph or it's nil
5020 (meaning we're deleting a glyph from an extent). */
5022 CHECK_BUFFER_GLYPH (glyph);
5024 set_extent_glyph (extent, glyph, endp, layout);
5028 DEFUN ("set-extent-begin-glyph", Fset_extent_begin_glyph, 2, 3, 0, /*
5029 Display a bitmap, subwindow or string at the beginning of EXTENT.
5030 BEGIN-GLYPH must be a glyph object. The layout policy defaults to `text'.
5032 (extent, begin_glyph, layout))
5034 return set_extent_glyph_1 (extent, begin_glyph, 0, layout);
5037 DEFUN ("set-extent-end-glyph", Fset_extent_end_glyph, 2, 3, 0, /*
5038 Display a bitmap, subwindow or string at the end of EXTENT.
5039 END-GLYPH must be a glyph object. The layout policy defaults to `text'.
5041 (extent, end_glyph, layout))
5043 return set_extent_glyph_1 (extent, end_glyph, 1, layout);
5046 DEFUN ("extent-begin-glyph", Fextent_begin_glyph, 1, 1, 0, /*
5047 Return the glyph object displayed at the beginning of EXTENT.
5048 If there is none, nil is returned.
5052 return extent_begin_glyph (decode_extent (extent, 0));
5055 DEFUN ("extent-end-glyph", Fextent_end_glyph, 1, 1, 0, /*
5056 Return the glyph object displayed at the end of EXTENT.
5057 If there is none, nil is returned.
5061 return extent_end_glyph (decode_extent (extent, 0));
5064 DEFUN ("set-extent-begin-glyph-layout", Fset_extent_begin_glyph_layout, 2, 2, 0, /*
5065 Set the layout policy of EXTENT's begin glyph.
5066 Access this using the `extent-begin-glyph-layout' function.
5070 EXTENT e = decode_extent (extent, 0);
5071 e = extent_ancestor (e);
5072 extent_begin_glyph_layout (e) = symbol_to_glyph_layout (layout);
5073 extent_maybe_changed_for_redisplay (e, 1, 0);
5077 DEFUN ("set-extent-end-glyph-layout", Fset_extent_end_glyph_layout, 2, 2, 0, /*
5078 Set the layout policy of EXTENT's end glyph.
5079 Access this using the `extent-end-glyph-layout' function.
5083 EXTENT e = decode_extent (extent, 0);
5084 e = extent_ancestor (e);
5085 extent_end_glyph_layout (e) = symbol_to_glyph_layout (layout);
5086 extent_maybe_changed_for_redisplay (e, 1, 0);
5090 DEFUN ("extent-begin-glyph-layout", Fextent_begin_glyph_layout, 1, 1, 0, /*
5091 Return the layout policy associated with EXTENT's begin glyph.
5092 Set this using the `set-extent-begin-glyph-layout' function.
5096 EXTENT e = decode_extent (extent, 0);
5097 return glyph_layout_to_symbol ((glyph_layout) extent_begin_glyph_layout (e));
5100 DEFUN ("extent-end-glyph-layout", Fextent_end_glyph_layout, 1, 1, 0, /*
5101 Return the layout policy associated with EXTENT's end glyph.
5102 Set this using the `set-extent-end-glyph-layout' function.
5106 EXTENT e = decode_extent (extent, 0);
5107 return glyph_layout_to_symbol ((glyph_layout) extent_end_glyph_layout (e));
5110 DEFUN ("set-extent-priority", Fset_extent_priority, 2, 2, 0, /*
5111 Set the display priority of EXTENT to PRIORITY (an integer).
5112 When the extent attributes are being merged for display, the priority
5113 is used to determine which extent takes precedence in the event of a
5114 conflict (two extents whose faces both specify font, for example: the
5115 font of the extent with the higher priority will be used).
5116 Extents are created with priority 0; priorities may be negative.
5120 EXTENT e = decode_extent (extent, 0);
5122 CHECK_INT (priority);
5123 e = extent_ancestor (e);
5124 set_extent_priority (e, XINT (priority));
5125 extent_maybe_changed_for_redisplay (e, 1, 0);
5129 DEFUN ("extent-priority", Fextent_priority, 1, 1, 0, /*
5130 Return the display priority of EXTENT; see `set-extent-priority'.
5134 EXTENT e = decode_extent (extent, 0);
5135 return make_int (extent_priority (e));
5138 DEFUN ("set-extent-property", Fset_extent_property, 3, 3, 0, /*
5139 Change a property of an extent.
5140 PROPERTY may be any symbol; the value stored may be accessed with
5141 the `extent-property' function.
5142 The following symbols have predefined meanings:
5144 detached Removes the extent from its buffer; setting this is
5145 the same as calling `detach-extent'.
5147 destroyed Removes the extent from its buffer, and makes it
5148 unusable in the future; this is the same calling
5151 priority Change redisplay priority; same as `set-extent-priority'.
5153 start-open Whether the set of characters within the extent is
5154 treated being open on the left, that is, whether
5155 the start position is an exclusive, rather than
5156 inclusive, boundary. If true, then characters
5157 inserted exactly at the beginning of the extent
5158 will remain outside of the extent; otherwise they
5159 will go into the extent, extending it.
5161 end-open Whether the set of characters within the extent is
5162 treated being open on the right, that is, whether
5163 the end position is an exclusive, rather than
5164 inclusive, boundary. If true, then characters
5165 inserted exactly at the end of the extent will
5166 remain outside of the extent; otherwise they will
5167 go into the extent, extending it.
5169 By default, extents have the `end-open' but not the
5170 `start-open' property set.
5172 read-only Text within this extent will be unmodifiable.
5174 initial-redisplay-function (EXPERIMENTAL)
5175 function to be called the first time (part of) the extent
5176 is redisplayed. It will be called with the extent as its
5178 Note: The function will not be called immediately
5179 during redisplay, an eval event will be dispatched.
5181 detachable Whether the extent gets detached (as with
5182 `detach-extent') when all the text within the
5183 extent is deleted. This is true by default. If
5184 this property is not set, the extent becomes a
5185 zero-length extent when its text is deleted. (In
5186 such a case, the `start-open' property is
5187 automatically removed if both the `start-open' and
5188 `end-open' properties are set, since zero-length
5189 extents open on both ends are not allowed.)
5191 face The face in which to display the text. Setting
5192 this is the same as calling `set-extent-face'.
5194 mouse-face If non-nil, the extent will be highlighted in this
5195 face when the mouse moves over it.
5197 pointer If non-nil, and a valid pointer glyph, this specifies
5198 the shape of the mouse pointer while over the extent.
5200 highlight Obsolete: Setting this property is equivalent to
5201 setting a `mouse-face' property of `highlight'.
5202 Reading this property returns non-nil if
5203 the extent has a non-nil `mouse-face' property.
5205 duplicable Whether this extent should be copied into strings,
5206 so that kill, yank, and undo commands will restore
5207 or copy it. `duplicable' extents are copied from
5208 an extent into a string when `buffer-substring' or
5209 a similar function creates a string. The extents
5210 in a string are copied into other strings created
5211 from the string using `concat' or `substring'.
5212 When `insert' or a similar function inserts the
5213 string into a buffer, the extents are copied back
5216 unique Meaningful only in conjunction with `duplicable'.
5217 When this is set, there may be only one instance
5218 of this extent attached at a time: if it is copied
5219 to the kill ring and then yanked, the extent is
5220 not copied. If, however, it is killed (removed
5221 from the buffer) and then yanked, it will be
5222 re-attached at the new position.
5224 invisible If the value is non-nil, text under this extent
5225 may be treated as not present for the purpose of
5226 redisplay, or may be displayed using an ellipsis
5227 or other marker; see `buffer-invisibility-spec'
5228 and `invisible-text-glyph'. In all cases,
5229 however, the text is still visible to other
5230 functions that examine a buffer's text.
5232 keymap This keymap is consulted for mouse clicks on this
5233 extent, or keypresses made while point is within the
5236 copy-function This is a hook that is run when a duplicable extent
5237 is about to be copied from a buffer to a string (or
5238 the kill ring). It is called with three arguments,
5239 the extent, and the buffer-positions within it
5240 which are being copied. If this function returns
5241 nil, then the extent will not be copied; otherwise
5244 paste-function This is a hook that is run when a duplicable extent is
5245 about to be copied from a string (or the kill ring)
5246 into a buffer. It is called with three arguments,
5247 the original extent, and the buffer positions which
5248 the copied extent will occupy. (This hook is run
5249 after the corresponding text has already been
5250 inserted into the buffer.) Note that the extent
5251 argument may be detached when this function is run.
5252 If this function returns nil, no extent will be
5253 inserted. Otherwise, there will be an extent
5254 covering the range in question.
5256 If the original extent is not attached to a buffer,
5257 then it will be re-attached at this range.
5258 Otherwise, a copy will be made, and that copy
5261 The copy-function and paste-function are meaningful
5262 only for extents with the `duplicable' flag set,
5263 and if they are not specified, behave as if `t' was
5264 the returned value. When these hooks are invoked,
5265 the current buffer is the buffer which the extent
5266 is being copied from/to, respectively.
5268 begin-glyph A glyph to be displayed at the beginning of the extent,
5271 end-glyph A glyph to be displayed at the end of the extent,
5274 begin-glyph-layout The layout policy (one of `text', `whitespace',
5275 `inside-margin', or `outside-margin') of the extent's
5278 end-glyph-layout The layout policy of the extent's end glyph.
5280 (extent, property, value))
5282 /* This function can GC if property is `keymap' */
5283 EXTENT e = decode_extent (extent, 0);
5285 if (EQ (property, Qread_only))
5286 set_extent_read_only (e, value);
5287 else if (EQ (property, Qunique))
5288 extent_unique_p (e) = !NILP (value);
5289 else if (EQ (property, Qduplicable))
5290 extent_duplicable_p (e) = !NILP (value);
5291 else if (EQ (property, Qinvisible))
5292 set_extent_invisible (e, value);
5293 else if (EQ (property, Qdetachable))
5294 extent_detachable_p (e) = !NILP (value);
5296 else if (EQ (property, Qdetached))
5299 error ("can only set `detached' to t");
5300 Fdetach_extent (extent);
5302 else if (EQ (property, Qdestroyed))
5305 error ("can only set `destroyed' to t");
5306 Fdelete_extent (extent);
5308 else if (EQ (property, Qpriority))
5309 Fset_extent_priority (extent, value);
5310 else if (EQ (property, Qface))
5311 Fset_extent_face (extent, value);
5312 else if (EQ (property, Qinitial_redisplay_function))
5313 Fset_extent_initial_redisplay_function (extent, value);
5314 else if (EQ (property, Qbefore_change_functions))
5315 set_extent_before_change_functions (e, value);
5316 else if (EQ (property, Qafter_change_functions))
5317 set_extent_after_change_functions (e, value);
5318 else if (EQ (property, Qmouse_face))
5319 Fset_extent_mouse_face (extent, value);
5321 else if (EQ (property, Qhighlight))
5322 Fset_extent_mouse_face (extent, Qhighlight);
5323 else if (EQ (property, Qbegin_glyph_layout))
5324 Fset_extent_begin_glyph_layout (extent, value);
5325 else if (EQ (property, Qend_glyph_layout))
5326 Fset_extent_end_glyph_layout (extent, value);
5327 /* For backwards compatibility. We use begin glyph because it is by
5328 far the more used of the two. */
5329 else if (EQ (property, Qglyph_layout))
5330 Fset_extent_begin_glyph_layout (extent, value);
5331 else if (EQ (property, Qbegin_glyph))
5332 Fset_extent_begin_glyph (extent, value, Qnil);
5333 else if (EQ (property, Qend_glyph))
5334 Fset_extent_end_glyph (extent, value, Qnil);
5335 else if (EQ (property, Qstart_open))
5336 set_extent_openness (e, !NILP (value), -1);
5337 else if (EQ (property, Qend_open))
5338 set_extent_openness (e, -1, !NILP (value));
5339 /* Support (but don't document...) the obvious *_closed antonyms. */
5340 else if (EQ (property, Qstart_closed))
5341 set_extent_openness (e, NILP (value), -1);
5342 else if (EQ (property, Qend_closed))
5343 set_extent_openness (e, -1, NILP (value));
5346 if (EQ (property, Qkeymap))
5347 while (!NILP (value) && NILP (Fkeymapp (value)))
5348 value = wrong_type_argument (Qkeymapp, value);
5350 external_plist_put (extent_plist_addr (e), property, value, 0, ERROR_ME);
5356 DEFUN ("set-extent-properties", Fset_extent_properties, 2, 2, 0, /*
5357 Change some properties of EXTENT.
5358 PLIST is a property list.
5359 For a list of built-in properties, see `set-extent-property'.
5363 /* This function can GC, if one of the properties is `keymap' */
5364 Lisp_Object property, value;
5365 struct gcpro gcpro1;
5368 plist = Fcopy_sequence (plist);
5369 Fcanonicalize_plist (plist, Qnil);
5371 while (!NILP (plist))
5373 property = Fcar (plist); plist = Fcdr (plist);
5374 value = Fcar (plist); plist = Fcdr (plist);
5375 Fset_extent_property (extent, property, value);
5381 DEFUN ("extent-property", Fextent_property, 2, 3, 0, /*
5382 Return EXTENT's value for property PROPERTY.
5383 See `set-extent-property' for the built-in property names.
5385 (extent, property, default_))
5387 EXTENT e = decode_extent (extent, 0);
5389 if (EQ (property, Qdetached))
5390 return extent_detached_p (e) ? Qt : Qnil;
5391 else if (EQ (property, Qdestroyed))
5392 return !EXTENT_LIVE_P (e) ? Qt : Qnil;
5393 else if (EQ (property, Qstart_open))
5394 return extent_normal_field (e, start_open) ? Qt : Qnil;
5395 else if (EQ (property, Qend_open))
5396 return extent_normal_field (e, end_open) ? Qt : Qnil;
5397 else if (EQ (property, Qunique))
5398 return extent_normal_field (e, unique) ? Qt : Qnil;
5399 else if (EQ (property, Qduplicable))
5400 return extent_normal_field (e, duplicable) ? Qt : Qnil;
5401 else if (EQ (property, Qdetachable))
5402 return extent_normal_field (e, detachable) ? Qt : Qnil;
5403 /* Support (but don't document...) the obvious *_closed antonyms. */
5404 else if (EQ (property, Qstart_closed))
5405 return extent_start_open_p (e) ? Qnil : Qt;
5406 else if (EQ (property, Qend_closed))
5407 return extent_end_open_p (e) ? Qnil : Qt;
5408 else if (EQ (property, Qpriority))
5409 return make_int (extent_priority (e));
5410 else if (EQ (property, Qread_only))
5411 return extent_read_only (e);
5412 else if (EQ (property, Qinvisible))
5413 return extent_invisible (e);
5414 else if (EQ (property, Qface))
5415 return Fextent_face (extent);
5416 else if (EQ (property, Qinitial_redisplay_function))
5417 return extent_initial_redisplay_function (e);
5418 else if (EQ (property, Qbefore_change_functions))
5419 return extent_before_change_functions (e);
5420 else if (EQ (property, Qafter_change_functions))
5421 return extent_after_change_functions (e);
5422 else if (EQ (property, Qmouse_face))
5423 return Fextent_mouse_face (extent);
5425 else if (EQ (property, Qhighlight))
5426 return !NILP (Fextent_mouse_face (extent)) ? Qt : Qnil;
5427 else if (EQ (property, Qbegin_glyph_layout))
5428 return Fextent_begin_glyph_layout (extent);
5429 else if (EQ (property, Qend_glyph_layout))
5430 return Fextent_end_glyph_layout (extent);
5431 /* For backwards compatibility. We use begin glyph because it is by
5432 far the more used of the two. */
5433 else if (EQ (property, Qglyph_layout))
5434 return Fextent_begin_glyph_layout (extent);
5435 else if (EQ (property, Qbegin_glyph))
5436 return extent_begin_glyph (e);
5437 else if (EQ (property, Qend_glyph))
5438 return extent_end_glyph (e);
5441 Lisp_Object value = external_plist_get (extent_plist_addr (e),
5442 property, 0, ERROR_ME);
5443 return UNBOUNDP (value) ? default_ : value;
5447 DEFUN ("extent-properties", Fextent_properties, 1, 1, 0, /*
5448 Return a property list of the attributes of EXTENT.
5449 Do not modify this list; use `set-extent-property' instead.
5454 Lisp_Object result, face, anc_obj;
5455 glyph_layout layout;
5457 CHECK_EXTENT (extent);
5458 e = XEXTENT (extent);
5459 if (!EXTENT_LIVE_P (e))
5460 return cons3 (Qdestroyed, Qt, Qnil);
5462 anc = extent_ancestor (e);
5463 XSETEXTENT (anc_obj, anc);
5465 /* For efficiency, use the ancestor for all properties except detached */
5467 result = extent_plist_slot (anc);
5469 if (!NILP (face = Fextent_face (anc_obj)))
5470 result = cons3 (Qface, face, result);
5472 if (!NILP (face = Fextent_mouse_face (anc_obj)))
5473 result = cons3 (Qmouse_face, face, result);
5475 if ((layout = (glyph_layout) extent_begin_glyph_layout (anc)) != GL_TEXT)
5477 Lisp_Object sym = glyph_layout_to_symbol (layout);
5478 result = cons3 (Qglyph_layout, sym, result); /* compatibility */
5479 result = cons3 (Qbegin_glyph_layout, sym, result);
5482 if ((layout = (glyph_layout) extent_end_glyph_layout (anc)) != GL_TEXT)
5483 result = cons3 (Qend_glyph_layout, glyph_layout_to_symbol (layout), result);
5485 if (!NILP (extent_end_glyph (anc)))
5486 result = cons3 (Qend_glyph, extent_end_glyph (anc), result);
5488 if (!NILP (extent_begin_glyph (anc)))
5489 result = cons3 (Qbegin_glyph, extent_begin_glyph (anc), result);
5491 if (extent_priority (anc) != 0)
5492 result = cons3 (Qpriority, make_int (extent_priority (anc)), result);
5494 if (!NILP (extent_initial_redisplay_function (anc)))
5495 result = cons3 (Qinitial_redisplay_function,
5496 extent_initial_redisplay_function (anc), result);
5498 if (!NILP (extent_before_change_functions (anc)))
5499 result = cons3 (Qbefore_change_functions,
5500 extent_before_change_functions (anc), result);
5502 if (!NILP (extent_after_change_functions (anc)))
5503 result = cons3 (Qafter_change_functions,
5504 extent_after_change_functions (anc), result);
5506 if (!NILP (extent_invisible (anc)))
5507 result = cons3 (Qinvisible, extent_invisible (anc), result);
5509 if (!NILP (extent_read_only (anc)))
5510 result = cons3 (Qread_only, extent_read_only (anc), result);
5512 if (extent_normal_field (anc, end_open))
5513 result = cons3 (Qend_open, Qt, result);
5515 if (extent_normal_field (anc, start_open))
5516 result = cons3 (Qstart_open, Qt, result);
5518 if (extent_normal_field (anc, detachable))
5519 result = cons3 (Qdetachable, Qt, result);
5521 if (extent_normal_field (anc, duplicable))
5522 result = cons3 (Qduplicable, Qt, result);
5524 if (extent_normal_field (anc, unique))
5525 result = cons3 (Qunique, Qt, result);
5527 /* detached is not an inherited property */
5528 if (extent_detached_p (e))
5529 result = cons3 (Qdetached, Qt, result);
5535 /************************************************************************/
5537 /************************************************************************/
5539 /* The display code looks into the Vlast_highlighted_extent variable to
5540 correctly display highlighted extents. This updates that variable,
5541 and marks the appropriate buffers as needing some redisplay.
5544 do_highlight (Lisp_Object extent_obj, int highlight_p)
5546 if (( highlight_p && (EQ (Vlast_highlighted_extent, extent_obj))) ||
5547 (!highlight_p && (EQ (Vlast_highlighted_extent, Qnil))))
5549 if (EXTENTP (Vlast_highlighted_extent) &&
5550 EXTENT_LIVE_P (XEXTENT (Vlast_highlighted_extent)))
5552 /* do not recurse on descendants. Only one extent is highlighted
5554 extent_changed_for_redisplay (XEXTENT (Vlast_highlighted_extent), 0, 0);
5556 Vlast_highlighted_extent = Qnil;
5557 if (!NILP (extent_obj)
5558 && BUFFERP (extent_object (XEXTENT (extent_obj)))
5561 extent_changed_for_redisplay (XEXTENT (extent_obj), 0, 0);
5562 Vlast_highlighted_extent = extent_obj;
5566 DEFUN ("force-highlight-extent", Fforce_highlight_extent, 1, 2, 0, /*
5567 Highlight or unhighlight the given extent.
5568 If the second arg is non-nil, it will be highlighted, else dehighlighted.
5569 This is the same as `highlight-extent', except that it will work even
5570 on extents without the `mouse-face' property.
5572 (extent, highlight_p))
5577 XSETEXTENT (extent, decode_extent (extent, DE_MUST_BE_ATTACHED));
5578 do_highlight (extent, !NILP (highlight_p));
5582 DEFUN ("highlight-extent", Fhighlight_extent, 1, 2, 0, /*
5583 Highlight EXTENT, if it is highlightable.
5584 \(that is, if it has the `mouse-face' property).
5585 If the second arg is non-nil, it will be highlighted, else dehighlighted.
5586 Highlighted extents are displayed as if they were merged with the face
5587 or faces specified by the `mouse-face' property.
5589 (extent, highlight_p))
5591 if (EXTENTP (extent) && NILP (extent_mouse_face (XEXTENT (extent))))
5594 return Fforce_highlight_extent (extent, highlight_p);
5598 /************************************************************************/
5599 /* strings and extents */
5600 /************************************************************************/
5602 /* copy/paste hooks */
5605 run_extent_copy_paste_internal (EXTENT e, Bufpos from, Bufpos to,
5609 /* This function can GC */
5611 Lisp_Object copy_fn;
5612 XSETEXTENT (extent, e);
5613 copy_fn = Fextent_property (extent, prop, Qnil);
5614 if (!NILP (copy_fn))
5617 struct gcpro gcpro1, gcpro2, gcpro3;
5618 GCPRO3 (extent, copy_fn, object);
5619 if (BUFFERP (object))
5620 flag = call3_in_buffer (XBUFFER (object), copy_fn, extent,
5621 make_int (from), make_int (to));
5623 flag = call3 (copy_fn, extent, make_int (from), make_int (to));
5625 if (NILP (flag) || !EXTENT_LIVE_P (XEXTENT (extent)))
5632 run_extent_copy_function (EXTENT e, Bytind from, Bytind to)
5634 Lisp_Object object = extent_object (e);
5635 /* This function can GC */
5636 return run_extent_copy_paste_internal
5637 (e, buffer_or_string_bytind_to_bufpos (object, from),
5638 buffer_or_string_bytind_to_bufpos (object, to), object,
5643 run_extent_paste_function (EXTENT e, Bytind from, Bytind to,
5646 /* This function can GC */
5647 return run_extent_copy_paste_internal
5648 (e, buffer_or_string_bytind_to_bufpos (object, from),
5649 buffer_or_string_bytind_to_bufpos (object, to), object,
5654 update_extent (EXTENT extent, Bytind from, Bytind to)
5656 set_extent_endpoints (extent, from, to, Qnil);
5659 /* Insert an extent, usually from the dup_list of a string which
5660 has just been inserted.
5661 This code does not handle the case of undo.
5664 insert_extent (EXTENT extent, Bytind new_start, Bytind new_end,
5665 Lisp_Object object, int run_hooks)
5667 /* This function can GC */
5670 if (!EQ (extent_object (extent), object))
5673 if (extent_detached_p (extent))
5676 !run_extent_paste_function (extent, new_start, new_end, object))
5677 /* The paste-function said don't re-attach this extent here. */
5680 update_extent (extent, new_start, new_end);
5684 Bytind exstart = extent_endpoint_bytind (extent, 0);
5685 Bytind exend = extent_endpoint_bytind (extent, 1);
5687 if (exend < new_start || exstart > new_end)
5691 new_start = min (exstart, new_start);
5692 new_end = max (exend, new_end);
5693 if (exstart != new_start || exend != new_end)
5694 update_extent (extent, new_start, new_end);
5698 XSETEXTENT (tmp, extent);
5703 !run_extent_paste_function (extent, new_start, new_end, object))
5704 /* The paste-function said don't attach a copy of the extent here. */
5708 XSETEXTENT (tmp, copy_extent (extent, new_start, new_end, object));
5713 DEFUN ("insert-extent", Finsert_extent, 1, 5, 0, /*
5714 Insert EXTENT from START to END in BUFFER-OR-STRING.
5715 BUFFER-OR-STRING defaults to the current buffer if omitted.
5716 This operation does not insert any characters,
5717 but otherwise acts as if there were a replicating extent whose
5718 parent is EXTENT in some string that was just inserted.
5719 Returns the newly-inserted extent.
5720 The fourth arg, NO-HOOKS, can be used to inhibit the running of the
5721 extent's `paste-function' property if it has one.
5722 See documentation on `detach-extent' for a discussion of undo recording.
5724 (extent, start, end, no_hooks, buffer_or_string))
5726 EXTENT ext = decode_extent (extent, 0);
5730 buffer_or_string = decode_buffer_or_string (buffer_or_string);
5731 get_buffer_or_string_range_byte (buffer_or_string, start, end, &s, &e,
5732 GB_ALLOW_PAST_ACCESSIBLE);
5734 copy = insert_extent (ext, s, e, buffer_or_string, NILP (no_hooks));
5737 if (extent_duplicable_p (XEXTENT (copy)))
5738 record_extent (copy, 1);
5744 /* adding buffer extents to a string */
5746 struct add_string_extents_arg
5754 add_string_extents_mapper (EXTENT extent, void *arg)
5756 /* This function can GC */
5757 struct add_string_extents_arg *closure =
5758 (struct add_string_extents_arg *) arg;
5759 Bytecount start = extent_endpoint_bytind (extent, 0) - closure->from;
5760 Bytecount end = extent_endpoint_bytind (extent, 1) - closure->from;
5762 if (extent_duplicable_p (extent))
5764 start = max (start, 0);
5765 end = min (end, closure->length);
5767 /* Run the copy-function to give an extent the option of
5768 not being copied into the string (or kill ring).
5770 if (extent_duplicable_p (extent) &&
5771 !run_extent_copy_function (extent, start + closure->from,
5772 end + closure->from))
5774 copy_extent (extent, start, end, closure->string);
5780 /* Add the extents in buffer BUF from OPOINT to OPOINT+LENGTH to
5781 the string STRING. */
5783 add_string_extents (Lisp_Object string, struct buffer *buf, Bytind opoint,
5786 /* This function can GC */
5787 struct add_string_extents_arg closure;
5788 struct gcpro gcpro1, gcpro2;
5791 closure.from = opoint;
5792 closure.length = length;
5793 closure.string = string;
5794 buffer = make_buffer (buf);
5795 GCPRO2 (buffer, string);
5796 map_extents_bytind (opoint, opoint + length, add_string_extents_mapper,
5797 (void *) &closure, buffer, 0,
5798 /* ignore extents that just abut the region */
5799 ME_END_CLOSED | ME_ALL_EXTENTS_OPEN |
5800 /* we are calling E-Lisp (the extent's copy function)
5801 so anything might happen */
5802 ME_MIGHT_CALL_ELISP);
5806 struct splice_in_string_extents_arg
5815 splice_in_string_extents_mapper (EXTENT extent, void *arg)
5817 /* This function can GC */
5818 struct splice_in_string_extents_arg *closure =
5819 (struct splice_in_string_extents_arg *) arg;
5820 /* BASE_START and BASE_END are the limits in the buffer of the string
5821 that was just inserted.
5823 NEW_START and NEW_END are the prospective buffer positions of the
5824 extent that is going into the buffer. */
5825 Bytind base_start = closure->opoint;
5826 Bytind base_end = base_start + closure->length;
5827 Bytind new_start = (base_start + extent_endpoint_bytind (extent, 0) -
5829 Bytind new_end = (base_start + extent_endpoint_bytind (extent, 1) -
5832 if (new_start < base_start)
5833 new_start = base_start;
5834 if (new_end > base_end)
5836 if (new_end <= new_start)
5839 if (!extent_duplicable_p (extent))
5843 !run_extent_paste_function (extent, new_start, new_end,
5846 copy_extent (extent, new_start, new_end, closure->buffer);
5851 /* We have just inserted a section of STRING (starting at POS, of
5852 length LENGTH) into buffer BUF at OPOINT. Do whatever is necessary
5853 to get the string's extents into the buffer. */
5856 splice_in_string_extents (Lisp_Object string, struct buffer *buf,
5857 Bytind opoint, Bytecount length, Bytecount pos)
5859 struct splice_in_string_extents_arg closure;
5860 struct gcpro gcpro1, gcpro2;
5863 buffer = make_buffer (buf);
5864 closure.opoint = opoint;
5866 closure.length = length;
5867 closure.buffer = buffer;
5868 GCPRO2 (buffer, string);
5869 map_extents_bytind (pos, pos + length,
5870 splice_in_string_extents_mapper,
5871 (void *) &closure, string, 0,
5872 /* ignore extents that just abut the region */
5873 ME_END_CLOSED | ME_ALL_EXTENTS_OPEN |
5874 /* we are calling E-Lisp (the extent's copy function)
5875 so anything might happen */
5876 ME_MIGHT_CALL_ELISP);
5880 struct copy_string_extents_arg
5885 Lisp_Object new_string;
5888 struct copy_string_extents_1_arg
5890 Lisp_Object parent_in_question;
5891 EXTENT found_extent;
5895 copy_string_extents_mapper (EXTENT extent, void *arg)
5897 struct copy_string_extents_arg *closure =
5898 (struct copy_string_extents_arg *) arg;
5899 Bytecount old_start, old_end, new_start, new_end;
5901 old_start = extent_endpoint_bytind (extent, 0);
5902 old_end = extent_endpoint_bytind (extent, 1);
5904 old_start = max (closure->old_pos, old_start);
5905 old_end = min (closure->old_pos + closure->length, old_end);
5907 if (old_start >= old_end)
5910 new_start = old_start + closure->new_pos - closure->old_pos;
5911 new_end = old_end + closure->new_pos - closure->old_pos;
5913 copy_extent (extent, new_start, new_end, closure->new_string);
5917 /* The string NEW_STRING was partially constructed from OLD_STRING.
5918 In particular, the section of length LEN starting at NEW_POS in
5919 NEW_STRING came from the section of the same length starting at
5920 OLD_POS in OLD_STRING. Copy the extents as appropriate. */
5923 copy_string_extents (Lisp_Object new_string, Lisp_Object old_string,
5924 Bytecount new_pos, Bytecount old_pos,
5927 struct copy_string_extents_arg closure;
5928 struct gcpro gcpro1, gcpro2;
5930 closure.new_pos = new_pos;
5931 closure.old_pos = old_pos;
5932 closure.new_string = new_string;
5933 closure.length = length;
5934 GCPRO2 (new_string, old_string);
5935 map_extents_bytind (old_pos, old_pos + length,
5936 copy_string_extents_mapper,
5937 (void *) &closure, old_string, 0,
5938 /* ignore extents that just abut the region */
5939 ME_END_CLOSED | ME_ALL_EXTENTS_OPEN |
5940 /* we are calling E-Lisp (the extent's copy function)
5941 so anything might happen */
5942 ME_MIGHT_CALL_ELISP);
5946 /* Checklist for sanity checking:
5947 - {kill, yank, copy} at {open, closed} {start, end} of {writable, read-only} extent
5948 - {kill, copy} & yank {once, repeatedly} duplicable extent in {same, different} buffer
5952 /************************************************************************/
5953 /* text properties */
5954 /************************************************************************/
5957 Originally this stuff was implemented in lisp (all of the functionality
5958 exists to make that possible) but speed was a problem.
5961 Lisp_Object Qtext_prop;
5962 Lisp_Object Qtext_prop_extent_paste_function;
5965 get_text_property_bytind (Bytind position, Lisp_Object prop,
5966 Lisp_Object object, enum extent_at_flag fl,
5967 int text_props_only)
5971 /* text_props_only specifies whether we only consider text-property
5972 extents (those with the 'text-prop property set) or all extents. */
5973 if (!text_props_only)
5974 extent = extent_at_bytind (position, object, prop, 0, fl);
5980 extent = extent_at_bytind (position, object, Qtext_prop, prior,
5984 if (EQ (prop, Fextent_property (extent, Qtext_prop, Qnil)))
5986 prior = XEXTENT (extent);
5991 return Fextent_property (extent, prop, Qnil);
5992 if (!NILP (Vdefault_text_properties))
5993 return Fplist_get (Vdefault_text_properties, prop, Qnil);
5998 get_text_property_1 (Lisp_Object pos, Lisp_Object prop, Lisp_Object object,
5999 Lisp_Object at_flag, int text_props_only)
6004 object = decode_buffer_or_string (object);
6005 position = get_buffer_or_string_pos_byte (object, pos, GB_NO_ERROR_IF_BAD);
6007 /* We canonicalize the start/end-open/closed properties to the
6008 non-default version -- "adding" the default property really
6009 needs to remove the non-default one. See below for more
6011 if (EQ (prop, Qstart_closed))
6017 if (EQ (prop, Qend_open))
6025 get_text_property_bytind (position, prop, object,
6026 decode_extent_at_flag (at_flag),
6029 val = NILP (val) ? Qt : Qnil;
6034 DEFUN ("get-text-property", Fget_text_property, 2, 4, 0, /*
6035 Return the value of the PROP property at the given position.
6036 Optional arg OBJECT specifies the buffer or string to look in, and
6037 defaults to the current buffer.
6038 Optional arg AT-FLAG controls what it means for a property to be "at"
6039 a position, and has the same meaning as in `extent-at'.
6040 This examines only those properties added with `put-text-property'.
6041 See also `get-char-property'.
6043 (pos, prop, object, at_flag))
6045 return get_text_property_1 (pos, prop, object, at_flag, 1);
6048 DEFUN ("get-char-property", Fget_char_property, 2, 4, 0, /*
6049 Return the value of the PROP property at the given position.
6050 Optional arg OBJECT specifies the buffer or string to look in, and
6051 defaults to the current buffer.
6052 Optional arg AT-FLAG controls what it means for a property to be "at"
6053 a position, and has the same meaning as in `extent-at'.
6054 This examines properties on all extents.
6055 See also `get-text-property'.
6057 (pos, prop, object, at_flag))
6059 return get_text_property_1 (pos, prop, object, at_flag, 0);
6062 /* About start/end-open/closed:
6064 These properties have to be handled specially because of their
6065 strange behavior. If I put the "start-open" property on a region,
6066 then *all* text-property extents in the region have to have their
6067 start be open. This is unlike all other properties, which don't
6068 affect the extents of text properties other than their own.
6072 1) We have to map start-closed to (not start-open) and end-open
6073 to (not end-closed) -- i.e. adding the default is really the
6074 same as remove the non-default property. It won't work, for
6075 example, to have both "start-open" and "start-closed" on
6077 2) Whenever we add one of these properties, we go through all
6078 text-property extents in the region and set the appropriate
6079 open/closedness on them.
6080 3) Whenever we change a text-property extent for a property,
6081 we have to make sure we set the open/closedness properly.
6083 (2) and (3) together rely on, and maintain, the invariant
6084 that the open/closedness of text-property extents is correct
6085 at the beginning and end of each operation.
6088 struct put_text_prop_arg
6090 Lisp_Object prop, value; /* The property and value we are storing */
6091 Bytind start, end; /* The region into which we are storing it */
6093 Lisp_Object the_extent; /* Our chosen extent; this is used for
6094 communication between subsequent passes. */
6095 int changed_p; /* Output: whether we have modified anything */
6099 put_text_prop_mapper (EXTENT e, void *arg)
6101 struct put_text_prop_arg *closure = (struct put_text_prop_arg *) arg;
6103 Lisp_Object object = closure->object;
6104 Lisp_Object value = closure->value;
6105 Bytind e_start, e_end;
6106 Bytind start = closure->start;
6107 Bytind end = closure->end;
6108 Lisp_Object extent, e_val;
6111 XSETEXTENT (extent, e);
6113 /* Note: in some cases when the property itself is 'start-open
6114 or 'end-closed, the checks to set the openness may do a bit
6115 of extra work; but it won't hurt because we then fix up the
6116 openness later on in put_text_prop_openness_mapper(). */
6117 if (!EQ (Fextent_property (extent, Qtext_prop, Qnil), closure->prop))
6118 /* It's not for this property; do nothing. */
6121 e_start = extent_endpoint_bytind (e, 0);
6122 e_end = extent_endpoint_bytind (e, 1);
6123 e_val = Fextent_property (extent, closure->prop, Qnil);
6124 is_eq = EQ (value, e_val);
6126 if (!NILP (value) && NILP (closure->the_extent) && is_eq)
6128 /* We want there to be an extent here at the end, and we haven't picked
6129 one yet, so use this one. Extend it as necessary. We only reuse an
6130 extent which has an EQ value for the prop in question to avoid
6131 side-effecting the kill ring (that is, we never change the property
6132 on an extent after it has been created.)
6134 if (e_start != start || e_end != end)
6136 Bytind new_start = min (e_start, start);
6137 Bytind new_end = max (e_end, end);
6138 set_extent_endpoints (e, new_start, new_end, Qnil);
6139 /* If we changed the endpoint, then we need to set its
6141 set_extent_openness (e, new_start != e_start
6142 ? !NILP (get_text_property_bytind
6143 (start, Qstart_open, object,
6144 EXTENT_AT_AFTER, 1)) : -1,
6146 ? NILP (get_text_property_bytind
6147 (end - 1, Qend_closed, object,
6148 EXTENT_AT_AFTER, 1))
6150 closure->changed_p = 1;
6152 closure->the_extent = extent;
6155 /* Even if we're adding a prop, at this point, we want all other extents of
6156 this prop to go away (as now they overlap). So the theory here is that,
6157 when we are adding a prop to a region that has multiple (disjoint)
6158 occurrences of that prop in it already, we pick one of those and extend
6159 it, and remove the others.
6162 else if (EQ (extent, closure->the_extent))
6164 /* just in case map-extents hits it again (does that happen?) */
6167 else if (e_start >= start && e_end <= end)
6169 /* Extent is contained in region; remove it. Don't destroy or modify
6170 it, because we don't want to change the attributes pointed to by the
6171 duplicates in the kill ring.
6174 closure->changed_p = 1;
6176 else if (!NILP (closure->the_extent) &&
6181 EXTENT te = XEXTENT (closure->the_extent);
6182 /* This extent overlaps, and has the same prop/value as the extent we've
6183 decided to reuse, so we can remove this existing extent as well (the
6184 whole thing, even the part outside of the region) and extend
6185 the-extent to cover it, resulting in the minimum number of extents in
6188 Bytind the_start = extent_endpoint_bytind (te, 0);
6189 Bytind the_end = extent_endpoint_bytind (te, 1);
6190 if (e_start != the_start && /* note AND not OR -- hmm, why is this
6191 the case? I think it's because the
6192 assumption that the text-property
6193 extents don't overlap makes it
6194 OK; changing it to an OR would
6195 result in changed_p sometimes getting
6196 falsely marked. Is this bad? */
6199 Bytind new_start = min (e_start, the_start);
6200 Bytind new_end = max (e_end, the_end);
6201 set_extent_endpoints (te, new_start, new_end, Qnil);
6202 /* If we changed the endpoint, then we need to set its
6203 openness. We are setting the endpoint to be the same as
6204 that of the extent we're about to remove, and we assume
6205 (the invariant mentioned above) that extent has the
6206 proper endpoint setting, so we just use it. */
6207 set_extent_openness (te, new_start != e_start ?
6208 (int) extent_start_open_p (e) : -1,
6210 (int) extent_end_open_p (e) : -1);
6211 closure->changed_p = 1;
6215 else if (e_end <= end)
6217 /* Extent begins before start but ends before end, so we can just
6218 decrease its end position.
6222 set_extent_endpoints (e, e_start, start, Qnil);
6223 set_extent_openness (e, -1, NILP (get_text_property_bytind
6224 (start - 1, Qend_closed, object,
6225 EXTENT_AT_AFTER, 1)));
6226 closure->changed_p = 1;
6229 else if (e_start >= start)
6231 /* Extent ends after end but begins after start, so we can just
6232 increase its start position.
6236 set_extent_endpoints (e, end, e_end, Qnil);
6237 set_extent_openness (e, !NILP (get_text_property_bytind
6238 (end, Qstart_open, object,
6239 EXTENT_AT_AFTER, 1)), -1);
6240 closure->changed_p = 1;
6245 /* Otherwise, `extent' straddles the region. We need to split it.
6247 set_extent_endpoints (e, e_start, start, Qnil);
6248 set_extent_openness (e, -1, NILP (get_text_property_bytind
6249 (start - 1, Qend_closed, object,
6250 EXTENT_AT_AFTER, 1)));
6251 set_extent_openness (copy_extent (e, end, e_end, extent_object (e)),
6252 !NILP (get_text_property_bytind
6253 (end, Qstart_open, object,
6254 EXTENT_AT_AFTER, 1)), -1);
6255 closure->changed_p = 1;
6258 return 0; /* to continue mapping. */
6262 put_text_prop_openness_mapper (EXTENT e, void *arg)
6264 struct put_text_prop_arg *closure = (struct put_text_prop_arg *) arg;
6265 Bytind e_start, e_end;
6266 Bytind start = closure->start;
6267 Bytind end = closure->end;
6269 XSETEXTENT (extent, e);
6270 e_start = extent_endpoint_bytind (e, 0);
6271 e_end = extent_endpoint_bytind (e, 1);
6273 if (NILP (Fextent_property (extent, Qtext_prop, Qnil)))
6275 /* It's not a text-property extent; do nothing. */
6278 /* Note end conditions and NILP/!NILP's carefully. */
6279 else if (EQ (closure->prop, Qstart_open)
6280 && e_start >= start && e_start < end)
6281 set_extent_openness (e, !NILP (closure->value), -1);
6282 else if (EQ (closure->prop, Qend_closed)
6283 && e_end > start && e_end <= end)
6284 set_extent_openness (e, -1, NILP (closure->value));
6286 return 0; /* to continue mapping. */
6290 put_text_prop (Bytind start, Bytind end, Lisp_Object object,
6291 Lisp_Object prop, Lisp_Object value,
6294 /* This function can GC */
6295 struct put_text_prop_arg closure;
6297 if (start == end) /* There are no characters in the region. */
6300 /* convert to the non-default versions, since a nil property is
6301 the same as it not being present. */
6302 if (EQ (prop, Qstart_closed))
6305 value = NILP (value) ? Qt : Qnil;
6307 else if (EQ (prop, Qend_open))
6310 value = NILP (value) ? Qt : Qnil;
6313 value = canonicalize_extent_property (prop, value);
6315 closure.prop = prop;
6316 closure.value = value;
6317 closure.start = start;
6319 closure.object = object;
6320 closure.changed_p = 0;
6321 closure.the_extent = Qnil;
6323 map_extents_bytind (start, end,
6324 put_text_prop_mapper,
6325 (void *) &closure, object, 0,
6326 /* get all extents that abut the region */
6327 ME_ALL_EXTENTS_CLOSED | ME_END_CLOSED |
6328 /* it might QUIT or error if the user has
6329 fucked with the extent plist. */
6330 /* #### dmoore - I think this should include
6331 ME_MIGHT_MOVE_SOE, since the callback function
6332 might recurse back into map_extents_bytind. */
6334 ME_MIGHT_MODIFY_EXTENTS);
6336 /* If we made it through the loop without reusing an extent
6337 (and we want there to be one) make it now.
6339 if (!NILP (value) && NILP (closure.the_extent))
6343 XSETEXTENT (extent, make_extent_internal (object, start, end));
6344 closure.changed_p = 1;
6345 Fset_extent_property (extent, Qtext_prop, prop);
6346 Fset_extent_property (extent, prop, value);
6349 extent_duplicable_p (XEXTENT (extent)) = 1;
6350 Fset_extent_property (extent, Qpaste_function,
6351 Qtext_prop_extent_paste_function);
6353 set_extent_openness (XEXTENT (extent),
6354 !NILP (get_text_property_bytind
6355 (start, Qstart_open, object,
6356 EXTENT_AT_AFTER, 1)),
6357 NILP (get_text_property_bytind
6358 (end - 1, Qend_closed, object,
6359 EXTENT_AT_AFTER, 1)));
6362 if (EQ (prop, Qstart_open) || EQ (prop, Qend_closed))
6364 map_extents_bytind (start, end,
6365 put_text_prop_openness_mapper,
6366 (void *) &closure, object, 0,
6367 /* get all extents that abut the region */
6368 ME_ALL_EXTENTS_CLOSED | ME_END_CLOSED |
6369 ME_MIGHT_MODIFY_EXTENTS);
6372 return closure.changed_p;
6375 DEFUN ("put-text-property", Fput_text_property, 4, 5, 0, /*
6376 Adds the given property/value to all characters in the specified region.
6377 The property is conceptually attached to the characters rather than the
6378 region. The properties are copied when the characters are copied/pasted.
6379 Fifth argument OBJECT is the buffer or string containing the text, and
6380 defaults to the current buffer.
6382 (start, end, prop, value, object))
6384 /* This function can GC */
6387 object = decode_buffer_or_string (object);
6388 get_buffer_or_string_range_byte (object, start, end, &s, &e, 0);
6389 put_text_prop (s, e, object, prop, value, 1);
6393 DEFUN ("put-nonduplicable-text-property", Fput_nonduplicable_text_property,
6395 Adds the given property/value to all characters in the specified region.
6396 The property is conceptually attached to the characters rather than the
6397 region, however the properties will not be copied when the characters
6399 Fifth argument OBJECT is the buffer or string containing the text, and
6400 defaults to the current buffer.
6402 (start, end, prop, value, object))
6404 /* This function can GC */
6407 object = decode_buffer_or_string (object);
6408 get_buffer_or_string_range_byte (object, start, end, &s, &e, 0);
6409 put_text_prop (s, e, object, prop, value, 0);
6413 DEFUN ("add-text-properties", Fadd_text_properties, 3, 4, 0, /*
6414 Add properties to the characters from START to END.
6415 The third argument PROPS is a property list specifying the property values
6416 to add. The optional fourth argument, OBJECT, is the buffer or string
6417 containing the text and defaults to the current buffer. Returns t if
6418 any property was changed, nil otherwise.
6420 (start, end, props, object))
6422 /* This function can GC */
6426 object = decode_buffer_or_string (object);
6427 get_buffer_or_string_range_byte (object, start, end, &s, &e, 0);
6429 for (; !NILP (props); props = Fcdr (Fcdr (props)))
6431 Lisp_Object prop = XCAR (props);
6432 Lisp_Object value = Fcar (XCDR (props));
6433 changed |= put_text_prop (s, e, object, prop, value, 1);
6435 return changed ? Qt : Qnil;
6439 DEFUN ("add-nonduplicable-text-properties", Fadd_nonduplicable_text_properties,
6441 Add nonduplicable properties to the characters from START to END.
6442 \(The properties will not be copied when the characters are copied.)
6443 The third argument PROPS is a property list specifying the property values
6444 to add. The optional fourth argument, OBJECT, is the buffer or string
6445 containing the text and defaults to the current buffer. Returns t if
6446 any property was changed, nil otherwise.
6448 (start, end, props, object))
6450 /* This function can GC */
6454 object = decode_buffer_or_string (object);
6455 get_buffer_or_string_range_byte (object, start, end, &s, &e, 0);
6457 for (; !NILP (props); props = Fcdr (Fcdr (props)))
6459 Lisp_Object prop = XCAR (props);
6460 Lisp_Object value = Fcar (XCDR (props));
6461 changed |= put_text_prop (s, e, object, prop, value, 0);
6463 return changed ? Qt : Qnil;
6466 DEFUN ("remove-text-properties", Fremove_text_properties, 3, 4, 0, /*
6467 Remove the given properties from all characters in the specified region.
6468 PROPS should be a plist, but the values in that plist are ignored (treated
6469 as nil). Returns t if any property was changed, nil otherwise.
6470 Fourth argument OBJECT is the buffer or string containing the text, and
6471 defaults to the current buffer.
6473 (start, end, props, object))
6475 /* This function can GC */
6479 object = decode_buffer_or_string (object);
6480 get_buffer_or_string_range_byte (object, start, end, &s, &e, 0);
6482 for (; !NILP (props); props = Fcdr (Fcdr (props)))
6484 Lisp_Object prop = XCAR (props);
6485 changed |= put_text_prop (s, e, object, prop, Qnil, 1);
6487 return changed ? Qt : Qnil;
6490 /* Whenever a text-prop extent is pasted into a buffer (via `yank' or `insert'
6491 or whatever) we attach the properties to the buffer by calling
6492 `put-text-property' instead of by simply allowing the extent to be copied or
6493 re-attached. Then we return nil, telling the extents code not to attach it
6494 again. By handing the insertion hackery in this way, we make kill/yank
6495 behave consistently with put-text-property and not fragment the extents
6496 (since text-prop extents must partition, not overlap).
6498 The lisp implementation of this was probably fast enough, but since I moved
6499 the rest of the put-text-prop code here, I moved this as well for
6502 DEFUN ("text-prop-extent-paste-function", Ftext_prop_extent_paste_function,
6504 Used as the `paste-function' property of `text-prop' extents.
6508 /* This function can GC */
6509 Lisp_Object prop, val;
6511 prop = Fextent_property (extent, Qtext_prop, Qnil);
6513 signal_simple_error ("Internal error: no text-prop", extent);
6514 val = Fextent_property (extent, prop, Qnil);
6516 /* removed by bill perry, 2/9/97
6517 ** This little bit of code would not allow you to have a text property
6518 ** with a value of Qnil. This is bad bad bad.
6521 signal_simple_error_2 ("Internal error: no text-prop",
6524 Fput_text_property (from, to, prop, val, Qnil);
6525 return Qnil; /* important! */
6528 /* This function could easily be written in Lisp but the C code wants
6529 to use it in connection with invisible extents (at least currently).
6530 If this changes, consider moving this back into Lisp. */
6532 DEFUN ("next-single-property-change", Fnext_single_property_change,
6534 Return the position of next property change for a specific property.
6535 Scans characters forward from POS till it finds a change in the PROP
6536 property, then returns the position of the change. The optional third
6537 argument OBJECT is the buffer or string to scan (defaults to the current
6539 The property values are compared with `eq'.
6540 Return nil if the property is constant all the way to the end of BUFFER.
6541 If the value is non-nil, it is a position greater than POS, never equal.
6543 If the optional fourth argument LIMIT is non-nil, don't search
6544 past position LIMIT; return LIMIT if nothing is found before LIMIT.
6545 If two or more extents with conflicting non-nil values for PROP overlap
6546 a particular character, it is undefined which value is considered to be
6547 the value of PROP. (Note that this situation will not happen if you always
6548 use the text-property primitives.)
6550 (pos, prop, object, limit))
6554 Lisp_Object extent, value;
6557 object = decode_buffer_or_string (object);
6558 bpos = get_buffer_or_string_pos_char (object, pos, 0);
6561 blim = buffer_or_string_accessible_end_char (object);
6566 blim = get_buffer_or_string_pos_char (object, limit, 0);
6570 extent = Fextent_at (make_int (bpos), object, prop, Qnil, Qnil);
6572 value = Fextent_property (extent, prop, Qnil);
6578 bpos = XINT (Fnext_extent_change (make_int (bpos), object));
6580 break; /* property is the same all the way to the end */
6581 extent = Fextent_at (make_int (bpos), object, prop, Qnil, Qnil);
6582 if ((NILP (extent) && !NILP (value)) ||
6583 (!NILP (extent) && !EQ (value,
6584 Fextent_property (extent, prop, Qnil))))
6585 return make_int (bpos);
6588 /* I think it's more sensible for this function to return nil always
6589 in this situation and it used to do it this way, but it's been changed
6590 for FSF compatibility. */
6594 return make_int (blim);
6597 /* See comment on previous function about why this is written in C. */
6599 DEFUN ("previous-single-property-change", Fprevious_single_property_change,
6601 Return the position of next property change for a specific property.
6602 Scans characters backward from POS till it finds a change in the PROP
6603 property, then returns the position of the change. The optional third
6604 argument OBJECT is the buffer or string to scan (defaults to the current
6606 The property values are compared with `eq'.
6607 Return nil if the property is constant all the way to the start of BUFFER.
6608 If the value is non-nil, it is a position less than POS, never equal.
6610 If the optional fourth argument LIMIT is non-nil, don't search back
6611 past position LIMIT; return LIMIT if nothing is found until LIMIT.
6612 If two or more extents with conflicting non-nil values for PROP overlap
6613 a particular character, it is undefined which value is considered to be
6614 the value of PROP. (Note that this situation will not happen if you always
6615 use the text-property primitives.)
6617 (pos, prop, object, limit))
6621 Lisp_Object extent, value;
6624 object = decode_buffer_or_string (object);
6625 bpos = get_buffer_or_string_pos_char (object, pos, 0);
6628 blim = buffer_or_string_accessible_begin_char (object);
6633 blim = get_buffer_or_string_pos_char (object, limit, 0);
6637 /* extent-at refers to the character AFTER bpos, but we want the
6638 character before bpos. Thus the - 1. extent-at simply
6639 returns nil on bogus positions, so not to worry. */
6640 extent = Fextent_at (make_int (bpos - 1), object, prop, Qnil, Qnil);
6642 value = Fextent_property (extent, prop, Qnil);
6648 bpos = XINT (Fprevious_extent_change (make_int (bpos), object));
6650 break; /* property is the same all the way to the beginning */
6651 extent = Fextent_at (make_int (bpos - 1), object, prop, Qnil, Qnil);
6652 if ((NILP (extent) && !NILP (value)) ||
6653 (!NILP (extent) && !EQ (value,
6654 Fextent_property (extent, prop, Qnil))))
6655 return make_int (bpos);
6658 /* I think it's more sensible for this function to return nil always
6659 in this situation and it used to do it this way, but it's been changed
6660 for FSF compatibility. */
6664 return make_int (blim);
6667 #ifdef MEMORY_USAGE_STATS
6670 compute_buffer_extent_usage (struct buffer *b, struct overhead_stats *ovstats)
6672 /* #### not yet written */
6676 #endif /* MEMORY_USAGE_STATS */
6679 /************************************************************************/
6680 /* initialization */
6681 /************************************************************************/
6684 syms_of_extents (void)
6686 defsymbol (&Qextentp, "extentp");
6687 defsymbol (&Qextent_live_p, "extent-live-p");
6689 defsymbol (&Qall_extents_closed, "all-extents-closed");
6690 defsymbol (&Qall_extents_open, "all-extents-open");
6691 defsymbol (&Qall_extents_closed_open, "all-extents-closed-open");
6692 defsymbol (&Qall_extents_open_closed, "all-extents-open-closed");
6693 defsymbol (&Qstart_in_region, "start-in-region");
6694 defsymbol (&Qend_in_region, "end-in-region");
6695 defsymbol (&Qstart_and_end_in_region, "start-and-end-in-region");
6696 defsymbol (&Qstart_or_end_in_region, "start-or-end-in-region");
6697 defsymbol (&Qnegate_in_region, "negate-in-region");
6699 defsymbol (&Qdetached, "detached");
6700 defsymbol (&Qdestroyed, "destroyed");
6701 defsymbol (&Qbegin_glyph, "begin-glyph");
6702 defsymbol (&Qend_glyph, "end-glyph");
6703 defsymbol (&Qstart_open, "start-open");
6704 defsymbol (&Qend_open, "end-open");
6705 defsymbol (&Qstart_closed, "start-closed");
6706 defsymbol (&Qend_closed, "end-closed");
6707 defsymbol (&Qread_only, "read-only");
6708 /* defsymbol (&Qhighlight, "highlight"); in faces.c */
6709 defsymbol (&Qunique, "unique");
6710 defsymbol (&Qduplicable, "duplicable");
6711 defsymbol (&Qdetachable, "detachable");
6712 defsymbol (&Qpriority, "priority");
6713 defsymbol (&Qmouse_face, "mouse-face");
6714 defsymbol (&Qinitial_redisplay_function,"initial-redisplay-function");
6717 defsymbol (&Qglyph_layout, "glyph-layout"); /* backwards compatibility */
6718 defsymbol (&Qbegin_glyph_layout, "begin-glyph-layout");
6719 defsymbol (&Qend_glyph_layout, "end-glyph-layout");
6720 defsymbol (&Qoutside_margin, "outside-margin");
6721 defsymbol (&Qinside_margin, "inside-margin");
6722 defsymbol (&Qwhitespace, "whitespace");
6723 /* Qtext defined in general.c */
6725 defsymbol (&Qglyph_invisible, "glyph-invisible");
6727 defsymbol (&Qpaste_function, "paste-function");
6728 defsymbol (&Qcopy_function, "copy-function");
6730 defsymbol (&Qtext_prop, "text-prop");
6731 defsymbol (&Qtext_prop_extent_paste_function,
6732 "text-prop-extent-paste-function");
6735 DEFSUBR (Fextent_live_p);
6736 DEFSUBR (Fextent_detached_p);
6737 DEFSUBR (Fextent_start_position);
6738 DEFSUBR (Fextent_end_position);
6739 DEFSUBR (Fextent_object);
6740 DEFSUBR (Fextent_length);
6742 DEFSUBR (Fmake_extent);
6743 DEFSUBR (Fcopy_extent);
6744 DEFSUBR (Fdelete_extent);
6745 DEFSUBR (Fdetach_extent);
6746 DEFSUBR (Fset_extent_endpoints);
6747 DEFSUBR (Fnext_extent);
6748 DEFSUBR (Fprevious_extent);
6750 DEFSUBR (Fnext_e_extent);
6751 DEFSUBR (Fprevious_e_extent);
6753 DEFSUBR (Fnext_extent_change);
6754 DEFSUBR (Fprevious_extent_change);
6756 DEFSUBR (Fextent_parent);
6757 DEFSUBR (Fextent_children);
6758 DEFSUBR (Fset_extent_parent);
6760 DEFSUBR (Fextent_in_region_p);
6761 DEFSUBR (Fmap_extents);
6762 DEFSUBR (Fmap_extent_children);
6763 DEFSUBR (Fextent_at);
6765 DEFSUBR (Fset_extent_initial_redisplay_function);
6766 DEFSUBR (Fextent_face);
6767 DEFSUBR (Fset_extent_face);
6768 DEFSUBR (Fextent_mouse_face);
6769 DEFSUBR (Fset_extent_mouse_face);
6770 DEFSUBR (Fset_extent_begin_glyph);
6771 DEFSUBR (Fset_extent_end_glyph);
6772 DEFSUBR (Fextent_begin_glyph);
6773 DEFSUBR (Fextent_end_glyph);
6774 DEFSUBR (Fset_extent_begin_glyph_layout);
6775 DEFSUBR (Fset_extent_end_glyph_layout);
6776 DEFSUBR (Fextent_begin_glyph_layout);
6777 DEFSUBR (Fextent_end_glyph_layout);
6778 DEFSUBR (Fset_extent_priority);
6779 DEFSUBR (Fextent_priority);
6780 DEFSUBR (Fset_extent_property);
6781 DEFSUBR (Fset_extent_properties);
6782 DEFSUBR (Fextent_property);
6783 DEFSUBR (Fextent_properties);
6785 DEFSUBR (Fhighlight_extent);
6786 DEFSUBR (Fforce_highlight_extent);
6788 DEFSUBR (Finsert_extent);
6790 DEFSUBR (Fget_text_property);
6791 DEFSUBR (Fget_char_property);
6792 DEFSUBR (Fput_text_property);
6793 DEFSUBR (Fput_nonduplicable_text_property);
6794 DEFSUBR (Fadd_text_properties);
6795 DEFSUBR (Fadd_nonduplicable_text_properties);
6796 DEFSUBR (Fremove_text_properties);
6797 DEFSUBR (Ftext_prop_extent_paste_function);
6798 DEFSUBR (Fnext_single_property_change);
6799 DEFSUBR (Fprevious_single_property_change);
6803 vars_of_extents (void)
6805 DEFVAR_INT ("mouse-highlight-priority", &mouse_highlight_priority /*
6806 The priority to use for the mouse-highlighting pseudo-extent
6807 that is used to highlight extents with the `mouse-face' attribute set.
6808 See `set-extent-priority'.
6810 /* Set mouse-highlight-priority (which ends up being used both for the
6811 mouse-highlighting pseudo-extent and the primary selection extent)
6812 to a very high value because very few extents should override it.
6813 1000 gives lots of room below it for different-prioritized extents.
6814 10 doesn't. ediff, for example, likes to use priorities around 100.
6816 mouse_highlight_priority = /* 10 */ 1000;
6818 DEFVAR_LISP ("default-text-properties", &Vdefault_text_properties /*
6819 Property list giving default values for text properties.
6820 Whenever a character does not specify a value for a property, the value
6821 stored in this list is used instead. This only applies when the
6822 functions `get-text-property' or `get-char-property' are called.
6824 Vdefault_text_properties = Qnil;
6826 staticpro (&Vlast_highlighted_extent);
6827 Vlast_highlighted_extent = Qnil;
6829 Vextent_face_reusable_list = Fcons (Qnil, Qnil);
6830 staticpro (&Vextent_face_reusable_list);
6832 extent_auxiliary_defaults.begin_glyph = Qnil;
6833 extent_auxiliary_defaults.end_glyph = Qnil;
6834 extent_auxiliary_defaults.parent = Qnil;
6835 extent_auxiliary_defaults.children = Qnil;
6836 extent_auxiliary_defaults.priority = 0;
6837 extent_auxiliary_defaults.invisible = Qnil;
6838 extent_auxiliary_defaults.read_only = Qnil;
6839 extent_auxiliary_defaults.mouse_face = Qnil;
6840 extent_auxiliary_defaults.initial_redisplay_function = Qnil;
6841 extent_auxiliary_defaults.before_change_functions = Qnil;
6842 extent_auxiliary_defaults.after_change_functions = Qnil;
6846 complex_vars_of_extents (void)
6848 staticpro (&Vextent_face_memoize_hash_table);
6849 /* The memoize hash table maps from lists of symbols to lists of
6850 faces. It needs to be `equal' to implement the memoization.
6851 The reverse table maps in the other direction and just needs
6852 to do `eq' comparison because the lists of faces are already
6854 Vextent_face_memoize_hash_table =
6855 make_lisp_hash_table (100, HASH_TABLE_VALUE_WEAK, HASH_TABLE_EQUAL);
6856 staticpro (&Vextent_face_reverse_memoize_hash_table);
6857 Vextent_face_reverse_memoize_hash_table =
6858 make_lisp_hash_table (100, HASH_TABLE_KEY_WEAK, HASH_TABLE_EQ);