1 /* Copyright (c) 1994, 1995 Free Software Foundation, Inc.
2 Copyright (c) 1995 Sun Microsystems, Inc.
3 Copyright (c) 1995, 1996 Ben Wing.
5 This file is part of XEmacs.
7 XEmacs is free software; you can redistribute it and/or modify it
8 under the terms of the GNU General Public License as published by the
9 Free Software Foundation; either version 2, or (at your option) any
12 XEmacs is distributed in the hope that it will be useful, but WITHOUT
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
17 You should have received a copy of the GNU General Public License
18 along with XEmacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
22 /* Synched up with: Not in FSF. */
24 /* This file has been Mule-ized. */
26 /* Written by Ben Wing <ben@xemacs.org>.
28 [Originally written by some people at Lucid.
30 Start/end-open stuff added by John Rose (john.rose@eng.sun.com).
31 Rewritten from scratch by Ben Wing, December 1994.] */
35 Extents are regions over a buffer, with a start and an end position
36 denoting the region of the buffer included in the extent. In
37 addition, either end can be closed or open, meaning that the endpoint
38 is or is not logically included in the extent. Insertion of a character
39 at a closed endpoint causes the character to go inside the extent;
40 insertion at an open endpoint causes the character to go outside.
42 Extent endpoints are stored using memory indices (see insdel.c),
43 to minimize the amount of adjusting that needs to be done when
44 characters are inserted or deleted.
46 (Formerly, extent endpoints at the gap could be either before or
47 after the gap, depending on the open/closedness of the endpoint.
48 The intent of this was to make it so that insertions would
49 automatically go inside or out of extents as necessary with no
50 further work needing to be done. It didn't work out that way,
51 however, and just ended up complexifying and buggifying all the
54 Extents are compared using memory indices. There are two orderings
55 for extents and both orders are kept current at all times. The normal
56 or "display" order is as follows:
58 Extent A is "less than" extent B, that is, earlier in the display order,
59 if: A-start < B-start,
60 or if: A-start = B-start, and A-end > B-end
62 So if two extents begin at the same position, the larger of them is the
63 earlier one in the display order (EXTENT_LESS is true).
65 For the e-order, the same thing holds: Extent A is "less than" extent B
66 in e-order, that is, later in the buffer,
68 or if: A-end = B-end, and A-start > B-start
70 So if two extents end at the same position, the smaller of them is the
71 earlier one in the e-order (EXTENT_E_LESS is true).
73 The display order and the e-order are complementary orders: any
74 theorem about the display order also applies to the e-order if you
75 swap all occurrences of "display order" and "e-order", "less than"
76 and "greater than", and "extent start" and "extent end".
78 Extents can be zero-length, and will end up that way if their endpoints
79 are explicitly set that way or if their detachable property is nil
80 and all the text in the extent is deleted. (The exception is open-open
81 zero-length extents, which are barred from existing because there is
82 no sensible way to define their properties. Deletion of the text in
83 an open-open extent causes it to be converted into a closed-open
84 extent.) Zero-length extents are primarily used to represent
85 annotations, and behave as follows:
87 1) Insertion at the position of a zero-length extent expands the extent
88 if both endpoints are closed; goes after the extent if it is closed-open;
89 and goes before the extent if it is open-closed.
91 2) Deletion of a character on a side of a zero-length extent whose
92 corresponding endpoint is closed causes the extent to be detached if
93 it is detachable; if the extent is not detachable or the corresponding
94 endpoint is open, the extent remains in the buffer, moving as necessary.
96 Note that closed-open, non-detachable zero-length extents behave exactly
97 like markers and that open-closed, non-detachable zero-length extents
98 behave like the "point-type" marker in Mule.
101 #### The following information is wrong in places.
103 More about the different orders:
104 --------------------------------
106 The extents in a buffer are ordered by "display order" because that
107 is that order that the redisplay mechanism needs to process them in.
108 The e-order is an auxiliary ordering used to facilitate operations
109 over extents. The operations that can be performed on the ordered
110 list of extents in a buffer are
112 1) Locate where an extent would go if inserted into the list.
113 2) Insert an extent into the list.
114 3) Remove an extent from the list.
115 4) Map over all the extents that overlap a range.
117 (4) requires being able to determine the first and last extents
118 that overlap a range.
120 NOTE: "overlap" is used as follows:
122 -- two ranges overlap if they have at least one point in common.
123 Whether the endpoints are open or closed makes a difference here.
124 -- a point overlaps a range if the point is contained within the
125 range; this is equivalent to treating a point P as the range
127 -- In the case of an *extent* overlapping a point or range, the
128 extent is normally treated as having closed endpoints. This
129 applies consistently in the discussion of stacks of extents
130 and such below. Note that this definition of overlap is not
131 necessarily consistent with the extents that `map-extents'
132 maps over, since `map-extents' sometimes pays attention to
133 whether the endpoints of an extents are open or closed.
134 But for our purposes, it greatly simplifies things to treat
135 all extents as having closed endpoints.
137 First, define >, <, <=, etc. as applied to extents to mean
138 comparison according to the display order. Comparison between an
139 extent E and an index I means comparison between E and the range
141 Also define e>, e<, e<=, etc. to mean comparison according to the
143 For any range R, define R(0) to be the starting index of the range
144 and R(1) to be the ending index of the range.
145 For any extent E, define E(next) to be the extent directly following
146 E, and E(prev) to be the extent directly preceding E. Assume
147 E(next) and E(prev) can be determined from E in constant time.
148 (This is because we store the extent list as a doubly linked
150 Similarly, define E(e-next) and E(e-prev) to be the extents
151 directly following and preceding E in the e-order.
156 Let F be the first extent overlapping R.
157 Let L be the last extent overlapping R.
159 Theorem 1: R(1) lies between L and L(next), i.e. L <= R(1) < L(next).
161 This follows easily from the definition of display order. The
162 basic reason that this theorem applies is that the display order
163 sorts by increasing starting index.
165 Therefore, we can determine L just by looking at where we would
166 insert R(1) into the list, and if we know F and are moving forward
167 over extents, we can easily determine when we've hit L by comparing
168 the extent we're at to R(1).
170 Theorem 2: F(e-prev) e< [1, R(0)] e<= F.
172 This is the analog of Theorem 1, and applies because the e-order
173 sorts by increasing ending index.
175 Therefore, F can be found in the same amount of time as operation (1),
176 i.e. the time that it takes to locate where an extent would go if
177 inserted into the e-order list.
179 If the lists were stored as balanced binary trees, then operation (1)
180 would take logarithmic time, which is usually quite fast. However,
181 currently they're stored as simple doubly-linked lists, and instead
182 we do some caching to try to speed things up.
184 Define a "stack of extents" (or "SOE") as the set of extents
185 (ordered in the display order) that overlap an index I, together with
186 the SOE's "previous" extent, which is an extent that precedes I in
187 the e-order. (Hopefully there will not be very many extents between
188 I and the previous extent.)
192 Let I be an index, let S be the stack of extents on I, let F be
193 the first extent in S, and let P be S's previous extent.
195 Theorem 3: The first extent in S is the first extent that overlaps
198 Proof: Any extent that overlaps [I, J] but does not include I must
199 have a start index > I, and thus be greater than any extent in S.
201 Therefore, finding the first extent that overlaps a range R is the
202 same as finding the first extent that overlaps R(0).
204 Theorem 4: Let I2 be an index such that I2 > I, and let F2 be the
205 first extent that overlaps I2. Then, either F2 is in S or F2 is
206 greater than any extent in S.
208 Proof: If F2 does not include I then its start index is greater
209 than I and thus it is greater than any extent in S, including F.
210 Otherwise, F2 includes I and thus is in S, and thus F2 >= F.
230 #include "redisplay.h"
232 /* ------------------------------- */
234 /* ------------------------------- */
236 /* Note that this object is not extent-specific and should perhaps be
237 moved into another file. */
239 /* Holds a marker that moves as elements in the array are inserted and
240 deleted, similar to standard markers. */
242 typedef struct gap_array_marker
245 struct gap_array_marker *next;
248 /* Holds a "gap array", which is an array of elements with a gap located
249 in it. Insertions and deletions with a high degree of locality
250 are very fast, essentially in constant time. Array positions as
251 used and returned in the gap array functions are independent of
254 typedef struct gap_array
261 Gap_Array_Marker *markers;
264 Gap_Array_Marker *gap_array_marker_freelist;
266 /* Convert a "memory position" (i.e. taking the gap into account) into
267 the address of the element at (i.e. after) that position. "Memory
268 positions" are only used internally and are of type Memind.
269 "Array positions" are used externally and are of type int. */
270 #define GAP_ARRAY_MEMEL_ADDR(ga, memel) ((ga)->array + (ga)->elsize*(memel))
272 /* Number of elements currently in a gap array */
273 #define GAP_ARRAY_NUM_ELS(ga) ((ga)->numels)
275 #define GAP_ARRAY_ARRAY_TO_MEMORY_POS(ga, pos) \
276 ((pos) <= (ga)->gap ? (pos) : (pos) + (ga)->gapsize)
278 #define GAP_ARRAY_MEMORY_TO_ARRAY_POS(ga, pos) \
279 ((pos) <= (ga)->gap ? (pos) : (pos) - (ga)->gapsize)
281 /* Convert an array position into the address of the element at
282 (i.e. after) that position. */
283 #define GAP_ARRAY_EL_ADDR(ga, pos) ((pos) < (ga)->gap ? \
284 GAP_ARRAY_MEMEL_ADDR(ga, pos) : \
285 GAP_ARRAY_MEMEL_ADDR(ga, (pos) + (ga)->gapsize))
287 /* ------------------------------- */
289 /* ------------------------------- */
291 typedef struct extent_list_marker
295 struct extent_list_marker *next;
296 } Extent_List_Marker;
298 typedef struct extent_list
302 Extent_List_Marker *markers;
305 Extent_List_Marker *extent_list_marker_freelist;
307 #define EXTENT_LESS_VALS(e,st,nd) ((extent_start (e) < (st)) || \
308 ((extent_start (e) == (st)) && \
309 (extent_end (e) > (nd))))
311 #define EXTENT_EQUAL_VALS(e,st,nd) ((extent_start (e) == (st)) && \
312 (extent_end (e) == (nd)))
314 #define EXTENT_LESS_EQUAL_VALS(e,st,nd) ((extent_start (e) < (st)) || \
315 ((extent_start (e) == (st)) && \
316 (extent_end (e) >= (nd))))
318 /* Is extent E1 less than extent E2 in the display order? */
319 #define EXTENT_LESS(e1,e2) \
320 EXTENT_LESS_VALS (e1, extent_start (e2), extent_end (e2))
322 /* Is extent E1 equal to extent E2? */
323 #define EXTENT_EQUAL(e1,e2) \
324 EXTENT_EQUAL_VALS (e1, extent_start (e2), extent_end (e2))
326 /* Is extent E1 less than or equal to extent E2 in the display order? */
327 #define EXTENT_LESS_EQUAL(e1,e2) \
328 EXTENT_LESS_EQUAL_VALS (e1, extent_start (e2), extent_end (e2))
330 #define EXTENT_E_LESS_VALS(e,st,nd) ((extent_end (e) < (nd)) || \
331 ((extent_end (e) == (nd)) && \
332 (extent_start (e) > (st))))
334 #define EXTENT_E_LESS_EQUAL_VALS(e,st,nd) ((extent_end (e) < (nd)) || \
335 ((extent_end (e) == (nd)) && \
336 (extent_start (e) >= (st))))
338 /* Is extent E1 less than extent E2 in the e-order? */
339 #define EXTENT_E_LESS(e1,e2) \
340 EXTENT_E_LESS_VALS(e1, extent_start (e2), extent_end (e2))
342 /* Is extent E1 less than or equal to extent E2 in the e-order? */
343 #define EXTENT_E_LESS_EQUAL(e1,e2) \
344 EXTENT_E_LESS_EQUAL_VALS (e1, extent_start (e2), extent_end (e2))
346 #define EXTENT_GAP_ARRAY_AT(ga, pos) (* (EXTENT *) GAP_ARRAY_EL_ADDR(ga, pos))
348 /* ------------------------------- */
349 /* auxiliary extent structure */
350 /* ------------------------------- */
352 struct extent_auxiliary extent_auxiliary_defaults;
354 /* ------------------------------- */
355 /* buffer-extent primitives */
356 /* ------------------------------- */
358 typedef struct stack_of_extents
360 Extent_List *extents;
361 Memind pos; /* Position of stack of extents. EXTENTS is the list of
362 all extents that overlap this position. This position
363 can be -1 if the stack of extents is invalid (this
364 happens when a buffer is first created or a string's
365 stack of extents is created [a string's stack of extents
366 is nuked when a GC occurs, to conserve memory]). */
369 /* ------------------------------- */
371 /* ------------------------------- */
373 typedef int Endpoint_Index;
375 #define memind_to_startind(x, start_open) \
376 ((Endpoint_Index) (((x) << 1) + !!(start_open)))
377 #define memind_to_endind(x, end_open) \
378 ((Endpoint_Index) (((x) << 1) - !!(end_open)))
380 /* Combination macros */
381 #define bytind_to_startind(buf, x, start_open) \
382 memind_to_startind (bytind_to_memind (buf, x), start_open)
383 #define bytind_to_endind(buf, x, end_open) \
384 memind_to_endind (bytind_to_memind (buf, x), end_open)
386 /* ------------------------------- */
387 /* buffer-or-string primitives */
388 /* ------------------------------- */
390 /* Similar for Bytinds and start/end indices. */
392 #define buffer_or_string_bytind_to_startind(obj, ind, start_open) \
393 memind_to_startind (buffer_or_string_bytind_to_memind (obj, ind), \
396 #define buffer_or_string_bytind_to_endind(obj, ind, end_open) \
397 memind_to_endind (buffer_or_string_bytind_to_memind (obj, ind), \
400 /* ------------------------------- */
401 /* Lisp-level functions */
402 /* ------------------------------- */
404 /* flags for decode_extent() */
405 #define DE_MUST_HAVE_BUFFER 1
406 #define DE_MUST_BE_ATTACHED 2
408 Lisp_Object Vlast_highlighted_extent;
409 int mouse_highlight_priority;
411 Lisp_Object Qextentp;
412 Lisp_Object Qextent_live_p;
414 Lisp_Object Qall_extents_closed;
415 Lisp_Object Qall_extents_open;
416 Lisp_Object Qall_extents_closed_open;
417 Lisp_Object Qall_extents_open_closed;
418 Lisp_Object Qstart_in_region;
419 Lisp_Object Qend_in_region;
420 Lisp_Object Qstart_and_end_in_region;
421 Lisp_Object Qstart_or_end_in_region;
422 Lisp_Object Qnegate_in_region;
424 Lisp_Object Qdetached;
425 Lisp_Object Qdestroyed;
426 Lisp_Object Qbegin_glyph;
427 Lisp_Object Qend_glyph;
428 Lisp_Object Qstart_open;
429 Lisp_Object Qend_open;
430 Lisp_Object Qstart_closed;
431 Lisp_Object Qend_closed;
432 Lisp_Object Qread_only;
433 /* Qhighlight defined in general.c */
435 Lisp_Object Qduplicable;
436 Lisp_Object Qdetachable;
437 Lisp_Object Qpriority;
438 Lisp_Object Qmouse_face;
439 Lisp_Object Qinitial_redisplay_function;
441 Lisp_Object Qglyph_layout; /* This exists only for backwards compatibility. */
442 Lisp_Object Qbegin_glyph_layout, Qend_glyph_layout;
443 Lisp_Object Qoutside_margin;
444 Lisp_Object Qinside_margin;
445 Lisp_Object Qwhitespace;
446 /* Qtext defined in general.c */
448 /* partially used in redisplay */
449 Lisp_Object Qglyph_invisible;
451 Lisp_Object Qcopy_function;
452 Lisp_Object Qpaste_function;
454 /* The idea here is that if we're given a list of faces, we
455 need to "memoize" this so that two lists of faces that are `equal'
456 turn into the same object. When `set-extent-face' is called, we
457 "memoize" into a list of actual faces; when `extent-face' is called,
458 we do a reverse lookup to get the list of symbols. */
460 static Lisp_Object canonicalize_extent_property (Lisp_Object prop,
462 Lisp_Object Vextent_face_memoize_hash_table;
463 Lisp_Object Vextent_face_reverse_memoize_hash_table;
464 Lisp_Object Vextent_face_reusable_list;
465 /* FSFmacs bogosity */
466 Lisp_Object Vdefault_text_properties;
469 EXFUN (Fextent_properties, 1);
470 EXFUN (Fset_extent_property, 3);
473 /************************************************************************/
474 /* Generalized gap array */
475 /************************************************************************/
477 /* This generalizes the "array with a gap" model used to store buffer
478 characters. This is based on the stuff in insdel.c and should
479 probably be merged with it. This is not extent-specific and should
480 perhaps be moved into a separate file. */
482 /* ------------------------------- */
483 /* internal functions */
484 /* ------------------------------- */
486 /* Adjust the gap array markers in the range (FROM, TO]. Parallel to
487 adjust_markers() in insdel.c. */
490 gap_array_adjust_markers (Gap_Array *ga, Memind from,
491 Memind to, int amount)
495 for (m = ga->markers; m; m = m->next)
496 m->pos = do_marker_adjustment (m->pos, from, to, amount);
499 /* Move the gap to array position POS. Parallel to move_gap() in
500 insdel.c but somewhat simplified. */
503 gap_array_move_gap (Gap_Array *ga, int pos)
506 int gapsize = ga->gapsize;
511 memmove (GAP_ARRAY_MEMEL_ADDR (ga, pos + gapsize),
512 GAP_ARRAY_MEMEL_ADDR (ga, pos),
513 (gap - pos)*ga->elsize);
514 gap_array_adjust_markers (ga, (Memind) pos, (Memind) gap,
519 memmove (GAP_ARRAY_MEMEL_ADDR (ga, gap),
520 GAP_ARRAY_MEMEL_ADDR (ga, gap + gapsize),
521 (pos - gap)*ga->elsize);
522 gap_array_adjust_markers (ga, (Memind) (gap + gapsize),
523 (Memind) (pos + gapsize), - gapsize);
528 /* Make the gap INCREMENT characters longer. Parallel to make_gap() in
532 gap_array_make_gap (Gap_Array *ga, int increment)
534 char *ptr = ga->array;
538 /* If we have to get more space, get enough to last a while. We use
539 a geometric progression that saves on realloc space. */
540 increment += 100 + ga->numels / 8;
542 ptr = (char *) xrealloc (ptr,
543 (ga->numels + ga->gapsize + increment)*ga->elsize);
548 real_gap_loc = ga->gap;
549 old_gap_size = ga->gapsize;
551 /* Call the newly allocated space a gap at the end of the whole space. */
552 ga->gap = ga->numels + ga->gapsize;
553 ga->gapsize = increment;
555 /* Move the new gap down to be consecutive with the end of the old one.
556 This adjusts the markers properly too. */
557 gap_array_move_gap (ga, real_gap_loc + old_gap_size);
559 /* Now combine the two into one large gap. */
560 ga->gapsize += old_gap_size;
561 ga->gap = real_gap_loc;
564 /* ------------------------------- */
565 /* external functions */
566 /* ------------------------------- */
568 /* Insert NUMELS elements (pointed to by ELPTR) into the specified
572 gap_array_insert_els (Gap_Array *ga, int pos, void *elptr, int numels)
574 assert (pos >= 0 && pos <= ga->numels);
575 if (ga->gapsize < numels)
576 gap_array_make_gap (ga, numels - ga->gapsize);
578 gap_array_move_gap (ga, pos);
580 memcpy (GAP_ARRAY_MEMEL_ADDR (ga, ga->gap), (char *) elptr,
582 ga->gapsize -= numels;
584 ga->numels += numels;
585 /* This is the equivalent of insert-before-markers.
587 #### Should only happen if marker is "moves forward at insert" type.
590 gap_array_adjust_markers (ga, pos - 1, pos, numels);
593 /* Delete NUMELS elements from the specified gap array, starting at FROM. */
596 gap_array_delete_els (Gap_Array *ga, int from, int numdel)
598 int to = from + numdel;
599 int gapsize = ga->gapsize;
602 assert (numdel >= 0);
603 assert (to <= ga->numels);
605 /* Make sure the gap is somewhere in or next to what we are deleting. */
607 gap_array_move_gap (ga, to);
609 gap_array_move_gap (ga, from);
611 /* Relocate all markers pointing into the new, larger gap
612 to point at the end of the text before the gap. */
613 gap_array_adjust_markers (ga, to + gapsize, to + gapsize,
616 ga->gapsize += numdel;
617 ga->numels -= numdel;
621 static Gap_Array_Marker *
622 gap_array_make_marker (Gap_Array *ga, int pos)
626 assert (pos >= 0 && pos <= ga->numels);
627 if (gap_array_marker_freelist)
629 m = gap_array_marker_freelist;
630 gap_array_marker_freelist = gap_array_marker_freelist->next;
633 m = xnew (Gap_Array_Marker);
635 m->pos = GAP_ARRAY_ARRAY_TO_MEMORY_POS (ga, pos);
636 m->next = ga->markers;
642 gap_array_delete_marker (Gap_Array *ga, Gap_Array_Marker *m)
644 Gap_Array_Marker *p, *prev;
646 for (prev = 0, p = ga->markers; p && p != m; prev = p, p = p->next)
650 prev->next = p->next;
652 ga->markers = p->next;
653 m->next = gap_array_marker_freelist;
654 m->pos = 0xDEADBEEF; /* -559038737 as an int */
655 gap_array_marker_freelist = m;
659 gap_array_delete_all_markers (Gap_Array *ga)
661 Gap_Array_Marker *p, *next;
663 for (p = ga->markers; p; p = next)
666 p->next = gap_array_marker_freelist;
667 p->pos = 0xDEADBEEF; /* -559038737 as an int */
668 gap_array_marker_freelist = p;
673 gap_array_move_marker (Gap_Array *ga, Gap_Array_Marker *m, int pos)
675 assert (pos >= 0 && pos <= ga->numels);
676 m->pos = GAP_ARRAY_ARRAY_TO_MEMORY_POS (ga, pos);
679 #define gap_array_marker_pos(ga, m) \
680 GAP_ARRAY_MEMORY_TO_ARRAY_POS (ga, (m)->pos)
683 make_gap_array (int elsize)
685 Gap_Array *ga = xnew_and_zero (Gap_Array);
691 free_gap_array (Gap_Array *ga)
695 gap_array_delete_all_markers (ga);
700 /************************************************************************/
701 /* Extent list primitives */
702 /************************************************************************/
704 /* A list of extents is maintained as a double gap array: one gap array
705 is ordered by start index (the "display order") and the other is
706 ordered by end index (the "e-order"). Note that positions in an
707 extent list should logically be conceived of as referring *to*
708 a particular extent (as is the norm in programs) rather than
709 sitting between two extents. Note also that callers of these
710 functions should not be aware of the fact that the extent list is
711 implemented as an array, except for the fact that positions are
712 integers (this should be generalized to handle integers and linked
716 /* Number of elements in an extent list */
717 #define extent_list_num_els(el) GAP_ARRAY_NUM_ELS(el->start)
719 /* Return the position at which EXTENT is located in the specified extent
720 list (in the display order if ENDP is 0, in the e-order otherwise).
721 If the extent is not found, the position where the extent would
722 be inserted is returned. If ENDP is 0, the insertion would go after
723 all other equal extents. If ENDP is not 0, the insertion would go
724 before all other equal extents. If FOUNDP is not 0, then whether
725 the extent was found will get written into it. */
728 extent_list_locate (Extent_List *el, EXTENT extent, int endp, int *foundp)
730 Gap_Array *ga = endp ? el->end : el->start;
731 int left = 0, right = GAP_ARRAY_NUM_ELS (ga);
732 int oldfoundpos, foundpos;
735 while (left != right)
737 /* RIGHT might not point to a valid extent (i.e. it's at the end
738 of the list), so NEWPOS must round down. */
739 unsigned int newpos = (left + right) >> 1;
740 EXTENT e = EXTENT_GAP_ARRAY_AT (ga, (int) newpos);
742 if (endp ? EXTENT_E_LESS (e, extent) : EXTENT_LESS (e, extent))
748 /* Now we're at the beginning of all equal extents. */
750 oldfoundpos = foundpos = left;
751 while (foundpos < GAP_ARRAY_NUM_ELS (ga))
753 EXTENT e = EXTENT_GAP_ARRAY_AT (ga, foundpos);
759 if (!EXTENT_EQUAL (e, extent))
771 /* Return the position of the first extent that begins at or after POS
772 (or ends at or after POS, if ENDP is not 0).
774 An out-of-range value for POS is allowed, and guarantees that the
775 position at the beginning or end of the extent list is returned. */
778 extent_list_locate_from_pos (Extent_List *el, Memind pos, int endp)
780 struct extent fake_extent;
783 Note that if we search for [POS, POS], then we get the following:
785 -- if ENDP is 0, then all extents whose start position is <= POS
786 lie before the returned position, and all extents whose start
787 position is > POS lie at or after the returned position.
789 -- if ENDP is not 0, then all extents whose end position is < POS
790 lie before the returned position, and all extents whose end
791 position is >= POS lie at or after the returned position.
794 set_extent_start (&fake_extent, endp ? pos : pos-1);
795 set_extent_end (&fake_extent, endp ? pos : pos-1);
796 return extent_list_locate (el, &fake_extent, endp, 0);
799 /* Return the extent at POS. */
802 extent_list_at (Extent_List *el, Memind pos, int endp)
804 Gap_Array *ga = endp ? el->end : el->start;
806 assert (pos >= 0 && pos < GAP_ARRAY_NUM_ELS (ga));
807 return EXTENT_GAP_ARRAY_AT (ga, pos);
810 /* Insert an extent into an extent list. */
813 extent_list_insert (Extent_List *el, EXTENT extent)
817 pos = extent_list_locate (el, extent, 0, &foundp);
819 gap_array_insert_els (el->start, pos, &extent, 1);
820 pos = extent_list_locate (el, extent, 1, &foundp);
822 gap_array_insert_els (el->end, pos, &extent, 1);
825 /* Delete an extent from an extent list. */
828 extent_list_delete (Extent_List *el, EXTENT extent)
832 pos = extent_list_locate (el, extent, 0, &foundp);
834 gap_array_delete_els (el->start, pos, 1);
835 pos = extent_list_locate (el, extent, 1, &foundp);
837 gap_array_delete_els (el->end, pos, 1);
841 extent_list_delete_all (Extent_List *el)
843 gap_array_delete_els (el->start, 0, GAP_ARRAY_NUM_ELS (el->start));
844 gap_array_delete_els (el->end, 0, GAP_ARRAY_NUM_ELS (el->end));
847 static Extent_List_Marker *
848 extent_list_make_marker (Extent_List *el, int pos, int endp)
850 Extent_List_Marker *m;
852 if (extent_list_marker_freelist)
854 m = extent_list_marker_freelist;
855 extent_list_marker_freelist = extent_list_marker_freelist->next;
858 m = xnew (Extent_List_Marker);
860 m->m = gap_array_make_marker (endp ? el->end : el->start, pos);
862 m->next = el->markers;
867 #define extent_list_move_marker(el, mkr, pos) \
868 gap_array_move_marker((mkr)->endp ? (el)->end : (el)->start, (mkr)->m, pos)
871 extent_list_delete_marker (Extent_List *el, Extent_List_Marker *m)
873 Extent_List_Marker *p, *prev;
875 for (prev = 0, p = el->markers; p && p != m; prev = p, p = p->next)
879 prev->next = p->next;
881 el->markers = p->next;
882 m->next = extent_list_marker_freelist;
883 extent_list_marker_freelist = m;
884 gap_array_delete_marker (m->endp ? el->end : el->start, m->m);
887 #define extent_list_marker_pos(el, mkr) \
888 gap_array_marker_pos ((mkr)->endp ? (el)->end : (el)->start, (mkr)->m)
891 allocate_extent_list (void)
893 Extent_List *el = xnew (Extent_List);
894 el->start = make_gap_array (sizeof(EXTENT));
895 el->end = make_gap_array (sizeof(EXTENT));
901 free_extent_list (Extent_List *el)
903 free_gap_array (el->start);
904 free_gap_array (el->end);
909 /************************************************************************/
910 /* Auxiliary extent structure */
911 /************************************************************************/
914 mark_extent_auxiliary (Lisp_Object obj, void (*markobj) (Lisp_Object))
916 struct extent_auxiliary *data = XEXTENT_AUXILIARY (obj);
917 markobj (data->begin_glyph);
918 markobj (data->end_glyph);
919 markobj (data->invisible);
920 markobj (data->children);
921 markobj (data->read_only);
922 markobj (data->mouse_face);
923 markobj (data->initial_redisplay_function);
924 markobj (data->before_change_functions);
925 markobj (data->after_change_functions);
929 DEFINE_LRECORD_IMPLEMENTATION ("extent-auxiliary", extent_auxiliary,
930 mark_extent_auxiliary, internal_object_printer,
931 0, 0, 0, 0, struct extent_auxiliary);
934 allocate_extent_auxiliary (EXTENT ext)
936 Lisp_Object extent_aux;
937 struct extent_auxiliary *data =
938 alloc_lcrecord_type (struct extent_auxiliary, &lrecord_extent_auxiliary);
940 copy_lcrecord (data, &extent_auxiliary_defaults);
941 XSETEXTENT_AUXILIARY (extent_aux, data);
942 ext->plist = Fcons (extent_aux, ext->plist);
943 ext->flags.has_aux = 1;
947 /************************************************************************/
948 /* Extent info structure */
949 /************************************************************************/
951 /* An extent-info structure consists of a list of the buffer or string's
952 extents and a "stack of extents" that lists all of the extents over
953 a particular position. The stack-of-extents info is used for
954 optimization purposes -- it basically caches some info that might
955 be expensive to compute. Certain otherwise hard computations are easy
956 given the stack of extents over a particular position, and if the
957 stack of extents over a nearby position is known (because it was
958 calculated at some prior point in time), it's easy to move the stack
959 of extents to the proper position.
961 Given that the stack of extents is an optimization, and given that
962 it requires memory, a string's stack of extents is wiped out each
963 time a garbage collection occurs. Therefore, any time you retrieve
964 the stack of extents, it might not be there. If you need it to
965 be there, use the _force version.
967 Similarly, a string may or may not have an extent_info structure.
968 (Generally it won't if there haven't been any extents added to the
969 string.) So use the _force version if you need the extent_info
970 structure to be there. */
972 static struct stack_of_extents *allocate_soe (void);
973 static void free_soe (struct stack_of_extents *soe);
974 static void soe_invalidate (Lisp_Object obj);
977 mark_extent_info (Lisp_Object obj, void (*markobj) (Lisp_Object))
979 struct extent_info *data = (struct extent_info *) XEXTENT_INFO (obj);
981 Extent_List *list = data->extents;
983 /* Vbuffer_defaults and Vbuffer_local_symbols are buffer-like
984 objects that are created specially and never have their extent
985 list initialized (or rather, it is set to zero in
986 nuke_all_buffer_slots()). However, these objects get
987 garbage-collected so we have to deal.
989 (Also the list can be zero when we're dealing with a destroyed
994 for (i = 0; i < extent_list_num_els (list); i++)
996 struct extent *extent = extent_list_at (list, i, 0);
999 XSETEXTENT (exobj, extent);
1008 finalize_extent_info (void *header, int for_disksave)
1010 struct extent_info *data = (struct extent_info *) header;
1017 free_soe (data->soe);
1022 free_extent_list (data->extents);
1027 DEFINE_LRECORD_IMPLEMENTATION ("extent-info", extent_info,
1028 mark_extent_info, internal_object_printer,
1029 finalize_extent_info, 0, 0, 0,
1030 struct extent_info);
1033 allocate_extent_info (void)
1035 Lisp_Object extent_info;
1036 struct extent_info *data =
1037 alloc_lcrecord_type (struct extent_info, &lrecord_extent_info);
1039 XSETEXTENT_INFO (extent_info, data);
1040 data->extents = allocate_extent_list ();
1046 flush_cached_extent_info (Lisp_Object extent_info)
1048 struct extent_info *data = XEXTENT_INFO (extent_info);
1052 free_soe (data->soe);
1058 /************************************************************************/
1059 /* Buffer/string extent primitives */
1060 /************************************************************************/
1062 /* The functions in this section are the ONLY ones that should know
1063 about the internal implementation of the extent lists. Other functions
1064 should only know that there are two orderings on extents, the "display"
1065 order (sorted by start position, basically) and the e-order (sorted
1066 by end position, basically), and that certain operations are provided
1067 to manipulate the list. */
1069 /* ------------------------------- */
1070 /* basic primitives */
1071 /* ------------------------------- */
1074 decode_buffer_or_string (Lisp_Object object)
1077 XSETBUFFER (object, current_buffer);
1078 else if (BUFFERP (object))
1079 CHECK_LIVE_BUFFER (object);
1080 else if (STRINGP (object))
1083 dead_wrong_type_argument (Qbuffer_or_string_p, object);
1089 extent_ancestor_1 (EXTENT e)
1091 while (e->flags.has_parent)
1093 /* There should be no circularities except in case of a logic
1094 error somewhere in the extent code */
1095 e = XEXTENT (XEXTENT_AUXILIARY (XCAR (e->plist))->parent);
1100 /* Given an extent object (string or buffer or nil), return its extent info.
1101 This may be 0 for a string. */
1103 static struct extent_info *
1104 buffer_or_string_extent_info (Lisp_Object object)
1106 if (STRINGP (object))
1108 Lisp_Object plist = XSTRING (object)->plist;
1109 if (!CONSP (plist) || !EXTENT_INFOP (XCAR (plist)))
1111 return XEXTENT_INFO (XCAR (plist));
1113 else if (NILP (object))
1116 return XEXTENT_INFO (XBUFFER (object)->extent_info);
1119 /* Given a string or buffer, return its extent list. This may be
1122 static Extent_List *
1123 buffer_or_string_extent_list (Lisp_Object object)
1125 struct extent_info *info = buffer_or_string_extent_info (object);
1129 return info->extents;
1132 /* Given a string or buffer, return its extent info. If it's not there,
1135 static struct extent_info *
1136 buffer_or_string_extent_info_force (Lisp_Object object)
1138 struct extent_info *info = buffer_or_string_extent_info (object);
1142 Lisp_Object extent_info;
1144 assert (STRINGP (object)); /* should never happen for buffers --
1145 the only buffers without an extent
1146 info are those after finalization,
1147 destroyed buffers, or special
1148 Lisp-inaccessible buffer objects. */
1149 extent_info = allocate_extent_info ();
1150 XSTRING (object)->plist = Fcons (extent_info, XSTRING (object)->plist);
1151 return XEXTENT_INFO (extent_info);
1157 /* Detach all the extents in OBJECT. Called from redisplay. */
1160 detach_all_extents (Lisp_Object object)
1162 struct extent_info *data = buffer_or_string_extent_info (object);
1170 for (i = 0; i < extent_list_num_els (data->extents); i++)
1172 EXTENT e = extent_list_at (data->extents, i, 0);
1173 /* No need to do detach_extent(). Just nuke the damn things,
1174 which results in the equivalent but faster. */
1175 set_extent_start (e, -1);
1176 set_extent_end (e, -1);
1180 /* But we need to clear all the lists containing extents or
1181 havoc will result. */
1182 extent_list_delete_all (data->extents);
1183 soe_invalidate (object);
1189 init_buffer_extents (struct buffer *b)
1191 b->extent_info = allocate_extent_info ();
1195 uninit_buffer_extents (struct buffer *b)
1197 struct extent_info *data = XEXTENT_INFO (b->extent_info);
1199 /* Don't destroy the extents here -- there may still be children
1200 extents pointing to the extents. */
1201 detach_all_extents (make_buffer (b));
1202 finalize_extent_info (data, 0);
1205 /* Retrieve the extent list that an extent is a member of; the
1206 return value will never be 0 except in destroyed buffers (in which
1207 case the only extents that can refer to this buffer are detached
1210 #define extent_extent_list(e) buffer_or_string_extent_list (extent_object (e))
1212 /* ------------------------------- */
1213 /* stack of extents */
1214 /* ------------------------------- */
1216 #ifdef ERROR_CHECK_EXTENTS
1219 sledgehammer_extent_check (Lisp_Object object)
1223 Extent_List *el = buffer_or_string_extent_list (object);
1224 struct buffer *buf = 0;
1229 if (BUFFERP (object))
1230 buf = XBUFFER (object);
1232 for (endp = 0; endp < 2; endp++)
1233 for (i = 1; i < extent_list_num_els (el); i++)
1235 EXTENT e1 = extent_list_at (el, i-1, endp);
1236 EXTENT e2 = extent_list_at (el, i, endp);
1239 assert (extent_start (e1) <= buf->text->gpt ||
1240 extent_start (e1) > buf->text->gpt + buf->text->gap_size);
1241 assert (extent_end (e1) <= buf->text->gpt ||
1242 extent_end (e1) > buf->text->gpt + buf->text->gap_size);
1244 assert (extent_start (e1) <= extent_end (e1));
1245 assert (endp ? (EXTENT_E_LESS_EQUAL (e1, e2)) :
1246 (EXTENT_LESS_EQUAL (e1, e2)));
1252 static Stack_Of_Extents *
1253 buffer_or_string_stack_of_extents (Lisp_Object object)
1255 struct extent_info *info = buffer_or_string_extent_info (object);
1261 static Stack_Of_Extents *
1262 buffer_or_string_stack_of_extents_force (Lisp_Object object)
1264 struct extent_info *info = buffer_or_string_extent_info_force (object);
1266 info->soe = allocate_soe ();
1270 /* #define SOE_DEBUG */
1274 static void print_extent_1 (char *buf, Lisp_Object extent);
1277 print_extent_2 (EXTENT e)
1282 XSETEXTENT (extent, e);
1283 print_extent_1 (buf, extent);
1284 fputs (buf, stdout);
1288 soe_dump (Lisp_Object obj)
1291 Stack_Of_Extents *soe = buffer_or_string_stack_of_extents (obj);
1301 printf ("SOE pos is %d (memind %d)\n",
1302 soe->pos < 0 ? soe->pos :
1303 buffer_or_string_memind_to_bytind (obj, soe->pos),
1305 for (endp = 0; endp < 2; endp++)
1307 printf (endp ? "SOE end:" : "SOE start:");
1308 for (i = 0; i < extent_list_num_els (sel); i++)
1310 EXTENT e = extent_list_at (sel, i, endp);
1321 /* Insert EXTENT into OBJ's stack of extents, if necessary. */
1324 soe_insert (Lisp_Object obj, EXTENT extent)
1326 Stack_Of_Extents *soe = buffer_or_string_stack_of_extents (obj);
1329 printf ("Inserting into SOE: ");
1330 print_extent_2 (extent);
1333 if (!soe || soe->pos < extent_start (extent) ||
1334 soe->pos > extent_end (extent))
1337 printf ("(not needed)\n\n");
1341 extent_list_insert (soe->extents, extent);
1343 puts ("SOE afterwards is:");
1348 /* Delete EXTENT from OBJ's stack of extents, if necessary. */
1351 soe_delete (Lisp_Object obj, EXTENT extent)
1353 Stack_Of_Extents *soe = buffer_or_string_stack_of_extents (obj);
1356 printf ("Deleting from SOE: ");
1357 print_extent_2 (extent);
1360 if (!soe || soe->pos < extent_start (extent) ||
1361 soe->pos > extent_end (extent))
1364 puts ("(not needed)\n");
1368 extent_list_delete (soe->extents, extent);
1370 puts ("SOE afterwards is:");
1375 /* Move OBJ's stack of extents to lie over the specified position. */
1378 soe_move (Lisp_Object obj, Memind pos)
1380 Stack_Of_Extents *soe = buffer_or_string_stack_of_extents_force (obj);
1381 Extent_List *sel = soe->extents;
1382 int numsoe = extent_list_num_els (sel);
1383 Extent_List *bel = buffer_or_string_extent_list (obj);
1387 #ifdef ERROR_CHECK_EXTENTS
1392 printf ("Moving SOE from %d (memind %d) to %d (memind %d)\n",
1393 soe->pos < 0 ? soe->pos :
1394 buffer_or_string_memind_to_bytind (obj, soe->pos), soe->pos,
1395 buffer_or_string_memind_to_bytind (obj, pos), pos);
1402 else if (soe->pos > pos)
1410 puts ("(not needed)\n");
1415 /* For DIRECTION = 1: Any extent that overlaps POS is either in the
1416 SOE (if the extent starts at or before SOE->POS) or is greater
1417 (in the display order) than any extent in the SOE (if it starts
1420 For DIRECTION = -1: Any extent that overlaps POS is either in the
1421 SOE (if the extent ends at or after SOE->POS) or is less (in the
1422 e-order) than any extent in the SOE (if it ends before SOE->POS).
1424 We proceed in two stages:
1426 1) delete all extents in the SOE that don't overlap POS.
1427 2) insert all extents into the SOE that start (or end, when
1428 DIRECTION = -1) in (SOE->POS, POS] and that overlap
1429 POS. (Don't include SOE->POS in the range because those
1430 extents would already be in the SOE.)
1437 /* Delete all extents in the SOE that don't overlap POS.
1438 This is all extents that end before (or start after,
1439 if DIRECTION = -1) POS.
1442 /* Deleting extents from the SOE is tricky because it changes
1443 the positions of extents. If we are deleting in the forward
1444 direction we have to call extent_list_at() on the same position
1445 over and over again because positions after the deleted element
1446 get shifted back by 1. To make life simplest, we delete forward
1447 irrespective of DIRECTION.
1455 end = extent_list_locate_from_pos (sel, pos, 1);
1459 start = extent_list_locate_from_pos (sel, pos+1, 0);
1463 for (i = start; i < end; i++)
1464 extent_list_delete (sel, extent_list_at (sel, start /* see above */,
1474 start_pos = extent_list_locate_from_pos (bel, soe->pos, endp) - 1;
1476 start_pos = extent_list_locate_from_pos (bel, soe->pos + 1, endp);
1478 for (; start_pos >= 0 && start_pos < extent_list_num_els (bel);
1479 start_pos += direction)
1481 EXTENT e = extent_list_at (bel, start_pos, endp);
1482 if ((direction > 0) ?
1483 (extent_start (e) > pos) :
1484 (extent_end (e) < pos))
1485 break; /* All further extents lie on the far side of POS
1486 and thus can't overlap. */
1487 if ((direction > 0) ?
1488 (extent_end (e) >= pos) :
1489 (extent_start (e) <= pos))
1490 extent_list_insert (sel, e);
1496 puts ("SOE afterwards is:");
1502 soe_invalidate (Lisp_Object obj)
1504 Stack_Of_Extents *soe = buffer_or_string_stack_of_extents (obj);
1508 extent_list_delete_all (soe->extents);
1513 static struct stack_of_extents *
1516 struct stack_of_extents *soe = xnew_and_zero (struct stack_of_extents);
1517 soe->extents = allocate_extent_list ();
1523 free_soe (struct stack_of_extents *soe)
1525 free_extent_list (soe->extents);
1529 /* ------------------------------- */
1530 /* other primitives */
1531 /* ------------------------------- */
1533 /* Return the start (endp == 0) or end (endp == 1) of an extent as
1534 a byte index. If you want the value as a memory index, use
1535 extent_endpoint(). If you want the value as a buffer position,
1536 use extent_endpoint_bufpos(). */
1539 extent_endpoint_bytind (EXTENT extent, int endp)
1541 assert (EXTENT_LIVE_P (extent));
1542 assert (!extent_detached_p (extent));
1544 Memind i = (endp) ? (extent_end (extent)) :
1545 (extent_start (extent));
1546 Lisp_Object obj = extent_object (extent);
1547 return buffer_or_string_memind_to_bytind (obj, i);
1552 extent_endpoint_bufpos (EXTENT extent, int endp)
1554 assert (EXTENT_LIVE_P (extent));
1555 assert (!extent_detached_p (extent));
1557 Memind i = (endp) ? (extent_end (extent)) :
1558 (extent_start (extent));
1559 Lisp_Object obj = extent_object (extent);
1560 return buffer_or_string_memind_to_bufpos (obj, i);
1564 /* A change to an extent occurred that will change the display, so
1565 notify redisplay. Maybe also recurse over all the extent's
1569 extent_changed_for_redisplay (EXTENT extent, int descendants_too,
1570 int invisibility_change)
1575 /* we could easily encounter a detached extent while traversing the
1576 children, but we should never be able to encounter a dead extent. */
1577 assert (EXTENT_LIVE_P (extent));
1579 if (descendants_too)
1581 Lisp_Object children = extent_children (extent);
1583 if (!NILP (children))
1585 /* first mark all of the extent's children. We will lose big-time
1586 if there are any circularities here, so we sure as hell better
1587 ensure that there aren't. */
1588 LIST_LOOP (rest, XWEAK_LIST_LIST (children))
1589 extent_changed_for_redisplay (XEXTENT (XCAR (rest)), 1,
1590 invisibility_change);
1594 /* now mark the extent itself. */
1596 object = extent_object (extent);
1598 if (!BUFFERP (object) || extent_detached_p (extent))
1599 /* #### Can changes to string extents affect redisplay?
1600 I will have to think about this. What about string glyphs?
1601 Things in the modeline? etc. */
1602 /* #### changes to string extents can certainly affect redisplay
1603 if the extent is in some generated-modeline-string: when
1604 we change an extent in generated-modeline-string, this changes
1605 its parent, which is in `modeline-format', so we should
1606 force the modeline to be updated. But how to determine whether
1607 a string is a `generated-modeline-string'? Looping through
1608 all buffers is not very efficient. Should we add all
1609 `generated-modeline-string' strings to a hash table?
1610 Maybe efficiency is not the greatest concern here and there's
1611 no big loss in looping over the buffers. */
1616 b = XBUFFER (object);
1617 BUF_FACECHANGE (b)++;
1618 MARK_EXTENTS_CHANGED;
1619 if (invisibility_change)
1621 buffer_extent_signal_changed_region (b,
1622 extent_endpoint_bufpos (extent, 0),
1623 extent_endpoint_bufpos (extent, 1));
1627 /* A change to an extent occurred that might affect redisplay.
1628 This is called when properties such as the endpoints, the layout,
1629 or the priority changes. Redisplay will be affected only if
1630 the extent has any displayable attributes. */
1633 extent_maybe_changed_for_redisplay (EXTENT extent, int descendants_too,
1634 int invisibility_change)
1636 /* Retrieve the ancestor for efficiency */
1637 EXTENT anc = extent_ancestor (extent);
1638 if (!NILP (extent_face (anc)) ||
1639 !NILP (extent_begin_glyph (anc)) ||
1640 !NILP (extent_end_glyph (anc)) ||
1641 !NILP (extent_mouse_face (anc)) ||
1642 !NILP (extent_invisible (anc)) ||
1643 !NILP (extent_initial_redisplay_function (anc)) ||
1644 invisibility_change)
1645 extent_changed_for_redisplay (extent, descendants_too,
1646 invisibility_change);
1650 make_extent_detached (Lisp_Object object)
1652 EXTENT extent = allocate_extent ();
1654 assert (NILP (object) || STRINGP (object) ||
1655 (BUFFERP (object) && BUFFER_LIVE_P (XBUFFER (object))));
1656 extent_object (extent) = object;
1657 /* Now make sure the extent info exists. */
1659 buffer_or_string_extent_info_force (object);
1663 /* A "real" extent is any extent other than the internal (not-user-visible)
1664 extents used by `map-extents'. */
1667 real_extent_at_forward (Extent_List *el, int pos, int endp)
1669 for (; pos < extent_list_num_els (el); pos++)
1671 EXTENT e = extent_list_at (el, pos, endp);
1672 if (!extent_internal_p (e))
1679 real_extent_at_backward (Extent_List *el, int pos, int endp)
1681 for (; pos >= 0; pos--)
1683 EXTENT e = extent_list_at (el, pos, endp);
1684 if (!extent_internal_p (e))
1691 extent_first (Lisp_Object obj)
1693 Extent_List *el = buffer_or_string_extent_list (obj);
1697 return real_extent_at_forward (el, 0, 0);
1702 extent_e_first (Lisp_Object obj)
1704 Extent_List *el = buffer_or_string_extent_list (obj);
1708 return real_extent_at_forward (el, 0, 1);
1713 extent_next (EXTENT e)
1715 Extent_List *el = extent_extent_list (e);
1717 int pos = extent_list_locate (el, e, 0, &foundp);
1719 return real_extent_at_forward (el, pos+1, 0);
1724 extent_e_next (EXTENT e)
1726 Extent_List *el = extent_extent_list (e);
1728 int pos = extent_list_locate (el, e, 1, &foundp);
1730 return real_extent_at_forward (el, pos+1, 1);
1735 extent_last (Lisp_Object obj)
1737 Extent_List *el = buffer_or_string_extent_list (obj);
1741 return real_extent_at_backward (el, extent_list_num_els (el) - 1, 0);
1746 extent_e_last (Lisp_Object obj)
1748 Extent_List *el = buffer_or_string_extent_list (obj);
1752 return real_extent_at_backward (el, extent_list_num_els (el) - 1, 1);
1757 extent_previous (EXTENT e)
1759 Extent_List *el = extent_extent_list (e);
1761 int pos = extent_list_locate (el, e, 0, &foundp);
1763 return real_extent_at_backward (el, pos-1, 0);
1768 extent_e_previous (EXTENT e)
1770 Extent_List *el = extent_extent_list (e);
1772 int pos = extent_list_locate (el, e, 1, &foundp);
1774 return real_extent_at_backward (el, pos-1, 1);
1779 extent_attach (EXTENT extent)
1781 Extent_List *el = extent_extent_list (extent);
1783 extent_list_insert (el, extent);
1784 soe_insert (extent_object (extent), extent);
1785 /* only this extent changed */
1786 extent_maybe_changed_for_redisplay (extent, 0,
1787 !NILP (extent_invisible (extent)));
1791 extent_detach (EXTENT extent)
1795 if (extent_detached_p (extent))
1797 el = extent_extent_list (extent);
1799 /* call this before messing with the extent. */
1800 extent_maybe_changed_for_redisplay (extent, 0,
1801 !NILP (extent_invisible (extent)));
1802 extent_list_delete (el, extent);
1803 soe_delete (extent_object (extent), extent);
1804 set_extent_start (extent, -1);
1805 set_extent_end (extent, -1);
1808 /* ------------------------------- */
1809 /* map-extents et al. */
1810 /* ------------------------------- */
1812 /* Returns true iff map_extents() would visit the given extent.
1813 See the comments at map_extents() for info on the overlap rule.
1814 Assumes that all validation on the extent and buffer positions has
1815 already been performed (see Fextent_in_region_p ()).
1818 extent_in_region_p (EXTENT extent, Bytind from, Bytind to,
1821 Lisp_Object obj = extent_object (extent);
1822 Endpoint_Index start, end, exs, exe;
1823 int start_open, end_open;
1824 unsigned int all_extents_flags = flags & ME_ALL_EXTENTS_MASK;
1825 unsigned int in_region_flags = flags & ME_IN_REGION_MASK;
1828 /* A zero-length region is treated as closed-closed. */
1831 flags |= ME_END_CLOSED;
1832 flags &= ~ME_START_OPEN;
1835 /* So is a zero-length extent. */
1836 if (extent_start (extent) == extent_end (extent))
1837 start_open = 0, end_open = 0;
1838 /* `all_extents_flags' will almost always be zero. */
1839 else if (all_extents_flags == 0)
1841 start_open = extent_start_open_p (extent);
1842 end_open = extent_end_open_p (extent);
1845 switch (all_extents_flags)
1847 case ME_ALL_EXTENTS_CLOSED: start_open = 0, end_open = 0; break;
1848 case ME_ALL_EXTENTS_OPEN: start_open = 1, end_open = 1; break;
1849 case ME_ALL_EXTENTS_CLOSED_OPEN: start_open = 0, end_open = 1; break;
1850 case ME_ALL_EXTENTS_OPEN_CLOSED: start_open = 1, end_open = 0; break;
1851 default: abort(); break;
1854 start = buffer_or_string_bytind_to_startind (obj, from,
1855 flags & ME_START_OPEN);
1856 end = buffer_or_string_bytind_to_endind (obj, to, ! (flags & ME_END_CLOSED));
1857 exs = memind_to_startind (extent_start (extent), start_open);
1858 exe = memind_to_endind (extent_end (extent), end_open);
1860 /* It's easy to determine whether an extent lies *outside* the
1861 region -- just determine whether it's completely before
1862 or completely after the region. Reject all such extents, so
1863 we're now left with only the extents that overlap the region.
1866 if (exs > end || exe < start)
1869 /* See if any further restrictions are called for. */
1870 /* in_region_flags will almost always be zero. */
1871 if (in_region_flags == 0)
1874 switch (in_region_flags)
1876 case ME_START_IN_REGION:
1877 retval = start <= exs && exs <= end; break;
1878 case ME_END_IN_REGION:
1879 retval = start <= exe && exe <= end; break;
1880 case ME_START_AND_END_IN_REGION:
1881 retval = start <= exs && exe <= end; break;
1882 case ME_START_OR_END_IN_REGION:
1883 retval = (start <= exs && exs <= end) || (start <= exe && exe <= end);
1888 return flags & ME_NEGATE_IN_REGION ? !retval : retval;
1891 struct map_extents_struct
1894 Extent_List_Marker *mkr;
1899 map_extents_unwind (Lisp_Object obj)
1901 struct map_extents_struct *closure =
1902 (struct map_extents_struct *) get_opaque_ptr (obj);
1903 free_opaque_ptr (obj);
1905 extent_detach (closure->range);
1907 extent_list_delete_marker (closure->el, closure->mkr);
1911 /* This is the guts of `map-extents' and the other functions that
1912 map over extents. In theory the operation of this function is
1913 simple: just figure out what extents we're mapping over, and
1914 call the function on each one of them in the range. Unfortunately
1915 there are a wide variety of things that the mapping function
1916 might do, and we have to be very tricky to avoid getting messed
1917 up. Furthermore, this function needs to be very fast (it is
1918 called multiple times every time text is inserted or deleted
1919 from a buffer), and so we can't always afford the overhead of
1920 dealing with all the possible things that the mapping function
1921 might do; thus, there are many flags that can be specified
1922 indicating what the mapping function might or might not do.
1924 The result of all this is that this is the most complicated
1925 function in this file. Change it at your own risk!
1927 A potential simplification to the logic below is to determine
1928 all the extents that the mapping function should be called on
1929 before any calls are actually made and save them in an array.
1930 That introduces its own complications, however (the array
1931 needs to be marked for garbage-collection, and a static array
1932 cannot be used because map_extents() needs to be reentrant).
1933 Furthermore, the results might be a little less sensible than
1938 map_extents_bytind (Bytind from, Bytind to, map_extents_fun fn, void *arg,
1939 Lisp_Object obj, EXTENT after, unsigned int flags)
1941 Memind st, en; /* range we're mapping over */
1942 EXTENT range = 0; /* extent for this, if ME_MIGHT_MODIFY_TEXT */
1943 Extent_List *el = 0; /* extent list we're iterating over */
1944 Extent_List_Marker *posm = 0; /* marker for extent list,
1945 if ME_MIGHT_MODIFY_EXTENTS */
1946 /* count and struct for unwind-protect, if ME_MIGHT_THROW */
1948 struct map_extents_struct closure;
1950 #ifdef ERROR_CHECK_EXTENTS
1951 assert (from <= to);
1952 assert (from >= buffer_or_string_absolute_begin_byte (obj) &&
1953 from <= buffer_or_string_absolute_end_byte (obj) &&
1954 to >= buffer_or_string_absolute_begin_byte (obj) &&
1955 to <= buffer_or_string_absolute_end_byte (obj));
1960 assert (EQ (obj, extent_object (after)));
1961 assert (!extent_detached_p (after));
1964 el = buffer_or_string_extent_list (obj);
1965 if (!el || !extent_list_num_els(el))
1969 st = buffer_or_string_bytind_to_memind (obj, from);
1970 en = buffer_or_string_bytind_to_memind (obj, to);
1972 if (flags & ME_MIGHT_MODIFY_TEXT)
1974 /* The mapping function might change the text in the buffer,
1975 so make an internal extent to hold the range we're mapping
1977 range = make_extent_detached (obj);
1978 set_extent_start (range, st);
1979 set_extent_end (range, en);
1980 range->flags.start_open = flags & ME_START_OPEN;
1981 range->flags.end_open = !(flags & ME_END_CLOSED);
1982 range->flags.internal = 1;
1983 range->flags.detachable = 0;
1984 extent_attach (range);
1987 if (flags & ME_MIGHT_THROW)
1989 /* The mapping function might throw past us so we need to use an
1990 unwind_protect() to eliminate the internal extent and range
1992 count = specpdl_depth ();
1993 closure.range = range;
1995 record_unwind_protect (map_extents_unwind,
1996 make_opaque_ptr (&closure));
1999 /* ---------- Figure out where we start and what direction
2000 we move in. This is the trickiest part of this
2001 function. ---------- */
2003 /* If ME_START_IN_REGION, ME_END_IN_REGION or ME_START_AND_END_IN_REGION
2004 was specified and ME_NEGATE_IN_REGION was not specified, our job
2005 is simple because of the presence of the display order and e-order.
2006 (Note that theoretically do something similar for
2007 ME_START_OR_END_IN_REGION, but that would require more trickiness
2008 than it's worth to avoid hitting the same extent twice.)
2010 In the general case, all the extents that overlap a range can be
2011 divided into two classes: those whose start position lies within
2012 the range (including the range's end but not including the
2013 range's start), and those that overlap the start position,
2014 i.e. those in the SOE for the start position. Or equivalently,
2015 the extents can be divided into those whose end position lies
2016 within the range and those in the SOE for the end position. Note
2017 that for this purpose we treat both the range and all extents in
2018 the buffer as closed on both ends. If this is not what the ME_
2019 flags specified, then we've mapped over a few too many extents,
2020 but no big deal because extent_in_region_p() will filter them
2021 out. Ideally, we could move the SOE to the closer of the range's
2022 two ends and work forwards or backwards from there. However, in
2023 order to make the semantics of the AFTER argument work out, we
2024 have to always go in the same direction; so we choose to always
2025 move the SOE to the start position.
2027 When it comes time to do the SOE stage, we first call soe_move()
2028 so that the SOE gets set up. Note that the SOE might get
2029 changed while we are mapping over its contents. If we can
2030 guarantee that the SOE won't get moved to a new position, we
2031 simply need to put a marker in the SOE and we will track deletions
2032 and insertions of extents in the SOE. If the SOE might get moved,
2033 however (this would happen as a result of a recursive invocation
2034 of map-extents or a call to a redisplay-type function), then
2035 trying to track its changes is hopeless, so we just keep a
2036 marker to the first (or last) extent in the SOE and use that as
2039 Finally, if DONT_USE_SOE is defined, we don't use the SOE at all
2040 and instead just map from the beginning of the buffer. This is
2041 used for testing purposes and allows the SOE to be calculated
2042 using map_extents() instead of the other way around. */
2045 int range_flag; /* ME_*_IN_REGION subset of flags */
2046 int do_soe_stage = 0; /* Are we mapping over the SOE? */
2047 /* Does the range stage map over start or end positions? */
2049 /* If type == 0, we include the start position in the range stage mapping.
2050 If type == 1, we exclude the start position in the range stage mapping.
2051 If type == 2, we begin at range_start_pos, an extent-list position.
2053 int range_start_type = 0;
2054 int range_start_pos = 0;
2057 range_flag = flags & ME_IN_REGION_MASK;
2058 if ((range_flag == ME_START_IN_REGION ||
2059 range_flag == ME_START_AND_END_IN_REGION) &&
2060 !(flags & ME_NEGATE_IN_REGION))
2062 /* map over start position in [range-start, range-end]. No SOE
2066 else if (range_flag == ME_END_IN_REGION && !(flags & ME_NEGATE_IN_REGION))
2068 /* map over end position in [range-start, range-end]. No SOE
2074 /* Need to include the SOE extents. */
2076 /* Just brute-force it: start from the beginning. */
2078 range_start_type = 2;
2079 range_start_pos = 0;
2081 Stack_Of_Extents *soe = buffer_or_string_stack_of_extents_force (obj);
2084 /* Move the SOE to the closer end of the range. This dictates
2085 whether we map over start positions or end positions. */
2088 numsoe = extent_list_num_els (soe->extents);
2091 if (flags & ME_MIGHT_MOVE_SOE)
2094 /* Can't map over SOE, so just extend range to cover the
2096 EXTENT e = extent_list_at (soe->extents, 0, 0);
2098 extent_list_locate (buffer_or_string_extent_list (obj), e, 0,
2101 range_start_type = 2;
2105 /* We can map over the SOE. */
2107 range_start_type = 1;
2112 /* No extents in the SOE to map over, so we act just as if
2113 ME_START_IN_REGION or ME_END_IN_REGION was specified.
2114 RANGE_ENDP already specified so no need to do anything else. */
2119 /* ---------- Now loop over the extents. ---------- */
2121 /* We combine the code for the two stages because much of it
2123 for (stage = 0; stage < 2; stage++)
2125 int pos = 0; /* Position in extent list */
2127 /* First set up start conditions */
2129 { /* The SOE stage */
2132 el = buffer_or_string_stack_of_extents_force (obj)->extents;
2133 /* We will always be looping over start extents here. */
2134 assert (!range_endp);
2138 { /* The range stage */
2139 el = buffer_or_string_extent_list (obj);
2140 switch (range_start_type)
2143 pos = extent_list_locate_from_pos (el, st, range_endp);
2146 pos = extent_list_locate_from_pos (el, st + 1, range_endp);
2149 pos = range_start_pos;
2154 if (flags & ME_MIGHT_MODIFY_EXTENTS)
2156 /* Create a marker to track changes to the extent list */
2158 /* Delete the marker used in the SOE stage. */
2159 extent_list_delete_marker
2160 (buffer_or_string_stack_of_extents_force (obj)->extents, posm);
2161 posm = extent_list_make_marker (el, pos, range_endp);
2162 /* tell the unwind function about the marker. */
2173 /* ----- update position in extent list
2174 and fetch next extent ----- */
2177 /* fetch POS again to track extent insertions or deletions */
2178 pos = extent_list_marker_pos (el, posm);
2179 if (pos >= extent_list_num_els (el))
2181 e = extent_list_at (el, pos, range_endp);
2184 /* now point the marker to the next one we're going to process.
2185 This ensures graceful behavior if this extent is deleted. */
2186 extent_list_move_marker (el, posm, pos);
2188 /* ----- deal with internal extents ----- */
2190 if (extent_internal_p (e))
2192 if (!(flags & ME_INCLUDE_INTERNAL))
2194 else if (e == range)
2196 /* We're processing internal extents and we've
2197 come across our own special range extent.
2198 (This happens only in adjust_extents*() and
2199 process_extents*(), which handle text
2200 insertion and deletion.) We need to omit
2201 processing of this extent; otherwise
2202 we will probably end up prematurely
2203 terminating this loop. */
2208 /* ----- deal with AFTER condition ----- */
2212 /* if e > after, then we can stop skipping extents. */
2213 if (EXTENT_LESS (after, e))
2215 else /* otherwise, skip this extent. */
2219 /* ----- stop if we're completely outside the range ----- */
2221 /* fetch ST and EN again to track text insertions or deletions */
2224 st = extent_start (range);
2225 en = extent_end (range);
2227 if (extent_endpoint (e, range_endp) > en)
2229 /* Can't be mapping over SOE because all extents in
2230 there should overlap ST */
2231 assert (stage == 1);
2235 /* ----- Now actually call the function ----- */
2237 obj2 = extent_object (e);
2238 if (extent_in_region_p (e,
2239 buffer_or_string_memind_to_bytind (obj2,
2241 buffer_or_string_memind_to_bytind (obj2,
2247 /* Function wants us to stop mapping. */
2248 stage = 1; /* so outer for loop will terminate */
2254 /* ---------- Finished looping. ---------- */
2257 if (flags & ME_MIGHT_THROW)
2258 /* This deletes the range extent and frees the marker. */
2259 unbind_to (count, Qnil);
2262 /* Delete them ourselves */
2264 extent_detach (range);
2266 extent_list_delete_marker (el, posm);
2271 map_extents (Bufpos from, Bufpos to, map_extents_fun fn,
2272 void *arg, Lisp_Object obj, EXTENT after, unsigned int flags)
2274 map_extents_bytind (buffer_or_string_bufpos_to_bytind (obj, from),
2275 buffer_or_string_bufpos_to_bytind (obj, to), fn, arg,
2279 /* ------------------------------- */
2280 /* adjust_extents() */
2281 /* ------------------------------- */
2283 /* Add AMOUNT to all extent endpoints in the range (FROM, TO]. This
2284 happens whenever the gap is moved or (under Mule) a character in a
2285 string is substituted for a different-length one. The reason for
2286 this is that extent endpoints behave just like markers (all memory
2287 indices do) and this adjustment correct for markers -- see
2288 adjust_markers(). Note that it is important that we visit all
2289 extent endpoints in the range, irrespective of whether the
2290 endpoints are open or closed.
2292 We could use map_extents() for this (and in fact the function
2293 was originally written that way), but the gap is in an incoherent
2294 state when this function is called and this function plays
2295 around with extent endpoints without detaching and reattaching
2296 the extents (this is provably correct and saves lots of time),
2297 so for safety we make it just look at the extent lists directly. */
2300 adjust_extents (Lisp_Object obj, Memind from, Memind to, int amount)
2306 Stack_Of_Extents *soe;
2308 #ifdef ERROR_CHECK_EXTENTS
2309 sledgehammer_extent_check (obj);
2311 el = buffer_or_string_extent_list (obj);
2313 if (!el || !extent_list_num_els(el))
2316 /* IMPORTANT! Compute the starting positions of the extents to
2317 modify BEFORE doing any modification! Otherwise the starting
2318 position for the second time through the loop might get
2319 incorrectly calculated (I got bit by this bug real bad). */
2320 startpos[0] = extent_list_locate_from_pos (el, from+1, 0);
2321 startpos[1] = extent_list_locate_from_pos (el, from+1, 1);
2322 for (endp = 0; endp < 2; endp++)
2324 for (pos = startpos[endp]; pos < extent_list_num_els (el);
2327 EXTENT e = extent_list_at (el, pos, endp);
2328 if (extent_endpoint (e, endp) > to)
2330 set_extent_endpoint (e,
2331 do_marker_adjustment (extent_endpoint (e, endp),
2337 /* The index for the buffer's SOE is a memory index and thus
2338 needs to be adjusted like a marker. */
2339 soe = buffer_or_string_stack_of_extents (obj);
2340 if (soe && soe->pos >= 0)
2341 soe->pos = do_marker_adjustment (soe->pos, from, to, amount);
2344 /* ------------------------------- */
2345 /* adjust_extents_for_deletion() */
2346 /* ------------------------------- */
2348 struct adjust_extents_for_deletion_arg
2350 EXTENT_dynarr *list;
2354 adjust_extents_for_deletion_mapper (EXTENT extent, void *arg)
2356 struct adjust_extents_for_deletion_arg *closure =
2357 (struct adjust_extents_for_deletion_arg *) arg;
2359 Dynarr_add (closure->list, extent);
2360 return 0; /* continue mapping */
2363 /* For all extent endpoints in the range (FROM, TO], move them to the beginning
2364 of the new gap. Note that it is important that we visit all extent
2365 endpoints in the range, irrespective of whether the endpoints are open or
2368 This function deals with weird stuff such as the fact that extents
2371 There is no string correspondent for this because you can't
2372 delete characters from a string.
2376 adjust_extents_for_deletion (Lisp_Object object, Bytind from,
2377 Bytind to, int gapsize, int numdel,
2380 struct adjust_extents_for_deletion_arg closure;
2382 Memind adjust_to = (Memind) (to + gapsize);
2383 Bytecount amount = - numdel - movegapsize;
2384 Memind oldsoe = 0, newsoe = 0;
2385 Stack_Of_Extents *soe = buffer_or_string_stack_of_extents (object);
2387 #ifdef ERROR_CHECK_EXTENTS
2388 sledgehammer_extent_check (object);
2390 closure.list = Dynarr_new (EXTENT);
2392 /* We're going to be playing weird games below with extents and the SOE
2393 and such, so compute the list now of all the extents that we're going
2394 to muck with. If we do the mapping and adjusting together, things can
2395 get all screwed up. */
2397 map_extents_bytind (from, to, adjust_extents_for_deletion_mapper,
2398 (void *) &closure, object, 0,
2399 /* extent endpoints move like markers regardless
2400 of their open/closeness. */
2401 ME_ALL_EXTENTS_CLOSED | ME_END_CLOSED |
2402 ME_START_OR_END_IN_REGION | ME_INCLUDE_INTERNAL);
2405 Old and new values for the SOE's position. (It gets adjusted
2406 like a marker, just like extent endpoints.)
2413 newsoe = do_marker_adjustment (soe->pos,
2414 adjust_to, adjust_to,
2420 for (i = 0; i < Dynarr_length (closure.list); i++)
2422 EXTENT extent = Dynarr_at (closure.list, i);
2423 Memind new_start = extent_start (extent);
2424 Memind new_end = extent_end (extent);
2426 /* do_marker_adjustment() will not adjust values that should not be
2427 adjusted. We're passing the same funky arguments to
2428 do_marker_adjustment() as buffer_delete_range() does. */
2430 do_marker_adjustment (new_start,
2431 adjust_to, adjust_to,
2434 do_marker_adjustment (new_end,
2435 adjust_to, adjust_to,
2438 /* We need to be very careful here so that the SOE doesn't get
2439 corrupted. We are shrinking extents out of the deleted region
2440 and simultaneously moving the SOE's pos out of the deleted
2441 region, so the SOE should contain the same extents at the end
2442 as at the beginning. However, extents may get reordered
2443 by this process, so we have to operate by pulling the extents
2444 out of the buffer and SOE, changing their bounds, and then
2445 reinserting them. In order for the SOE not to get screwed up,
2446 we have to make sure that the SOE's pos points to its old
2447 location whenever we pull an extent out, and points to its
2448 new location whenever we put the extent back in.
2451 if (new_start != extent_start (extent) ||
2452 new_end != extent_end (extent))
2454 extent_detach (extent);
2455 set_extent_start (extent, new_start);
2456 set_extent_end (extent, new_end);
2459 extent_attach (extent);
2468 #ifdef ERROR_CHECK_EXTENTS
2469 sledgehammer_extent_check (object);
2471 Dynarr_free (closure.list);
2474 /* ------------------------------- */
2475 /* extent fragments */
2476 /* ------------------------------- */
2478 /* Imagine that the buffer is divided up into contiguous,
2479 nonoverlapping "runs" of text such that no extent
2480 starts or ends within a run (extents that abut the
2483 An extent fragment is a structure that holds data about
2484 the run that contains a particular buffer position (if
2485 the buffer position is at the junction of two runs, the
2486 run after the position is used) -- the beginning and
2487 end of the run, a list of all of the extents in that
2488 run, the "merged face" that results from merging all of
2489 the faces corresponding to those extents, the begin and
2490 end glyphs at the beginning of the run, etc. This is
2491 the information that redisplay needs in order to
2494 Extent fragments have to be very quick to update to
2495 a new buffer position when moving linearly through
2496 the buffer. They rely on the stack-of-extents code,
2497 which does the heavy-duty algorithmic work of determining
2498 which extents overly a particular position. */
2500 /* This function returns the position of the beginning of
2501 the first run that begins after POS, or returns POS if
2502 there are no such runs. */
2505 extent_find_end_of_run (Lisp_Object obj, Bytind pos, int outside_accessible)
2508 Extent_List *bel = buffer_or_string_extent_list (obj);
2511 Memind mempos = buffer_or_string_bytind_to_memind (obj, pos);
2512 Bytind limit = outside_accessible ?
2513 buffer_or_string_absolute_end_byte (obj) :
2514 buffer_or_string_accessible_end_byte (obj);
2516 if (!bel || !extent_list_num_els(bel))
2519 sel = buffer_or_string_stack_of_extents_force (obj)->extents;
2520 soe_move (obj, mempos);
2522 /* Find the first start position after POS. */
2523 elind1 = extent_list_locate_from_pos (bel, mempos+1, 0);
2524 if (elind1 < extent_list_num_els (bel))
2525 pos1 = buffer_or_string_memind_to_bytind
2526 (obj, extent_start (extent_list_at (bel, elind1, 0)));
2530 /* Find the first end position after POS. The extent corresponding
2531 to this position is either in the SOE or is greater than or
2532 equal to POS1, so we just have to look in the SOE. */
2533 elind2 = extent_list_locate_from_pos (sel, mempos+1, 1);
2534 if (elind2 < extent_list_num_els (sel))
2535 pos2 = buffer_or_string_memind_to_bytind
2536 (obj, extent_end (extent_list_at (sel, elind2, 1)));
2540 return min (min (pos1, pos2), limit);
2544 extent_find_beginning_of_run (Lisp_Object obj, Bytind pos,
2545 int outside_accessible)
2548 Extent_List *bel = buffer_or_string_extent_list (obj);
2551 Memind mempos = buffer_or_string_bytind_to_memind (obj, pos);
2552 Bytind limit = outside_accessible ?
2553 buffer_or_string_absolute_begin_byte (obj) :
2554 buffer_or_string_accessible_begin_byte (obj);
2556 if (!bel || !extent_list_num_els(bel))
2559 sel = buffer_or_string_stack_of_extents_force (obj)->extents;
2560 soe_move (obj, mempos);
2562 /* Find the first end position before POS. */
2563 elind1 = extent_list_locate_from_pos (bel, mempos, 1);
2565 pos1 = buffer_or_string_memind_to_bytind
2566 (obj, extent_end (extent_list_at (bel, elind1 - 1, 1)));
2570 /* Find the first start position before POS. The extent corresponding
2571 to this position is either in the SOE or is less than or
2572 equal to POS1, so we just have to look in the SOE. */
2573 elind2 = extent_list_locate_from_pos (sel, mempos, 0);
2575 pos2 = buffer_or_string_memind_to_bytind
2576 (obj, extent_start (extent_list_at (sel, elind2 - 1, 0)));
2580 return max (max (pos1, pos2), limit);
2583 struct extent_fragment *
2584 extent_fragment_new (Lisp_Object buffer_or_string, struct frame *frm)
2586 struct extent_fragment *ef = xnew_and_zero (struct extent_fragment);
2588 ef->object = buffer_or_string;
2590 ef->extents = Dynarr_new (EXTENT);
2591 ef->begin_glyphs = Dynarr_new (glyph_block);
2592 ef->end_glyphs = Dynarr_new (glyph_block);
2598 extent_fragment_delete (struct extent_fragment *ef)
2600 Dynarr_free (ef->extents);
2601 Dynarr_free (ef->begin_glyphs);
2602 Dynarr_free (ef->end_glyphs);
2606 /* Note: CONST is losing, but `const' is part of the interface of qsort() */
2608 extent_priority_sort_function (const void *humpty, const void *dumpty)
2610 CONST EXTENT foo = * (CONST EXTENT *) humpty;
2611 CONST EXTENT bar = * (CONST EXTENT *) dumpty;
2612 if (extent_priority (foo) < extent_priority (bar))
2614 return extent_priority (foo) > extent_priority (bar);
2618 extent_fragment_sort_by_priority (EXTENT_dynarr *extarr)
2622 /* Sort our copy of the stack by extent_priority. We use a bubble
2623 sort here because it's going to be faster than qsort() for small
2624 numbers of extents (less than 10 or so), and 99.999% of the time
2625 there won't ever be more extents than this in the stack. */
2626 if (Dynarr_length (extarr) < 10)
2628 for (i = 1; i < Dynarr_length (extarr); i++)
2632 (extent_priority (Dynarr_at (extarr, j)) >
2633 extent_priority (Dynarr_at (extarr, j+1))))
2635 EXTENT tmp = Dynarr_at (extarr, j);
2636 Dynarr_at (extarr, j) = Dynarr_at (extarr, j+1);
2637 Dynarr_at (extarr, j+1) = tmp;
2643 /* But some loser programs mess up and may create a large number
2644 of extents overlapping the same spot. This will result in
2645 catastrophic behavior if we use the bubble sort above. */
2646 qsort (Dynarr_atp (extarr, 0), Dynarr_length (extarr),
2647 sizeof (EXTENT), extent_priority_sort_function);
2650 /* If PROP is the `invisible' property of an extent,
2651 this is 1 if the extent should be treated as invisible. */
2653 #define EXTENT_PROP_MEANS_INVISIBLE(buf, prop) \
2654 (EQ (buf->invisibility_spec, Qt) \
2656 : invisible_p (prop, buf->invisibility_spec))
2658 /* If PROP is the `invisible' property of a extent,
2659 this is 1 if the extent should be treated as invisible
2660 and should have an ellipsis. */
2662 #define EXTENT_PROP_MEANS_INVISIBLE_WITH_ELLIPSIS(buf, prop) \
2663 (EQ (buf->invisibility_spec, Qt) \
2665 : invisible_ellipsis_p (prop, buf->invisibility_spec))
2667 /* This is like a combination of memq and assq.
2668 Return 1 if PROPVAL appears as an element of LIST
2669 or as the car of an element of LIST.
2670 If PROPVAL is a list, compare each element against LIST
2671 in that way, and return 1 if any element of PROPVAL is found in LIST.
2673 This function cannot quit. */
2676 invisible_p (REGISTER Lisp_Object propval, Lisp_Object list)
2678 REGISTER Lisp_Object tail, proptail;
2679 for (tail = list; CONSP (tail); tail = XCDR (tail))
2681 REGISTER Lisp_Object tem;
2683 if (EQ (propval, tem))
2685 if (CONSP (tem) && EQ (propval, XCAR (tem)))
2688 if (CONSP (propval))
2689 for (proptail = propval; CONSP (proptail);
2690 proptail = XCDR (proptail))
2692 Lisp_Object propelt;
2693 propelt = XCAR (proptail);
2694 for (tail = list; CONSP (tail); tail = XCDR (tail))
2696 REGISTER Lisp_Object tem;
2698 if (EQ (propelt, tem))
2700 if (CONSP (tem) && EQ (propelt, XCAR (tem)))
2707 /* Return 1 if PROPVAL appears as the car of an element of LIST
2708 and the cdr of that element is non-nil.
2709 If PROPVAL is a list, check each element of PROPVAL in that way,
2710 and the first time some element is found,
2711 return 1 if the cdr of that element is non-nil.
2713 This function cannot quit. */
2716 invisible_ellipsis_p (REGISTER Lisp_Object propval, Lisp_Object list)
2718 REGISTER Lisp_Object tail, proptail;
2719 for (tail = list; CONSP (tail); tail = XCDR (tail))
2721 REGISTER Lisp_Object tem;
2723 if (CONSP (tem) && EQ (propval, XCAR (tem)))
2724 return ! NILP (XCDR (tem));
2726 if (CONSP (propval))
2727 for (proptail = propval; CONSP (proptail);
2728 proptail = XCDR (proptail))
2730 Lisp_Object propelt;
2731 propelt = XCAR (proptail);
2732 for (tail = list; CONSP (tail); tail = XCDR (tail))
2734 REGISTER Lisp_Object tem;
2736 if (CONSP (tem) && EQ (propelt, XCAR (tem)))
2737 return ! NILP (XCDR (tem));
2744 extent_fragment_update (struct window *w, struct extent_fragment *ef,
2749 buffer_or_string_stack_of_extents_force (ef->object)->extents;
2751 struct extent dummy_lhe_extent;
2752 Memind mempos = buffer_or_string_bytind_to_memind (ef->object, pos);
2754 #ifdef ERROR_CHECK_EXTENTS
2755 assert (pos >= buffer_or_string_accessible_begin_byte (ef->object)
2756 && pos <= buffer_or_string_accessible_end_byte (ef->object));
2759 Dynarr_reset (ef->extents);
2760 Dynarr_reset (ef->begin_glyphs);
2761 Dynarr_reset (ef->end_glyphs);
2763 ef->previously_invisible = ef->invisible;
2766 if (ef->invisible_ellipses)
2767 ef->invisible_ellipses_already_displayed = 1;
2770 ef->invisible_ellipses_already_displayed = 0;
2772 ef->invisible_ellipses = 0;
2774 /* Set up the begin and end positions. */
2776 ef->end = extent_find_end_of_run (ef->object, pos, 0);
2778 /* Note that extent_find_end_of_run() already moved the SOE for us. */
2779 /* soe_move (ef->object, mempos); */
2781 /* Determine the begin glyphs at POS. */
2782 for (i = 0; i < extent_list_num_els (sel); i++)
2784 EXTENT e = extent_list_at (sel, i, 0);
2785 if (extent_start (e) == mempos && !NILP (extent_begin_glyph (e)))
2787 Lisp_Object glyph = extent_begin_glyph (e);
2788 struct glyph_block gb;
2791 XSETEXTENT (gb.extent, e);
2792 Dynarr_add (ef->begin_glyphs, gb);
2796 /* Determine the end glyphs at POS. */
2797 for (i = 0; i < extent_list_num_els (sel); i++)
2799 EXTENT e = extent_list_at (sel, i, 1);
2800 if (extent_end (e) == mempos && !NILP (extent_end_glyph (e)))
2802 Lisp_Object glyph = extent_end_glyph (e);
2803 struct glyph_block gb;
2806 XSETEXTENT (gb.extent, e);
2807 Dynarr_add (ef->end_glyphs, gb);
2811 /* We tried determining all the charsets used in the run here,
2812 but that fails even if we only do the current line -- display
2813 tables or non-printable characters might cause other charsets
2816 /* Determine whether the last-highlighted-extent is present. */
2817 if (EXTENTP (Vlast_highlighted_extent))
2818 lhe = XEXTENT (Vlast_highlighted_extent);
2820 /* Now add all extents that overlap the character after POS and
2821 have a non-nil face. Also check if the character is invisible. */
2822 for (i = 0; i < extent_list_num_els (sel); i++)
2824 EXTENT e = extent_list_at (sel, i, 0);
2825 if (extent_end (e) > mempos)
2827 Lisp_Object invis_prop = extent_invisible (e);
2829 if (!NILP (invis_prop))
2831 if (!BUFFERP (ef->object))
2832 /* #### no `string-invisibility-spec' */
2836 if (!ef->invisible_ellipses_already_displayed &&
2837 EXTENT_PROP_MEANS_INVISIBLE_WITH_ELLIPSIS
2838 (XBUFFER (ef->object), invis_prop))
2841 ef->invisible_ellipses = 1;
2843 else if (EXTENT_PROP_MEANS_INVISIBLE
2844 (XBUFFER (ef->object), invis_prop))
2849 /* Remember that one of the extents in the list might be our
2850 dummy extent representing the highlighting that is
2851 attached to some other extent that is currently
2852 mouse-highlighted. When an extent is mouse-highlighted,
2853 it is as if there are two extents there, of potentially
2854 different priorities: the extent being highlighted, with
2855 whatever face and priority it has; and an ephemeral
2856 extent in the `mouse-face' face with
2857 `mouse-highlight-priority'.
2860 if (!NILP (extent_face (e)))
2861 Dynarr_add (ef->extents, e);
2865 /* zeroing isn't really necessary; we only deref `priority'
2867 xzero (dummy_lhe_extent);
2868 set_extent_priority (&dummy_lhe_extent,
2869 mouse_highlight_priority);
2870 /* Need to break up the following expression, due to an */
2871 /* error in the Digital UNIX 3.2g C compiler (Digital */
2872 /* UNIX Compiler Driver 3.11). */
2873 f = extent_mouse_face (lhe);
2874 extent_face (&dummy_lhe_extent) = f;
2875 Dynarr_add (ef->extents, &dummy_lhe_extent);
2877 /* since we are looping anyway, we might as well do this here */
2878 if ((!NILP(extent_initial_redisplay_function (e))) &&
2879 !extent_in_red_event_p(e))
2881 Lisp_Object function = extent_initial_redisplay_function (e);
2884 /* printf ("initial redisplay function called!\n "); */
2886 /* print_extent_2 (e);
2889 /* FIXME: One should probably inhibit the displaying of
2890 this extent to reduce flicker */
2891 extent_in_red_event_p(e) = 1;
2893 /* call the function */
2896 Fenqueue_eval_event(function,obj);
2901 extent_fragment_sort_by_priority (ef->extents);
2903 /* Now merge the faces together into a single face. The code to
2904 do this is in faces.c because it involves manipulating faces. */
2905 return get_extent_fragment_face_cache_index (w, ef);
2909 /************************************************************************/
2910 /* extent-object methods */
2911 /************************************************************************/
2913 /* These are the basic helper functions for handling the allocation of
2914 extent objects. They are similar to the functions for other
2915 lrecord objects. allocate_extent() is in alloc.c, not here. */
2917 static Lisp_Object mark_extent (Lisp_Object, void (*) (Lisp_Object));
2918 static int extent_equal (Lisp_Object, Lisp_Object, int depth);
2919 static unsigned long extent_hash (Lisp_Object obj, int depth);
2920 static void print_extent (Lisp_Object obj, Lisp_Object printcharfun,
2922 static Lisp_Object extent_getprop (Lisp_Object obj, Lisp_Object prop);
2923 static int extent_putprop (Lisp_Object obj, Lisp_Object prop,
2925 static int extent_remprop (Lisp_Object obj, Lisp_Object prop);
2926 static Lisp_Object extent_plist (Lisp_Object obj);
2928 static const struct lrecord_description extent_description[] = {
2929 { XD_LISP_OBJECT, offsetof(struct extent, object), 2 },
2930 { XD_LISP_OBJECT, offsetof(struct extent, plist), 1 },
2934 DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS ("extent", extent,
2937 /* NOTE: If you declare a
2938 finalization method here,
2939 it will NOT be called.
2942 extent_equal, extent_hash,
2944 extent_getprop, extent_putprop,
2945 extent_remprop, extent_plist,
2949 mark_extent (Lisp_Object obj, void (*markobj) (Lisp_Object))
2951 struct extent *extent = XEXTENT (obj);
2953 markobj (extent_object (extent));
2954 markobj (extent_no_chase_normal_field (extent, face));
2955 return extent->plist;
2959 print_extent_1 (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
2961 EXTENT ext = XEXTENT (obj);
2962 EXTENT anc = extent_ancestor (ext);
2964 char buf[64], *bp = buf;
2966 /* Retrieve the ancestor and use it, for faster retrieval of properties */
2968 if (!NILP (extent_begin_glyph (anc))) *bp++ = '*';
2969 *bp++ = (extent_start_open_p (anc) ? '(': '[');
2970 if (extent_detached_p (ext))
2971 strcpy (bp, "detached");
2974 Bufpos from = XINT (Fextent_start_position (obj));
2975 Bufpos to = XINT (Fextent_end_position (obj));
2976 sprintf (bp, "%d, %d", from, to);
2979 *bp++ = (extent_end_open_p (anc) ? ')': ']');
2980 if (!NILP (extent_end_glyph (anc))) *bp++ = '*';
2983 if (!NILP (extent_read_only (anc))) *bp++ = '%';
2984 if (!NILP (extent_mouse_face (anc))) *bp++ = 'H';
2985 if (extent_unique_p (anc)) *bp++ = 'U';
2986 else if (extent_duplicable_p (anc)) *bp++ = 'D';
2987 if (!NILP (extent_invisible (anc))) *bp++ = 'I';
2989 if (!NILP (extent_read_only (anc)) || !NILP (extent_mouse_face (anc)) ||
2990 extent_unique_p (anc) ||
2991 extent_duplicable_p (anc) || !NILP (extent_invisible (anc)))
2994 write_c_string (buf, printcharfun);
2996 tail = extent_plist_slot (anc);
2998 for (; !NILP (tail); tail = Fcdr (Fcdr (tail)))
3000 Lisp_Object v = XCAR (XCDR (tail));
3001 if (NILP (v)) continue;
3002 print_internal (XCAR (tail), printcharfun, escapeflag);
3003 write_c_string (" ", printcharfun);
3006 sprintf (buf, "0x%lx", (long) ext);
3007 write_c_string (buf, printcharfun);
3011 print_extent (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
3015 CONST char *title = "";
3016 CONST char *name = "";
3017 CONST char *posttitle = "";
3018 Lisp_Object obj2 = Qnil;
3020 /* Destroyed extents have 't' in the object field, causing
3021 extent_object() to abort (maybe). */
3022 if (EXTENT_LIVE_P (XEXTENT (obj)))
3023 obj2 = extent_object (XEXTENT (obj));
3026 title = "no buffer";
3027 else if (BUFFERP (obj2))
3029 if (BUFFER_LIVE_P (XBUFFER (obj2)))
3032 name = (char *) XSTRING_DATA (XBUFFER (obj2)->name);
3036 title = "Killed Buffer";
3042 assert (STRINGP (obj2));
3043 title = "string \"";
3045 name = (char *) XSTRING_DATA (obj2);
3050 if (!EXTENT_LIVE_P (XEXTENT (obj)))
3051 error ("printing unreadable object #<destroyed extent>");
3053 error ("printing unreadable object #<extent 0x%lx>",
3054 (long) XEXTENT (obj));
3057 if (!EXTENT_LIVE_P (XEXTENT (obj)))
3058 write_c_string ("#<destroyed extent", printcharfun);
3061 char *buf = (char *)
3062 alloca (strlen (title) + strlen (name) + strlen (posttitle) + 1);
3063 write_c_string ("#<extent ", printcharfun);
3064 print_extent_1 (obj, printcharfun, escapeflag);
3065 write_c_string (extent_detached_p (XEXTENT (obj))
3066 ? " from " : " in ", printcharfun);
3067 sprintf (buf, "%s%s%s", title, name, posttitle);
3068 write_c_string (buf, printcharfun);
3074 error ("printing unreadable object #<extent>");
3075 write_c_string ("#<extent", printcharfun);
3077 write_c_string (">", printcharfun);
3081 properties_equal (EXTENT e1, EXTENT e2, int depth)
3083 /* When this function is called, all indirections have been followed.
3084 Thus, the indirection checks in the various macros below will not
3085 amount to anything, and could be removed. However, the time
3086 savings would probably not be significant. */
3087 if (!(EQ (extent_face (e1), extent_face (e2)) &&
3088 extent_priority (e1) == extent_priority (e2) &&
3089 internal_equal (extent_begin_glyph (e1), extent_begin_glyph (e2),
3091 internal_equal (extent_end_glyph (e1), extent_end_glyph (e2),
3095 /* compare the bit flags. */
3097 /* The has_aux field should not be relevant. */
3098 int e1_has_aux = e1->flags.has_aux;
3099 int e2_has_aux = e2->flags.has_aux;
3102 e1->flags.has_aux = e2->flags.has_aux = 0;
3103 value = memcmp (&e1->flags, &e2->flags, sizeof (e1->flags));
3104 e1->flags.has_aux = e1_has_aux;
3105 e2->flags.has_aux = e2_has_aux;
3110 /* compare the random elements of the plists. */
3111 return !plists_differ (extent_no_chase_plist (e1),
3112 extent_no_chase_plist (e2),
3117 extent_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
3119 struct extent *e1 = XEXTENT (obj1);
3120 struct extent *e2 = XEXTENT (obj2);
3122 (extent_start (e1) == extent_start (e2) &&
3123 extent_end (e1) == extent_end (e2) &&
3124 internal_equal (extent_object (e1), extent_object (e2), depth + 1) &&
3125 properties_equal (extent_ancestor (e1), extent_ancestor (e2),
3129 static unsigned long
3130 extent_hash (Lisp_Object obj, int depth)
3132 struct extent *e = XEXTENT (obj);
3133 /* No need to hash all of the elements; that would take too long.
3134 Just hash the most common ones. */
3135 return HASH3 (extent_start (e), extent_end (e),
3136 internal_hash (extent_object (e), depth + 1));
3140 extent_getprop (Lisp_Object obj, Lisp_Object prop)
3142 return Fextent_property (obj, prop, Qunbound);
3146 extent_putprop (Lisp_Object obj, Lisp_Object prop, Lisp_Object value)
3148 Fset_extent_property (obj, prop, value);
3153 extent_remprop (Lisp_Object obj, Lisp_Object prop)
3155 EXTENT ext = XEXTENT (obj);
3157 /* This list is taken from Fset_extent_property, and should be kept
3159 if (EQ (prop, Qread_only)
3160 || EQ (prop, Qunique)
3161 || EQ (prop, Qduplicable)
3162 || EQ (prop, Qinvisible)
3163 || EQ (prop, Qdetachable)
3164 || EQ (prop, Qdetached)
3165 || EQ (prop, Qdestroyed)
3166 || EQ (prop, Qpriority)
3168 || EQ (prop, Qinitial_redisplay_function)
3169 || EQ (prop, Qafter_change_functions)
3170 || EQ (prop, Qbefore_change_functions)
3171 || EQ (prop, Qmouse_face)
3172 || EQ (prop, Qhighlight)
3173 || EQ (prop, Qbegin_glyph_layout)
3174 || EQ (prop, Qend_glyph_layout)
3175 || EQ (prop, Qglyph_layout)
3176 || EQ (prop, Qbegin_glyph)
3177 || EQ (prop, Qend_glyph)
3178 || EQ (prop, Qstart_open)
3179 || EQ (prop, Qend_open)
3180 || EQ (prop, Qstart_closed)
3181 || EQ (prop, Qend_closed)
3182 || EQ (prop, Qkeymap))
3184 /* #### Is this correct, anyway? */
3188 return external_remprop (&ext->plist, prop, 0, ERROR_ME);
3192 extent_plist (Lisp_Object obj)
3194 return Fextent_properties (obj);
3198 /************************************************************************/
3199 /* basic extent accessors */
3200 /************************************************************************/
3202 /* These functions are for checking externally-passed extent objects
3203 and returning an extent's basic properties, which include the
3204 buffer the extent is associated with, the endpoints of the extent's
3205 range, the open/closed-ness of those endpoints, and whether the
3206 extent is detached. Manipulating these properties requires
3207 manipulating the ordered lists that hold extents; thus, functions
3208 to do that are in a later section. */
3210 /* Given a Lisp_Object that is supposed to be an extent, make sure it
3211 is OK and return an extent pointer. Extents can be in one of four
3215 2) detached and not associated with a buffer
3216 3) detached and associated with a buffer
3217 4) attached to a buffer
3219 If FLAGS is 0, types 2-4 are allowed. If FLAGS is DE_MUST_HAVE_BUFFER,
3220 types 3-4 are allowed. If FLAGS is DE_MUST_BE_ATTACHED, only type 4
3225 decode_extent (Lisp_Object extent_obj, unsigned int flags)
3230 CHECK_LIVE_EXTENT (extent_obj);
3231 extent = XEXTENT (extent_obj);
3232 obj = extent_object (extent);
3234 /* the following condition will fail if we're dealing with a freed extent */
3235 assert (NILP (obj) || BUFFERP (obj) || STRINGP (obj));
3237 if (flags & DE_MUST_BE_ATTACHED)
3238 flags |= DE_MUST_HAVE_BUFFER;
3240 /* if buffer is dead, then convert extent to have no buffer. */
3241 if (BUFFERP (obj) && !BUFFER_LIVE_P (XBUFFER (obj)))
3242 obj = extent_object (extent) = Qnil;
3244 assert (!NILP (obj) || extent_detached_p (extent));
3246 if ((NILP (obj) && (flags & DE_MUST_HAVE_BUFFER))
3247 || (extent_detached_p (extent) && (flags & DE_MUST_BE_ATTACHED)))
3249 signal_simple_error ("extent doesn't belong to a buffer or string",
3256 /* Note that the returned value is a buffer position, not a byte index. */
3259 extent_endpoint_external (Lisp_Object extent_obj, int endp)
3261 EXTENT extent = decode_extent (extent_obj, 0);
3263 if (extent_detached_p (extent))
3266 return make_int (extent_endpoint_bufpos (extent, endp));
3269 DEFUN ("extentp", Fextentp, 1, 1, 0, /*
3270 Return t if OBJECT is an extent.
3274 return EXTENTP (object) ? Qt : Qnil;
3277 DEFUN ("extent-live-p", Fextent_live_p, 1, 1, 0, /*
3278 Return t if OBJECT is an extent that has not been destroyed.
3282 return EXTENTP (object) && EXTENT_LIVE_P (XEXTENT (object)) ? Qt : Qnil;
3285 DEFUN ("extent-detached-p", Fextent_detached_p, 1, 1, 0, /*
3286 Return t if EXTENT is detached.
3290 return extent_detached_p (decode_extent (extent, 0)) ? Qt : Qnil;
3293 DEFUN ("extent-object", Fextent_object, 1, 1, 0, /*
3294 Return object (buffer or string) that EXTENT refers to.
3298 return extent_object (decode_extent (extent, 0));
3301 DEFUN ("extent-start-position", Fextent_start_position, 1, 1, 0, /*
3302 Return start position of EXTENT, or nil if EXTENT is detached.
3306 return extent_endpoint_external (extent, 0);
3309 DEFUN ("extent-end-position", Fextent_end_position, 1, 1, 0, /*
3310 Return end position of EXTENT, or nil if EXTENT is detached.
3314 return extent_endpoint_external (extent, 1);
3317 DEFUN ("extent-length", Fextent_length, 1, 1, 0, /*
3318 Return length of EXTENT in characters.
3322 EXTENT e = decode_extent (extent, DE_MUST_BE_ATTACHED);
3323 return make_int (extent_endpoint_bufpos (e, 1)
3324 - extent_endpoint_bufpos (e, 0));
3327 DEFUN ("next-extent", Fnext_extent, 1, 1, 0, /*
3328 Find next extent after EXTENT.
3329 If EXTENT is a buffer return the first extent in the buffer; likewise
3331 Extents in a buffer are ordered in what is called the "display"
3332 order, which sorts by increasing start positions and then by *decreasing*
3334 If you want to perform an operation on a series of extents, use
3335 `map-extents' instead of this function; it is much more efficient.
3336 The primary use of this function should be to enumerate all the
3337 extents in a buffer.
3338 Note: The display order is not necessarily the order that `map-extents'
3339 processes extents in!
3346 if (EXTENTP (extent))
3347 next = extent_next (decode_extent (extent, DE_MUST_BE_ATTACHED));
3349 next = extent_first (decode_buffer_or_string (extent));
3353 XSETEXTENT (val, next);
3357 DEFUN ("previous-extent", Fprevious_extent, 1, 1, 0, /*
3358 Find last extent before EXTENT.
3359 If EXTENT is a buffer return the last extent in the buffer; likewise
3361 This function is analogous to `next-extent'.
3368 if (EXTENTP (extent))
3369 prev = extent_previous (decode_extent (extent, DE_MUST_BE_ATTACHED));
3371 prev = extent_last (decode_buffer_or_string (extent));
3375 XSETEXTENT (val, prev);
3381 DEFUN ("next-e-extent", Fnext_e_extent, 1, 1, 0, /*
3382 Find next extent after EXTENT using the "e" order.
3383 If EXTENT is a buffer return the first extent in the buffer; likewise
3391 if (EXTENTP (extent))
3392 next = extent_e_next (decode_extent (extent, DE_MUST_BE_ATTACHED));
3394 next = extent_e_first (decode_buffer_or_string (extent));
3398 XSETEXTENT (val, next);
3402 DEFUN ("previous-e-extent", Fprevious_e_extent, 1, 1, 0, /*
3403 Find last extent before EXTENT using the "e" order.
3404 If EXTENT is a buffer return the last extent in the buffer; likewise
3406 This function is analogous to `next-e-extent'.
3413 if (EXTENTP (extent))
3414 prev = extent_e_previous (decode_extent (extent, DE_MUST_BE_ATTACHED));
3416 prev = extent_e_last (decode_buffer_or_string (extent));
3420 XSETEXTENT (val, prev);
3426 DEFUN ("next-extent-change", Fnext_extent_change, 1, 2, 0, /*
3427 Return the next position after POS where an extent begins or ends.
3428 If POS is at the end of the buffer or string, POS will be returned;
3429 otherwise a position greater than POS will always be returned.
3430 If BUFFER is nil, the current buffer is assumed.
3434 Lisp_Object obj = decode_buffer_or_string (object);
3437 bpos = get_buffer_or_string_pos_byte (obj, pos, GB_ALLOW_PAST_ACCESSIBLE);
3438 bpos = extent_find_end_of_run (obj, bpos, 1);
3439 return make_int (buffer_or_string_bytind_to_bufpos (obj, bpos));
3442 DEFUN ("previous-extent-change", Fprevious_extent_change, 1, 2, 0, /*
3443 Return the last position before POS where an extent begins or ends.
3444 If POS is at the beginning of the buffer or string, POS will be returned;
3445 otherwise a position less than POS will always be returned.
3446 If OBJECT is nil, the current buffer is assumed.
3450 Lisp_Object obj = decode_buffer_or_string (object);
3453 bpos = get_buffer_or_string_pos_byte (obj, pos, GB_ALLOW_PAST_ACCESSIBLE);
3454 bpos = extent_find_beginning_of_run (obj, bpos, 1);
3455 return make_int (buffer_or_string_bytind_to_bufpos (obj, bpos));
3459 /************************************************************************/
3460 /* parent and children stuff */
3461 /************************************************************************/
3463 DEFUN ("extent-parent", Fextent_parent, 1, 1, 0, /*
3464 Return the parent (if any) of EXTENT.
3465 If an extent has a parent, it derives all its properties from that extent
3466 and has no properties of its own. (The only "properties" that the
3467 extent keeps are the buffer/string it refers to and the start and end
3468 points.) It is possible for an extent's parent to itself have a parent.
3471 /* do I win the prize for the strangest split infinitive? */
3473 EXTENT e = decode_extent (extent, 0);
3474 return extent_parent (e);
3477 DEFUN ("extent-children", Fextent_children, 1, 1, 0, /*
3478 Return a list of the children (if any) of EXTENT.
3479 The children of an extent are all those extents whose parent is that extent.
3480 This function does not recursively trace children of children.
3481 \(To do that, use `extent-descendants'.)
3485 EXTENT e = decode_extent (extent, 0);
3486 Lisp_Object children = extent_children (e);
3488 if (!NILP (children))
3489 return Fcopy_sequence (XWEAK_LIST_LIST (children));
3495 remove_extent_from_children_list (EXTENT e, Lisp_Object child)
3497 Lisp_Object children = extent_children (e);
3499 #ifdef ERROR_CHECK_EXTENTS
3500 assert (!NILP (memq_no_quit (child, XWEAK_LIST_LIST (children))));
3502 XWEAK_LIST_LIST (children) =
3503 delq_no_quit (child, XWEAK_LIST_LIST (children));
3507 add_extent_to_children_list (EXTENT e, Lisp_Object child)
3509 Lisp_Object children = extent_children (e);
3511 if (NILP (children))
3513 children = make_weak_list (WEAK_LIST_SIMPLE);
3514 set_extent_no_chase_aux_field (e, children, children);
3517 #ifdef ERROR_CHECK_EXTENTS
3518 assert (NILP (memq_no_quit (child, XWEAK_LIST_LIST (children))));
3520 XWEAK_LIST_LIST (children) = Fcons (child, XWEAK_LIST_LIST (children));
3523 DEFUN ("set-extent-parent", Fset_extent_parent, 2, 2, 0, /*
3524 Set the parent of EXTENT to PARENT (may be nil).
3525 See `extent-parent'.
3529 EXTENT e = decode_extent (extent, 0);
3530 Lisp_Object cur_parent = extent_parent (e);
3533 XSETEXTENT (extent, e);
3535 CHECK_LIVE_EXTENT (parent);
3536 if (EQ (parent, cur_parent))
3538 for (rest = parent; !NILP (rest); rest = extent_parent (XEXTENT (rest)))
3539 if (EQ (rest, extent))
3540 signal_simple_error ("Circular parent chain would result", extent);
3543 remove_extent_from_children_list (XEXTENT (cur_parent), extent);
3544 set_extent_no_chase_aux_field (e, parent, Qnil);
3545 e->flags.has_parent = 0;
3549 add_extent_to_children_list (XEXTENT (parent), extent);
3550 set_extent_no_chase_aux_field (e, parent, parent);
3551 e->flags.has_parent = 1;
3553 /* changing the parent also changes the properties of all children. */
3555 int old_invis = (!NILP (cur_parent) &&
3556 !NILP (extent_invisible (XEXTENT (cur_parent))));
3557 int new_invis = (!NILP (parent) &&
3558 !NILP (extent_invisible (XEXTENT (parent))));
3560 extent_maybe_changed_for_redisplay (e, 1, new_invis != old_invis);
3567 /************************************************************************/
3568 /* basic extent mutators */
3569 /************************************************************************/
3571 /* Note: If you track non-duplicable extents by undo, you'll get bogus
3572 undo records for transient extents via update-extent.
3573 For example, query-replace will do this.
3577 set_extent_endpoints_1 (EXTENT extent, Memind start, Memind end)
3579 #ifdef ERROR_CHECK_EXTENTS
3580 Lisp_Object obj = extent_object (extent);
3582 assert (start <= end);
3585 assert (valid_memind_p (XBUFFER (obj), start));
3586 assert (valid_memind_p (XBUFFER (obj), end));
3590 /* Optimization: if the extent is already where we want it to be,
3592 if (!extent_detached_p (extent) && extent_start (extent) == start &&
3593 extent_end (extent) == end)
3596 if (extent_detached_p (extent))
3598 if (extent_duplicable_p (extent))
3600 Lisp_Object extent_obj;
3601 XSETEXTENT (extent_obj, extent);
3602 record_extent (extent_obj, 1);
3606 extent_detach (extent);
3608 set_extent_start (extent, start);
3609 set_extent_end (extent, end);
3610 extent_attach (extent);
3613 /* Set extent's endpoints to S and E, and put extent in buffer or string
3614 OBJECT. (If OBJECT is nil, do not change the extent's object.) */
3617 set_extent_endpoints (EXTENT extent, Bytind s, Bytind e, Lisp_Object object)
3623 object = extent_object (extent);
3624 assert (!NILP (object));
3626 else if (!EQ (object, extent_object (extent)))
3628 extent_detach (extent);
3629 extent_object (extent) = object;
3632 start = s < 0 ? extent_start (extent) :
3633 buffer_or_string_bytind_to_memind (object, s);
3634 end = e < 0 ? extent_end (extent) :
3635 buffer_or_string_bytind_to_memind (object, e);
3636 set_extent_endpoints_1 (extent, start, end);
3640 set_extent_openness (EXTENT extent, int start_open, int end_open)
3642 if (start_open != -1)
3643 extent_start_open_p (extent) = start_open;
3645 extent_end_open_p (extent) = end_open;
3646 /* changing the open/closedness of an extent does not affect
3651 make_extent_internal (Lisp_Object object, Bytind from, Bytind to)
3655 extent = make_extent_detached (object);
3656 set_extent_endpoints (extent, from, to, Qnil);
3661 copy_extent (EXTENT original, Bytind from, Bytind to, Lisp_Object object)
3665 e = make_extent_detached (object);
3667 set_extent_endpoints (e, from, to, Qnil);
3669 e->plist = Fcopy_sequence (original->plist);
3670 memcpy (&e->flags, &original->flags, sizeof (e->flags));
3671 if (e->flags.has_aux)
3673 /* also need to copy the aux struct. It won't work for
3674 this extent to share the same aux struct as the original
3676 struct extent_auxiliary *data =
3677 alloc_lcrecord_type (struct extent_auxiliary,
3678 &lrecord_extent_auxiliary);
3680 copy_lcrecord (data, XEXTENT_AUXILIARY (XCAR (original->plist)));
3681 XSETEXTENT_AUXILIARY (XCAR (e->plist), data);
3685 /* we may have just added another child to the parent extent. */
3686 Lisp_Object parent = extent_parent (e);
3690 XSETEXTENT (extent, e);
3691 add_extent_to_children_list (XEXTENT (parent), extent);
3699 destroy_extent (EXTENT extent)
3701 Lisp_Object rest, nextrest, children;
3702 Lisp_Object extent_obj;
3704 if (!extent_detached_p (extent))
3705 extent_detach (extent);
3706 /* disassociate the extent from its children and parent */
3707 children = extent_children (extent);
3708 if (!NILP (children))
3710 LIST_LOOP_DELETING (rest, nextrest, XWEAK_LIST_LIST (children))
3711 Fset_extent_parent (XCAR (rest), Qnil);
3713 XSETEXTENT (extent_obj, extent);
3714 Fset_extent_parent (extent_obj, Qnil);
3715 /* mark the extent as destroyed */
3716 extent_object (extent) = Qt;
3719 DEFUN ("make-extent", Fmake_extent, 2, 3, 0, /*
3720 Make an extent for the range [FROM, TO) in BUFFER-OR-STRING.
3721 BUFFER-OR-STRING defaults to the current buffer. Insertions at point
3722 TO will be outside of the extent; insertions at FROM will be inside the
3723 extent, causing the extent to grow. (This is the same way that markers
3724 behave.) You can change the behavior of insertions at the endpoints
3725 using `set-extent-property'. The extent is initially detached if both
3726 FROM and TO are nil, and in this case BUFFER-OR-STRING defaults to nil,
3727 meaning the extent is in no buffer and no string.
3729 (from, to, buffer_or_string))
3731 Lisp_Object extent_obj;
3734 obj = decode_buffer_or_string (buffer_or_string);
3735 if (NILP (from) && NILP (to))
3737 if (NILP (buffer_or_string))
3739 XSETEXTENT (extent_obj, make_extent_detached (obj));
3745 get_buffer_or_string_range_byte (obj, from, to, &start, &end,
3746 GB_ALLOW_PAST_ACCESSIBLE);
3747 XSETEXTENT (extent_obj, make_extent_internal (obj, start, end));
3752 DEFUN ("copy-extent", Fcopy_extent, 1, 2, 0, /*
3753 Make a copy of EXTENT. It is initially detached.
3754 Optional argument BUFFER-OR-STRING defaults to EXTENT's buffer or string.
3756 (extent, buffer_or_string))
3758 EXTENT ext = decode_extent (extent, 0);
3760 if (NILP (buffer_or_string))
3761 buffer_or_string = extent_object (ext);
3763 buffer_or_string = decode_buffer_or_string (buffer_or_string);
3765 XSETEXTENT (extent, copy_extent (ext, -1, -1, buffer_or_string));
3769 DEFUN ("delete-extent", Fdelete_extent, 1, 1, 0, /*
3770 Remove EXTENT from its buffer and destroy it.
3771 This does not modify the buffer's text, only its display properties.
3772 The extent cannot be used thereafter.
3778 /* We do not call decode_extent() here because already-destroyed
3780 CHECK_EXTENT (extent);
3781 ext = XEXTENT (extent);
3783 if (!EXTENT_LIVE_P (ext))
3785 destroy_extent (ext);
3789 DEFUN ("detach-extent", Fdetach_extent, 1, 1, 0, /*
3790 Remove EXTENT from its buffer in such a way that it can be re-inserted.
3791 An extent is also detached when all of its characters are all killed by a
3792 deletion, unless its `detachable' property has been unset.
3794 Extents which have the `duplicable' attribute are tracked by the undo
3795 mechanism. Detachment via `detach-extent' and string deletion is recorded,
3796 as is attachment via `insert-extent' and string insertion. Extent motion,
3797 face changes, and attachment via `make-extent' and `set-extent-endpoints'
3798 are not recorded. This means that extent changes which are to be undo-able
3799 must be performed by character editing, or by insertion and detachment of
3804 EXTENT ext = decode_extent (extent, 0);
3806 if (extent_detached_p (ext))
3808 if (extent_duplicable_p (ext))
3809 record_extent (extent, 0);
3810 extent_detach (ext);
3815 DEFUN ("set-extent-endpoints", Fset_extent_endpoints, 3, 4, 0, /*
3816 Set the endpoints of EXTENT to START, END.
3817 If START and END are null, call detach-extent on EXTENT.
3818 BUFFER-OR-STRING specifies the new buffer or string that the extent should
3819 be in, and defaults to EXTENT's buffer or string. (If nil, and EXTENT
3820 is in no buffer and no string, it defaults to the current buffer.)
3821 See documentation on `detach-extent' for a discussion of undo recording.
3823 (extent, start, end, buffer_or_string))
3828 ext = decode_extent (extent, 0);
3830 if (NILP (buffer_or_string))
3832 buffer_or_string = extent_object (ext);
3833 if (NILP (buffer_or_string))
3834 buffer_or_string = Fcurrent_buffer ();
3837 buffer_or_string = decode_buffer_or_string (buffer_or_string);
3839 if (NILP (start) && NILP (end))
3840 return Fdetach_extent (extent);
3842 get_buffer_or_string_range_byte (buffer_or_string, start, end, &s, &e,
3843 GB_ALLOW_PAST_ACCESSIBLE);
3845 set_extent_endpoints (ext, s, e, buffer_or_string);
3850 /************************************************************************/
3851 /* mapping over extents */
3852 /************************************************************************/
3855 decode_map_extents_flags (Lisp_Object flags)
3857 unsigned int retval = 0;
3858 unsigned int all_extents_specified = 0;
3859 unsigned int in_region_specified = 0;
3861 if (EQ (flags, Qt)) /* obsoleteness compatibility */
3862 return ME_END_CLOSED;
3865 if (SYMBOLP (flags))
3866 flags = Fcons (flags, Qnil);
3867 while (!NILP (flags))
3873 if (EQ (sym, Qall_extents_closed) || EQ (sym, Qall_extents_open) ||
3874 EQ (sym, Qall_extents_closed_open) ||
3875 EQ (sym, Qall_extents_open_closed))
3877 if (all_extents_specified)
3878 error ("Only one `all-extents-*' flag may be specified");
3879 all_extents_specified = 1;
3881 if (EQ (sym, Qstart_in_region) || EQ (sym, Qend_in_region) ||
3882 EQ (sym, Qstart_and_end_in_region) ||
3883 EQ (sym, Qstart_or_end_in_region))
3885 if (in_region_specified)
3886 error ("Only one `*-in-region' flag may be specified");
3887 in_region_specified = 1;
3890 /* I do so love that conditional operator ... */
3892 EQ (sym, Qend_closed) ? ME_END_CLOSED :
3893 EQ (sym, Qstart_open) ? ME_START_OPEN :
3894 EQ (sym, Qall_extents_closed) ? ME_ALL_EXTENTS_CLOSED :
3895 EQ (sym, Qall_extents_open) ? ME_ALL_EXTENTS_OPEN :
3896 EQ (sym, Qall_extents_closed_open) ? ME_ALL_EXTENTS_CLOSED_OPEN :
3897 EQ (sym, Qall_extents_open_closed) ? ME_ALL_EXTENTS_OPEN_CLOSED :
3898 EQ (sym, Qstart_in_region) ? ME_START_IN_REGION :
3899 EQ (sym, Qend_in_region) ? ME_END_IN_REGION :
3900 EQ (sym, Qstart_and_end_in_region) ? ME_START_AND_END_IN_REGION :
3901 EQ (sym, Qstart_or_end_in_region) ? ME_START_OR_END_IN_REGION :
3902 EQ (sym, Qnegate_in_region) ? ME_NEGATE_IN_REGION :
3903 (signal_simple_error ("Invalid `map-extents' flag", sym), 0);
3905 flags = XCDR (flags);
3910 DEFUN ("extent-in-region-p", Fextent_in_region_p, 1, 4, 0, /*
3911 Return whether EXTENT overlaps a specified region.
3912 This is equivalent to whether `map-extents' would visit EXTENT when called
3915 (extent, from, to, flags))
3918 EXTENT ext = decode_extent (extent, DE_MUST_BE_ATTACHED);
3919 Lisp_Object obj = extent_object (ext);
3921 get_buffer_or_string_range_byte (obj, from, to, &start, &end, GB_ALLOW_NIL |
3922 GB_ALLOW_PAST_ACCESSIBLE);
3924 return extent_in_region_p (ext, start, end, decode_map_extents_flags (flags)) ?
3928 struct slow_map_extents_arg
3930 Lisp_Object map_arg;
3931 Lisp_Object map_routine;
3933 Lisp_Object property;
3938 slow_map_extents_function (EXTENT extent, void *arg)
3940 /* This function can GC */
3941 struct slow_map_extents_arg *closure = (struct slow_map_extents_arg *) arg;
3942 Lisp_Object extent_obj;
3944 XSETEXTENT (extent_obj, extent);
3946 /* make sure this extent qualifies according to the PROPERTY
3949 if (!NILP (closure->property))
3951 Lisp_Object value = Fextent_property (extent_obj, closure->property,
3953 if ((NILP (closure->value) && NILP (value)) ||
3954 (!NILP (closure->value) && !EQ (value, closure->value)))
3958 closure->result = call2 (closure->map_routine, extent_obj,
3960 return !NILP (closure->result);
3963 DEFUN ("map-extents", Fmap_extents, 1, 8, 0, /*
3964 Map FUNCTION over the extents which overlap a region in OBJECT.
3965 OBJECT is normally a buffer or string but could be an extent (see below).
3966 The region is normally bounded by [FROM, TO) (i.e. the beginning of the
3967 region is closed and the end of the region is open), but this can be
3968 changed with the FLAGS argument (see below for a complete discussion).
3970 FUNCTION is called with the arguments (extent, MAPARG). The arguments
3971 OBJECT, FROM, TO, MAPARG, and FLAGS are all optional and default to
3972 the current buffer, the beginning of OBJECT, the end of OBJECT, nil,
3973 and nil, respectively. `map-extents' returns the first non-nil result
3974 produced by FUNCTION, and no more calls to FUNCTION are made after it
3977 If OBJECT is an extent, FROM and TO default to the extent's endpoints,
3978 and the mapping omits that extent and its predecessors. This feature
3979 supports restarting a loop based on `map-extents'. Note: OBJECT must
3980 be attached to a buffer or string, and the mapping is done over that
3983 An extent overlaps the region if there is any point in the extent that is
3984 also in the region. (For the purpose of overlap, zero-length extents and
3985 regions are treated as closed on both ends regardless of their endpoints'
3986 specified open/closedness.) Note that the endpoints of an extent or region
3987 are considered to be in that extent or region if and only if the
3988 corresponding end is closed. For example, the extent [5,7] overlaps the
3989 region [2,5] because 5 is in both the extent and the region. However, (5,7]
3990 does not overlap [2,5] because 5 is not in the extent, and neither [5,7] nor
3991 \(5,7] overlaps the region [2,5) because 5 is not in the region.
3993 The optional FLAGS can be a symbol or a list of one or more symbols,
3994 modifying the behavior of `map-extents'. Allowed symbols are:
3996 end-closed The region's end is closed.
3998 start-open The region's start is open.
4000 all-extents-closed Treat all extents as closed on both ends for the
4001 purpose of determining whether they overlap the
4002 region, irrespective of their actual open- or
4004 all-extents-open Treat all extents as open on both ends.
4005 all-extents-closed-open Treat all extents as start-closed, end-open.
4006 all-extents-open-closed Treat all extents as start-open, end-closed.
4008 start-in-region In addition to the above conditions for extent
4009 overlap, the extent's start position must lie within
4010 the specified region. Note that, for this
4011 condition, open start positions are treated as if
4012 0.5 was added to the endpoint's value, and open
4013 end positions are treated as if 0.5 was subtracted
4014 from the endpoint's value.
4015 end-in-region The extent's end position must lie within the
4017 start-and-end-in-region Both the extent's start and end positions must lie
4019 start-or-end-in-region Either the extent's start or end position must lie
4022 negate-in-region The condition specified by a `*-in-region' flag
4023 must NOT hold for the extent to be considered.
4026 At most one of `all-extents-closed', `all-extents-open',
4027 `all-extents-closed-open', and `all-extents-open-closed' may be specified.
4029 At most one of `start-in-region', `end-in-region',
4030 `start-and-end-in-region', and `start-or-end-in-region' may be specified.
4032 If optional arg PROPERTY is non-nil, only extents with that property set
4033 on them will be visited. If optional arg VALUE is non-nil, only extents
4034 whose value for that property is `eq' to VALUE will be visited.
4036 (function, object, from, to, maparg, flags, property, value))
4038 /* This function can GC */
4039 struct slow_map_extents_arg closure;
4040 unsigned int me_flags;
4042 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
4045 if (EXTENTP (object))
4047 after = decode_extent (object, DE_MUST_BE_ATTACHED);
4049 from = Fextent_start_position (object);
4051 to = Fextent_end_position (object);
4052 object = extent_object (after);
4055 object = decode_buffer_or_string (object);
4057 get_buffer_or_string_range_byte (object, from, to, &start, &end,
4058 GB_ALLOW_NIL | GB_ALLOW_PAST_ACCESSIBLE);
4060 me_flags = decode_map_extents_flags (flags);
4062 if (!NILP (property))
4065 value = canonicalize_extent_property (property, value);
4068 GCPRO5 (function, maparg, object, property, value);
4070 closure.map_arg = maparg;
4071 closure.map_routine = function;
4072 closure.result = Qnil;
4073 closure.property = property;
4074 closure.value = value;
4076 map_extents_bytind (start, end, slow_map_extents_function,
4077 (void *) &closure, object, after,
4078 /* You never know what the user might do ... */
4079 me_flags | ME_MIGHT_CALL_ELISP);
4082 return closure.result;
4086 /************************************************************************/
4087 /* mapping over extents -- other functions */
4088 /************************************************************************/
4090 /* ------------------------------- */
4091 /* map-extent-children */
4092 /* ------------------------------- */
4094 struct slow_map_extent_children_arg
4096 Lisp_Object map_arg;
4097 Lisp_Object map_routine;
4099 Lisp_Object property;
4107 slow_map_extent_children_function (EXTENT extent, void *arg)
4109 /* This function can GC */
4110 struct slow_map_extent_children_arg *closure =
4111 (struct slow_map_extent_children_arg *) arg;
4112 Lisp_Object extent_obj;
4113 Bytind start = extent_endpoint_bytind (extent, 0);
4114 Bytind end = extent_endpoint_bytind (extent, 1);
4115 /* Make sure the extent starts inside the region of interest,
4116 rather than just overlaps it.
4118 if (start < closure->start_min)
4120 /* Make sure the extent is not a child of a previous visited one.
4121 We know already, because of extent ordering,
4122 that start >= prev_start, and that if
4123 start == prev_start, then end <= prev_end.
4125 if (start == closure->prev_start)
4127 if (end < closure->prev_end)
4130 else /* start > prev_start */
4132 if (start < closure->prev_end)
4134 /* corner case: prev_end can be -1 if there is no prev */
4136 XSETEXTENT (extent_obj, extent);
4138 /* make sure this extent qualifies according to the PROPERTY
4141 if (!NILP (closure->property))
4143 Lisp_Object value = Fextent_property (extent_obj, closure->property,
4145 if ((NILP (closure->value) && NILP (value)) ||
4146 (!NILP (closure->value) && !EQ (value, closure->value)))
4150 closure->result = call2 (closure->map_routine, extent_obj,
4153 /* Since the callback may change the buffer, compute all stored
4154 buffer positions here.
4156 closure->start_min = -1; /* no need for this any more */
4157 closure->prev_start = extent_endpoint_bytind (extent, 0);
4158 closure->prev_end = extent_endpoint_bytind (extent, 1);
4160 return !NILP (closure->result);
4163 DEFUN ("map-extent-children", Fmap_extent_children, 1, 8, 0, /*
4164 Map FUNCTION over the extents in the region from FROM to TO.
4165 FUNCTION is called with arguments (extent, MAPARG). See `map-extents'
4166 for a full discussion of the arguments FROM, TO, and FLAGS.
4168 The arguments are the same as for `map-extents', but this function differs
4169 in that it only visits extents which start in the given region, and also
4170 in that, after visiting an extent E, it skips all other extents which start
4171 inside E but end before E's end.
4173 Thus, this function may be used to walk a tree of extents in a buffer:
4174 (defun walk-extents (buffer &optional ignore)
4175 (map-extent-children 'walk-extents buffer))
4177 (function, object, from, to, maparg, flags, property, value))
4179 /* This function can GC */
4180 struct slow_map_extent_children_arg closure;
4181 unsigned int me_flags;
4183 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
4186 if (EXTENTP (object))
4188 after = decode_extent (object, DE_MUST_BE_ATTACHED);
4190 from = Fextent_start_position (object);
4192 to = Fextent_end_position (object);
4193 object = extent_object (after);
4196 object = decode_buffer_or_string (object);
4198 get_buffer_or_string_range_byte (object, from, to, &start, &end,
4199 GB_ALLOW_NIL | GB_ALLOW_PAST_ACCESSIBLE);
4201 me_flags = decode_map_extents_flags (flags);
4203 if (!NILP (property))
4206 value = canonicalize_extent_property (property, value);
4209 GCPRO5 (function, maparg, object, property, value);
4211 closure.map_arg = maparg;
4212 closure.map_routine = function;
4213 closure.result = Qnil;
4214 closure.property = property;
4215 closure.value = value;
4216 closure.start_min = start;
4217 closure.prev_start = -1;
4218 closure.prev_end = -1;
4219 map_extents_bytind (start, end, slow_map_extent_children_function,
4220 (void *) &closure, object, after,
4221 /* You never know what the user might do ... */
4222 me_flags | ME_MIGHT_CALL_ELISP);
4225 return closure.result;
4228 /* ------------------------------- */
4230 /* ------------------------------- */
4232 /* find "smallest" matching extent containing pos -- (flag == 0) means
4233 all extents match, else (EXTENT_FLAGS (extent) & flag) must be true;
4234 for more than one matching extent with precisely the same endpoints,
4235 we choose the last extent in the extents_list.
4236 The search stops just before "before", if that is non-null.
4239 struct extent_at_arg
4255 static enum extent_at_flag
4256 decode_extent_at_flag (Lisp_Object at_flag)
4259 return EXTENT_AT_AFTER;
4261 CHECK_SYMBOL (at_flag);
4262 if (EQ (at_flag, Qafter)) return EXTENT_AT_AFTER;
4263 if (EQ (at_flag, Qbefore)) return EXTENT_AT_BEFORE;
4264 if (EQ (at_flag, Qat)) return EXTENT_AT_AT;
4266 signal_simple_error ("Invalid AT-FLAG in `extent-at'", at_flag);
4267 return EXTENT_AT_AFTER; /* unreached */
4271 extent_at_mapper (EXTENT e, void *arg)
4273 struct extent_at_arg *closure = (struct extent_at_arg *) arg;
4275 if (e == closure->before)
4278 /* If closure->prop is non-nil, then the extent is only acceptable
4279 if it has a non-nil value for that property. */
4280 if (!NILP (closure->prop))
4283 XSETEXTENT (extent, e);
4284 if (NILP (Fextent_property (extent, closure->prop, Qnil)))
4289 EXTENT current = closure->best_match;
4293 /* redundant but quick test */
4294 else if (extent_start (current) > extent_start (e))
4297 /* we return the "last" best fit, instead of the first --
4298 this is because then the glyph closest to two equivalent
4299 extents corresponds to the "extent-at" the text just past
4301 else if (!EXTENT_LESS_VALS (e, closure->best_start,
4307 closure->best_match = e;
4308 closure->best_start = extent_start (e);
4309 closure->best_end = extent_end (e);
4316 extent_at_bytind (Bytind position, Lisp_Object object, Lisp_Object property,
4317 EXTENT before, enum extent_at_flag at_flag)
4319 struct extent_at_arg closure;
4320 Lisp_Object extent_obj;
4322 /* it might be argued that invalid positions should cause
4323 errors, but the principle of least surprise dictates that
4324 nil should be returned (extent-at is often used in
4325 response to a mouse event, and in many cases previous events
4326 have changed the buffer contents).
4328 Also, the openness stuff in the text-property code currently
4329 does not check its limits and might go off the end. */
4330 if ((at_flag == EXTENT_AT_BEFORE
4331 ? position <= buffer_or_string_absolute_begin_byte (object)
4332 : position < buffer_or_string_absolute_begin_byte (object))
4333 || (at_flag == EXTENT_AT_AFTER
4334 ? position >= buffer_or_string_absolute_end_byte (object)
4335 : position > buffer_or_string_absolute_end_byte (object)))
4338 closure.best_match = 0;
4339 closure.prop = property;
4340 closure.before = before;
4342 map_extents_bytind (at_flag == EXTENT_AT_BEFORE ? position - 1 : position,
4343 at_flag == EXTENT_AT_AFTER ? position + 1 : position,
4344 extent_at_mapper, (void *) &closure, object, 0,
4345 ME_START_OPEN | ME_ALL_EXTENTS_CLOSED);
4347 if (!closure.best_match)
4350 XSETEXTENT (extent_obj, closure.best_match);
4354 DEFUN ("extent-at", Fextent_at, 1, 5, 0, /*
4355 Find "smallest" extent at POS in OBJECT having PROPERTY set.
4356 Normally, an extent is "at" POS if it overlaps the region (POS, POS+1);
4357 i.e. if it covers the character after POS. (However, see the definition
4358 of AT-FLAG.) "Smallest" means the extent that comes last in the display
4359 order; this normally means the extent whose start position is closest to
4360 POS. See `next-extent' for more information.
4361 OBJECT specifies a buffer or string and defaults to the current buffer.
4362 PROPERTY defaults to nil, meaning that any extent will do.
4363 Properties are attached to extents with `set-extent-property', which see.
4364 Returns nil if POS is invalid or there is no matching extent at POS.
4365 If the fourth argument BEFORE is not nil, it must be an extent; any returned
4366 extent will precede that extent. This feature allows `extent-at' to be
4367 used by a loop over extents.
4368 AT-FLAG controls how end cases are handled, and should be one of:
4370 nil or `after' An extent is at POS if it covers the character
4371 after POS. This is consistent with the way
4372 that text properties work.
4373 `before' An extent is at POS if it covers the character
4375 `at' An extent is at POS if it overlaps or abuts POS.
4376 This includes all zero-length extents at POS.
4378 Note that in all cases, the start-openness and end-openness of the extents
4379 considered is ignored. If you want to pay attention to those properties,
4380 you should use `map-extents', which gives you more control.
4382 (pos, object, property, before, at_flag))
4385 EXTENT before_extent;
4386 enum extent_at_flag fl;
4388 object = decode_buffer_or_string (object);
4389 position = get_buffer_or_string_pos_byte (object, pos, GB_NO_ERROR_IF_BAD);
4393 before_extent = decode_extent (before, DE_MUST_BE_ATTACHED);
4394 if (before_extent && !EQ (object, extent_object (before_extent)))
4395 signal_simple_error ("extent not in specified buffer or string", object);
4396 fl = decode_extent_at_flag (at_flag);
4398 return extent_at_bytind (position, object, property, before_extent, fl);
4401 /* ------------------------------- */
4402 /* verify_extent_modification() */
4403 /* ------------------------------- */
4405 /* verify_extent_modification() is called when a buffer or string is
4406 modified to check whether the modification is occuring inside a
4410 struct verify_extents_arg
4415 Lisp_Object iro; /* value of inhibit-read-only */
4419 verify_extent_mapper (EXTENT extent, void *arg)
4421 struct verify_extents_arg *closure = (struct verify_extents_arg *) arg;
4422 Lisp_Object prop = extent_read_only (extent);
4427 if (CONSP (closure->iro) && !NILP (Fmemq (prop, closure->iro)))
4430 #if 0 /* Nobody seems to care for this any more -sb */
4431 /* Allow deletion if the extent is completely contained in
4432 the region being deleted.
4433 This is important for supporting tokens which are internally
4434 write-protected, but which can be killed and yanked as a whole.
4435 Ignore open/closed distinctions at this point.
4438 if (closure->start != closure->end &&
4439 extent_start (extent) >= closure->start &&
4440 extent_end (extent) <= closure->end)
4445 Fsignal (Qbuffer_read_only, (list1 (closure->object)));
4447 RETURN_NOT_REACHED(0)
4450 /* Value of Vinhibit_read_only is precomputed and passed in for
4454 verify_extent_modification (Lisp_Object object, Bytind from, Bytind to,
4455 Lisp_Object inhibit_read_only_value)
4458 struct verify_extents_arg closure;
4460 /* If insertion, visit closed-endpoint extents touching the insertion
4461 point because the text would go inside those extents. If deletion,
4462 treat the range as open on both ends so that touching extents are not
4463 visited. Note that we assume that an insertion is occurring if the
4464 changed range has zero length, and a deletion otherwise. This
4465 fails if a change (i.e. non-insertion, non-deletion) is happening.
4466 As far as I know, this doesn't currently occur in XEmacs. --ben */
4467 closed = (from==to);
4468 closure.object = object;
4469 closure.start = buffer_or_string_bytind_to_memind (object, from);
4470 closure.end = buffer_or_string_bytind_to_memind (object, to);
4471 closure.iro = inhibit_read_only_value;
4473 map_extents_bytind (from, to, verify_extent_mapper, (void *) &closure,
4474 object, 0, closed ? ME_END_CLOSED : ME_START_OPEN);
4477 /* ------------------------------------ */
4478 /* process_extents_for_insertion() */
4479 /* ------------------------------------ */
4481 struct process_extents_for_insertion_arg
4488 /* A region of length LENGTH was just inserted at OPOINT. Modify all
4489 of the extents as required for the insertion, based on their
4490 start-open/end-open properties.
4494 process_extents_for_insertion_mapper (EXTENT extent, void *arg)
4496 struct process_extents_for_insertion_arg *closure =
4497 (struct process_extents_for_insertion_arg *) arg;
4498 Memind indice = buffer_or_string_bytind_to_memind (closure->object,
4501 /* When this function is called, one end of the newly-inserted text should
4502 be adjacent to some endpoint of the extent, or disjoint from it. If
4503 the insertion overlaps any existing extent, something is wrong.
4505 #ifdef ERROR_CHECK_EXTENTS
4506 if (extent_start (extent) > indice &&
4507 extent_start (extent) < indice + closure->length)
4509 if (extent_end (extent) > indice &&
4510 extent_end (extent) < indice + closure->length)
4514 /* The extent-adjustment code adjusted the extent's endpoints as if
4515 they were markers -- endpoints at the gap (i.e. the insertion
4516 point) go to the left of the insertion point, which is correct
4517 for [) extents. We need to fix the other kinds of extents.
4519 Note that both conditions below will hold for zero-length (]
4520 extents at the gap. Zero-length () extents would get adjusted
4521 such that their start is greater than their end; we treat them
4522 as [) extents. This is unfortunately an inelegant part of the
4523 extent model, but there is no way around it. */
4526 Memind new_start, new_end;
4528 new_start = extent_start (extent);
4529 new_end = extent_end (extent);
4530 if (indice == extent_start (extent) && extent_start_open_p (extent) &&
4531 /* coerce zero-length () extents to [) */
4532 new_start != new_end)
4533 new_start += closure->length;
4534 if (indice == extent_end (extent) && !extent_end_open_p (extent))
4535 new_end += closure->length;
4536 set_extent_endpoints_1 (extent, new_start, new_end);
4543 process_extents_for_insertion (Lisp_Object object, Bytind opoint,
4546 struct process_extents_for_insertion_arg closure;
4548 closure.opoint = opoint;
4549 closure.length = length;
4550 closure.object = object;
4552 map_extents_bytind (opoint, opoint + length,
4553 process_extents_for_insertion_mapper,
4554 (void *) &closure, object, 0,
4555 ME_END_CLOSED | ME_MIGHT_MODIFY_EXTENTS |
4556 ME_INCLUDE_INTERNAL);
4559 /* ------------------------------------ */
4560 /* process_extents_for_deletion() */
4561 /* ------------------------------------ */
4563 struct process_extents_for_deletion_arg
4566 int destroy_included_extents;
4569 /* This function is called when we're about to delete the range [from, to].
4570 Detach all of the extents that are completely inside the range [from, to],
4571 if they're detachable or open-open. */
4574 process_extents_for_deletion_mapper (EXTENT extent, void *arg)
4576 struct process_extents_for_deletion_arg *closure =
4577 (struct process_extents_for_deletion_arg *) arg;
4579 /* If the extent lies completely within the range that
4580 is being deleted, then nuke the extent if it's detachable
4581 (otherwise, it will become a zero-length extent). */
4583 if (closure->start <= extent_start (extent) &&
4584 extent_end (extent) <= closure->end)
4586 if (extent_detachable_p (extent))
4588 if (closure->destroy_included_extents)
4589 destroy_extent (extent);
4591 extent_detach (extent);
4598 /* DESTROY_THEM means destroy the extents instead of just deleting them.
4599 It is unused currently, but perhaps might be used (there used to
4600 be a function process_extents_for_destruction(), #if 0'd out,
4601 that did the equivalent). */
4603 process_extents_for_deletion (Lisp_Object object, Bytind from,
4604 Bytind to, int destroy_them)
4606 struct process_extents_for_deletion_arg closure;
4608 closure.start = buffer_or_string_bytind_to_memind (object, from);
4609 closure.end = buffer_or_string_bytind_to_memind (object, to);
4610 closure.destroy_included_extents = destroy_them;
4612 map_extents_bytind (from, to, process_extents_for_deletion_mapper,
4613 (void *) &closure, object, 0,
4614 ME_END_CLOSED | ME_MIGHT_MODIFY_EXTENTS);
4617 /* ------------------------------- */
4618 /* report_extent_modification() */
4619 /* ------------------------------- */
4620 struct report_extent_modification_closure {
4627 /* This juggling with the pointer to another file's global variable is
4628 kind of yucky. Perhaps I should just export the variable. */
4629 static int *inside_change_hook_pointer;
4632 report_extent_modification_restore (Lisp_Object buffer)
4634 *inside_change_hook_pointer = 0;
4635 if (current_buffer != XBUFFER (buffer))
4636 Fset_buffer (buffer);
4641 report_extent_modification_mapper (EXTENT extent, void *arg)
4643 struct report_extent_modification_closure *closure =
4644 (struct report_extent_modification_closure *)arg;
4645 Lisp_Object exobj, startobj, endobj;
4646 Lisp_Object hook = (closure->afterp
4647 ? extent_after_change_functions (extent)
4648 : extent_before_change_functions (extent));
4652 XSETEXTENT (exobj, extent);
4653 XSETINT (startobj, closure->start);
4654 XSETINT (endobj, closure->end);
4656 /* Now that we are sure to call elisp, set up an unwind-protect so
4657 inside_change_hook gets restored in case we throw. Also record
4658 the current buffer, in case we change it. Do the recording only
4660 if (closure->speccount == -1)
4662 closure->speccount = specpdl_depth ();
4663 record_unwind_protect (report_extent_modification_restore,
4664 Fcurrent_buffer ());
4667 /* The functions will expect closure->buffer to be the current
4668 buffer, so change it if it isn't. */
4669 if (current_buffer != XBUFFER (closure->buffer))
4670 Fset_buffer (closure->buffer);
4672 /* #### It's a shame that we can't use any of the existing run_hook*
4673 functions here. This is so because all of them work with
4674 symbols, to be able to retrieve default values of local hooks.
4677 if (!CONSP (hook) || EQ (XCAR (hook), Qlambda))
4678 call3 (hook, exobj, startobj, endobj);
4682 EXTERNAL_LIST_LOOP (tail, hook)
4683 call3 (XCAR (tail), exobj, startobj, endobj);
4689 report_extent_modification (Lisp_Object buffer, Bufpos start, Bufpos end,
4690 int *inside, int afterp)
4692 struct report_extent_modification_closure closure;
4694 closure.buffer = buffer;
4695 closure.start = start;
4697 closure.afterp = afterp;
4698 closure.speccount = -1;
4700 inside_change_hook_pointer = inside;
4703 map_extents (start, end, report_extent_modification_mapper, (void *)&closure,
4704 buffer, NULL, ME_MIGHT_CALL_ELISP);
4706 if (closure.speccount == -1)
4710 /* We mustn't unbind when closure.speccount != -1 because
4711 map_extents_bytind has already done that. */
4712 assert (*inside == 0);
4717 /************************************************************************/
4718 /* extent properties */
4719 /************************************************************************/
4722 set_extent_invisible (EXTENT extent, Lisp_Object value)
4724 if (!EQ (extent_invisible (extent), value))
4726 set_extent_invisible_1 (extent, value);
4727 extent_changed_for_redisplay (extent, 1, 1);
4731 /* This function does "memoization" -- similar to the interning
4732 that happens with symbols. Given a list of faces, an equivalent
4733 list is returned such that if this function is called twice with
4734 input that is `equal', the resulting outputs will be `eq'.
4736 Note that the inputs and outputs are in general *not* `equal' --
4737 faces in symbol form become actual face objects in the output.
4738 This is necessary so that temporary faces stay around. */
4741 memoize_extent_face_internal (Lisp_Object list)
4745 Lisp_Object cons, thecons;
4746 Lisp_Object oldtail, tail;
4747 struct gcpro gcpro1;
4752 return Fget_face (list);
4754 /* To do the memoization, we use a hash table mapping from
4755 external lists to internal lists. We do `equal' comparisons
4756 on the keys so the memoization works correctly.
4758 Note that we canonicalize things so that the keys in the
4759 hash table (the external lists) always contain symbols and
4760 the values (the internal lists) always contain face objects.
4762 We also maintain a "reverse" table that maps from the internal
4763 lists to the external equivalents. The idea here is twofold:
4765 1) `extent-face' wants to return a list containing face symbols
4766 rather than face objects.
4767 2) We don't want things to get quite so messed up if the user
4768 maliciously side-effects the returned lists.
4771 len = XINT (Flength (list));
4772 thelen = XINT (Flength (Vextent_face_reusable_list));
4777 /* We canonicalize the given list into another list.
4778 We try to avoid consing except when necessary, so we have
4784 cons = Vextent_face_reusable_list;
4785 while (!NILP (XCDR (cons)))
4787 XCDR (cons) = Fmake_list (make_int (len - thelen), Qnil);
4789 else if (thelen > len)
4793 /* Truncate the list temporarily so it's the right length;
4794 remember the old tail. */
4795 cons = Vextent_face_reusable_list;
4796 for (i = 0; i < len - 1; i++)
4799 oldtail = XCDR (cons);
4803 thecons = Vextent_face_reusable_list;
4804 EXTERNAL_LIST_LOOP (cons, list)
4806 Lisp_Object face = Fget_face (XCAR (cons));
4808 XCAR (thecons) = Fface_name (face);
4809 thecons = XCDR (thecons);
4812 list = Fgethash (Vextent_face_reusable_list, Vextent_face_memoize_hash_table,
4816 Lisp_Object symlist = Fcopy_sequence (Vextent_face_reusable_list);
4817 Lisp_Object facelist = Fcopy_sequence (Vextent_face_reusable_list);
4819 LIST_LOOP (cons, facelist)
4821 XCAR (cons) = Fget_face (XCAR (cons));
4823 Fputhash (symlist, facelist, Vextent_face_memoize_hash_table);
4824 Fputhash (facelist, symlist, Vextent_face_reverse_memoize_hash_table);
4828 /* Now restore the truncated tail of the reusable list, if necessary. */
4830 XCDR (tail) = oldtail;
4837 external_of_internal_memoized_face (Lisp_Object face)
4841 else if (!CONSP (face))
4842 return XFACE (face)->name;
4845 face = Fgethash (face, Vextent_face_reverse_memoize_hash_table,
4847 assert (!UNBOUNDP (face));
4853 canonicalize_extent_property (Lisp_Object prop, Lisp_Object value)
4855 if (EQ (prop, Qface) || EQ (prop, Qmouse_face))
4856 value = (external_of_internal_memoized_face
4857 (memoize_extent_face_internal (value)));
4861 /* Do we need a lisp-level function ? */
4862 DEFUN ("set-extent-initial-redisplay-function", Fset_extent_initial_redisplay_function,
4864 Note: This feature is experimental!
4866 Set initial-redisplay-function of EXTENT to the function
4869 The first time the EXTENT is (re)displayed, an eval event will be
4870 dispatched calling FUNCTION with EXTENT as its only argument.
4874 EXTENT e = decode_extent(extent, DE_MUST_BE_ATTACHED);
4876 e = extent_ancestor (e); /* Is this needed? Macro also does chasing!*/
4877 set_extent_initial_redisplay_function(e,function);
4878 extent_in_red_event_p(e) = 0; /* If the function changed we can spawn
4880 extent_changed_for_redisplay(e,1,0); /* Do we need to mark children too ?*/
4885 DEFUN ("extent-face", Fextent_face, 1, 1, 0, /*
4886 Return the name of the face in which EXTENT is displayed, or nil
4887 if the extent's face is unspecified. This might also return a list
4894 CHECK_EXTENT (extent);
4895 face = extent_face (XEXTENT (extent));
4897 return external_of_internal_memoized_face (face);
4900 DEFUN ("set-extent-face", Fset_extent_face, 2, 2, 0, /*
4901 Make the given EXTENT have the graphic attributes specified by FACE.
4902 FACE can also be a list of faces, and all faces listed will apply,
4903 with faces earlier in the list taking priority over those later in the
4908 EXTENT e = decode_extent(extent, 0);
4909 Lisp_Object orig_face = face;
4911 /* retrieve the ancestor for efficiency and proper redisplay noting. */
4912 e = extent_ancestor (e);
4914 face = memoize_extent_face_internal (face);
4916 extent_face (e) = face;
4917 extent_changed_for_redisplay (e, 1, 0);
4923 DEFUN ("extent-mouse-face", Fextent_mouse_face, 1, 1, 0, /*
4924 Return the face used to highlight EXTENT when the mouse passes over it.
4925 The return value will be a face name, a list of face names, or nil
4926 if the extent's mouse face is unspecified.
4932 CHECK_EXTENT (extent);
4933 face = extent_mouse_face (XEXTENT (extent));
4935 return external_of_internal_memoized_face (face);
4938 DEFUN ("set-extent-mouse-face", Fset_extent_mouse_face, 2, 2, 0, /*
4939 Set the face used to highlight EXTENT when the mouse passes over it.
4940 FACE can also be a list of faces, and all faces listed will apply,
4941 with faces earlier in the list taking priority over those later in the
4947 Lisp_Object orig_face = face;
4949 CHECK_EXTENT (extent);
4950 e = XEXTENT (extent);
4951 /* retrieve the ancestor for efficiency and proper redisplay noting. */
4952 e = extent_ancestor (e);
4954 face = memoize_extent_face_internal (face);
4956 set_extent_mouse_face (e, face);
4957 extent_changed_for_redisplay (e, 1, 0);
4963 set_extent_glyph (EXTENT extent, Lisp_Object glyph, int endp,
4964 glyph_layout layout)
4966 extent = extent_ancestor (extent);
4970 set_extent_begin_glyph (extent, glyph);
4971 extent_begin_glyph_layout (extent) = layout;
4975 set_extent_end_glyph (extent, glyph);
4976 extent_end_glyph_layout (extent) = layout;
4979 extent_changed_for_redisplay (extent, 1, 0);
4983 glyph_layout_to_symbol (glyph_layout layout)
4987 case GL_TEXT: return Qtext;
4988 case GL_OUTSIDE_MARGIN: return Qoutside_margin;
4989 case GL_INSIDE_MARGIN: return Qinside_margin;
4990 case GL_WHITESPACE: return Qwhitespace;
4993 return Qnil; /* unreached */
4998 symbol_to_glyph_layout (Lisp_Object layout_obj)
5000 if (NILP (layout_obj))
5003 CHECK_SYMBOL (layout_obj);
5004 if (EQ (layout_obj, Qoutside_margin)) return GL_OUTSIDE_MARGIN;
5005 if (EQ (layout_obj, Qinside_margin)) return GL_INSIDE_MARGIN;
5006 if (EQ (layout_obj, Qwhitespace)) return GL_WHITESPACE;
5007 if (EQ (layout_obj, Qtext)) return GL_TEXT;
5009 signal_simple_error ("Unknown glyph layout type", layout_obj);
5010 return GL_TEXT; /* unreached */
5014 set_extent_glyph_1 (Lisp_Object extent_obj, Lisp_Object glyph, int endp,
5015 Lisp_Object layout_obj)
5017 EXTENT extent = decode_extent (extent_obj, DE_MUST_HAVE_BUFFER);
5018 glyph_layout layout = symbol_to_glyph_layout (layout_obj);
5020 /* Make sure we've actually been given a valid glyph or it's nil
5021 (meaning we're deleting a glyph from an extent). */
5023 CHECK_BUFFER_GLYPH (glyph);
5025 set_extent_glyph (extent, glyph, endp, layout);
5029 DEFUN ("set-extent-begin-glyph", Fset_extent_begin_glyph, 2, 3, 0, /*
5030 Display a bitmap, subwindow or string at the beginning of EXTENT.
5031 BEGIN-GLYPH must be a glyph object. The layout policy defaults to `text'.
5033 (extent, begin_glyph, layout))
5035 return set_extent_glyph_1 (extent, begin_glyph, 0, layout);
5038 DEFUN ("set-extent-end-glyph", Fset_extent_end_glyph, 2, 3, 0, /*
5039 Display a bitmap, subwindow or string at the end of EXTENT.
5040 END-GLYPH must be a glyph object. The layout policy defaults to `text'.
5042 (extent, end_glyph, layout))
5044 return set_extent_glyph_1 (extent, end_glyph, 1, layout);
5047 DEFUN ("extent-begin-glyph", Fextent_begin_glyph, 1, 1, 0, /*
5048 Return the glyph object displayed at the beginning of EXTENT.
5049 If there is none, nil is returned.
5053 return extent_begin_glyph (decode_extent (extent, 0));
5056 DEFUN ("extent-end-glyph", Fextent_end_glyph, 1, 1, 0, /*
5057 Return the glyph object displayed at the end of EXTENT.
5058 If there is none, nil is returned.
5062 return extent_end_glyph (decode_extent (extent, 0));
5065 DEFUN ("set-extent-begin-glyph-layout", Fset_extent_begin_glyph_layout, 2, 2, 0, /*
5066 Set the layout policy of EXTENT's begin glyph.
5067 Access this using the `extent-begin-glyph-layout' function.
5071 EXTENT e = decode_extent (extent, 0);
5072 e = extent_ancestor (e);
5073 extent_begin_glyph_layout (e) = symbol_to_glyph_layout (layout);
5074 extent_maybe_changed_for_redisplay (e, 1, 0);
5078 DEFUN ("set-extent-end-glyph-layout", Fset_extent_end_glyph_layout, 2, 2, 0, /*
5079 Set the layout policy of EXTENT's end glyph.
5080 Access this using the `extent-end-glyph-layout' function.
5084 EXTENT e = decode_extent (extent, 0);
5085 e = extent_ancestor (e);
5086 extent_end_glyph_layout (e) = symbol_to_glyph_layout (layout);
5087 extent_maybe_changed_for_redisplay (e, 1, 0);
5091 DEFUN ("extent-begin-glyph-layout", Fextent_begin_glyph_layout, 1, 1, 0, /*
5092 Return the layout policy associated with EXTENT's begin glyph.
5093 Set this using the `set-extent-begin-glyph-layout' function.
5097 EXTENT e = decode_extent (extent, 0);
5098 return glyph_layout_to_symbol ((glyph_layout) extent_begin_glyph_layout (e));
5101 DEFUN ("extent-end-glyph-layout", Fextent_end_glyph_layout, 1, 1, 0, /*
5102 Return the layout policy associated with EXTENT's end glyph.
5103 Set this using the `set-extent-end-glyph-layout' function.
5107 EXTENT e = decode_extent (extent, 0);
5108 return glyph_layout_to_symbol ((glyph_layout) extent_end_glyph_layout (e));
5111 DEFUN ("set-extent-priority", Fset_extent_priority, 2, 2, 0, /*
5112 Set the display priority of EXTENT to PRIORITY (an integer).
5113 When the extent attributes are being merged for display, the priority
5114 is used to determine which extent takes precedence in the event of a
5115 conflict (two extents whose faces both specify font, for example: the
5116 font of the extent with the higher priority will be used).
5117 Extents are created with priority 0; priorities may be negative.
5121 EXTENT e = decode_extent (extent, 0);
5123 CHECK_INT (priority);
5124 e = extent_ancestor (e);
5125 set_extent_priority (e, XINT (priority));
5126 extent_maybe_changed_for_redisplay (e, 1, 0);
5130 DEFUN ("extent-priority", Fextent_priority, 1, 1, 0, /*
5131 Return the display priority of EXTENT; see `set-extent-priority'.
5135 EXTENT e = decode_extent (extent, 0);
5136 return make_int (extent_priority (e));
5139 DEFUN ("set-extent-property", Fset_extent_property, 3, 3, 0, /*
5140 Change a property of an extent.
5141 PROPERTY may be any symbol; the value stored may be accessed with
5142 the `extent-property' function.
5143 The following symbols have predefined meanings:
5145 detached Removes the extent from its buffer; setting this is
5146 the same as calling `detach-extent'.
5148 destroyed Removes the extent from its buffer, and makes it
5149 unusable in the future; this is the same calling
5152 priority Change redisplay priority; same as `set-extent-priority'.
5154 start-open Whether the set of characters within the extent is
5155 treated being open on the left, that is, whether
5156 the start position is an exclusive, rather than
5157 inclusive, boundary. If true, then characters
5158 inserted exactly at the beginning of the extent
5159 will remain outside of the extent; otherwise they
5160 will go into the extent, extending it.
5162 end-open Whether the set of characters within the extent is
5163 treated being open on the right, that is, whether
5164 the end position is an exclusive, rather than
5165 inclusive, boundary. If true, then characters
5166 inserted exactly at the end of the extent will
5167 remain outside of the extent; otherwise they will
5168 go into the extent, extending it.
5170 By default, extents have the `end-open' but not the
5171 `start-open' property set.
5173 read-only Text within this extent will be unmodifiable.
5175 initial-redisplay-function (EXPERIMENTAL)
5176 function to be called the first time (part of) the extent
5177 is redisplayed. It will be called with the extent as its
5179 Note: The function will not be called immediately
5180 during redisplay, an eval event will be dispatched.
5182 detachable Whether the extent gets detached (as with
5183 `detach-extent') when all the text within the
5184 extent is deleted. This is true by default. If
5185 this property is not set, the extent becomes a
5186 zero-length extent when its text is deleted. (In
5187 such a case, the `start-open' property is
5188 automatically removed if both the `start-open' and
5189 `end-open' properties are set, since zero-length
5190 extents open on both ends are not allowed.)
5192 face The face in which to display the text. Setting
5193 this is the same as calling `set-extent-face'.
5195 mouse-face If non-nil, the extent will be highlighted in this
5196 face when the mouse moves over it.
5198 pointer If non-nil, and a valid pointer glyph, this specifies
5199 the shape of the mouse pointer while over the extent.
5201 highlight Obsolete: Setting this property is equivalent to
5202 setting a `mouse-face' property of `highlight'.
5203 Reading this property returns non-nil if
5204 the extent has a non-nil `mouse-face' property.
5206 duplicable Whether this extent should be copied into strings,
5207 so that kill, yank, and undo commands will restore
5208 or copy it. `duplicable' extents are copied from
5209 an extent into a string when `buffer-substring' or
5210 a similar function creates a string. The extents
5211 in a string are copied into other strings created
5212 from the string using `concat' or `substring'.
5213 When `insert' or a similar function inserts the
5214 string into a buffer, the extents are copied back
5217 unique Meaningful only in conjunction with `duplicable'.
5218 When this is set, there may be only one instance
5219 of this extent attached at a time: if it is copied
5220 to the kill ring and then yanked, the extent is
5221 not copied. If, however, it is killed (removed
5222 from the buffer) and then yanked, it will be
5223 re-attached at the new position.
5225 invisible If the value is non-nil, text under this extent
5226 may be treated as not present for the purpose of
5227 redisplay, or may be displayed using an ellipsis
5228 or other marker; see `buffer-invisibility-spec'
5229 and `invisible-text-glyph'. In all cases,
5230 however, the text is still visible to other
5231 functions that examine a buffer's text.
5233 keymap This keymap is consulted for mouse clicks on this
5234 extent, or keypresses made while point is within the
5237 copy-function This is a hook that is run when a duplicable extent
5238 is about to be copied from a buffer to a string (or
5239 the kill ring). It is called with three arguments,
5240 the extent, and the buffer-positions within it
5241 which are being copied. If this function returns
5242 nil, then the extent will not be copied; otherwise
5245 paste-function This is a hook that is run when a duplicable extent is
5246 about to be copied from a string (or the kill ring)
5247 into a buffer. It is called with three arguments,
5248 the original extent, and the buffer positions which
5249 the copied extent will occupy. (This hook is run
5250 after the corresponding text has already been
5251 inserted into the buffer.) Note that the extent
5252 argument may be detached when this function is run.
5253 If this function returns nil, no extent will be
5254 inserted. Otherwise, there will be an extent
5255 covering the range in question.
5257 If the original extent is not attached to a buffer,
5258 then it will be re-attached at this range.
5259 Otherwise, a copy will be made, and that copy
5262 The copy-function and paste-function are meaningful
5263 only for extents with the `duplicable' flag set,
5264 and if they are not specified, behave as if `t' was
5265 the returned value. When these hooks are invoked,
5266 the current buffer is the buffer which the extent
5267 is being copied from/to, respectively.
5269 begin-glyph A glyph to be displayed at the beginning of the extent,
5272 end-glyph A glyph to be displayed at the end of the extent,
5275 begin-glyph-layout The layout policy (one of `text', `whitespace',
5276 `inside-margin', or `outside-margin') of the extent's
5279 end-glyph-layout The layout policy of the extent's end glyph.
5281 (extent, property, value))
5283 /* This function can GC if property is `keymap' */
5284 EXTENT e = decode_extent (extent, 0);
5286 if (EQ (property, Qread_only))
5287 set_extent_read_only (e, value);
5288 else if (EQ (property, Qunique))
5289 extent_unique_p (e) = !NILP (value);
5290 else if (EQ (property, Qduplicable))
5291 extent_duplicable_p (e) = !NILP (value);
5292 else if (EQ (property, Qinvisible))
5293 set_extent_invisible (e, value);
5294 else if (EQ (property, Qdetachable))
5295 extent_detachable_p (e) = !NILP (value);
5297 else if (EQ (property, Qdetached))
5300 error ("can only set `detached' to t");
5301 Fdetach_extent (extent);
5303 else if (EQ (property, Qdestroyed))
5306 error ("can only set `destroyed' to t");
5307 Fdelete_extent (extent);
5309 else if (EQ (property, Qpriority))
5310 Fset_extent_priority (extent, value);
5311 else if (EQ (property, Qface))
5312 Fset_extent_face (extent, value);
5313 else if (EQ (property, Qinitial_redisplay_function))
5314 Fset_extent_initial_redisplay_function (extent, value);
5315 else if (EQ (property, Qbefore_change_functions))
5316 set_extent_before_change_functions (e, value);
5317 else if (EQ (property, Qafter_change_functions))
5318 set_extent_after_change_functions (e, value);
5319 else if (EQ (property, Qmouse_face))
5320 Fset_extent_mouse_face (extent, value);
5322 else if (EQ (property, Qhighlight))
5323 Fset_extent_mouse_face (extent, Qhighlight);
5324 else if (EQ (property, Qbegin_glyph_layout))
5325 Fset_extent_begin_glyph_layout (extent, value);
5326 else if (EQ (property, Qend_glyph_layout))
5327 Fset_extent_end_glyph_layout (extent, value);
5328 /* For backwards compatibility. We use begin glyph because it is by
5329 far the more used of the two. */
5330 else if (EQ (property, Qglyph_layout))
5331 Fset_extent_begin_glyph_layout (extent, value);
5332 else if (EQ (property, Qbegin_glyph))
5333 Fset_extent_begin_glyph (extent, value, Qnil);
5334 else if (EQ (property, Qend_glyph))
5335 Fset_extent_end_glyph (extent, value, Qnil);
5336 else if (EQ (property, Qstart_open))
5337 set_extent_openness (e, !NILP (value), -1);
5338 else if (EQ (property, Qend_open))
5339 set_extent_openness (e, -1, !NILP (value));
5340 /* Support (but don't document...) the obvious *_closed antonyms. */
5341 else if (EQ (property, Qstart_closed))
5342 set_extent_openness (e, NILP (value), -1);
5343 else if (EQ (property, Qend_closed))
5344 set_extent_openness (e, -1, NILP (value));
5347 if (EQ (property, Qkeymap))
5348 while (!NILP (value) && NILP (Fkeymapp (value)))
5349 value = wrong_type_argument (Qkeymapp, value);
5351 external_plist_put (extent_plist_addr (e), property, value, 0, ERROR_ME);
5357 DEFUN ("set-extent-properties", Fset_extent_properties, 2, 2, 0, /*
5358 Change some properties of EXTENT.
5359 PLIST is a property list.
5360 For a list of built-in properties, see `set-extent-property'.
5364 /* This function can GC, if one of the properties is `keymap' */
5365 Lisp_Object property, value;
5366 struct gcpro gcpro1;
5369 plist = Fcopy_sequence (plist);
5370 Fcanonicalize_plist (plist, Qnil);
5372 while (!NILP (plist))
5374 property = Fcar (plist); plist = Fcdr (plist);
5375 value = Fcar (plist); plist = Fcdr (plist);
5376 Fset_extent_property (extent, property, value);
5382 DEFUN ("extent-property", Fextent_property, 2, 3, 0, /*
5383 Return EXTENT's value for property PROPERTY.
5384 See `set-extent-property' for the built-in property names.
5386 (extent, property, default_))
5388 EXTENT e = decode_extent (extent, 0);
5390 if (EQ (property, Qdetached))
5391 return extent_detached_p (e) ? Qt : Qnil;
5392 else if (EQ (property, Qdestroyed))
5393 return !EXTENT_LIVE_P (e) ? Qt : Qnil;
5394 else if (EQ (property, Qstart_open))
5395 return extent_normal_field (e, start_open) ? Qt : Qnil;
5396 else if (EQ (property, Qend_open))
5397 return extent_normal_field (e, end_open) ? Qt : Qnil;
5398 else if (EQ (property, Qunique))
5399 return extent_normal_field (e, unique) ? Qt : Qnil;
5400 else if (EQ (property, Qduplicable))
5401 return extent_normal_field (e, duplicable) ? Qt : Qnil;
5402 else if (EQ (property, Qdetachable))
5403 return extent_normal_field (e, detachable) ? Qt : Qnil;
5404 /* Support (but don't document...) the obvious *_closed antonyms. */
5405 else if (EQ (property, Qstart_closed))
5406 return extent_start_open_p (e) ? Qnil : Qt;
5407 else if (EQ (property, Qend_closed))
5408 return extent_end_open_p (e) ? Qnil : Qt;
5409 else if (EQ (property, Qpriority))
5410 return make_int (extent_priority (e));
5411 else if (EQ (property, Qread_only))
5412 return extent_read_only (e);
5413 else if (EQ (property, Qinvisible))
5414 return extent_invisible (e);
5415 else if (EQ (property, Qface))
5416 return Fextent_face (extent);
5417 else if (EQ (property, Qinitial_redisplay_function))
5418 return extent_initial_redisplay_function (e);
5419 else if (EQ (property, Qbefore_change_functions))
5420 return extent_before_change_functions (e);
5421 else if (EQ (property, Qafter_change_functions))
5422 return extent_after_change_functions (e);
5423 else if (EQ (property, Qmouse_face))
5424 return Fextent_mouse_face (extent);
5426 else if (EQ (property, Qhighlight))
5427 return !NILP (Fextent_mouse_face (extent)) ? Qt : Qnil;
5428 else if (EQ (property, Qbegin_glyph_layout))
5429 return Fextent_begin_glyph_layout (extent);
5430 else if (EQ (property, Qend_glyph_layout))
5431 return Fextent_end_glyph_layout (extent);
5432 /* For backwards compatibility. We use begin glyph because it is by
5433 far the more used of the two. */
5434 else if (EQ (property, Qglyph_layout))
5435 return Fextent_begin_glyph_layout (extent);
5436 else if (EQ (property, Qbegin_glyph))
5437 return extent_begin_glyph (e);
5438 else if (EQ (property, Qend_glyph))
5439 return extent_end_glyph (e);
5442 Lisp_Object value = external_plist_get (extent_plist_addr (e),
5443 property, 0, ERROR_ME);
5444 return UNBOUNDP (value) ? default_ : value;
5448 DEFUN ("extent-properties", Fextent_properties, 1, 1, 0, /*
5449 Return a property list of the attributes of EXTENT.
5450 Do not modify this list; use `set-extent-property' instead.
5455 Lisp_Object result, face, anc_obj;
5456 glyph_layout layout;
5458 CHECK_EXTENT (extent);
5459 e = XEXTENT (extent);
5460 if (!EXTENT_LIVE_P (e))
5461 return cons3 (Qdestroyed, Qt, Qnil);
5463 anc = extent_ancestor (e);
5464 XSETEXTENT (anc_obj, anc);
5466 /* For efficiency, use the ancestor for all properties except detached */
5468 result = extent_plist_slot (anc);
5470 if (!NILP (face = Fextent_face (anc_obj)))
5471 result = cons3 (Qface, face, result);
5473 if (!NILP (face = Fextent_mouse_face (anc_obj)))
5474 result = cons3 (Qmouse_face, face, result);
5476 if ((layout = (glyph_layout) extent_begin_glyph_layout (anc)) != GL_TEXT)
5478 Lisp_Object sym = glyph_layout_to_symbol (layout);
5479 result = cons3 (Qglyph_layout, sym, result); /* compatibility */
5480 result = cons3 (Qbegin_glyph_layout, sym, result);
5483 if ((layout = (glyph_layout) extent_end_glyph_layout (anc)) != GL_TEXT)
5484 result = cons3 (Qend_glyph_layout, glyph_layout_to_symbol (layout), result);
5486 if (!NILP (extent_end_glyph (anc)))
5487 result = cons3 (Qend_glyph, extent_end_glyph (anc), result);
5489 if (!NILP (extent_begin_glyph (anc)))
5490 result = cons3 (Qbegin_glyph, extent_begin_glyph (anc), result);
5492 if (extent_priority (anc) != 0)
5493 result = cons3 (Qpriority, make_int (extent_priority (anc)), result);
5495 if (!NILP (extent_initial_redisplay_function (anc)))
5496 result = cons3 (Qinitial_redisplay_function,
5497 extent_initial_redisplay_function (anc), result);
5499 if (!NILP (extent_before_change_functions (anc)))
5500 result = cons3 (Qbefore_change_functions,
5501 extent_before_change_functions (anc), result);
5503 if (!NILP (extent_after_change_functions (anc)))
5504 result = cons3 (Qafter_change_functions,
5505 extent_after_change_functions (anc), result);
5507 if (!NILP (extent_invisible (anc)))
5508 result = cons3 (Qinvisible, extent_invisible (anc), result);
5510 if (!NILP (extent_read_only (anc)))
5511 result = cons3 (Qread_only, extent_read_only (anc), result);
5513 if (extent_normal_field (anc, end_open))
5514 result = cons3 (Qend_open, Qt, result);
5516 if (extent_normal_field (anc, start_open))
5517 result = cons3 (Qstart_open, Qt, result);
5519 if (extent_normal_field (anc, detachable))
5520 result = cons3 (Qdetachable, Qt, result);
5522 if (extent_normal_field (anc, duplicable))
5523 result = cons3 (Qduplicable, Qt, result);
5525 if (extent_normal_field (anc, unique))
5526 result = cons3 (Qunique, Qt, result);
5528 /* detached is not an inherited property */
5529 if (extent_detached_p (e))
5530 result = cons3 (Qdetached, Qt, result);
5536 /************************************************************************/
5538 /************************************************************************/
5540 /* The display code looks into the Vlast_highlighted_extent variable to
5541 correctly display highlighted extents. This updates that variable,
5542 and marks the appropriate buffers as needing some redisplay.
5545 do_highlight (Lisp_Object extent_obj, int highlight_p)
5547 if (( highlight_p && (EQ (Vlast_highlighted_extent, extent_obj))) ||
5548 (!highlight_p && (EQ (Vlast_highlighted_extent, Qnil))))
5550 if (EXTENTP (Vlast_highlighted_extent) &&
5551 EXTENT_LIVE_P (XEXTENT (Vlast_highlighted_extent)))
5553 /* do not recurse on descendants. Only one extent is highlighted
5555 extent_changed_for_redisplay (XEXTENT (Vlast_highlighted_extent), 0, 0);
5557 Vlast_highlighted_extent = Qnil;
5558 if (!NILP (extent_obj)
5559 && BUFFERP (extent_object (XEXTENT (extent_obj)))
5562 extent_changed_for_redisplay (XEXTENT (extent_obj), 0, 0);
5563 Vlast_highlighted_extent = extent_obj;
5567 DEFUN ("force-highlight-extent", Fforce_highlight_extent, 1, 2, 0, /*
5568 Highlight or unhighlight the given extent.
5569 If the second arg is non-nil, it will be highlighted, else dehighlighted.
5570 This is the same as `highlight-extent', except that it will work even
5571 on extents without the `mouse-face' property.
5573 (extent, highlight_p))
5578 XSETEXTENT (extent, decode_extent (extent, DE_MUST_BE_ATTACHED));
5579 do_highlight (extent, !NILP (highlight_p));
5583 DEFUN ("highlight-extent", Fhighlight_extent, 1, 2, 0, /*
5584 Highlight EXTENT, if it is highlightable.
5585 \(that is, if it has the `mouse-face' property).
5586 If the second arg is non-nil, it will be highlighted, else dehighlighted.
5587 Highlighted extents are displayed as if they were merged with the face
5588 or faces specified by the `mouse-face' property.
5590 (extent, highlight_p))
5592 if (EXTENTP (extent) && NILP (extent_mouse_face (XEXTENT (extent))))
5595 return Fforce_highlight_extent (extent, highlight_p);
5599 /************************************************************************/
5600 /* strings and extents */
5601 /************************************************************************/
5603 /* copy/paste hooks */
5606 run_extent_copy_paste_internal (EXTENT e, Bufpos from, Bufpos to,
5610 /* This function can GC */
5612 Lisp_Object copy_fn;
5613 XSETEXTENT (extent, e);
5614 copy_fn = Fextent_property (extent, prop, Qnil);
5615 if (!NILP (copy_fn))
5618 struct gcpro gcpro1, gcpro2, gcpro3;
5619 GCPRO3 (extent, copy_fn, object);
5620 if (BUFFERP (object))
5621 flag = call3_in_buffer (XBUFFER (object), copy_fn, extent,
5622 make_int (from), make_int (to));
5624 flag = call3 (copy_fn, extent, make_int (from), make_int (to));
5626 if (NILP (flag) || !EXTENT_LIVE_P (XEXTENT (extent)))
5633 run_extent_copy_function (EXTENT e, Bytind from, Bytind to)
5635 Lisp_Object object = extent_object (e);
5636 /* This function can GC */
5637 return run_extent_copy_paste_internal
5638 (e, buffer_or_string_bytind_to_bufpos (object, from),
5639 buffer_or_string_bytind_to_bufpos (object, to), object,
5644 run_extent_paste_function (EXTENT e, Bytind from, Bytind to,
5647 /* This function can GC */
5648 return run_extent_copy_paste_internal
5649 (e, buffer_or_string_bytind_to_bufpos (object, from),
5650 buffer_or_string_bytind_to_bufpos (object, to), object,
5655 update_extent (EXTENT extent, Bytind from, Bytind to)
5657 set_extent_endpoints (extent, from, to, Qnil);
5660 /* Insert an extent, usually from the dup_list of a string which
5661 has just been inserted.
5662 This code does not handle the case of undo.
5665 insert_extent (EXTENT extent, Bytind new_start, Bytind new_end,
5666 Lisp_Object object, int run_hooks)
5668 /* This function can GC */
5671 if (!EQ (extent_object (extent), object))
5674 if (extent_detached_p (extent))
5677 !run_extent_paste_function (extent, new_start, new_end, object))
5678 /* The paste-function said don't re-attach this extent here. */
5681 update_extent (extent, new_start, new_end);
5685 Bytind exstart = extent_endpoint_bytind (extent, 0);
5686 Bytind exend = extent_endpoint_bytind (extent, 1);
5688 if (exend < new_start || exstart > new_end)
5692 new_start = min (exstart, new_start);
5693 new_end = max (exend, new_end);
5694 if (exstart != new_start || exend != new_end)
5695 update_extent (extent, new_start, new_end);
5699 XSETEXTENT (tmp, extent);
5704 !run_extent_paste_function (extent, new_start, new_end, object))
5705 /* The paste-function said don't attach a copy of the extent here. */
5709 XSETEXTENT (tmp, copy_extent (extent, new_start, new_end, object));
5714 DEFUN ("insert-extent", Finsert_extent, 1, 5, 0, /*
5715 Insert EXTENT from START to END in BUFFER-OR-STRING.
5716 BUFFER-OR-STRING defaults to the current buffer if omitted.
5717 This operation does not insert any characters,
5718 but otherwise acts as if there were a replicating extent whose
5719 parent is EXTENT in some string that was just inserted.
5720 Returns the newly-inserted extent.
5721 The fourth arg, NO-HOOKS, can be used to inhibit the running of the
5722 extent's `paste-function' property if it has one.
5723 See documentation on `detach-extent' for a discussion of undo recording.
5725 (extent, start, end, no_hooks, buffer_or_string))
5727 EXTENT ext = decode_extent (extent, 0);
5731 buffer_or_string = decode_buffer_or_string (buffer_or_string);
5732 get_buffer_or_string_range_byte (buffer_or_string, start, end, &s, &e,
5733 GB_ALLOW_PAST_ACCESSIBLE);
5735 copy = insert_extent (ext, s, e, buffer_or_string, NILP (no_hooks));
5738 if (extent_duplicable_p (XEXTENT (copy)))
5739 record_extent (copy, 1);
5745 /* adding buffer extents to a string */
5747 struct add_string_extents_arg
5755 add_string_extents_mapper (EXTENT extent, void *arg)
5757 /* This function can GC */
5758 struct add_string_extents_arg *closure =
5759 (struct add_string_extents_arg *) arg;
5760 Bytecount start = extent_endpoint_bytind (extent, 0) - closure->from;
5761 Bytecount end = extent_endpoint_bytind (extent, 1) - closure->from;
5763 if (extent_duplicable_p (extent))
5765 start = max (start, 0);
5766 end = min (end, closure->length);
5768 /* Run the copy-function to give an extent the option of
5769 not being copied into the string (or kill ring).
5771 if (extent_duplicable_p (extent) &&
5772 !run_extent_copy_function (extent, start + closure->from,
5773 end + closure->from))
5775 copy_extent (extent, start, end, closure->string);
5781 /* Add the extents in buffer BUF from OPOINT to OPOINT+LENGTH to
5782 the string STRING. */
5784 add_string_extents (Lisp_Object string, struct buffer *buf, Bytind opoint,
5787 /* This function can GC */
5788 struct add_string_extents_arg closure;
5789 struct gcpro gcpro1, gcpro2;
5792 closure.from = opoint;
5793 closure.length = length;
5794 closure.string = string;
5795 buffer = make_buffer (buf);
5796 GCPRO2 (buffer, string);
5797 map_extents_bytind (opoint, opoint + length, add_string_extents_mapper,
5798 (void *) &closure, buffer, 0,
5799 /* ignore extents that just abut the region */
5800 ME_END_CLOSED | ME_ALL_EXTENTS_OPEN |
5801 /* we are calling E-Lisp (the extent's copy function)
5802 so anything might happen */
5803 ME_MIGHT_CALL_ELISP);
5807 struct splice_in_string_extents_arg
5816 splice_in_string_extents_mapper (EXTENT extent, void *arg)
5818 /* This function can GC */
5819 struct splice_in_string_extents_arg *closure =
5820 (struct splice_in_string_extents_arg *) arg;
5821 /* BASE_START and BASE_END are the limits in the buffer of the string
5822 that was just inserted.
5824 NEW_START and NEW_END are the prospective buffer positions of the
5825 extent that is going into the buffer. */
5826 Bytind base_start = closure->opoint;
5827 Bytind base_end = base_start + closure->length;
5828 Bytind new_start = (base_start + extent_endpoint_bytind (extent, 0) -
5830 Bytind new_end = (base_start + extent_endpoint_bytind (extent, 1) -
5833 if (new_start < base_start)
5834 new_start = base_start;
5835 if (new_end > base_end)
5837 if (new_end <= new_start)
5840 if (!extent_duplicable_p (extent))
5844 !run_extent_paste_function (extent, new_start, new_end,
5847 copy_extent (extent, new_start, new_end, closure->buffer);
5852 /* We have just inserted a section of STRING (starting at POS, of
5853 length LENGTH) into buffer BUF at OPOINT. Do whatever is necessary
5854 to get the string's extents into the buffer. */
5857 splice_in_string_extents (Lisp_Object string, struct buffer *buf,
5858 Bytind opoint, Bytecount length, Bytecount pos)
5860 struct splice_in_string_extents_arg closure;
5861 struct gcpro gcpro1, gcpro2;
5864 buffer = make_buffer (buf);
5865 closure.opoint = opoint;
5867 closure.length = length;
5868 closure.buffer = buffer;
5869 GCPRO2 (buffer, string);
5870 map_extents_bytind (pos, pos + length,
5871 splice_in_string_extents_mapper,
5872 (void *) &closure, string, 0,
5873 /* ignore extents that just abut the region */
5874 ME_END_CLOSED | ME_ALL_EXTENTS_OPEN |
5875 /* we are calling E-Lisp (the extent's copy function)
5876 so anything might happen */
5877 ME_MIGHT_CALL_ELISP);
5881 struct copy_string_extents_arg
5886 Lisp_Object new_string;
5889 struct copy_string_extents_1_arg
5891 Lisp_Object parent_in_question;
5892 EXTENT found_extent;
5896 copy_string_extents_mapper (EXTENT extent, void *arg)
5898 struct copy_string_extents_arg *closure =
5899 (struct copy_string_extents_arg *) arg;
5900 Bytecount old_start, old_end, new_start, new_end;
5902 old_start = extent_endpoint_bytind (extent, 0);
5903 old_end = extent_endpoint_bytind (extent, 1);
5905 old_start = max (closure->old_pos, old_start);
5906 old_end = min (closure->old_pos + closure->length, old_end);
5908 if (old_start >= old_end)
5911 new_start = old_start + closure->new_pos - closure->old_pos;
5912 new_end = old_end + closure->new_pos - closure->old_pos;
5914 copy_extent (extent, new_start, new_end, closure->new_string);
5918 /* The string NEW_STRING was partially constructed from OLD_STRING.
5919 In particular, the section of length LEN starting at NEW_POS in
5920 NEW_STRING came from the section of the same length starting at
5921 OLD_POS in OLD_STRING. Copy the extents as appropriate. */
5924 copy_string_extents (Lisp_Object new_string, Lisp_Object old_string,
5925 Bytecount new_pos, Bytecount old_pos,
5928 struct copy_string_extents_arg closure;
5929 struct gcpro gcpro1, gcpro2;
5931 closure.new_pos = new_pos;
5932 closure.old_pos = old_pos;
5933 closure.new_string = new_string;
5934 closure.length = length;
5935 GCPRO2 (new_string, old_string);
5936 map_extents_bytind (old_pos, old_pos + length,
5937 copy_string_extents_mapper,
5938 (void *) &closure, old_string, 0,
5939 /* ignore extents that just abut the region */
5940 ME_END_CLOSED | ME_ALL_EXTENTS_OPEN |
5941 /* we are calling E-Lisp (the extent's copy function)
5942 so anything might happen */
5943 ME_MIGHT_CALL_ELISP);
5947 /* Checklist for sanity checking:
5948 - {kill, yank, copy} at {open, closed} {start, end} of {writable, read-only} extent
5949 - {kill, copy} & yank {once, repeatedly} duplicable extent in {same, different} buffer
5953 /************************************************************************/
5954 /* text properties */
5955 /************************************************************************/
5958 Originally this stuff was implemented in lisp (all of the functionality
5959 exists to make that possible) but speed was a problem.
5962 Lisp_Object Qtext_prop;
5963 Lisp_Object Qtext_prop_extent_paste_function;
5966 get_text_property_bytind (Bytind position, Lisp_Object prop,
5967 Lisp_Object object, enum extent_at_flag fl,
5968 int text_props_only)
5972 /* text_props_only specifies whether we only consider text-property
5973 extents (those with the 'text-prop property set) or all extents. */
5974 if (!text_props_only)
5975 extent = extent_at_bytind (position, object, prop, 0, fl);
5981 extent = extent_at_bytind (position, object, Qtext_prop, prior,
5985 if (EQ (prop, Fextent_property (extent, Qtext_prop, Qnil)))
5987 prior = XEXTENT (extent);
5992 return Fextent_property (extent, prop, Qnil);
5993 if (!NILP (Vdefault_text_properties))
5994 return Fplist_get (Vdefault_text_properties, prop, Qnil);
5999 get_text_property_1 (Lisp_Object pos, Lisp_Object prop, Lisp_Object object,
6000 Lisp_Object at_flag, int text_props_only)
6005 object = decode_buffer_or_string (object);
6006 position = get_buffer_or_string_pos_byte (object, pos, GB_NO_ERROR_IF_BAD);
6008 /* We canonicalize the start/end-open/closed properties to the
6009 non-default version -- "adding" the default property really
6010 needs to remove the non-default one. See below for more
6012 if (EQ (prop, Qstart_closed))
6018 if (EQ (prop, Qend_open))
6026 get_text_property_bytind (position, prop, object,
6027 decode_extent_at_flag (at_flag),
6030 val = NILP (val) ? Qt : Qnil;
6035 DEFUN ("get-text-property", Fget_text_property, 2, 4, 0, /*
6036 Return the value of the PROP property at the given position.
6037 Optional arg OBJECT specifies the buffer or string to look in, and
6038 defaults to the current buffer.
6039 Optional arg AT-FLAG controls what it means for a property to be "at"
6040 a position, and has the same meaning as in `extent-at'.
6041 This examines only those properties added with `put-text-property'.
6042 See also `get-char-property'.
6044 (pos, prop, object, at_flag))
6046 return get_text_property_1 (pos, prop, object, at_flag, 1);
6049 DEFUN ("get-char-property", Fget_char_property, 2, 4, 0, /*
6050 Return the value of the PROP property at the given position.
6051 Optional arg OBJECT specifies the buffer or string to look in, and
6052 defaults to the current buffer.
6053 Optional arg AT-FLAG controls what it means for a property to be "at"
6054 a position, and has the same meaning as in `extent-at'.
6055 This examines properties on all extents.
6056 See also `get-text-property'.
6058 (pos, prop, object, at_flag))
6060 return get_text_property_1 (pos, prop, object, at_flag, 0);
6063 /* About start/end-open/closed:
6065 These properties have to be handled specially because of their
6066 strange behavior. If I put the "start-open" property on a region,
6067 then *all* text-property extents in the region have to have their
6068 start be open. This is unlike all other properties, which don't
6069 affect the extents of text properties other than their own.
6073 1) We have to map start-closed to (not start-open) and end-open
6074 to (not end-closed) -- i.e. adding the default is really the
6075 same as remove the non-default property. It won't work, for
6076 example, to have both "start-open" and "start-closed" on
6078 2) Whenever we add one of these properties, we go through all
6079 text-property extents in the region and set the appropriate
6080 open/closedness on them.
6081 3) Whenever we change a text-property extent for a property,
6082 we have to make sure we set the open/closedness properly.
6084 (2) and (3) together rely on, and maintain, the invariant
6085 that the open/closedness of text-property extents is correct
6086 at the beginning and end of each operation.
6089 struct put_text_prop_arg
6091 Lisp_Object prop, value; /* The property and value we are storing */
6092 Bytind start, end; /* The region into which we are storing it */
6094 Lisp_Object the_extent; /* Our chosen extent; this is used for
6095 communication between subsequent passes. */
6096 int changed_p; /* Output: whether we have modified anything */
6100 put_text_prop_mapper (EXTENT e, void *arg)
6102 struct put_text_prop_arg *closure = (struct put_text_prop_arg *) arg;
6104 Lisp_Object object = closure->object;
6105 Lisp_Object value = closure->value;
6106 Bytind e_start, e_end;
6107 Bytind start = closure->start;
6108 Bytind end = closure->end;
6109 Lisp_Object extent, e_val;
6112 XSETEXTENT (extent, e);
6114 /* Note: in some cases when the property itself is 'start-open
6115 or 'end-closed, the checks to set the openness may do a bit
6116 of extra work; but it won't hurt because we then fix up the
6117 openness later on in put_text_prop_openness_mapper(). */
6118 if (!EQ (Fextent_property (extent, Qtext_prop, Qnil), closure->prop))
6119 /* It's not for this property; do nothing. */
6122 e_start = extent_endpoint_bytind (e, 0);
6123 e_end = extent_endpoint_bytind (e, 1);
6124 e_val = Fextent_property (extent, closure->prop, Qnil);
6125 is_eq = EQ (value, e_val);
6127 if (!NILP (value) && NILP (closure->the_extent) && is_eq)
6129 /* We want there to be an extent here at the end, and we haven't picked
6130 one yet, so use this one. Extend it as necessary. We only reuse an
6131 extent which has an EQ value for the prop in question to avoid
6132 side-effecting the kill ring (that is, we never change the property
6133 on an extent after it has been created.)
6135 if (e_start != start || e_end != end)
6137 Bytind new_start = min (e_start, start);
6138 Bytind new_end = max (e_end, end);
6139 set_extent_endpoints (e, new_start, new_end, Qnil);
6140 /* If we changed the endpoint, then we need to set its
6142 set_extent_openness (e, new_start != e_start
6143 ? !NILP (get_text_property_bytind
6144 (start, Qstart_open, object,
6145 EXTENT_AT_AFTER, 1)) : -1,
6147 ? NILP (get_text_property_bytind
6148 (end - 1, Qend_closed, object,
6149 EXTENT_AT_AFTER, 1))
6151 closure->changed_p = 1;
6153 closure->the_extent = extent;
6156 /* Even if we're adding a prop, at this point, we want all other extents of
6157 this prop to go away (as now they overlap). So the theory here is that,
6158 when we are adding a prop to a region that has multiple (disjoint)
6159 occurrences of that prop in it already, we pick one of those and extend
6160 it, and remove the others.
6163 else if (EQ (extent, closure->the_extent))
6165 /* just in case map-extents hits it again (does that happen?) */
6168 else if (e_start >= start && e_end <= end)
6170 /* Extent is contained in region; remove it. Don't destroy or modify
6171 it, because we don't want to change the attributes pointed to by the
6172 duplicates in the kill ring.
6175 closure->changed_p = 1;
6177 else if (!NILP (closure->the_extent) &&
6182 EXTENT te = XEXTENT (closure->the_extent);
6183 /* This extent overlaps, and has the same prop/value as the extent we've
6184 decided to reuse, so we can remove this existing extent as well (the
6185 whole thing, even the part outside of the region) and extend
6186 the-extent to cover it, resulting in the minimum number of extents in
6189 Bytind the_start = extent_endpoint_bytind (te, 0);
6190 Bytind the_end = extent_endpoint_bytind (te, 1);
6191 if (e_start != the_start && /* note AND not OR -- hmm, why is this
6192 the case? I think it's because the
6193 assumption that the text-property
6194 extents don't overlap makes it
6195 OK; changing it to an OR would
6196 result in changed_p sometimes getting
6197 falsely marked. Is this bad? */
6200 Bytind new_start = min (e_start, the_start);
6201 Bytind new_end = max (e_end, the_end);
6202 set_extent_endpoints (te, new_start, new_end, Qnil);
6203 /* If we changed the endpoint, then we need to set its
6204 openness. We are setting the endpoint to be the same as
6205 that of the extent we're about to remove, and we assume
6206 (the invariant mentioned above) that extent has the
6207 proper endpoint setting, so we just use it. */
6208 set_extent_openness (te, new_start != e_start ?
6209 (int) extent_start_open_p (e) : -1,
6211 (int) extent_end_open_p (e) : -1);
6212 closure->changed_p = 1;
6216 else if (e_end <= end)
6218 /* Extent begins before start but ends before end, so we can just
6219 decrease its end position.
6223 set_extent_endpoints (e, e_start, start, Qnil);
6224 set_extent_openness (e, -1, NILP (get_text_property_bytind
6225 (start - 1, Qend_closed, object,
6226 EXTENT_AT_AFTER, 1)));
6227 closure->changed_p = 1;
6230 else if (e_start >= start)
6232 /* Extent ends after end but begins after start, so we can just
6233 increase its start position.
6237 set_extent_endpoints (e, end, e_end, Qnil);
6238 set_extent_openness (e, !NILP (get_text_property_bytind
6239 (end, Qstart_open, object,
6240 EXTENT_AT_AFTER, 1)), -1);
6241 closure->changed_p = 1;
6246 /* Otherwise, `extent' straddles the region. We need to split it.
6248 set_extent_endpoints (e, e_start, start, Qnil);
6249 set_extent_openness (e, -1, NILP (get_text_property_bytind
6250 (start - 1, Qend_closed, object,
6251 EXTENT_AT_AFTER, 1)));
6252 set_extent_openness (copy_extent (e, end, e_end, extent_object (e)),
6253 !NILP (get_text_property_bytind
6254 (end, Qstart_open, object,
6255 EXTENT_AT_AFTER, 1)), -1);
6256 closure->changed_p = 1;
6259 return 0; /* to continue mapping. */
6263 put_text_prop_openness_mapper (EXTENT e, void *arg)
6265 struct put_text_prop_arg *closure = (struct put_text_prop_arg *) arg;
6266 Bytind e_start, e_end;
6267 Bytind start = closure->start;
6268 Bytind end = closure->end;
6270 XSETEXTENT (extent, e);
6271 e_start = extent_endpoint_bytind (e, 0);
6272 e_end = extent_endpoint_bytind (e, 1);
6274 if (NILP (Fextent_property (extent, Qtext_prop, Qnil)))
6276 /* It's not a text-property extent; do nothing. */
6279 /* Note end conditions and NILP/!NILP's carefully. */
6280 else if (EQ (closure->prop, Qstart_open)
6281 && e_start >= start && e_start < end)
6282 set_extent_openness (e, !NILP (closure->value), -1);
6283 else if (EQ (closure->prop, Qend_closed)
6284 && e_end > start && e_end <= end)
6285 set_extent_openness (e, -1, NILP (closure->value));
6287 return 0; /* to continue mapping. */
6291 put_text_prop (Bytind start, Bytind end, Lisp_Object object,
6292 Lisp_Object prop, Lisp_Object value,
6295 /* This function can GC */
6296 struct put_text_prop_arg closure;
6298 if (start == end) /* There are no characters in the region. */
6301 /* convert to the non-default versions, since a nil property is
6302 the same as it not being present. */
6303 if (EQ (prop, Qstart_closed))
6306 value = NILP (value) ? Qt : Qnil;
6308 else if (EQ (prop, Qend_open))
6311 value = NILP (value) ? Qt : Qnil;
6314 value = canonicalize_extent_property (prop, value);
6316 closure.prop = prop;
6317 closure.value = value;
6318 closure.start = start;
6320 closure.object = object;
6321 closure.changed_p = 0;
6322 closure.the_extent = Qnil;
6324 map_extents_bytind (start, end,
6325 put_text_prop_mapper,
6326 (void *) &closure, object, 0,
6327 /* get all extents that abut the region */
6328 ME_ALL_EXTENTS_CLOSED | ME_END_CLOSED |
6329 /* it might QUIT or error if the user has
6330 fucked with the extent plist. */
6331 /* #### dmoore - I think this should include
6332 ME_MIGHT_MOVE_SOE, since the callback function
6333 might recurse back into map_extents_bytind. */
6335 ME_MIGHT_MODIFY_EXTENTS);
6337 /* If we made it through the loop without reusing an extent
6338 (and we want there to be one) make it now.
6340 if (!NILP (value) && NILP (closure.the_extent))
6344 XSETEXTENT (extent, make_extent_internal (object, start, end));
6345 closure.changed_p = 1;
6346 Fset_extent_property (extent, Qtext_prop, prop);
6347 Fset_extent_property (extent, prop, value);
6350 extent_duplicable_p (XEXTENT (extent)) = 1;
6351 Fset_extent_property (extent, Qpaste_function,
6352 Qtext_prop_extent_paste_function);
6354 set_extent_openness (XEXTENT (extent),
6355 !NILP (get_text_property_bytind
6356 (start, Qstart_open, object,
6357 EXTENT_AT_AFTER, 1)),
6358 NILP (get_text_property_bytind
6359 (end - 1, Qend_closed, object,
6360 EXTENT_AT_AFTER, 1)));
6363 if (EQ (prop, Qstart_open) || EQ (prop, Qend_closed))
6365 map_extents_bytind (start, end,
6366 put_text_prop_openness_mapper,
6367 (void *) &closure, object, 0,
6368 /* get all extents that abut the region */
6369 ME_ALL_EXTENTS_CLOSED | ME_END_CLOSED |
6370 ME_MIGHT_MODIFY_EXTENTS);
6373 return closure.changed_p;
6376 DEFUN ("put-text-property", Fput_text_property, 4, 5, 0, /*
6377 Adds the given property/value to all characters in the specified region.
6378 The property is conceptually attached to the characters rather than the
6379 region. The properties are copied when the characters are copied/pasted.
6380 Fifth argument OBJECT is the buffer or string containing the text, and
6381 defaults to the current buffer.
6383 (start, end, prop, value, object))
6385 /* This function can GC */
6388 object = decode_buffer_or_string (object);
6389 get_buffer_or_string_range_byte (object, start, end, &s, &e, 0);
6390 put_text_prop (s, e, object, prop, value, 1);
6394 DEFUN ("put-nonduplicable-text-property", Fput_nonduplicable_text_property,
6396 Adds the given property/value to all characters in the specified region.
6397 The property is conceptually attached to the characters rather than the
6398 region, however the properties will not be copied when the characters
6400 Fifth argument OBJECT is the buffer or string containing the text, and
6401 defaults to the current buffer.
6403 (start, end, prop, value, object))
6405 /* This function can GC */
6408 object = decode_buffer_or_string (object);
6409 get_buffer_or_string_range_byte (object, start, end, &s, &e, 0);
6410 put_text_prop (s, e, object, prop, value, 0);
6414 DEFUN ("add-text-properties", Fadd_text_properties, 3, 4, 0, /*
6415 Add properties to the characters from START to END.
6416 The third argument PROPS is a property list specifying the property values
6417 to add. The optional fourth argument, OBJECT, is the buffer or string
6418 containing the text and defaults to the current buffer. Returns t if
6419 any property was changed, nil otherwise.
6421 (start, end, props, object))
6423 /* This function can GC */
6427 object = decode_buffer_or_string (object);
6428 get_buffer_or_string_range_byte (object, start, end, &s, &e, 0);
6430 for (; !NILP (props); props = Fcdr (Fcdr (props)))
6432 Lisp_Object prop = XCAR (props);
6433 Lisp_Object value = Fcar (XCDR (props));
6434 changed |= put_text_prop (s, e, object, prop, value, 1);
6436 return changed ? Qt : Qnil;
6440 DEFUN ("add-nonduplicable-text-properties", Fadd_nonduplicable_text_properties,
6442 Add nonduplicable properties to the characters from START to END.
6443 \(The properties will not be copied when the characters are copied.)
6444 The third argument PROPS is a property list specifying the property values
6445 to add. The optional fourth argument, OBJECT, is the buffer or string
6446 containing the text and defaults to the current buffer. Returns t if
6447 any property was changed, nil otherwise.
6449 (start, end, props, object))
6451 /* This function can GC */
6455 object = decode_buffer_or_string (object);
6456 get_buffer_or_string_range_byte (object, start, end, &s, &e, 0);
6458 for (; !NILP (props); props = Fcdr (Fcdr (props)))
6460 Lisp_Object prop = XCAR (props);
6461 Lisp_Object value = Fcar (XCDR (props));
6462 changed |= put_text_prop (s, e, object, prop, value, 0);
6464 return changed ? Qt : Qnil;
6467 DEFUN ("remove-text-properties", Fremove_text_properties, 3, 4, 0, /*
6468 Remove the given properties from all characters in the specified region.
6469 PROPS should be a plist, but the values in that plist are ignored (treated
6470 as nil). Returns t if any property was changed, nil otherwise.
6471 Fourth argument OBJECT is the buffer or string containing the text, and
6472 defaults to the current buffer.
6474 (start, end, props, object))
6476 /* This function can GC */
6480 object = decode_buffer_or_string (object);
6481 get_buffer_or_string_range_byte (object, start, end, &s, &e, 0);
6483 for (; !NILP (props); props = Fcdr (Fcdr (props)))
6485 Lisp_Object prop = XCAR (props);
6486 changed |= put_text_prop (s, e, object, prop, Qnil, 1);
6488 return changed ? Qt : Qnil;
6491 /* Whenever a text-prop extent is pasted into a buffer (via `yank' or `insert'
6492 or whatever) we attach the properties to the buffer by calling
6493 `put-text-property' instead of by simply allowing the extent to be copied or
6494 re-attached. Then we return nil, telling the extents code not to attach it
6495 again. By handing the insertion hackery in this way, we make kill/yank
6496 behave consistently with put-text-property and not fragment the extents
6497 (since text-prop extents must partition, not overlap).
6499 The lisp implementation of this was probably fast enough, but since I moved
6500 the rest of the put-text-prop code here, I moved this as well for
6503 DEFUN ("text-prop-extent-paste-function", Ftext_prop_extent_paste_function,
6505 Used as the `paste-function' property of `text-prop' extents.
6509 /* This function can GC */
6510 Lisp_Object prop, val;
6512 prop = Fextent_property (extent, Qtext_prop, Qnil);
6514 signal_simple_error ("Internal error: no text-prop", extent);
6515 val = Fextent_property (extent, prop, Qnil);
6517 /* removed by bill perry, 2/9/97
6518 ** This little bit of code would not allow you to have a text property
6519 ** with a value of Qnil. This is bad bad bad.
6522 signal_simple_error_2 ("Internal error: no text-prop",
6525 Fput_text_property (from, to, prop, val, Qnil);
6526 return Qnil; /* important! */
6529 /* This function could easily be written in Lisp but the C code wants
6530 to use it in connection with invisible extents (at least currently).
6531 If this changes, consider moving this back into Lisp. */
6533 DEFUN ("next-single-property-change", Fnext_single_property_change,
6535 Return the position of next property change for a specific property.
6536 Scans characters forward from POS till it finds a change in the PROP
6537 property, then returns the position of the change. The optional third
6538 argument OBJECT is the buffer or string to scan (defaults to the current
6540 The property values are compared with `eq'.
6541 Return nil if the property is constant all the way to the end of BUFFER.
6542 If the value is non-nil, it is a position greater than POS, never equal.
6544 If the optional fourth argument LIMIT is non-nil, don't search
6545 past position LIMIT; return LIMIT if nothing is found before LIMIT.
6546 If two or more extents with conflicting non-nil values for PROP overlap
6547 a particular character, it is undefined which value is considered to be
6548 the value of PROP. (Note that this situation will not happen if you always
6549 use the text-property primitives.)
6551 (pos, prop, object, limit))
6555 Lisp_Object extent, value;
6558 object = decode_buffer_or_string (object);
6559 bpos = get_buffer_or_string_pos_char (object, pos, 0);
6562 blim = buffer_or_string_accessible_end_char (object);
6567 blim = get_buffer_or_string_pos_char (object, limit, 0);
6571 extent = Fextent_at (make_int (bpos), object, prop, Qnil, Qnil);
6573 value = Fextent_property (extent, prop, Qnil);
6579 bpos = XINT (Fnext_extent_change (make_int (bpos), object));
6581 break; /* property is the same all the way to the end */
6582 extent = Fextent_at (make_int (bpos), object, prop, Qnil, Qnil);
6583 if ((NILP (extent) && !NILP (value)) ||
6584 (!NILP (extent) && !EQ (value,
6585 Fextent_property (extent, prop, Qnil))))
6586 return make_int (bpos);
6589 /* I think it's more sensible for this function to return nil always
6590 in this situation and it used to do it this way, but it's been changed
6591 for FSF compatibility. */
6595 return make_int (blim);
6598 /* See comment on previous function about why this is written in C. */
6600 DEFUN ("previous-single-property-change", Fprevious_single_property_change,
6602 Return the position of next property change for a specific property.
6603 Scans characters backward from POS till it finds a change in the PROP
6604 property, then returns the position of the change. The optional third
6605 argument OBJECT is the buffer or string to scan (defaults to the current
6607 The property values are compared with `eq'.
6608 Return nil if the property is constant all the way to the start of BUFFER.
6609 If the value is non-nil, it is a position less than POS, never equal.
6611 If the optional fourth argument LIMIT is non-nil, don't search back
6612 past position LIMIT; return LIMIT if nothing is found until LIMIT.
6613 If two or more extents with conflicting non-nil values for PROP overlap
6614 a particular character, it is undefined which value is considered to be
6615 the value of PROP. (Note that this situation will not happen if you always
6616 use the text-property primitives.)
6618 (pos, prop, object, limit))
6622 Lisp_Object extent, value;
6625 object = decode_buffer_or_string (object);
6626 bpos = get_buffer_or_string_pos_char (object, pos, 0);
6629 blim = buffer_or_string_accessible_begin_char (object);
6634 blim = get_buffer_or_string_pos_char (object, limit, 0);
6638 /* extent-at refers to the character AFTER bpos, but we want the
6639 character before bpos. Thus the - 1. extent-at simply
6640 returns nil on bogus positions, so not to worry. */
6641 extent = Fextent_at (make_int (bpos - 1), object, prop, Qnil, Qnil);
6643 value = Fextent_property (extent, prop, Qnil);
6649 bpos = XINT (Fprevious_extent_change (make_int (bpos), object));
6651 break; /* property is the same all the way to the beginning */
6652 extent = Fextent_at (make_int (bpos - 1), object, prop, Qnil, Qnil);
6653 if ((NILP (extent) && !NILP (value)) ||
6654 (!NILP (extent) && !EQ (value,
6655 Fextent_property (extent, prop, Qnil))))
6656 return make_int (bpos);
6659 /* I think it's more sensible for this function to return nil always
6660 in this situation and it used to do it this way, but it's been changed
6661 for FSF compatibility. */
6665 return make_int (blim);
6668 #ifdef MEMORY_USAGE_STATS
6671 compute_buffer_extent_usage (struct buffer *b, struct overhead_stats *ovstats)
6673 /* #### not yet written */
6677 #endif /* MEMORY_USAGE_STATS */
6680 /************************************************************************/
6681 /* initialization */
6682 /************************************************************************/
6685 syms_of_extents (void)
6687 defsymbol (&Qextentp, "extentp");
6688 defsymbol (&Qextent_live_p, "extent-live-p");
6690 defsymbol (&Qall_extents_closed, "all-extents-closed");
6691 defsymbol (&Qall_extents_open, "all-extents-open");
6692 defsymbol (&Qall_extents_closed_open, "all-extents-closed-open");
6693 defsymbol (&Qall_extents_open_closed, "all-extents-open-closed");
6694 defsymbol (&Qstart_in_region, "start-in-region");
6695 defsymbol (&Qend_in_region, "end-in-region");
6696 defsymbol (&Qstart_and_end_in_region, "start-and-end-in-region");
6697 defsymbol (&Qstart_or_end_in_region, "start-or-end-in-region");
6698 defsymbol (&Qnegate_in_region, "negate-in-region");
6700 defsymbol (&Qdetached, "detached");
6701 defsymbol (&Qdestroyed, "destroyed");
6702 defsymbol (&Qbegin_glyph, "begin-glyph");
6703 defsymbol (&Qend_glyph, "end-glyph");
6704 defsymbol (&Qstart_open, "start-open");
6705 defsymbol (&Qend_open, "end-open");
6706 defsymbol (&Qstart_closed, "start-closed");
6707 defsymbol (&Qend_closed, "end-closed");
6708 defsymbol (&Qread_only, "read-only");
6709 /* defsymbol (&Qhighlight, "highlight"); in faces.c */
6710 defsymbol (&Qunique, "unique");
6711 defsymbol (&Qduplicable, "duplicable");
6712 defsymbol (&Qdetachable, "detachable");
6713 defsymbol (&Qpriority, "priority");
6714 defsymbol (&Qmouse_face, "mouse-face");
6715 defsymbol (&Qinitial_redisplay_function,"initial-redisplay-function");
6718 defsymbol (&Qglyph_layout, "glyph-layout"); /* backwards compatibility */
6719 defsymbol (&Qbegin_glyph_layout, "begin-glyph-layout");
6720 defsymbol (&Qend_glyph_layout, "end-glyph-layout");
6721 defsymbol (&Qoutside_margin, "outside-margin");
6722 defsymbol (&Qinside_margin, "inside-margin");
6723 defsymbol (&Qwhitespace, "whitespace");
6724 /* Qtext defined in general.c */
6726 defsymbol (&Qglyph_invisible, "glyph-invisible");
6728 defsymbol (&Qpaste_function, "paste-function");
6729 defsymbol (&Qcopy_function, "copy-function");
6731 defsymbol (&Qtext_prop, "text-prop");
6732 defsymbol (&Qtext_prop_extent_paste_function,
6733 "text-prop-extent-paste-function");
6736 DEFSUBR (Fextent_live_p);
6737 DEFSUBR (Fextent_detached_p);
6738 DEFSUBR (Fextent_start_position);
6739 DEFSUBR (Fextent_end_position);
6740 DEFSUBR (Fextent_object);
6741 DEFSUBR (Fextent_length);
6743 DEFSUBR (Fmake_extent);
6744 DEFSUBR (Fcopy_extent);
6745 DEFSUBR (Fdelete_extent);
6746 DEFSUBR (Fdetach_extent);
6747 DEFSUBR (Fset_extent_endpoints);
6748 DEFSUBR (Fnext_extent);
6749 DEFSUBR (Fprevious_extent);
6751 DEFSUBR (Fnext_e_extent);
6752 DEFSUBR (Fprevious_e_extent);
6754 DEFSUBR (Fnext_extent_change);
6755 DEFSUBR (Fprevious_extent_change);
6757 DEFSUBR (Fextent_parent);
6758 DEFSUBR (Fextent_children);
6759 DEFSUBR (Fset_extent_parent);
6761 DEFSUBR (Fextent_in_region_p);
6762 DEFSUBR (Fmap_extents);
6763 DEFSUBR (Fmap_extent_children);
6764 DEFSUBR (Fextent_at);
6766 DEFSUBR (Fset_extent_initial_redisplay_function);
6767 DEFSUBR (Fextent_face);
6768 DEFSUBR (Fset_extent_face);
6769 DEFSUBR (Fextent_mouse_face);
6770 DEFSUBR (Fset_extent_mouse_face);
6771 DEFSUBR (Fset_extent_begin_glyph);
6772 DEFSUBR (Fset_extent_end_glyph);
6773 DEFSUBR (Fextent_begin_glyph);
6774 DEFSUBR (Fextent_end_glyph);
6775 DEFSUBR (Fset_extent_begin_glyph_layout);
6776 DEFSUBR (Fset_extent_end_glyph_layout);
6777 DEFSUBR (Fextent_begin_glyph_layout);
6778 DEFSUBR (Fextent_end_glyph_layout);
6779 DEFSUBR (Fset_extent_priority);
6780 DEFSUBR (Fextent_priority);
6781 DEFSUBR (Fset_extent_property);
6782 DEFSUBR (Fset_extent_properties);
6783 DEFSUBR (Fextent_property);
6784 DEFSUBR (Fextent_properties);
6786 DEFSUBR (Fhighlight_extent);
6787 DEFSUBR (Fforce_highlight_extent);
6789 DEFSUBR (Finsert_extent);
6791 DEFSUBR (Fget_text_property);
6792 DEFSUBR (Fget_char_property);
6793 DEFSUBR (Fput_text_property);
6794 DEFSUBR (Fput_nonduplicable_text_property);
6795 DEFSUBR (Fadd_text_properties);
6796 DEFSUBR (Fadd_nonduplicable_text_properties);
6797 DEFSUBR (Fremove_text_properties);
6798 DEFSUBR (Ftext_prop_extent_paste_function);
6799 DEFSUBR (Fnext_single_property_change);
6800 DEFSUBR (Fprevious_single_property_change);
6804 vars_of_extents (void)
6806 DEFVAR_INT ("mouse-highlight-priority", &mouse_highlight_priority /*
6807 The priority to use for the mouse-highlighting pseudo-extent
6808 that is used to highlight extents with the `mouse-face' attribute set.
6809 See `set-extent-priority'.
6811 /* Set mouse-highlight-priority (which ends up being used both for the
6812 mouse-highlighting pseudo-extent and the primary selection extent)
6813 to a very high value because very few extents should override it.
6814 1000 gives lots of room below it for different-prioritized extents.
6815 10 doesn't. ediff, for example, likes to use priorities around 100.
6817 mouse_highlight_priority = /* 10 */ 1000;
6819 DEFVAR_LISP ("default-text-properties", &Vdefault_text_properties /*
6820 Property list giving default values for text properties.
6821 Whenever a character does not specify a value for a property, the value
6822 stored in this list is used instead. This only applies when the
6823 functions `get-text-property' or `get-char-property' are called.
6825 Vdefault_text_properties = Qnil;
6827 staticpro (&Vlast_highlighted_extent);
6828 Vlast_highlighted_extent = Qnil;
6830 Vextent_face_reusable_list = Fcons (Qnil, Qnil);
6831 staticpro (&Vextent_face_reusable_list);
6833 extent_auxiliary_defaults.begin_glyph = Qnil;
6834 extent_auxiliary_defaults.end_glyph = Qnil;
6835 extent_auxiliary_defaults.parent = Qnil;
6836 extent_auxiliary_defaults.children = Qnil;
6837 extent_auxiliary_defaults.priority = 0;
6838 extent_auxiliary_defaults.invisible = Qnil;
6839 extent_auxiliary_defaults.read_only = Qnil;
6840 extent_auxiliary_defaults.mouse_face = Qnil;
6841 extent_auxiliary_defaults.initial_redisplay_function = Qnil;
6842 extent_auxiliary_defaults.before_change_functions = Qnil;
6843 extent_auxiliary_defaults.after_change_functions = Qnil;
6847 complex_vars_of_extents (void)
6849 staticpro (&Vextent_face_memoize_hash_table);
6850 /* The memoize hash table maps from lists of symbols to lists of
6851 faces. It needs to be `equal' to implement the memoization.
6852 The reverse table maps in the other direction and just needs
6853 to do `eq' comparison because the lists of faces are already
6855 Vextent_face_memoize_hash_table =
6856 make_lisp_hash_table (100, HASH_TABLE_VALUE_WEAK, HASH_TABLE_EQUAL);
6857 staticpro (&Vextent_face_reverse_memoize_hash_table);
6858 Vextent_face_reverse_memoize_hash_table =
6859 make_lisp_hash_table (100, HASH_TABLE_KEY_WEAK, HASH_TABLE_EQ);