1 /* Copyright (c) 1994, 1995 Free Software Foundation, Inc.
2 Copyright (c) 1995 Sun Microsystems, Inc.
3 Copyright (c) 1995, 1996, 2000 Ben Wing.
5 This file is part of XEmacs.
7 XEmacs is free software; you can redistribute it and/or modify it
8 under the terms of the GNU General Public License as published by the
9 Free Software Foundation; either version 2, or (at your option) any
12 XEmacs is distributed in the hope that it will be useful, but WITHOUT
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
17 You should have received a copy of the GNU General Public License
18 along with XEmacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
22 /* Synched up with: Not in FSF. */
24 /* This file has been Mule-ized. */
26 /* Written by Ben Wing <ben@xemacs.org>.
28 [Originally written by some people at Lucid.
30 Start/end-open stuff added by John Rose (john.rose@eng.sun.com).
31 Rewritten from scratch by Ben Wing, December 1994.] */
35 Extents are regions over a buffer, with a start and an end position
36 denoting the region of the buffer included in the extent. In
37 addition, either end can be closed or open, meaning that the endpoint
38 is or is not logically included in the extent. Insertion of a character
39 at a closed endpoint causes the character to go inside the extent;
40 insertion at an open endpoint causes the character to go outside.
42 Extent endpoints are stored using memory indices (see insdel.c),
43 to minimize the amount of adjusting that needs to be done when
44 characters are inserted or deleted.
46 (Formerly, extent endpoints at the gap could be either before or
47 after the gap, depending on the open/closedness of the endpoint.
48 The intent of this was to make it so that insertions would
49 automatically go inside or out of extents as necessary with no
50 further work needing to be done. It didn't work out that way,
51 however, and just ended up complexifying and buggifying all the
54 Extents are compared using memory indices. There are two orderings
55 for extents and both orders are kept current at all times. The normal
56 or "display" order is as follows:
58 Extent A is "less than" extent B, that is, earlier in the display order,
59 if: A-start < B-start,
60 or if: A-start = B-start, and A-end > B-end
62 So if two extents begin at the same position, the larger of them is the
63 earlier one in the display order (EXTENT_LESS is true).
65 For the e-order, the same thing holds: Extent A is "less than" extent B
66 in e-order, that is, later in the buffer,
68 or if: A-end = B-end, and A-start > B-start
70 So if two extents end at the same position, the smaller of them is the
71 earlier one in the e-order (EXTENT_E_LESS is true).
73 The display order and the e-order are complementary orders: any
74 theorem about the display order also applies to the e-order if you
75 swap all occurrences of "display order" and "e-order", "less than"
76 and "greater than", and "extent start" and "extent end".
78 Extents can be zero-length, and will end up that way if their endpoints
79 are explicitly set that way or if their detachable property is nil
80 and all the text in the extent is deleted. (The exception is open-open
81 zero-length extents, which are barred from existing because there is
82 no sensible way to define their properties. Deletion of the text in
83 an open-open extent causes it to be converted into a closed-open
84 extent.) Zero-length extents are primarily used to represent
85 annotations, and behave as follows:
87 1) Insertion at the position of a zero-length extent expands the extent
88 if both endpoints are closed; goes after the extent if it is closed-open;
89 and goes before the extent if it is open-closed.
91 2) Deletion of a character on a side of a zero-length extent whose
92 corresponding endpoint is closed causes the extent to be detached if
93 it is detachable; if the extent is not detachable or the corresponding
94 endpoint is open, the extent remains in the buffer, moving as necessary.
96 Note that closed-open, non-detachable zero-length extents behave exactly
97 like markers and that open-closed, non-detachable zero-length extents
98 behave like the "point-type" marker in Mule.
101 #### The following information is wrong in places.
103 More about the different orders:
104 --------------------------------
106 The extents in a buffer are ordered by "display order" because that
107 is that order that the redisplay mechanism needs to process them in.
108 The e-order is an auxiliary ordering used to facilitate operations
109 over extents. The operations that can be performed on the ordered
110 list of extents in a buffer are
112 1) Locate where an extent would go if inserted into the list.
113 2) Insert an extent into the list.
114 3) Remove an extent from the list.
115 4) Map over all the extents that overlap a range.
117 (4) requires being able to determine the first and last extents
118 that overlap a range.
120 NOTE: "overlap" is used as follows:
122 -- two ranges overlap if they have at least one point in common.
123 Whether the endpoints are open or closed makes a difference here.
124 -- a point overlaps a range if the point is contained within the
125 range; this is equivalent to treating a point P as the range
127 -- In the case of an *extent* overlapping a point or range, the
128 extent is normally treated as having closed endpoints. This
129 applies consistently in the discussion of stacks of extents
130 and such below. Note that this definition of overlap is not
131 necessarily consistent with the extents that `map-extents'
132 maps over, since `map-extents' sometimes pays attention to
133 whether the endpoints of an extents are open or closed.
134 But for our purposes, it greatly simplifies things to treat
135 all extents as having closed endpoints.
137 First, define >, <, <=, etc. as applied to extents to mean
138 comparison according to the display order. Comparison between an
139 extent E and an index I means comparison between E and the range
141 Also define e>, e<, e<=, etc. to mean comparison according to the
143 For any range R, define R(0) to be the starting index of the range
144 and R(1) to be the ending index of the range.
145 For any extent E, define E(next) to be the extent directly following
146 E, and E(prev) to be the extent directly preceding E. Assume
147 E(next) and E(prev) can be determined from E in constant time.
148 (This is because we store the extent list as a doubly linked
150 Similarly, define E(e-next) and E(e-prev) to be the extents
151 directly following and preceding E in the e-order.
156 Let F be the first extent overlapping R.
157 Let L be the last extent overlapping R.
159 Theorem 1: R(1) lies between L and L(next), i.e. L <= R(1) < L(next).
161 This follows easily from the definition of display order. The
162 basic reason that this theorem applies is that the display order
163 sorts by increasing starting index.
165 Therefore, we can determine L just by looking at where we would
166 insert R(1) into the list, and if we know F and are moving forward
167 over extents, we can easily determine when we've hit L by comparing
168 the extent we're at to R(1).
170 Theorem 2: F(e-prev) e< [1, R(0)] e<= F.
172 This is the analog of Theorem 1, and applies because the e-order
173 sorts by increasing ending index.
175 Therefore, F can be found in the same amount of time as operation (1),
176 i.e. the time that it takes to locate where an extent would go if
177 inserted into the e-order list.
179 If the lists were stored as balanced binary trees, then operation (1)
180 would take logarithmic time, which is usually quite fast. However,
181 currently they're stored as simple doubly-linked lists, and instead
182 we do some caching to try to speed things up.
184 Define a "stack of extents" (or "SOE") as the set of extents
185 (ordered in the display order) that overlap an index I, together with
186 the SOE's "previous" extent, which is an extent that precedes I in
187 the e-order. (Hopefully there will not be very many extents between
188 I and the previous extent.)
192 Let I be an index, let S be the stack of extents on I, let F be
193 the first extent in S, and let P be S's previous extent.
195 Theorem 3: The first extent in S is the first extent that overlaps
198 Proof: Any extent that overlaps [I, J] but does not include I must
199 have a start index > I, and thus be greater than any extent in S.
201 Therefore, finding the first extent that overlaps a range R is the
202 same as finding the first extent that overlaps R(0).
204 Theorem 4: Let I2 be an index such that I2 > I, and let F2 be the
205 first extent that overlaps I2. Then, either F2 is in S or F2 is
206 greater than any extent in S.
208 Proof: If F2 does not include I then its start index is greater
209 than I and thus it is greater than any extent in S, including F.
210 Otherwise, F2 includes I and thus is in S, and thus F2 >= F.
229 #include "redisplay.h"
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 static 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 static 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 Fixnum 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 Lisp_Object Qcopy_function;
449 Lisp_Object Qpaste_function;
451 /* The idea here is that if we're given a list of faces, we
452 need to "memoize" this so that two lists of faces that are `equal'
453 turn into the same object. When `set-extent-face' is called, we
454 "memoize" into a list of actual faces; when `extent-face' is called,
455 we do a reverse lookup to get the list of symbols. */
457 static Lisp_Object canonicalize_extent_property (Lisp_Object prop,
459 Lisp_Object Vextent_face_memoize_hash_table;
460 Lisp_Object Vextent_face_reverse_memoize_hash_table;
461 Lisp_Object Vextent_face_reusable_list;
462 /* FSFmacs bogosity */
463 Lisp_Object Vdefault_text_properties;
465 EXFUN (Fextent_properties, 1);
466 EXFUN (Fset_extent_property, 3);
468 /* if true, we don't want to set any redisplay flags on modeline extent
470 int in_modeline_generation;
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)
916 struct extent_auxiliary *data = XEXTENT_AUXILIARY (obj);
917 mark_object (data->begin_glyph);
918 mark_object (data->end_glyph);
919 mark_object (data->invisible);
920 mark_object (data->children);
921 mark_object (data->read_only);
922 mark_object (data->mouse_face);
923 mark_object (data->initial_redisplay_function);
924 mark_object (data->before_change_functions);
925 mark_object (data->after_change_functions);
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)
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);
1000 mark_object (exobj);
1008 finalize_extent_info (void *header, int for_disksave)
1010 struct extent_info *data = (struct extent_info *) header;
1017 free_soe (data->soe);
1022 free_extent_list (data->extents);
1027 DEFINE_LRECORD_IMPLEMENTATION ("extent-info", extent_info,
1028 mark_extent_info, internal_object_printer,
1029 finalize_extent_info, 0, 0, 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) : extent_start (extent);
1545 Lisp_Object obj = extent_object (extent);
1546 return buffer_or_string_memind_to_bytind (obj, i);
1551 extent_endpoint_bufpos (EXTENT extent, int endp)
1553 assert (EXTENT_LIVE_P (extent));
1554 assert (!extent_detached_p (extent));
1556 Memind i = endp ? extent_end (extent) : extent_start (extent);
1557 Lisp_Object obj = extent_object (extent);
1558 return buffer_or_string_memind_to_bufpos (obj, i);
1562 /* A change to an extent occurred that will change the display, so
1563 notify redisplay. Maybe also recurse over all the extent's
1567 extent_changed_for_redisplay (EXTENT extent, int descendants_too,
1568 int invisibility_change)
1573 /* we could easily encounter a detached extent while traversing the
1574 children, but we should never be able to encounter a dead extent. */
1575 assert (EXTENT_LIVE_P (extent));
1577 if (descendants_too)
1579 Lisp_Object children = extent_children (extent);
1581 if (!NILP (children))
1583 /* first mark all of the extent's children. We will lose big-time
1584 if there are any circularities here, so we sure as hell better
1585 ensure that there aren't. */
1586 LIST_LOOP (rest, XWEAK_LIST_LIST (children))
1587 extent_changed_for_redisplay (XEXTENT (XCAR (rest)), 1,
1588 invisibility_change);
1592 /* now mark the extent itself. */
1594 object = extent_object (extent);
1596 if (extent_detached_p (extent))
1599 else if (STRINGP (object))
1601 /* #### Changes to string extents can affect redisplay if they are
1602 in the modeline or in the gutters.
1604 If the extent is in some generated-modeline-string: when we
1605 change an extent in generated-modeline-string, this changes its
1606 parent, which is in `modeline-format', so we should force the
1607 modeline to be updated. But how to determine whether a string
1608 is a `generated-modeline-string'? Looping through all buffers
1609 is not very efficient. Should we add all
1610 `generated-modeline-string' strings to a hash table? Maybe
1611 efficiency is not the greatest concern here and there's no big
1612 loss in looping over the buffers.
1614 If the extent is in a gutter we mark the gutter as
1615 changed. This means (a) we can update extents in the gutters
1616 when we need it. (b) we don't have to update the gutters when
1617 only extents attached to buffers have changed. */
1619 if (!in_modeline_generation)
1620 MARK_EXTENTS_CHANGED;
1621 gutter_extent_signal_changed_region_maybe (object,
1622 extent_endpoint_bufpos (extent, 0),
1623 extent_endpoint_bufpos (extent, 1));
1625 else if (BUFFERP (object))
1628 b = XBUFFER (object);
1629 BUF_FACECHANGE (b)++;
1630 MARK_EXTENTS_CHANGED;
1631 if (invisibility_change)
1633 buffer_extent_signal_changed_region (b,
1634 extent_endpoint_bufpos (extent, 0),
1635 extent_endpoint_bufpos (extent, 1));
1639 /* A change to an extent occurred that might affect redisplay.
1640 This is called when properties such as the endpoints, the layout,
1641 or the priority changes. Redisplay will be affected only if
1642 the extent has any displayable attributes. */
1645 extent_maybe_changed_for_redisplay (EXTENT extent, int descendants_too,
1646 int invisibility_change)
1648 /* Retrieve the ancestor for efficiency */
1649 EXTENT anc = extent_ancestor (extent);
1650 if (!NILP (extent_face (anc)) ||
1651 !NILP (extent_begin_glyph (anc)) ||
1652 !NILP (extent_end_glyph (anc)) ||
1653 !NILP (extent_mouse_face (anc)) ||
1654 !NILP (extent_invisible (anc)) ||
1655 !NILP (extent_initial_redisplay_function (anc)) ||
1656 invisibility_change)
1657 extent_changed_for_redisplay (extent, descendants_too,
1658 invisibility_change);
1662 make_extent_detached (Lisp_Object object)
1664 EXTENT extent = allocate_extent ();
1666 assert (NILP (object) || STRINGP (object) ||
1667 (BUFFERP (object) && BUFFER_LIVE_P (XBUFFER (object))));
1668 extent_object (extent) = object;
1669 /* Now make sure the extent info exists. */
1671 buffer_or_string_extent_info_force (object);
1675 /* A "real" extent is any extent other than the internal (not-user-visible)
1676 extents used by `map-extents'. */
1679 real_extent_at_forward (Extent_List *el, int pos, int endp)
1681 for (; pos < extent_list_num_els (el); pos++)
1683 EXTENT e = extent_list_at (el, pos, endp);
1684 if (!extent_internal_p (e))
1691 real_extent_at_backward (Extent_List *el, int pos, int endp)
1693 for (; pos >= 0; pos--)
1695 EXTENT e = extent_list_at (el, pos, endp);
1696 if (!extent_internal_p (e))
1703 extent_first (Lisp_Object obj)
1705 Extent_List *el = buffer_or_string_extent_list (obj);
1709 return real_extent_at_forward (el, 0, 0);
1714 extent_e_first (Lisp_Object obj)
1716 Extent_List *el = buffer_or_string_extent_list (obj);
1720 return real_extent_at_forward (el, 0, 1);
1725 extent_next (EXTENT e)
1727 Extent_List *el = extent_extent_list (e);
1729 int pos = extent_list_locate (el, e, 0, &foundp);
1731 return real_extent_at_forward (el, pos+1, 0);
1736 extent_e_next (EXTENT e)
1738 Extent_List *el = extent_extent_list (e);
1740 int pos = extent_list_locate (el, e, 1, &foundp);
1742 return real_extent_at_forward (el, pos+1, 1);
1747 extent_last (Lisp_Object obj)
1749 Extent_List *el = buffer_or_string_extent_list (obj);
1753 return real_extent_at_backward (el, extent_list_num_els (el) - 1, 0);
1758 extent_e_last (Lisp_Object obj)
1760 Extent_List *el = buffer_or_string_extent_list (obj);
1764 return real_extent_at_backward (el, extent_list_num_els (el) - 1, 1);
1769 extent_previous (EXTENT e)
1771 Extent_List *el = extent_extent_list (e);
1773 int pos = extent_list_locate (el, e, 0, &foundp);
1775 return real_extent_at_backward (el, pos-1, 0);
1780 extent_e_previous (EXTENT e)
1782 Extent_List *el = extent_extent_list (e);
1784 int pos = extent_list_locate (el, e, 1, &foundp);
1786 return real_extent_at_backward (el, pos-1, 1);
1791 extent_attach (EXTENT extent)
1793 Extent_List *el = extent_extent_list (extent);
1795 extent_list_insert (el, extent);
1796 soe_insert (extent_object (extent), extent);
1797 /* only this extent changed */
1798 extent_maybe_changed_for_redisplay (extent, 0,
1799 !NILP (extent_invisible (extent)));
1803 extent_detach (EXTENT extent)
1807 if (extent_detached_p (extent))
1809 el = extent_extent_list (extent);
1811 /* call this before messing with the extent. */
1812 extent_maybe_changed_for_redisplay (extent, 0,
1813 !NILP (extent_invisible (extent)));
1814 extent_list_delete (el, extent);
1815 soe_delete (extent_object (extent), extent);
1816 set_extent_start (extent, -1);
1817 set_extent_end (extent, -1);
1820 /* ------------------------------- */
1821 /* map-extents et al. */
1822 /* ------------------------------- */
1824 /* Returns true iff map_extents() would visit the given extent.
1825 See the comments at map_extents() for info on the overlap rule.
1826 Assumes that all validation on the extent and buffer positions has
1827 already been performed (see Fextent_in_region_p ()).
1830 extent_in_region_p (EXTENT extent, Bytind from, Bytind to,
1833 Lisp_Object obj = extent_object (extent);
1834 Endpoint_Index start, end, exs, exe;
1835 int start_open, end_open;
1836 unsigned int all_extents_flags = flags & ME_ALL_EXTENTS_MASK;
1837 unsigned int in_region_flags = flags & ME_IN_REGION_MASK;
1840 /* A zero-length region is treated as closed-closed. */
1843 flags |= ME_END_CLOSED;
1844 flags &= ~ME_START_OPEN;
1847 /* So is a zero-length extent. */
1848 if (extent_start (extent) == extent_end (extent))
1849 start_open = 0, end_open = 0;
1850 /* `all_extents_flags' will almost always be zero. */
1851 else if (all_extents_flags == 0)
1853 start_open = extent_start_open_p (extent);
1854 end_open = extent_end_open_p (extent);
1857 switch (all_extents_flags)
1859 case ME_ALL_EXTENTS_CLOSED: start_open = 0, end_open = 0; break;
1860 case ME_ALL_EXTENTS_OPEN: start_open = 1, end_open = 1; break;
1861 case ME_ALL_EXTENTS_CLOSED_OPEN: start_open = 0, end_open = 1; break;
1862 case ME_ALL_EXTENTS_OPEN_CLOSED: start_open = 1, end_open = 0; break;
1863 default: abort(); return 0;
1866 start = buffer_or_string_bytind_to_startind (obj, from,
1867 flags & ME_START_OPEN);
1868 end = buffer_or_string_bytind_to_endind (obj, to, ! (flags & ME_END_CLOSED));
1869 exs = memind_to_startind (extent_start (extent), start_open);
1870 exe = memind_to_endind (extent_end (extent), end_open);
1872 /* It's easy to determine whether an extent lies *outside* the
1873 region -- just determine whether it's completely before
1874 or completely after the region. Reject all such extents, so
1875 we're now left with only the extents that overlap the region.
1878 if (exs > end || exe < start)
1881 /* See if any further restrictions are called for. */
1882 /* in_region_flags will almost always be zero. */
1883 if (in_region_flags == 0)
1886 switch (in_region_flags)
1888 case ME_START_IN_REGION:
1889 retval = start <= exs && exs <= end; break;
1890 case ME_END_IN_REGION:
1891 retval = start <= exe && exe <= end; break;
1892 case ME_START_AND_END_IN_REGION:
1893 retval = start <= exs && exe <= end; break;
1894 case ME_START_OR_END_IN_REGION:
1895 retval = (start <= exs && exs <= end) || (start <= exe && exe <= end);
1900 return flags & ME_NEGATE_IN_REGION ? !retval : retval;
1903 struct map_extents_struct
1906 Extent_List_Marker *mkr;
1911 map_extents_unwind (Lisp_Object obj)
1913 struct map_extents_struct *closure =
1914 (struct map_extents_struct *) get_opaque_ptr (obj);
1915 free_opaque_ptr (obj);
1917 extent_detach (closure->range);
1919 extent_list_delete_marker (closure->el, closure->mkr);
1923 /* This is the guts of `map-extents' and the other functions that
1924 map over extents. In theory the operation of this function is
1925 simple: just figure out what extents we're mapping over, and
1926 call the function on each one of them in the range. Unfortunately
1927 there are a wide variety of things that the mapping function
1928 might do, and we have to be very tricky to avoid getting messed
1929 up. Furthermore, this function needs to be very fast (it is
1930 called multiple times every time text is inserted or deleted
1931 from a buffer), and so we can't always afford the overhead of
1932 dealing with all the possible things that the mapping function
1933 might do; thus, there are many flags that can be specified
1934 indicating what the mapping function might or might not do.
1936 The result of all this is that this is the most complicated
1937 function in this file. Change it at your own risk!
1939 A potential simplification to the logic below is to determine
1940 all the extents that the mapping function should be called on
1941 before any calls are actually made and save them in an array.
1942 That introduces its own complications, however (the array
1943 needs to be marked for garbage-collection, and a static array
1944 cannot be used because map_extents() needs to be reentrant).
1945 Furthermore, the results might be a little less sensible than
1950 map_extents_bytind (Bytind from, Bytind to, map_extents_fun fn, void *arg,
1951 Lisp_Object obj, EXTENT after, unsigned int flags)
1953 Memind st, en; /* range we're mapping over */
1954 EXTENT range = 0; /* extent for this, if ME_MIGHT_MODIFY_TEXT */
1955 Extent_List *el = 0; /* extent list we're iterating over */
1956 Extent_List_Marker *posm = 0; /* marker for extent list,
1957 if ME_MIGHT_MODIFY_EXTENTS */
1958 /* count and struct for unwind-protect, if ME_MIGHT_THROW */
1960 struct map_extents_struct closure;
1962 #ifdef ERROR_CHECK_EXTENTS
1963 assert (from <= to);
1964 assert (from >= buffer_or_string_absolute_begin_byte (obj) &&
1965 from <= buffer_or_string_absolute_end_byte (obj) &&
1966 to >= buffer_or_string_absolute_begin_byte (obj) &&
1967 to <= buffer_or_string_absolute_end_byte (obj));
1972 assert (EQ (obj, extent_object (after)));
1973 assert (!extent_detached_p (after));
1976 el = buffer_or_string_extent_list (obj);
1977 if (!el || !extent_list_num_els(el))
1981 st = buffer_or_string_bytind_to_memind (obj, from);
1982 en = buffer_or_string_bytind_to_memind (obj, to);
1984 if (flags & ME_MIGHT_MODIFY_TEXT)
1986 /* The mapping function might change the text in the buffer,
1987 so make an internal extent to hold the range we're mapping
1989 range = make_extent_detached (obj);
1990 set_extent_start (range, st);
1991 set_extent_end (range, en);
1992 range->flags.start_open = flags & ME_START_OPEN;
1993 range->flags.end_open = !(flags & ME_END_CLOSED);
1994 range->flags.internal = 1;
1995 range->flags.detachable = 0;
1996 extent_attach (range);
1999 if (flags & ME_MIGHT_THROW)
2001 /* The mapping function might throw past us so we need to use an
2002 unwind_protect() to eliminate the internal extent and range
2004 count = specpdl_depth ();
2005 closure.range = range;
2007 record_unwind_protect (map_extents_unwind,
2008 make_opaque_ptr (&closure));
2011 /* ---------- Figure out where we start and what direction
2012 we move in. This is the trickiest part of this
2013 function. ---------- */
2015 /* If ME_START_IN_REGION, ME_END_IN_REGION or ME_START_AND_END_IN_REGION
2016 was specified and ME_NEGATE_IN_REGION was not specified, our job
2017 is simple because of the presence of the display order and e-order.
2018 (Note that theoretically do something similar for
2019 ME_START_OR_END_IN_REGION, but that would require more trickiness
2020 than it's worth to avoid hitting the same extent twice.)
2022 In the general case, all the extents that overlap a range can be
2023 divided into two classes: those whose start position lies within
2024 the range (including the range's end but not including the
2025 range's start), and those that overlap the start position,
2026 i.e. those in the SOE for the start position. Or equivalently,
2027 the extents can be divided into those whose end position lies
2028 within the range and those in the SOE for the end position. Note
2029 that for this purpose we treat both the range and all extents in
2030 the buffer as closed on both ends. If this is not what the ME_
2031 flags specified, then we've mapped over a few too many extents,
2032 but no big deal because extent_in_region_p() will filter them
2033 out. Ideally, we could move the SOE to the closer of the range's
2034 two ends and work forwards or backwards from there. However, in
2035 order to make the semantics of the AFTER argument work out, we
2036 have to always go in the same direction; so we choose to always
2037 move the SOE to the start position.
2039 When it comes time to do the SOE stage, we first call soe_move()
2040 so that the SOE gets set up. Note that the SOE might get
2041 changed while we are mapping over its contents. If we can
2042 guarantee that the SOE won't get moved to a new position, we
2043 simply need to put a marker in the SOE and we will track deletions
2044 and insertions of extents in the SOE. If the SOE might get moved,
2045 however (this would happen as a result of a recursive invocation
2046 of map-extents or a call to a redisplay-type function), then
2047 trying to track its changes is hopeless, so we just keep a
2048 marker to the first (or last) extent in the SOE and use that as
2051 Finally, if DONT_USE_SOE is defined, we don't use the SOE at all
2052 and instead just map from the beginning of the buffer. This is
2053 used for testing purposes and allows the SOE to be calculated
2054 using map_extents() instead of the other way around. */
2057 int range_flag; /* ME_*_IN_REGION subset of flags */
2058 int do_soe_stage = 0; /* Are we mapping over the SOE? */
2059 /* Does the range stage map over start or end positions? */
2061 /* If type == 0, we include the start position in the range stage mapping.
2062 If type == 1, we exclude the start position in the range stage mapping.
2063 If type == 2, we begin at range_start_pos, an extent-list position.
2065 int range_start_type = 0;
2066 int range_start_pos = 0;
2069 range_flag = flags & ME_IN_REGION_MASK;
2070 if ((range_flag == ME_START_IN_REGION ||
2071 range_flag == ME_START_AND_END_IN_REGION) &&
2072 !(flags & ME_NEGATE_IN_REGION))
2074 /* map over start position in [range-start, range-end]. No SOE
2078 else if (range_flag == ME_END_IN_REGION && !(flags & ME_NEGATE_IN_REGION))
2080 /* map over end position in [range-start, range-end]. No SOE
2086 /* Need to include the SOE extents. */
2088 /* Just brute-force it: start from the beginning. */
2090 range_start_type = 2;
2091 range_start_pos = 0;
2093 Stack_Of_Extents *soe = buffer_or_string_stack_of_extents_force (obj);
2096 /* Move the SOE to the closer end of the range. This dictates
2097 whether we map over start positions or end positions. */
2100 numsoe = extent_list_num_els (soe->extents);
2103 if (flags & ME_MIGHT_MOVE_SOE)
2106 /* Can't map over SOE, so just extend range to cover the
2108 EXTENT e = extent_list_at (soe->extents, 0, 0);
2110 extent_list_locate (buffer_or_string_extent_list (obj), e, 0,
2113 range_start_type = 2;
2117 /* We can map over the SOE. */
2119 range_start_type = 1;
2124 /* No extents in the SOE to map over, so we act just as if
2125 ME_START_IN_REGION or ME_END_IN_REGION was specified.
2126 RANGE_ENDP already specified so no need to do anything else. */
2131 /* ---------- Now loop over the extents. ---------- */
2133 /* We combine the code for the two stages because much of it
2135 for (stage = 0; stage < 2; stage++)
2137 int pos = 0; /* Position in extent list */
2139 /* First set up start conditions */
2141 { /* The SOE stage */
2144 el = buffer_or_string_stack_of_extents_force (obj)->extents;
2145 /* We will always be looping over start extents here. */
2146 assert (!range_endp);
2150 { /* The range stage */
2151 el = buffer_or_string_extent_list (obj);
2152 switch (range_start_type)
2155 pos = extent_list_locate_from_pos (el, st, range_endp);
2158 pos = extent_list_locate_from_pos (el, st + 1, range_endp);
2161 pos = range_start_pos;
2166 if (flags & ME_MIGHT_MODIFY_EXTENTS)
2168 /* Create a marker to track changes to the extent list */
2170 /* Delete the marker used in the SOE stage. */
2171 extent_list_delete_marker
2172 (buffer_or_string_stack_of_extents_force (obj)->extents, posm);
2173 posm = extent_list_make_marker (el, pos, range_endp);
2174 /* tell the unwind function about the marker. */
2185 /* ----- update position in extent list
2186 and fetch next extent ----- */
2189 /* fetch POS again to track extent insertions or deletions */
2190 pos = extent_list_marker_pos (el, posm);
2191 if (pos >= extent_list_num_els (el))
2193 e = extent_list_at (el, pos, range_endp);
2196 /* now point the marker to the next one we're going to process.
2197 This ensures graceful behavior if this extent is deleted. */
2198 extent_list_move_marker (el, posm, pos);
2200 /* ----- deal with internal extents ----- */
2202 if (extent_internal_p (e))
2204 if (!(flags & ME_INCLUDE_INTERNAL))
2206 else if (e == range)
2208 /* We're processing internal extents and we've
2209 come across our own special range extent.
2210 (This happens only in adjust_extents*() and
2211 process_extents*(), which handle text
2212 insertion and deletion.) We need to omit
2213 processing of this extent; otherwise
2214 we will probably end up prematurely
2215 terminating this loop. */
2220 /* ----- deal with AFTER condition ----- */
2224 /* if e > after, then we can stop skipping extents. */
2225 if (EXTENT_LESS (after, e))
2227 else /* otherwise, skip this extent. */
2231 /* ----- stop if we're completely outside the range ----- */
2233 /* fetch ST and EN again to track text insertions or deletions */
2236 st = extent_start (range);
2237 en = extent_end (range);
2239 if (extent_endpoint (e, range_endp) > en)
2241 /* Can't be mapping over SOE because all extents in
2242 there should overlap ST */
2243 assert (stage == 1);
2247 /* ----- Now actually call the function ----- */
2249 obj2 = extent_object (e);
2250 if (extent_in_region_p (e,
2251 buffer_or_string_memind_to_bytind (obj2,
2253 buffer_or_string_memind_to_bytind (obj2,
2259 /* Function wants us to stop mapping. */
2260 stage = 1; /* so outer for loop will terminate */
2266 /* ---------- Finished looping. ---------- */
2269 if (flags & ME_MIGHT_THROW)
2270 /* This deletes the range extent and frees the marker. */
2271 unbind_to (count, Qnil);
2274 /* Delete them ourselves */
2276 extent_detach (range);
2278 extent_list_delete_marker (el, posm);
2283 map_extents (Bufpos from, Bufpos to, map_extents_fun fn,
2284 void *arg, Lisp_Object obj, EXTENT after, unsigned int flags)
2286 map_extents_bytind (buffer_or_string_bufpos_to_bytind (obj, from),
2287 buffer_or_string_bufpos_to_bytind (obj, to), fn, arg,
2291 /* ------------------------------- */
2292 /* adjust_extents() */
2293 /* ------------------------------- */
2295 /* Add AMOUNT to all extent endpoints in the range (FROM, TO]. This
2296 happens whenever the gap is moved or (under Mule) a character in a
2297 string is substituted for a different-length one. The reason for
2298 this is that extent endpoints behave just like markers (all memory
2299 indices do) and this adjustment correct for markers -- see
2300 adjust_markers(). Note that it is important that we visit all
2301 extent endpoints in the range, irrespective of whether the
2302 endpoints are open or closed.
2304 We could use map_extents() for this (and in fact the function
2305 was originally written that way), but the gap is in an incoherent
2306 state when this function is called and this function plays
2307 around with extent endpoints without detaching and reattaching
2308 the extents (this is provably correct and saves lots of time),
2309 so for safety we make it just look at the extent lists directly. */
2312 adjust_extents (Lisp_Object obj, Memind from, Memind to, int amount)
2318 Stack_Of_Extents *soe;
2320 #ifdef ERROR_CHECK_EXTENTS
2321 sledgehammer_extent_check (obj);
2323 el = buffer_or_string_extent_list (obj);
2325 if (!el || !extent_list_num_els(el))
2328 /* IMPORTANT! Compute the starting positions of the extents to
2329 modify BEFORE doing any modification! Otherwise the starting
2330 position for the second time through the loop might get
2331 incorrectly calculated (I got bit by this bug real bad). */
2332 startpos[0] = extent_list_locate_from_pos (el, from+1, 0);
2333 startpos[1] = extent_list_locate_from_pos (el, from+1, 1);
2334 for (endp = 0; endp < 2; endp++)
2336 for (pos = startpos[endp]; pos < extent_list_num_els (el);
2339 EXTENT e = extent_list_at (el, pos, endp);
2340 if (extent_endpoint (e, endp) > to)
2342 set_extent_endpoint (e,
2343 do_marker_adjustment (extent_endpoint (e, endp),
2349 /* The index for the buffer's SOE is a memory index and thus
2350 needs to be adjusted like a marker. */
2351 soe = buffer_or_string_stack_of_extents (obj);
2352 if (soe && soe->pos >= 0)
2353 soe->pos = do_marker_adjustment (soe->pos, from, to, amount);
2356 /* ------------------------------- */
2357 /* adjust_extents_for_deletion() */
2358 /* ------------------------------- */
2360 struct adjust_extents_for_deletion_arg
2362 EXTENT_dynarr *list;
2366 adjust_extents_for_deletion_mapper (EXTENT extent, void *arg)
2368 struct adjust_extents_for_deletion_arg *closure =
2369 (struct adjust_extents_for_deletion_arg *) arg;
2371 Dynarr_add (closure->list, extent);
2372 return 0; /* continue mapping */
2375 /* For all extent endpoints in the range (FROM, TO], move them to the beginning
2376 of the new gap. Note that it is important that we visit all extent
2377 endpoints in the range, irrespective of whether the endpoints are open or
2380 This function deals with weird stuff such as the fact that extents
2383 There is no string correspondent for this because you can't
2384 delete characters from a string.
2388 adjust_extents_for_deletion (Lisp_Object object, Bytind from,
2389 Bytind to, int gapsize, int numdel,
2392 struct adjust_extents_for_deletion_arg closure;
2394 Memind adjust_to = (Memind) (to + gapsize);
2395 Bytecount amount = - numdel - movegapsize;
2396 Memind oldsoe = 0, newsoe = 0;
2397 Stack_Of_Extents *soe = buffer_or_string_stack_of_extents (object);
2399 #ifdef ERROR_CHECK_EXTENTS
2400 sledgehammer_extent_check (object);
2402 closure.list = Dynarr_new (EXTENT);
2404 /* We're going to be playing weird games below with extents and the SOE
2405 and such, so compute the list now of all the extents that we're going
2406 to muck with. If we do the mapping and adjusting together, things can
2407 get all screwed up. */
2409 map_extents_bytind (from, to, adjust_extents_for_deletion_mapper,
2410 (void *) &closure, object, 0,
2411 /* extent endpoints move like markers regardless
2412 of their open/closeness. */
2413 ME_ALL_EXTENTS_CLOSED | ME_END_CLOSED |
2414 ME_START_OR_END_IN_REGION | ME_INCLUDE_INTERNAL);
2417 Old and new values for the SOE's position. (It gets adjusted
2418 like a marker, just like extent endpoints.)
2425 newsoe = do_marker_adjustment (soe->pos,
2426 adjust_to, adjust_to,
2432 for (i = 0; i < Dynarr_length (closure.list); i++)
2434 EXTENT extent = Dynarr_at (closure.list, i);
2435 Memind new_start = extent_start (extent);
2436 Memind new_end = extent_end (extent);
2438 /* do_marker_adjustment() will not adjust values that should not be
2439 adjusted. We're passing the same funky arguments to
2440 do_marker_adjustment() as buffer_delete_range() does. */
2442 do_marker_adjustment (new_start,
2443 adjust_to, adjust_to,
2446 do_marker_adjustment (new_end,
2447 adjust_to, adjust_to,
2450 /* We need to be very careful here so that the SOE doesn't get
2451 corrupted. We are shrinking extents out of the deleted region
2452 and simultaneously moving the SOE's pos out of the deleted
2453 region, so the SOE should contain the same extents at the end
2454 as at the beginning. However, extents may get reordered
2455 by this process, so we have to operate by pulling the extents
2456 out of the buffer and SOE, changing their bounds, and then
2457 reinserting them. In order for the SOE not to get screwed up,
2458 we have to make sure that the SOE's pos points to its old
2459 location whenever we pull an extent out, and points to its
2460 new location whenever we put the extent back in.
2463 if (new_start != extent_start (extent) ||
2464 new_end != extent_end (extent))
2466 extent_detach (extent);
2467 set_extent_start (extent, new_start);
2468 set_extent_end (extent, new_end);
2471 extent_attach (extent);
2480 #ifdef ERROR_CHECK_EXTENTS
2481 sledgehammer_extent_check (object);
2483 Dynarr_free (closure.list);
2486 /* ------------------------------- */
2487 /* extent fragments */
2488 /* ------------------------------- */
2490 /* Imagine that the buffer is divided up into contiguous,
2491 nonoverlapping "runs" of text such that no extent
2492 starts or ends within a run (extents that abut the
2495 An extent fragment is a structure that holds data about
2496 the run that contains a particular buffer position (if
2497 the buffer position is at the junction of two runs, the
2498 run after the position is used) -- the beginning and
2499 end of the run, a list of all of the extents in that
2500 run, the "merged face" that results from merging all of
2501 the faces corresponding to those extents, the begin and
2502 end glyphs at the beginning of the run, etc. This is
2503 the information that redisplay needs in order to
2506 Extent fragments have to be very quick to update to
2507 a new buffer position when moving linearly through
2508 the buffer. They rely on the stack-of-extents code,
2509 which does the heavy-duty algorithmic work of determining
2510 which extents overly a particular position. */
2512 /* This function returns the position of the beginning of
2513 the first run that begins after POS, or returns POS if
2514 there are no such runs. */
2517 extent_find_end_of_run (Lisp_Object obj, Bytind pos, int outside_accessible)
2520 Extent_List *bel = buffer_or_string_extent_list (obj);
2523 Memind mempos = buffer_or_string_bytind_to_memind (obj, pos);
2524 Bytind limit = outside_accessible ?
2525 buffer_or_string_absolute_end_byte (obj) :
2526 buffer_or_string_accessible_end_byte (obj);
2528 if (!bel || !extent_list_num_els(bel))
2531 sel = buffer_or_string_stack_of_extents_force (obj)->extents;
2532 soe_move (obj, mempos);
2534 /* Find the first start position after POS. */
2535 elind1 = extent_list_locate_from_pos (bel, mempos+1, 0);
2536 if (elind1 < extent_list_num_els (bel))
2537 pos1 = buffer_or_string_memind_to_bytind
2538 (obj, extent_start (extent_list_at (bel, elind1, 0)));
2542 /* Find the first end position after POS. The extent corresponding
2543 to this position is either in the SOE or is greater than or
2544 equal to POS1, so we just have to look in the SOE. */
2545 elind2 = extent_list_locate_from_pos (sel, mempos+1, 1);
2546 if (elind2 < extent_list_num_els (sel))
2547 pos2 = buffer_or_string_memind_to_bytind
2548 (obj, extent_end (extent_list_at (sel, elind2, 1)));
2552 return min (min (pos1, pos2), limit);
2556 extent_find_beginning_of_run (Lisp_Object obj, Bytind pos,
2557 int outside_accessible)
2560 Extent_List *bel = buffer_or_string_extent_list (obj);
2563 Memind mempos = buffer_or_string_bytind_to_memind (obj, pos);
2564 Bytind limit = outside_accessible ?
2565 buffer_or_string_absolute_begin_byte (obj) :
2566 buffer_or_string_accessible_begin_byte (obj);
2568 if (!bel || !extent_list_num_els(bel))
2571 sel = buffer_or_string_stack_of_extents_force (obj)->extents;
2572 soe_move (obj, mempos);
2574 /* Find the first end position before POS. */
2575 elind1 = extent_list_locate_from_pos (bel, mempos, 1);
2577 pos1 = buffer_or_string_memind_to_bytind
2578 (obj, extent_end (extent_list_at (bel, elind1 - 1, 1)));
2582 /* Find the first start position before POS. The extent corresponding
2583 to this position is either in the SOE or is less than or
2584 equal to POS1, so we just have to look in the SOE. */
2585 elind2 = extent_list_locate_from_pos (sel, mempos, 0);
2587 pos2 = buffer_or_string_memind_to_bytind
2588 (obj, extent_start (extent_list_at (sel, elind2 - 1, 0)));
2592 return max (max (pos1, pos2), limit);
2595 struct extent_fragment *
2596 extent_fragment_new (Lisp_Object buffer_or_string, struct frame *frm)
2598 struct extent_fragment *ef = xnew_and_zero (struct extent_fragment);
2600 ef->object = buffer_or_string;
2602 ef->extents = Dynarr_new (EXTENT);
2603 ef->begin_glyphs = Dynarr_new (glyph_block);
2604 ef->end_glyphs = Dynarr_new (glyph_block);
2610 extent_fragment_delete (struct extent_fragment *ef)
2612 Dynarr_free (ef->extents);
2613 Dynarr_free (ef->begin_glyphs);
2614 Dynarr_free (ef->end_glyphs);
2619 extent_priority_sort_function (const void *humpty, const void *dumpty)
2621 const EXTENT foo = * (const EXTENT *) humpty;
2622 const EXTENT bar = * (const EXTENT *) dumpty;
2623 if (extent_priority (foo) < extent_priority (bar))
2625 return extent_priority (foo) > extent_priority (bar);
2629 extent_fragment_sort_by_priority (EXTENT_dynarr *extarr)
2633 /* Sort our copy of the stack by extent_priority. We use a bubble
2634 sort here because it's going to be faster than qsort() for small
2635 numbers of extents (less than 10 or so), and 99.999% of the time
2636 there won't ever be more extents than this in the stack. */
2637 if (Dynarr_length (extarr) < 10)
2639 for (i = 1; i < Dynarr_length (extarr); i++)
2643 (extent_priority (Dynarr_at (extarr, j)) >
2644 extent_priority (Dynarr_at (extarr, j+1))))
2646 EXTENT tmp = Dynarr_at (extarr, j);
2647 Dynarr_at (extarr, j) = Dynarr_at (extarr, j+1);
2648 Dynarr_at (extarr, j+1) = tmp;
2654 /* But some loser programs mess up and may create a large number
2655 of extents overlapping the same spot. This will result in
2656 catastrophic behavior if we use the bubble sort above. */
2657 qsort (Dynarr_atp (extarr, 0), Dynarr_length (extarr),
2658 sizeof (EXTENT), extent_priority_sort_function);
2661 /* If PROP is the `invisible' property of an extent,
2662 this is 1 if the extent should be treated as invisible. */
2664 #define EXTENT_PROP_MEANS_INVISIBLE(buf, prop) \
2665 (EQ (buf->invisibility_spec, Qt) \
2667 : invisible_p (prop, buf->invisibility_spec))
2669 /* If PROP is the `invisible' property of a extent,
2670 this is 1 if the extent should be treated as invisible
2671 and should have an ellipsis. */
2673 #define EXTENT_PROP_MEANS_INVISIBLE_WITH_ELLIPSIS(buf, prop) \
2674 (EQ (buf->invisibility_spec, Qt) \
2676 : invisible_ellipsis_p (prop, buf->invisibility_spec))
2678 /* This is like a combination of memq and assq.
2679 Return 1 if PROPVAL appears as an element of LIST
2680 or as the car of an element of LIST.
2681 If PROPVAL is a list, compare each element against LIST
2682 in that way, and return 1 if any element of PROPVAL is found in LIST.
2684 This function cannot quit. */
2687 invisible_p (REGISTER Lisp_Object propval, Lisp_Object list)
2689 REGISTER Lisp_Object tail, proptail;
2690 for (tail = list; CONSP (tail); tail = XCDR (tail))
2692 REGISTER Lisp_Object tem;
2694 if (EQ (propval, tem))
2696 if (CONSP (tem) && EQ (propval, XCAR (tem)))
2699 if (CONSP (propval))
2700 for (proptail = propval; CONSP (proptail);
2701 proptail = XCDR (proptail))
2703 Lisp_Object propelt;
2704 propelt = XCAR (proptail);
2705 for (tail = list; CONSP (tail); tail = XCDR (tail))
2707 REGISTER Lisp_Object tem;
2709 if (EQ (propelt, tem))
2711 if (CONSP (tem) && EQ (propelt, XCAR (tem)))
2718 /* Return 1 if PROPVAL appears as the car of an element of LIST
2719 and the cdr of that element is non-nil.
2720 If PROPVAL is a list, check each element of PROPVAL in that way,
2721 and the first time some element is found,
2722 return 1 if the cdr of that element is non-nil.
2724 This function cannot quit. */
2727 invisible_ellipsis_p (REGISTER Lisp_Object propval, Lisp_Object list)
2729 REGISTER Lisp_Object tail, proptail;
2730 for (tail = list; CONSP (tail); tail = XCDR (tail))
2732 REGISTER Lisp_Object tem;
2734 if (CONSP (tem) && EQ (propval, XCAR (tem)))
2735 return ! NILP (XCDR (tem));
2737 if (CONSP (propval))
2738 for (proptail = propval; CONSP (proptail);
2739 proptail = XCDR (proptail))
2741 Lisp_Object propelt;
2742 propelt = XCAR (proptail);
2743 for (tail = list; CONSP (tail); tail = XCDR (tail))
2745 REGISTER Lisp_Object tem;
2747 if (CONSP (tem) && EQ (propelt, XCAR (tem)))
2748 return ! NILP (XCDR (tem));
2755 extent_fragment_update (struct window *w, struct extent_fragment *ef,
2756 Bytind pos, Lisp_Object last_glyph)
2759 int seen_glyph = NILP (last_glyph) ? 1 : 0;
2761 buffer_or_string_stack_of_extents_force (ef->object)->extents;
2763 struct extent dummy_lhe_extent;
2764 Memind mempos = buffer_or_string_bytind_to_memind (ef->object, pos);
2766 #ifdef ERROR_CHECK_EXTENTS
2767 assert (pos >= buffer_or_string_accessible_begin_byte (ef->object)
2768 && pos <= buffer_or_string_accessible_end_byte (ef->object));
2771 Dynarr_reset (ef->extents);
2772 Dynarr_reset (ef->begin_glyphs);
2773 Dynarr_reset (ef->end_glyphs);
2775 ef->previously_invisible = ef->invisible;
2778 if (ef->invisible_ellipses)
2779 ef->invisible_ellipses_already_displayed = 1;
2782 ef->invisible_ellipses_already_displayed = 0;
2784 ef->invisible_ellipses = 0;
2786 /* Set up the begin and end positions. */
2788 ef->end = extent_find_end_of_run (ef->object, pos, 0);
2790 /* Note that extent_find_end_of_run() already moved the SOE for us. */
2791 /* soe_move (ef->object, mempos); */
2793 /* Determine the begin glyphs at POS. */
2794 for (i = 0; i < extent_list_num_els (sel); i++)
2796 EXTENT e = extent_list_at (sel, i, 0);
2797 if (extent_start (e) == mempos && !NILP (extent_begin_glyph (e)))
2799 Lisp_Object glyph = extent_begin_glyph (e);
2801 struct glyph_block gb;
2804 XSETEXTENT (gb.extent, e);
2805 Dynarr_add (ef->begin_glyphs, gb);
2807 else if (EQ (glyph, last_glyph))
2812 /* Determine the end glyphs at POS. */
2813 for (i = 0; i < extent_list_num_els (sel); i++)
2815 EXTENT e = extent_list_at (sel, i, 1);
2816 if (extent_end (e) == mempos && !NILP (extent_end_glyph (e)))
2818 Lisp_Object glyph = extent_end_glyph (e);
2820 struct glyph_block gb;
2823 XSETEXTENT (gb.extent, e);
2824 Dynarr_add (ef->end_glyphs, gb);
2826 else if (EQ (glyph, last_glyph))
2831 /* We tried determining all the charsets used in the run here,
2832 but that fails even if we only do the current line -- display
2833 tables or non-printable characters might cause other charsets
2836 /* Determine whether the last-highlighted-extent is present. */
2837 if (EXTENTP (Vlast_highlighted_extent))
2838 lhe = XEXTENT (Vlast_highlighted_extent);
2840 /* Now add all extents that overlap the character after POS and
2841 have a non-nil face. Also check if the character is invisible. */
2842 for (i = 0; i < extent_list_num_els (sel); i++)
2844 EXTENT e = extent_list_at (sel, i, 0);
2845 if (extent_end (e) > mempos)
2847 Lisp_Object invis_prop = extent_invisible (e);
2849 if (!NILP (invis_prop))
2851 if (!BUFFERP (ef->object))
2852 /* #### no `string-invisibility-spec' */
2856 if (!ef->invisible_ellipses_already_displayed &&
2857 EXTENT_PROP_MEANS_INVISIBLE_WITH_ELLIPSIS
2858 (XBUFFER (ef->object), invis_prop))
2861 ef->invisible_ellipses = 1;
2863 else if (EXTENT_PROP_MEANS_INVISIBLE
2864 (XBUFFER (ef->object), invis_prop))
2869 /* Remember that one of the extents in the list might be our
2870 dummy extent representing the highlighting that is
2871 attached to some other extent that is currently
2872 mouse-highlighted. When an extent is mouse-highlighted,
2873 it is as if there are two extents there, of potentially
2874 different priorities: the extent being highlighted, with
2875 whatever face and priority it has; and an ephemeral
2876 extent in the `mouse-face' face with
2877 `mouse-highlight-priority'.
2880 if (!NILP (extent_face (e)))
2881 Dynarr_add (ef->extents, e);
2885 /* zeroing isn't really necessary; we only deref `priority'
2887 xzero (dummy_lhe_extent);
2888 set_extent_priority (&dummy_lhe_extent,
2889 mouse_highlight_priority);
2890 /* Need to break up the following expression, due to an */
2891 /* error in the Digital UNIX 3.2g C compiler (Digital */
2892 /* UNIX Compiler Driver 3.11). */
2893 f = extent_mouse_face (lhe);
2894 extent_face (&dummy_lhe_extent) = f;
2895 Dynarr_add (ef->extents, &dummy_lhe_extent);
2897 /* since we are looping anyway, we might as well do this here */
2898 if ((!NILP(extent_initial_redisplay_function (e))) &&
2899 !extent_in_red_event_p(e))
2901 Lisp_Object function = extent_initial_redisplay_function (e);
2904 /* printf ("initial redisplay function called!\n "); */
2906 /* print_extent_2 (e);
2909 /* FIXME: One should probably inhibit the displaying of
2910 this extent to reduce flicker */
2911 extent_in_red_event_p(e) = 1;
2913 /* call the function */
2916 Fenqueue_eval_event(function,obj);
2921 extent_fragment_sort_by_priority (ef->extents);
2923 /* Now merge the faces together into a single face. The code to
2924 do this is in faces.c because it involves manipulating faces. */
2925 return get_extent_fragment_face_cache_index (w, ef);
2929 /************************************************************************/
2930 /* extent-object methods */
2931 /************************************************************************/
2933 /* These are the basic helper functions for handling the allocation of
2934 extent objects. They are similar to the functions for other
2935 lrecord objects. allocate_extent() is in alloc.c, not here. */
2938 mark_extent (Lisp_Object obj)
2940 struct extent *extent = XEXTENT (obj);
2942 mark_object (extent_object (extent));
2943 mark_object (extent_no_chase_normal_field (extent, face));
2944 return extent->plist;
2948 print_extent_1 (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
2950 EXTENT ext = XEXTENT (obj);
2951 EXTENT anc = extent_ancestor (ext);
2953 char buf[64], *bp = buf;
2955 /* Retrieve the ancestor and use it, for faster retrieval of properties */
2957 if (!NILP (extent_begin_glyph (anc))) *bp++ = '*';
2958 *bp++ = (extent_start_open_p (anc) ? '(': '[');
2959 if (extent_detached_p (ext))
2960 strcpy (bp, "detached");
2962 sprintf (bp, "%ld, %ld",
2963 XINT (Fextent_start_position (obj)),
2964 XINT (Fextent_end_position (obj)));
2966 *bp++ = (extent_end_open_p (anc) ? ')': ']');
2967 if (!NILP (extent_end_glyph (anc))) *bp++ = '*';
2970 if (!NILP (extent_read_only (anc))) *bp++ = '%';
2971 if (!NILP (extent_mouse_face (anc))) *bp++ = 'H';
2972 if (extent_unique_p (anc)) *bp++ = 'U';
2973 else if (extent_duplicable_p (anc)) *bp++ = 'D';
2974 if (!NILP (extent_invisible (anc))) *bp++ = 'I';
2976 if (!NILP (extent_read_only (anc)) || !NILP (extent_mouse_face (anc)) ||
2977 extent_unique_p (anc) ||
2978 extent_duplicable_p (anc) || !NILP (extent_invisible (anc)))
2981 write_c_string (buf, printcharfun);
2983 tail = extent_plist_slot (anc);
2985 for (; !NILP (tail); tail = Fcdr (Fcdr (tail)))
2987 Lisp_Object v = XCAR (XCDR (tail));
2988 if (NILP (v)) continue;
2989 print_internal (XCAR (tail), printcharfun, escapeflag);
2990 write_c_string (" ", printcharfun);
2993 sprintf (buf, "0x%lx", (long) ext);
2994 write_c_string (buf, printcharfun);
2998 print_extent (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
3002 const char *title = "";
3003 const char *name = "";
3004 const char *posttitle = "";
3005 Lisp_Object obj2 = Qnil;
3007 /* Destroyed extents have 't' in the object field, causing
3008 extent_object() to abort (maybe). */
3009 if (EXTENT_LIVE_P (XEXTENT (obj)))
3010 obj2 = extent_object (XEXTENT (obj));
3013 title = "no buffer";
3014 else if (BUFFERP (obj2))
3016 if (BUFFER_LIVE_P (XBUFFER (obj2)))
3019 name = (char *) XSTRING_DATA (XBUFFER (obj2)->name);
3023 title = "Killed Buffer";
3029 assert (STRINGP (obj2));
3030 title = "string \"";
3032 name = (char *) XSTRING_DATA (obj2);
3037 if (!EXTENT_LIVE_P (XEXTENT (obj)))
3038 error ("printing unreadable object #<destroyed extent>");
3040 error ("printing unreadable object #<extent 0x%lx>",
3041 (long) XEXTENT (obj));
3044 if (!EXTENT_LIVE_P (XEXTENT (obj)))
3045 write_c_string ("#<destroyed extent", printcharfun);
3048 char *buf = (char *)
3049 alloca (strlen (title) + strlen (name) + strlen (posttitle) + 1);
3050 write_c_string ("#<extent ", printcharfun);
3051 print_extent_1 (obj, printcharfun, escapeflag);
3052 write_c_string (extent_detached_p (XEXTENT (obj))
3053 ? " from " : " in ", printcharfun);
3054 sprintf (buf, "%s%s%s", title, name, posttitle);
3055 write_c_string (buf, printcharfun);
3061 error ("printing unreadable object #<extent>");
3062 write_c_string ("#<extent", printcharfun);
3064 write_c_string (">", printcharfun);
3068 properties_equal (EXTENT e1, EXTENT e2, int depth)
3070 /* When this function is called, all indirections have been followed.
3071 Thus, the indirection checks in the various macros below will not
3072 amount to anything, and could be removed. However, the time
3073 savings would probably not be significant. */
3074 if (!(EQ (extent_face (e1), extent_face (e2)) &&
3075 extent_priority (e1) == extent_priority (e2) &&
3076 internal_equal (extent_begin_glyph (e1), extent_begin_glyph (e2),
3078 internal_equal (extent_end_glyph (e1), extent_end_glyph (e2),
3082 /* compare the bit flags. */
3084 /* The has_aux field should not be relevant. */
3085 int e1_has_aux = e1->flags.has_aux;
3086 int e2_has_aux = e2->flags.has_aux;
3089 e1->flags.has_aux = e2->flags.has_aux = 0;
3090 value = memcmp (&e1->flags, &e2->flags, sizeof (e1->flags));
3091 e1->flags.has_aux = e1_has_aux;
3092 e2->flags.has_aux = e2_has_aux;
3097 /* compare the random elements of the plists. */
3098 return !plists_differ (extent_no_chase_plist (e1),
3099 extent_no_chase_plist (e2),
3104 extent_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
3106 struct extent *e1 = XEXTENT (obj1);
3107 struct extent *e2 = XEXTENT (obj2);
3109 (extent_start (e1) == extent_start (e2) &&
3110 extent_end (e1) == extent_end (e2) &&
3111 internal_equal (extent_object (e1), extent_object (e2), depth + 1) &&
3112 properties_equal (extent_ancestor (e1), extent_ancestor (e2),
3116 static unsigned long
3117 extent_hash (Lisp_Object obj, int depth)
3119 struct extent *e = XEXTENT (obj);
3120 /* No need to hash all of the elements; that would take too long.
3121 Just hash the most common ones. */
3122 return HASH3 (extent_start (e), extent_end (e),
3123 internal_hash (extent_object (e), depth + 1));
3126 static const struct lrecord_description extent_description[] = {
3127 { XD_LISP_OBJECT, offsetof (struct extent, object) },
3128 { XD_LISP_OBJECT, offsetof (struct extent, flags.face) },
3129 { XD_LISP_OBJECT, offsetof (struct extent, plist) },
3134 extent_getprop (Lisp_Object obj, Lisp_Object prop)
3136 return Fextent_property (obj, prop, Qunbound);
3140 extent_putprop (Lisp_Object obj, Lisp_Object prop, Lisp_Object value)
3142 Fset_extent_property (obj, prop, value);
3147 extent_remprop (Lisp_Object obj, Lisp_Object prop)
3149 EXTENT ext = XEXTENT (obj);
3151 /* This list is taken from Fset_extent_property, and should be kept
3153 if (EQ (prop, Qread_only)
3154 || EQ (prop, Qunique)
3155 || EQ (prop, Qduplicable)
3156 || EQ (prop, Qinvisible)
3157 || EQ (prop, Qdetachable)
3158 || EQ (prop, Qdetached)
3159 || EQ (prop, Qdestroyed)
3160 || EQ (prop, Qpriority)
3162 || EQ (prop, Qinitial_redisplay_function)
3163 || EQ (prop, Qafter_change_functions)
3164 || EQ (prop, Qbefore_change_functions)
3165 || EQ (prop, Qmouse_face)
3166 || EQ (prop, Qhighlight)
3167 || EQ (prop, Qbegin_glyph_layout)
3168 || EQ (prop, Qend_glyph_layout)
3169 || EQ (prop, Qglyph_layout)
3170 || EQ (prop, Qbegin_glyph)
3171 || EQ (prop, Qend_glyph)
3172 || EQ (prop, Qstart_open)
3173 || EQ (prop, Qend_open)
3174 || EQ (prop, Qstart_closed)
3175 || EQ (prop, Qend_closed)
3176 || EQ (prop, Qkeymap))
3178 /* #### Is this correct, anyway? */
3182 return external_remprop (extent_plist_addr (ext), prop, 0, ERROR_ME);
3186 extent_plist (Lisp_Object obj)
3188 return Fextent_properties (obj);
3191 DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS ("extent", extent,
3194 /* NOTE: If you declare a
3195 finalization method here,
3196 it will NOT be called.
3199 extent_equal, extent_hash,
3201 extent_getprop, extent_putprop,
3202 extent_remprop, extent_plist,
3206 /************************************************************************/
3207 /* basic extent accessors */
3208 /************************************************************************/
3210 /* These functions are for checking externally-passed extent objects
3211 and returning an extent's basic properties, which include the
3212 buffer the extent is associated with, the endpoints of the extent's
3213 range, the open/closed-ness of those endpoints, and whether the
3214 extent is detached. Manipulating these properties requires
3215 manipulating the ordered lists that hold extents; thus, functions
3216 to do that are in a later section. */
3218 /* Given a Lisp_Object that is supposed to be an extent, make sure it
3219 is OK and return an extent pointer. Extents can be in one of four
3223 2) detached and not associated with a buffer
3224 3) detached and associated with a buffer
3225 4) attached to a buffer
3227 If FLAGS is 0, types 2-4 are allowed. If FLAGS is DE_MUST_HAVE_BUFFER,
3228 types 3-4 are allowed. If FLAGS is DE_MUST_BE_ATTACHED, only type 4
3233 decode_extent (Lisp_Object extent_obj, unsigned int flags)
3238 CHECK_LIVE_EXTENT (extent_obj);
3239 extent = XEXTENT (extent_obj);
3240 obj = extent_object (extent);
3242 /* the following condition will fail if we're dealing with a freed extent */
3243 assert (NILP (obj) || BUFFERP (obj) || STRINGP (obj));
3245 if (flags & DE_MUST_BE_ATTACHED)
3246 flags |= DE_MUST_HAVE_BUFFER;
3248 /* if buffer is dead, then convert extent to have no buffer. */
3249 if (BUFFERP (obj) && !BUFFER_LIVE_P (XBUFFER (obj)))
3250 obj = extent_object (extent) = Qnil;
3252 assert (!NILP (obj) || extent_detached_p (extent));
3254 if ((NILP (obj) && (flags & DE_MUST_HAVE_BUFFER))
3255 || (extent_detached_p (extent) && (flags & DE_MUST_BE_ATTACHED)))
3257 invalid_argument ("extent doesn't belong to a buffer or string",
3264 /* Note that the returned value is a buffer position, not a byte index. */
3267 extent_endpoint_external (Lisp_Object extent_obj, int endp)
3269 EXTENT extent = decode_extent (extent_obj, 0);
3271 if (extent_detached_p (extent))
3274 return make_int (extent_endpoint_bufpos (extent, endp));
3277 DEFUN ("extentp", Fextentp, 1, 1, 0, /*
3278 Return t if OBJECT is an extent.
3282 return EXTENTP (object) ? Qt : Qnil;
3285 DEFUN ("extent-live-p", Fextent_live_p, 1, 1, 0, /*
3286 Return t if OBJECT is an extent that has not been destroyed.
3290 return EXTENTP (object) && EXTENT_LIVE_P (XEXTENT (object)) ? Qt : Qnil;
3293 DEFUN ("extent-detached-p", Fextent_detached_p, 1, 1, 0, /*
3294 Return t if EXTENT is detached.
3298 return extent_detached_p (decode_extent (extent, 0)) ? Qt : Qnil;
3301 DEFUN ("extent-object", Fextent_object, 1, 1, 0, /*
3302 Return object (buffer or string) that EXTENT refers to.
3306 return extent_object (decode_extent (extent, 0));
3309 DEFUN ("extent-start-position", Fextent_start_position, 1, 1, 0, /*
3310 Return start position of EXTENT, or nil if EXTENT is detached.
3314 return extent_endpoint_external (extent, 0);
3317 DEFUN ("extent-end-position", Fextent_end_position, 1, 1, 0, /*
3318 Return end position of EXTENT, or nil if EXTENT is detached.
3322 return extent_endpoint_external (extent, 1);
3325 DEFUN ("extent-length", Fextent_length, 1, 1, 0, /*
3326 Return length of EXTENT in characters.
3330 EXTENT e = decode_extent (extent, DE_MUST_BE_ATTACHED);
3331 return make_int (extent_endpoint_bufpos (e, 1)
3332 - extent_endpoint_bufpos (e, 0));
3335 DEFUN ("next-extent", Fnext_extent, 1, 1, 0, /*
3336 Find next extent after EXTENT.
3337 If EXTENT is a buffer return the first extent in the buffer; likewise
3339 Extents in a buffer are ordered in what is called the "display"
3340 order, which sorts by increasing start positions and then by *decreasing*
3342 If you want to perform an operation on a series of extents, use
3343 `map-extents' instead of this function; it is much more efficient.
3344 The primary use of this function should be to enumerate all the
3345 extents in a buffer.
3346 Note: The display order is not necessarily the order that `map-extents'
3347 processes extents in!
3354 if (EXTENTP (extent))
3355 next = extent_next (decode_extent (extent, DE_MUST_BE_ATTACHED));
3357 next = extent_first (decode_buffer_or_string (extent));
3361 XSETEXTENT (val, next);
3365 DEFUN ("previous-extent", Fprevious_extent, 1, 1, 0, /*
3366 Find last extent before EXTENT.
3367 If EXTENT is a buffer return the last extent in the buffer; likewise
3369 This function is analogous to `next-extent'.
3376 if (EXTENTP (extent))
3377 prev = extent_previous (decode_extent (extent, DE_MUST_BE_ATTACHED));
3379 prev = extent_last (decode_buffer_or_string (extent));
3383 XSETEXTENT (val, prev);
3389 DEFUN ("next-e-extent", Fnext_e_extent, 1, 1, 0, /*
3390 Find next extent after EXTENT using the "e" order.
3391 If EXTENT is a buffer return the first extent in the buffer; likewise
3399 if (EXTENTP (extent))
3400 next = extent_e_next (decode_extent (extent, DE_MUST_BE_ATTACHED));
3402 next = extent_e_first (decode_buffer_or_string (extent));
3406 XSETEXTENT (val, next);
3410 DEFUN ("previous-e-extent", Fprevious_e_extent, 1, 1, 0, /*
3411 Find last extent before EXTENT using the "e" order.
3412 If EXTENT is a buffer return the last extent in the buffer; likewise
3414 This function is analogous to `next-e-extent'.
3421 if (EXTENTP (extent))
3422 prev = extent_e_previous (decode_extent (extent, DE_MUST_BE_ATTACHED));
3424 prev = extent_e_last (decode_buffer_or_string (extent));
3428 XSETEXTENT (val, prev);
3434 DEFUN ("next-extent-change", Fnext_extent_change, 1, 2, 0, /*
3435 Return the next position after POS where an extent begins or ends.
3436 If POS is at the end of the buffer or string, POS will be returned;
3437 otherwise a position greater than POS will always be returned.
3438 If OBJECT is nil, the current buffer is assumed.
3442 Lisp_Object obj = decode_buffer_or_string (object);
3445 bpos = get_buffer_or_string_pos_byte (obj, pos, GB_ALLOW_PAST_ACCESSIBLE);
3446 bpos = extent_find_end_of_run (obj, bpos, 1);
3447 return make_int (buffer_or_string_bytind_to_bufpos (obj, bpos));
3450 DEFUN ("previous-extent-change", Fprevious_extent_change, 1, 2, 0, /*
3451 Return the last position before POS where an extent begins or ends.
3452 If POS is at the beginning of the buffer or string, POS will be returned;
3453 otherwise a position less than POS will always be returned.
3454 If OBJECT is nil, the current buffer is assumed.
3458 Lisp_Object obj = decode_buffer_or_string (object);
3461 bpos = get_buffer_or_string_pos_byte (obj, pos, GB_ALLOW_PAST_ACCESSIBLE);
3462 bpos = extent_find_beginning_of_run (obj, bpos, 1);
3463 return make_int (buffer_or_string_bytind_to_bufpos (obj, bpos));
3467 /************************************************************************/
3468 /* parent and children stuff */
3469 /************************************************************************/
3471 DEFUN ("extent-parent", Fextent_parent, 1, 1, 0, /*
3472 Return the parent (if any) of EXTENT.
3473 If an extent has a parent, it derives all its properties from that extent
3474 and has no properties of its own. (The only "properties" that the
3475 extent keeps are the buffer/string it refers to and the start and end
3476 points.) It is possible for an extent's parent to itself have a parent.
3479 /* do I win the prize for the strangest split infinitive? */
3481 EXTENT e = decode_extent (extent, 0);
3482 return extent_parent (e);
3485 DEFUN ("extent-children", Fextent_children, 1, 1, 0, /*
3486 Return a list of the children (if any) of EXTENT.
3487 The children of an extent are all those extents whose parent is that extent.
3488 This function does not recursively trace children of children.
3489 \(To do that, use `extent-descendants'.)
3493 EXTENT e = decode_extent (extent, 0);
3494 Lisp_Object children = extent_children (e);
3496 if (!NILP (children))
3497 return Fcopy_sequence (XWEAK_LIST_LIST (children));
3503 remove_extent_from_children_list (EXTENT e, Lisp_Object child)
3505 Lisp_Object children = extent_children (e);
3507 #ifdef ERROR_CHECK_EXTENTS
3508 assert (!NILP (memq_no_quit (child, XWEAK_LIST_LIST (children))));
3510 XWEAK_LIST_LIST (children) =
3511 delq_no_quit (child, XWEAK_LIST_LIST (children));
3515 add_extent_to_children_list (EXTENT e, Lisp_Object child)
3517 Lisp_Object children = extent_children (e);
3519 if (NILP (children))
3521 children = make_weak_list (WEAK_LIST_SIMPLE);
3522 set_extent_no_chase_aux_field (e, children, children);
3525 #ifdef ERROR_CHECK_EXTENTS
3526 assert (NILP (memq_no_quit (child, XWEAK_LIST_LIST (children))));
3528 XWEAK_LIST_LIST (children) = Fcons (child, XWEAK_LIST_LIST (children));
3531 DEFUN ("set-extent-parent", Fset_extent_parent, 2, 2, 0, /*
3532 Set the parent of EXTENT to PARENT (may be nil).
3533 See `extent-parent'.
3537 EXTENT e = decode_extent (extent, 0);
3538 Lisp_Object cur_parent = extent_parent (e);
3541 XSETEXTENT (extent, e);
3543 CHECK_LIVE_EXTENT (parent);
3544 if (EQ (parent, cur_parent))
3546 for (rest = parent; !NILP (rest); rest = extent_parent (XEXTENT (rest)))
3547 if (EQ (rest, extent))
3548 signal_type_error (Qinvalid_change,
3549 "Circular parent chain would result",
3553 remove_extent_from_children_list (XEXTENT (cur_parent), extent);
3554 set_extent_no_chase_aux_field (e, parent, Qnil);
3555 e->flags.has_parent = 0;
3559 add_extent_to_children_list (XEXTENT (parent), extent);
3560 set_extent_no_chase_aux_field (e, parent, parent);
3561 e->flags.has_parent = 1;
3563 /* changing the parent also changes the properties of all children. */
3565 int old_invis = (!NILP (cur_parent) &&
3566 !NILP (extent_invisible (XEXTENT (cur_parent))));
3567 int new_invis = (!NILP (parent) &&
3568 !NILP (extent_invisible (XEXTENT (parent))));
3570 extent_maybe_changed_for_redisplay (e, 1, new_invis != old_invis);
3577 /************************************************************************/
3578 /* basic extent mutators */
3579 /************************************************************************/
3581 /* Note: If you track non-duplicable extents by undo, you'll get bogus
3582 undo records for transient extents via update-extent.
3583 For example, query-replace will do this.
3587 set_extent_endpoints_1 (EXTENT extent, Memind start, Memind end)
3589 #ifdef ERROR_CHECK_EXTENTS
3590 Lisp_Object obj = extent_object (extent);
3592 assert (start <= end);
3595 assert (valid_memind_p (XBUFFER (obj), start));
3596 assert (valid_memind_p (XBUFFER (obj), end));
3600 /* Optimization: if the extent is already where we want it to be,
3602 if (!extent_detached_p (extent) && extent_start (extent) == start &&
3603 extent_end (extent) == end)
3606 if (extent_detached_p (extent))
3608 if (extent_duplicable_p (extent))
3610 Lisp_Object extent_obj;
3611 XSETEXTENT (extent_obj, extent);
3612 record_extent (extent_obj, 1);
3616 extent_detach (extent);
3618 set_extent_start (extent, start);
3619 set_extent_end (extent, end);
3620 extent_attach (extent);
3623 /* Set extent's endpoints to S and E, and put extent in buffer or string
3624 OBJECT. (If OBJECT is nil, do not change the extent's object.) */
3627 set_extent_endpoints (EXTENT extent, Bytind s, Bytind e, Lisp_Object object)
3633 object = extent_object (extent);
3634 assert (!NILP (object));
3636 else if (!EQ (object, extent_object (extent)))
3638 extent_detach (extent);
3639 extent_object (extent) = object;
3642 start = s < 0 ? extent_start (extent) :
3643 buffer_or_string_bytind_to_memind (object, s);
3644 end = e < 0 ? extent_end (extent) :
3645 buffer_or_string_bytind_to_memind (object, e);
3646 set_extent_endpoints_1 (extent, start, end);
3650 set_extent_openness (EXTENT extent, int start_open, int end_open)
3652 if (start_open != -1)
3653 extent_start_open_p (extent) = start_open;
3655 extent_end_open_p (extent) = end_open;
3656 /* changing the open/closedness of an extent does not affect
3661 make_extent_internal (Lisp_Object object, Bytind from, Bytind to)
3665 extent = make_extent_detached (object);
3666 set_extent_endpoints (extent, from, to, Qnil);
3671 copy_extent (EXTENT original, Bytind from, Bytind to, Lisp_Object object)
3675 e = make_extent_detached (object);
3677 set_extent_endpoints (e, from, to, Qnil);
3679 e->plist = Fcopy_sequence (original->plist);
3680 memcpy (&e->flags, &original->flags, sizeof (e->flags));
3681 if (e->flags.has_aux)
3683 /* also need to copy the aux struct. It won't work for
3684 this extent to share the same aux struct as the original
3686 struct extent_auxiliary *data =
3687 alloc_lcrecord_type (struct extent_auxiliary,
3688 &lrecord_extent_auxiliary);
3690 copy_lcrecord (data, XEXTENT_AUXILIARY (XCAR (original->plist)));
3691 XSETEXTENT_AUXILIARY (XCAR (e->plist), data);
3695 /* we may have just added another child to the parent extent. */
3696 Lisp_Object parent = extent_parent (e);
3700 XSETEXTENT (extent, e);
3701 add_extent_to_children_list (XEXTENT (parent), extent);
3709 destroy_extent (EXTENT extent)
3711 Lisp_Object rest, nextrest, children;
3712 Lisp_Object extent_obj;
3714 if (!extent_detached_p (extent))
3715 extent_detach (extent);
3716 /* disassociate the extent from its children and parent */
3717 children = extent_children (extent);
3718 if (!NILP (children))
3720 LIST_LOOP_DELETING (rest, nextrest, XWEAK_LIST_LIST (children))
3721 Fset_extent_parent (XCAR (rest), Qnil);
3723 XSETEXTENT (extent_obj, extent);
3724 Fset_extent_parent (extent_obj, Qnil);
3725 /* mark the extent as destroyed */
3726 extent_object (extent) = Qt;
3729 DEFUN ("make-extent", Fmake_extent, 2, 3, 0, /*
3730 Make an extent for the range [FROM, TO) in BUFFER-OR-STRING.
3731 BUFFER-OR-STRING defaults to the current buffer. Insertions at point
3732 TO will be outside of the extent; insertions at FROM will be inside the
3733 extent, causing the extent to grow. (This is the same way that markers
3734 behave.) You can change the behavior of insertions at the endpoints
3735 using `set-extent-property'. The extent is initially detached if both
3736 FROM and TO are nil, and in this case BUFFER-OR-STRING defaults to nil,
3737 meaning the extent is in no buffer and no string.
3739 (from, to, buffer_or_string))
3741 Lisp_Object extent_obj;
3744 obj = decode_buffer_or_string (buffer_or_string);
3745 if (NILP (from) && NILP (to))
3747 if (NILP (buffer_or_string))
3749 XSETEXTENT (extent_obj, make_extent_detached (obj));
3755 get_buffer_or_string_range_byte (obj, from, to, &start, &end,
3756 GB_ALLOW_PAST_ACCESSIBLE);
3757 XSETEXTENT (extent_obj, make_extent_internal (obj, start, end));
3762 DEFUN ("copy-extent", Fcopy_extent, 1, 2, 0, /*
3763 Make a copy of EXTENT. It is initially detached.
3764 Optional argument BUFFER-OR-STRING defaults to EXTENT's buffer or string.
3766 (extent, buffer_or_string))
3768 EXTENT ext = decode_extent (extent, 0);
3770 if (NILP (buffer_or_string))
3771 buffer_or_string = extent_object (ext);
3773 buffer_or_string = decode_buffer_or_string (buffer_or_string);
3775 XSETEXTENT (extent, copy_extent (ext, -1, -1, buffer_or_string));
3779 DEFUN ("delete-extent", Fdelete_extent, 1, 1, 0, /*
3780 Remove EXTENT from its buffer and destroy it.
3781 This does not modify the buffer's text, only its display properties.
3782 The extent cannot be used thereafter.
3788 /* We do not call decode_extent() here because already-destroyed
3790 CHECK_EXTENT (extent);
3791 ext = XEXTENT (extent);
3793 if (!EXTENT_LIVE_P (ext))
3795 destroy_extent (ext);
3799 DEFUN ("detach-extent", Fdetach_extent, 1, 1, 0, /*
3800 Remove EXTENT from its buffer in such a way that it can be re-inserted.
3801 An extent is also detached when all of its characters are all killed by a
3802 deletion, unless its `detachable' property has been unset.
3804 Extents which have the `duplicable' attribute are tracked by the undo
3805 mechanism. Detachment via `detach-extent' and string deletion is recorded,
3806 as is attachment via `insert-extent' and string insertion. Extent motion,
3807 face changes, and attachment via `make-extent' and `set-extent-endpoints'
3808 are not recorded. This means that extent changes which are to be undo-able
3809 must be performed by character editing, or by insertion and detachment of
3814 EXTENT ext = decode_extent (extent, 0);
3816 if (extent_detached_p (ext))
3818 if (extent_duplicable_p (ext))
3819 record_extent (extent, 0);
3820 extent_detach (ext);
3825 DEFUN ("set-extent-endpoints", Fset_extent_endpoints, 3, 4, 0, /*
3826 Set the endpoints of EXTENT to START, END.
3827 If START and END are null, call detach-extent on EXTENT.
3828 BUFFER-OR-STRING specifies the new buffer or string that the extent should
3829 be in, and defaults to EXTENT's buffer or string. (If nil, and EXTENT
3830 is in no buffer and no string, it defaults to the current buffer.)
3831 See documentation on `detach-extent' for a discussion of undo recording.
3833 (extent, start, end, buffer_or_string))
3838 ext = decode_extent (extent, 0);
3840 if (NILP (buffer_or_string))
3842 buffer_or_string = extent_object (ext);
3843 if (NILP (buffer_or_string))
3844 buffer_or_string = Fcurrent_buffer ();
3847 buffer_or_string = decode_buffer_or_string (buffer_or_string);
3849 if (NILP (start) && NILP (end))
3850 return Fdetach_extent (extent);
3852 get_buffer_or_string_range_byte (buffer_or_string, start, end, &s, &e,
3853 GB_ALLOW_PAST_ACCESSIBLE);
3855 buffer_or_string_extent_info_force (buffer_or_string);
3856 set_extent_endpoints (ext, s, e, buffer_or_string);
3861 /************************************************************************/
3862 /* mapping over extents */
3863 /************************************************************************/
3866 decode_map_extents_flags (Lisp_Object flags)
3868 unsigned int retval = 0;
3869 unsigned int all_extents_specified = 0;
3870 unsigned int in_region_specified = 0;
3872 if (EQ (flags, Qt)) /* obsoleteness compatibility */
3873 return ME_END_CLOSED;
3876 if (SYMBOLP (flags))
3877 flags = Fcons (flags, Qnil);
3878 while (!NILP (flags))
3884 if (EQ (sym, Qall_extents_closed) || EQ (sym, Qall_extents_open) ||
3885 EQ (sym, Qall_extents_closed_open) ||
3886 EQ (sym, Qall_extents_open_closed))
3888 if (all_extents_specified)
3889 error ("Only one `all-extents-*' flag may be specified");
3890 all_extents_specified = 1;
3892 if (EQ (sym, Qstart_in_region) || EQ (sym, Qend_in_region) ||
3893 EQ (sym, Qstart_and_end_in_region) ||
3894 EQ (sym, Qstart_or_end_in_region))
3896 if (in_region_specified)
3897 error ("Only one `*-in-region' flag may be specified");
3898 in_region_specified = 1;
3901 /* I do so love that conditional operator ... */
3903 EQ (sym, Qend_closed) ? ME_END_CLOSED :
3904 EQ (sym, Qstart_open) ? ME_START_OPEN :
3905 EQ (sym, Qall_extents_closed) ? ME_ALL_EXTENTS_CLOSED :
3906 EQ (sym, Qall_extents_open) ? ME_ALL_EXTENTS_OPEN :
3907 EQ (sym, Qall_extents_closed_open) ? ME_ALL_EXTENTS_CLOSED_OPEN :
3908 EQ (sym, Qall_extents_open_closed) ? ME_ALL_EXTENTS_OPEN_CLOSED :
3909 EQ (sym, Qstart_in_region) ? ME_START_IN_REGION :
3910 EQ (sym, Qend_in_region) ? ME_END_IN_REGION :
3911 EQ (sym, Qstart_and_end_in_region) ? ME_START_AND_END_IN_REGION :
3912 EQ (sym, Qstart_or_end_in_region) ? ME_START_OR_END_IN_REGION :
3913 EQ (sym, Qnegate_in_region) ? ME_NEGATE_IN_REGION :
3914 (invalid_argument ("Invalid `map-extents' flag", sym), 0);
3916 flags = XCDR (flags);
3921 DEFUN ("extent-in-region-p", Fextent_in_region_p, 1, 4, 0, /*
3922 Return whether EXTENT overlaps a specified region.
3923 This is equivalent to whether `map-extents' would visit EXTENT when called
3926 (extent, from, to, flags))
3929 EXTENT ext = decode_extent (extent, DE_MUST_BE_ATTACHED);
3930 Lisp_Object obj = extent_object (ext);
3932 get_buffer_or_string_range_byte (obj, from, to, &start, &end, GB_ALLOW_NIL |
3933 GB_ALLOW_PAST_ACCESSIBLE);
3935 return extent_in_region_p (ext, start, end, decode_map_extents_flags (flags)) ?
3939 struct slow_map_extents_arg
3941 Lisp_Object map_arg;
3942 Lisp_Object map_routine;
3944 Lisp_Object property;
3949 slow_map_extents_function (EXTENT extent, void *arg)
3951 /* This function can GC */
3952 struct slow_map_extents_arg *closure = (struct slow_map_extents_arg *) arg;
3953 Lisp_Object extent_obj;
3955 XSETEXTENT (extent_obj, extent);
3957 /* make sure this extent qualifies according to the PROPERTY
3960 if (!NILP (closure->property))
3962 Lisp_Object value = Fextent_property (extent_obj, closure->property,
3964 if ((NILP (closure->value) && NILP (value)) ||
3965 (!NILP (closure->value) && !EQ (value, closure->value)))
3969 closure->result = call2 (closure->map_routine, extent_obj,
3971 return !NILP (closure->result);
3974 DEFUN ("map-extents", Fmap_extents, 1, 8, 0, /*
3975 Map FUNCTION over the extents which overlap a region in OBJECT.
3976 OBJECT is normally a buffer or string but could be an extent (see below).
3977 The region is normally bounded by [FROM, TO) (i.e. the beginning of the
3978 region is closed and the end of the region is open), but this can be
3979 changed with the FLAGS argument (see below for a complete discussion).
3981 FUNCTION is called with the arguments (extent, MAPARG). The arguments
3982 OBJECT, FROM, TO, MAPARG, and FLAGS are all optional and default to
3983 the current buffer, the beginning of OBJECT, the end of OBJECT, nil,
3984 and nil, respectively. `map-extents' returns the first non-nil result
3985 produced by FUNCTION, and no more calls to FUNCTION are made after it
3988 If OBJECT is an extent, FROM and TO default to the extent's endpoints,
3989 and the mapping omits that extent and its predecessors. This feature
3990 supports restarting a loop based on `map-extents'. Note: OBJECT must
3991 be attached to a buffer or string, and the mapping is done over that
3994 An extent overlaps the region if there is any point in the extent that is
3995 also in the region. (For the purpose of overlap, zero-length extents and
3996 regions are treated as closed on both ends regardless of their endpoints'
3997 specified open/closedness.) Note that the endpoints of an extent or region
3998 are considered to be in that extent or region if and only if the
3999 corresponding end is closed. For example, the extent [5,7] overlaps the
4000 region [2,5] because 5 is in both the extent and the region. However, (5,7]
4001 does not overlap [2,5] because 5 is not in the extent, and neither [5,7] nor
4002 \(5,7] overlaps the region [2,5) because 5 is not in the region.
4004 The optional FLAGS can be a symbol or a list of one or more symbols,
4005 modifying the behavior of `map-extents'. Allowed symbols are:
4007 end-closed The region's end is closed.
4009 start-open The region's start is open.
4011 all-extents-closed Treat all extents as closed on both ends for the
4012 purpose of determining whether they overlap the
4013 region, irrespective of their actual open- or
4015 all-extents-open Treat all extents as open on both ends.
4016 all-extents-closed-open Treat all extents as start-closed, end-open.
4017 all-extents-open-closed Treat all extents as start-open, end-closed.
4019 start-in-region In addition to the above conditions for extent
4020 overlap, the extent's start position must lie within
4021 the specified region. Note that, for this
4022 condition, open start positions are treated as if
4023 0.5 was added to the endpoint's value, and open
4024 end positions are treated as if 0.5 was subtracted
4025 from the endpoint's value.
4026 end-in-region The extent's end position must lie within the
4028 start-and-end-in-region Both the extent's start and end positions must lie
4030 start-or-end-in-region Either the extent's start or end position must lie
4033 negate-in-region The condition specified by a `*-in-region' flag
4034 must NOT hold for the extent to be considered.
4037 At most one of `all-extents-closed', `all-extents-open',
4038 `all-extents-closed-open', and `all-extents-open-closed' may be specified.
4040 At most one of `start-in-region', `end-in-region',
4041 `start-and-end-in-region', and `start-or-end-in-region' may be specified.
4043 If optional arg PROPERTY is non-nil, only extents with that property set
4044 on them will be visited. If optional arg VALUE is non-nil, only extents
4045 whose value for that property is `eq' to VALUE will be visited.
4047 (function, object, from, to, maparg, flags, property, value))
4049 /* This function can GC */
4050 struct slow_map_extents_arg closure;
4051 unsigned int me_flags;
4053 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
4056 if (EXTENTP (object))
4058 after = decode_extent (object, DE_MUST_BE_ATTACHED);
4060 from = Fextent_start_position (object);
4062 to = Fextent_end_position (object);
4063 object = extent_object (after);
4066 object = decode_buffer_or_string (object);
4068 get_buffer_or_string_range_byte (object, from, to, &start, &end,
4069 GB_ALLOW_NIL | GB_ALLOW_PAST_ACCESSIBLE);
4071 me_flags = decode_map_extents_flags (flags);
4073 if (!NILP (property))
4076 value = canonicalize_extent_property (property, value);
4079 GCPRO5 (function, maparg, object, property, value);
4081 closure.map_arg = maparg;
4082 closure.map_routine = function;
4083 closure.result = Qnil;
4084 closure.property = property;
4085 closure.value = value;
4087 map_extents_bytind (start, end, slow_map_extents_function,
4088 (void *) &closure, object, after,
4089 /* You never know what the user might do ... */
4090 me_flags | ME_MIGHT_CALL_ELISP);
4093 return closure.result;
4097 /************************************************************************/
4098 /* mapping over extents -- other functions */
4099 /************************************************************************/
4101 /* ------------------------------- */
4102 /* map-extent-children */
4103 /* ------------------------------- */
4105 struct slow_map_extent_children_arg
4107 Lisp_Object map_arg;
4108 Lisp_Object map_routine;
4110 Lisp_Object property;
4118 slow_map_extent_children_function (EXTENT extent, void *arg)
4120 /* This function can GC */
4121 struct slow_map_extent_children_arg *closure =
4122 (struct slow_map_extent_children_arg *) arg;
4123 Lisp_Object extent_obj;
4124 Bytind start = extent_endpoint_bytind (extent, 0);
4125 Bytind end = extent_endpoint_bytind (extent, 1);
4126 /* Make sure the extent starts inside the region of interest,
4127 rather than just overlaps it.
4129 if (start < closure->start_min)
4131 /* Make sure the extent is not a child of a previous visited one.
4132 We know already, because of extent ordering,
4133 that start >= prev_start, and that if
4134 start == prev_start, then end <= prev_end.
4136 if (start == closure->prev_start)
4138 if (end < closure->prev_end)
4141 else /* start > prev_start */
4143 if (start < closure->prev_end)
4145 /* corner case: prev_end can be -1 if there is no prev */
4147 XSETEXTENT (extent_obj, extent);
4149 /* make sure this extent qualifies according to the PROPERTY
4152 if (!NILP (closure->property))
4154 Lisp_Object value = Fextent_property (extent_obj, closure->property,
4156 if ((NILP (closure->value) && NILP (value)) ||
4157 (!NILP (closure->value) && !EQ (value, closure->value)))
4161 closure->result = call2 (closure->map_routine, extent_obj,
4164 /* Since the callback may change the buffer, compute all stored
4165 buffer positions here.
4167 closure->start_min = -1; /* no need for this any more */
4168 closure->prev_start = extent_endpoint_bytind (extent, 0);
4169 closure->prev_end = extent_endpoint_bytind (extent, 1);
4171 return !NILP (closure->result);
4174 DEFUN ("map-extent-children", Fmap_extent_children, 1, 8, 0, /*
4175 Map FUNCTION over the extents in the region from FROM to TO.
4176 FUNCTION is called with arguments (extent, MAPARG). See `map-extents'
4177 for a full discussion of the arguments FROM, TO, and FLAGS.
4179 The arguments are the same as for `map-extents', but this function differs
4180 in that it only visits extents which start in the given region, and also
4181 in that, after visiting an extent E, it skips all other extents which start
4182 inside E but end before E's end.
4184 Thus, this function may be used to walk a tree of extents in a buffer:
4185 (defun walk-extents (buffer &optional ignore)
4186 (map-extent-children 'walk-extents buffer))
4188 (function, object, from, to, maparg, flags, property, value))
4190 /* This function can GC */
4191 struct slow_map_extent_children_arg closure;
4192 unsigned int me_flags;
4194 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
4197 if (EXTENTP (object))
4199 after = decode_extent (object, DE_MUST_BE_ATTACHED);
4201 from = Fextent_start_position (object);
4203 to = Fextent_end_position (object);
4204 object = extent_object (after);
4207 object = decode_buffer_or_string (object);
4209 get_buffer_or_string_range_byte (object, from, to, &start, &end,
4210 GB_ALLOW_NIL | GB_ALLOW_PAST_ACCESSIBLE);
4212 me_flags = decode_map_extents_flags (flags);
4214 if (!NILP (property))
4217 value = canonicalize_extent_property (property, value);
4220 GCPRO5 (function, maparg, object, property, value);
4222 closure.map_arg = maparg;
4223 closure.map_routine = function;
4224 closure.result = Qnil;
4225 closure.property = property;
4226 closure.value = value;
4227 closure.start_min = start;
4228 closure.prev_start = -1;
4229 closure.prev_end = -1;
4230 map_extents_bytind (start, end, slow_map_extent_children_function,
4231 (void *) &closure, object, after,
4232 /* You never know what the user might do ... */
4233 me_flags | ME_MIGHT_CALL_ELISP);
4236 return closure.result;
4239 /* ------------------------------- */
4241 /* ------------------------------- */
4243 /* find "smallest" matching extent containing pos -- (flag == 0) means
4244 all extents match, else (EXTENT_FLAGS (extent) & flag) must be true;
4245 for more than one matching extent with precisely the same endpoints,
4246 we choose the last extent in the extents_list.
4247 The search stops just before "before", if that is non-null.
4250 struct extent_at_arg
4252 Lisp_Object best_match; /* or list of extents */
4267 static enum extent_at_flag
4268 decode_extent_at_flag (Lisp_Object at_flag)
4271 return EXTENT_AT_AFTER;
4273 CHECK_SYMBOL (at_flag);
4274 if (EQ (at_flag, Qafter)) return EXTENT_AT_AFTER;
4275 if (EQ (at_flag, Qbefore)) return EXTENT_AT_BEFORE;
4276 if (EQ (at_flag, Qat)) return EXTENT_AT_AT;
4278 invalid_argument ("Invalid AT-FLAG in `extent-at'", at_flag);
4279 return EXTENT_AT_AFTER; /* unreached */
4283 extent_at_mapper (EXTENT e, void *arg)
4285 struct extent_at_arg *closure = (struct extent_at_arg *) arg;
4287 if (e == closure->before)
4290 /* If closure->prop is non-nil, then the extent is only acceptable
4291 if it has a non-nil value for that property. */
4292 if (!NILP (closure->prop))
4295 XSETEXTENT (extent, e);
4296 if (NILP (Fextent_property (extent, closure->prop, Qnil)))
4300 if (!closure->all_extents)
4304 if (NILP (closure->best_match))
4306 current = XEXTENT (closure->best_match);
4307 /* redundant but quick test */
4308 if (extent_start (current) > extent_start (e))
4311 /* we return the "last" best fit, instead of the first --
4312 this is because then the glyph closest to two equivalent
4313 extents corresponds to the "extent-at" the text just past
4315 else if (!EXTENT_LESS_VALS (e, closure->best_start,
4321 XSETEXTENT (closure->best_match, e);
4322 closure->best_start = extent_start (e);
4323 closure->best_end = extent_end (e);
4329 XSETEXTENT (extent, e);
4330 closure->best_match = Fcons (extent, closure->best_match);
4337 extent_at_bytind (Bytind position, Lisp_Object object, Lisp_Object property,
4338 EXTENT before, enum extent_at_flag at_flag, int all_extents)
4340 struct extent_at_arg closure;
4341 struct gcpro gcpro1;
4343 /* it might be argued that invalid positions should cause
4344 errors, but the principle of least surprise dictates that
4345 nil should be returned (extent-at is often used in
4346 response to a mouse event, and in many cases previous events
4347 have changed the buffer contents).
4349 Also, the openness stuff in the text-property code currently
4350 does not check its limits and might go off the end. */
4351 if ((at_flag == EXTENT_AT_BEFORE
4352 ? position <= buffer_or_string_absolute_begin_byte (object)
4353 : position < buffer_or_string_absolute_begin_byte (object))
4354 || (at_flag == EXTENT_AT_AFTER
4355 ? position >= buffer_or_string_absolute_end_byte (object)
4356 : position > buffer_or_string_absolute_end_byte (object)))
4359 closure.best_match = Qnil;
4360 closure.prop = property;
4361 closure.before = before;
4362 closure.all_extents = all_extents;
4364 GCPRO1 (closure.best_match);
4365 map_extents_bytind (at_flag == EXTENT_AT_BEFORE ? position - 1 : position,
4366 at_flag == EXTENT_AT_AFTER ? position + 1 : position,
4367 extent_at_mapper, (void *) &closure, object, 0,
4368 ME_START_OPEN | ME_ALL_EXTENTS_CLOSED);
4370 closure.best_match = Fnreverse (closure.best_match);
4373 return closure.best_match;
4376 DEFUN ("extent-at", Fextent_at, 1, 5, 0, /*
4377 Find "smallest" extent at POS in OBJECT having PROPERTY set.
4378 Normally, an extent is "at" POS if it overlaps the region (POS, POS+1);
4379 i.e. if it covers the character after POS. (However, see the definition
4380 of AT-FLAG.) "Smallest" means the extent that comes last in the display
4381 order; this normally means the extent whose start position is closest to
4382 POS. See `next-extent' for more information.
4383 OBJECT specifies a buffer or string and defaults to the current buffer.
4384 PROPERTY defaults to nil, meaning that any extent will do.
4385 Properties are attached to extents with `set-extent-property', which see.
4386 Returns nil if POS is invalid or there is no matching extent at POS.
4387 If the fourth argument BEFORE is not nil, it must be an extent; any returned
4388 extent will precede that extent. This feature allows `extent-at' to be
4389 used by a loop over extents.
4390 AT-FLAG controls how end cases are handled, and should be one of:
4392 nil or `after' An extent is at POS if it covers the character
4393 after POS. This is consistent with the way
4394 that text properties work.
4395 `before' An extent is at POS if it covers the character
4397 `at' An extent is at POS if it overlaps or abuts POS.
4398 This includes all zero-length extents at POS.
4400 Note that in all cases, the start-openness and end-openness of the extents
4401 considered is ignored. If you want to pay attention to those properties,
4402 you should use `map-extents', which gives you more control.
4404 (pos, object, property, before, at_flag))
4407 EXTENT before_extent;
4408 enum extent_at_flag fl;
4410 object = decode_buffer_or_string (object);
4411 position = get_buffer_or_string_pos_byte (object, pos, GB_NO_ERROR_IF_BAD);
4415 before_extent = decode_extent (before, DE_MUST_BE_ATTACHED);
4416 if (before_extent && !EQ (object, extent_object (before_extent)))
4417 invalid_argument ("extent not in specified buffer or string", object);
4418 fl = decode_extent_at_flag (at_flag);
4420 return extent_at_bytind (position, object, property, before_extent, fl, 0);
4423 DEFUN ("extents-at", Fextents_at, 1, 5, 0, /*
4424 Find all extents at POS in OBJECT having PROPERTY set.
4425 Normally, an extent is "at" POS if it overlaps the region (POS, POS+1);
4426 i.e. if it covers the character after POS. (However, see the definition
4428 This provides similar functionality to `extent-list', but does so in a way
4429 that is compatible with `extent-at'. (For example, errors due to POS out of
4430 range are ignored; this makes it safer to use this function in response to
4431 a mouse event, because in many cases previous events have changed the buffer
4433 OBJECT specifies a buffer or string and defaults to the current buffer.
4434 PROPERTY defaults to nil, meaning that any extent will do.
4435 Properties are attached to extents with `set-extent-property', which see.
4436 Returns nil if POS is invalid or there is no matching extent at POS.
4437 If the fourth argument BEFORE is not nil, it must be an extent; any returned
4438 extent will precede that extent. This feature allows `extents-at' to be
4439 used by a loop over extents.
4440 AT-FLAG controls how end cases are handled, and should be one of:
4442 nil or `after' An extent is at POS if it covers the character
4443 after POS. This is consistent with the way
4444 that text properties work.
4445 `before' An extent is at POS if it covers the character
4447 `at' An extent is at POS if it overlaps or abuts POS.
4448 This includes all zero-length extents at POS.
4450 Note that in all cases, the start-openness and end-openness of the extents
4451 considered is ignored. If you want to pay attention to those properties,
4452 you should use `map-extents', which gives you more control.
4454 (pos, object, property, before, at_flag))
4457 EXTENT before_extent;
4458 enum extent_at_flag fl;
4460 object = decode_buffer_or_string (object);
4461 position = get_buffer_or_string_pos_byte (object, pos, GB_NO_ERROR_IF_BAD);
4465 before_extent = decode_extent (before, DE_MUST_BE_ATTACHED);
4466 if (before_extent && !EQ (object, extent_object (before_extent)))
4467 invalid_argument ("extent not in specified buffer or string", object);
4468 fl = decode_extent_at_flag (at_flag);
4470 return extent_at_bytind (position, object, property, before_extent, fl, 1);
4473 /* ------------------------------- */
4474 /* verify_extent_modification() */
4475 /* ------------------------------- */
4477 /* verify_extent_modification() is called when a buffer or string is
4478 modified to check whether the modification is occuring inside a
4482 struct verify_extents_arg
4487 Lisp_Object iro; /* value of inhibit-read-only */
4491 verify_extent_mapper (EXTENT extent, void *arg)
4493 struct verify_extents_arg *closure = (struct verify_extents_arg *) arg;
4494 Lisp_Object prop = extent_read_only (extent);
4499 if (CONSP (closure->iro) && !NILP (Fmemq (prop, closure->iro)))
4502 #if 0 /* Nobody seems to care for this any more -sb */
4503 /* Allow deletion if the extent is completely contained in
4504 the region being deleted.
4505 This is important for supporting tokens which are internally
4506 write-protected, but which can be killed and yanked as a whole.
4507 Ignore open/closed distinctions at this point.
4510 if (closure->start != closure->end &&
4511 extent_start (extent) >= closure->start &&
4512 extent_end (extent) <= closure->end)
4517 Fsignal (Qbuffer_read_only, (list1 (closure->object)));
4519 RETURN_NOT_REACHED(0)
4522 /* Value of Vinhibit_read_only is precomputed and passed in for
4526 verify_extent_modification (Lisp_Object object, Bytind from, Bytind to,
4527 Lisp_Object inhibit_read_only_value)
4530 struct verify_extents_arg closure;
4532 /* If insertion, visit closed-endpoint extents touching the insertion
4533 point because the text would go inside those extents. If deletion,
4534 treat the range as open on both ends so that touching extents are not
4535 visited. Note that we assume that an insertion is occurring if the
4536 changed range has zero length, and a deletion otherwise. This
4537 fails if a change (i.e. non-insertion, non-deletion) is happening.
4538 As far as I know, this doesn't currently occur in XEmacs. --ben */
4539 closed = (from==to);
4540 closure.object = object;
4541 closure.start = buffer_or_string_bytind_to_memind (object, from);
4542 closure.end = buffer_or_string_bytind_to_memind (object, to);
4543 closure.iro = inhibit_read_only_value;
4545 map_extents_bytind (from, to, verify_extent_mapper, (void *) &closure,
4546 object, 0, closed ? ME_END_CLOSED : ME_START_OPEN);
4549 /* ------------------------------------ */
4550 /* process_extents_for_insertion() */
4551 /* ------------------------------------ */
4553 struct process_extents_for_insertion_arg
4560 /* A region of length LENGTH was just inserted at OPOINT. Modify all
4561 of the extents as required for the insertion, based on their
4562 start-open/end-open properties.
4566 process_extents_for_insertion_mapper (EXTENT extent, void *arg)
4568 struct process_extents_for_insertion_arg *closure =
4569 (struct process_extents_for_insertion_arg *) arg;
4570 Memind indice = buffer_or_string_bytind_to_memind (closure->object,
4573 /* When this function is called, one end of the newly-inserted text should
4574 be adjacent to some endpoint of the extent, or disjoint from it. If
4575 the insertion overlaps any existing extent, something is wrong.
4577 #ifdef ERROR_CHECK_EXTENTS
4578 if (extent_start (extent) > indice &&
4579 extent_start (extent) < indice + closure->length)
4581 if (extent_end (extent) > indice &&
4582 extent_end (extent) < indice + closure->length)
4586 /* The extent-adjustment code adjusted the extent's endpoints as if
4587 all extents were closed-open -- endpoints at the insertion point
4588 remain unchanged. We need to fix the other kinds of extents:
4590 1. Start position of start-open extents needs to be moved.
4592 2. End position of end-closed extents needs to be moved.
4594 Note that both conditions hold for zero-length (] extents at the
4595 insertion point. But under these rules, zero-length () extents
4596 would get adjusted such that their start is greater than their
4597 end; instead of allowing that, we treat them as [) extents by
4598 modifying condition #1 to not fire nothing when dealing with a
4599 zero-length open-open extent.
4601 Existence of zero-length open-open extents is unfortunately an
4602 inelegant part of the extent model, but there is no way around
4606 Memind new_start = extent_start (extent);
4607 Memind new_end = extent_end (extent);
4609 if (indice == extent_start (extent) && extent_start_open_p (extent)
4610 /* zero-length () extents are exempt; see comment above. */
4611 && !(new_start == new_end && extent_end_open_p (extent))
4613 new_start += closure->length;
4614 if (indice == extent_end (extent) && !extent_end_open_p (extent))
4615 new_end += closure->length;
4617 set_extent_endpoints_1 (extent, new_start, new_end);
4624 process_extents_for_insertion (Lisp_Object object, Bytind opoint,
4627 struct process_extents_for_insertion_arg closure;
4629 closure.opoint = opoint;
4630 closure.length = length;
4631 closure.object = object;
4633 map_extents_bytind (opoint, opoint + length,
4634 process_extents_for_insertion_mapper,
4635 (void *) &closure, object, 0,
4636 ME_END_CLOSED | ME_MIGHT_MODIFY_EXTENTS |
4637 ME_INCLUDE_INTERNAL);
4640 /* ------------------------------------ */
4641 /* process_extents_for_deletion() */
4642 /* ------------------------------------ */
4644 struct process_extents_for_deletion_arg
4647 int destroy_included_extents;
4650 /* This function is called when we're about to delete the range [from, to].
4651 Detach all of the extents that are completely inside the range [from, to],
4652 if they're detachable or open-open. */
4655 process_extents_for_deletion_mapper (EXTENT extent, void *arg)
4657 struct process_extents_for_deletion_arg *closure =
4658 (struct process_extents_for_deletion_arg *) arg;
4660 /* If the extent lies completely within the range that
4661 is being deleted, then nuke the extent if it's detachable
4662 (otherwise, it will become a zero-length extent). */
4664 if (closure->start <= extent_start (extent) &&
4665 extent_end (extent) <= closure->end)
4667 if (extent_detachable_p (extent))
4669 if (closure->destroy_included_extents)
4670 destroy_extent (extent);
4672 extent_detach (extent);
4679 /* DESTROY_THEM means destroy the extents instead of just deleting them.
4680 It is unused currently, but perhaps might be used (there used to
4681 be a function process_extents_for_destruction(), #if 0'd out,
4682 that did the equivalent). */
4684 process_extents_for_deletion (Lisp_Object object, Bytind from,
4685 Bytind to, int destroy_them)
4687 struct process_extents_for_deletion_arg closure;
4689 closure.start = buffer_or_string_bytind_to_memind (object, from);
4690 closure.end = buffer_or_string_bytind_to_memind (object, to);
4691 closure.destroy_included_extents = destroy_them;
4693 map_extents_bytind (from, to, process_extents_for_deletion_mapper,
4694 (void *) &closure, object, 0,
4695 ME_END_CLOSED | ME_MIGHT_MODIFY_EXTENTS);
4698 /* ------------------------------- */
4699 /* report_extent_modification() */
4700 /* ------------------------------- */
4701 struct report_extent_modification_closure {
4709 report_extent_modification_restore (Lisp_Object buffer)
4711 if (current_buffer != XBUFFER (buffer))
4712 Fset_buffer (buffer);
4717 report_extent_modification_mapper (EXTENT extent, void *arg)
4719 struct report_extent_modification_closure *closure =
4720 (struct report_extent_modification_closure *)arg;
4721 Lisp_Object exobj, startobj, endobj;
4722 Lisp_Object hook = (closure->afterp
4723 ? extent_after_change_functions (extent)
4724 : extent_before_change_functions (extent));
4728 XSETEXTENT (exobj, extent);
4729 XSETINT (startobj, closure->start);
4730 XSETINT (endobj, closure->end);
4732 /* Now that we are sure to call elisp, set up an unwind-protect so
4733 inside_change_hook gets restored in case we throw. Also record
4734 the current buffer, in case we change it. Do the recording only
4737 One confusing thing here is that our caller never actually calls
4738 unbind_to (closure.speccount, Qnil). This is because
4739 map_extents_bytind() unbinds before, and with a smaller
4740 speccount. The additional unbind_to() in
4741 report_extent_modification() would cause XEmacs to abort. */
4742 if (closure->speccount == -1)
4744 closure->speccount = specpdl_depth ();
4745 record_unwind_protect (report_extent_modification_restore,
4746 Fcurrent_buffer ());
4749 /* The functions will expect closure->buffer to be the current
4750 buffer, so change it if it isn't. */
4751 if (current_buffer != XBUFFER (closure->buffer))
4752 Fset_buffer (closure->buffer);
4754 /* #### It's a shame that we can't use any of the existing run_hook*
4755 functions here. This is so because all of them work with
4756 symbols, to be able to retrieve default values of local hooks.
4759 #### Idea: we could set up a dummy symbol, and call the hook
4760 functions on *that*. */
4762 if (!CONSP (hook) || EQ (XCAR (hook), Qlambda))
4763 call3 (hook, exobj, startobj, endobj);
4767 EXTERNAL_LIST_LOOP (tail, hook)
4768 /* #### Shouldn't this perform the same Fset_buffer() check as
4770 call3 (XCAR (tail), exobj, startobj, endobj);
4776 report_extent_modification (Lisp_Object buffer, Bufpos start, Bufpos end,
4779 struct report_extent_modification_closure closure;
4781 closure.buffer = buffer;
4782 closure.start = start;
4784 closure.afterp = afterp;
4785 closure.speccount = -1;
4787 map_extents (start, end, report_extent_modification_mapper, (void *)&closure,
4788 buffer, NULL, ME_MIGHT_CALL_ELISP);
4792 /************************************************************************/
4793 /* extent properties */
4794 /************************************************************************/
4797 set_extent_invisible (EXTENT extent, Lisp_Object value)
4799 if (!EQ (extent_invisible (extent), value))
4801 set_extent_invisible_1 (extent, value);
4802 extent_changed_for_redisplay (extent, 1, 1);
4806 /* This function does "memoization" -- similar to the interning
4807 that happens with symbols. Given a list of faces, an equivalent
4808 list is returned such that if this function is called twice with
4809 input that is `equal', the resulting outputs will be `eq'.
4811 Note that the inputs and outputs are in general *not* `equal' --
4812 faces in symbol form become actual face objects in the output.
4813 This is necessary so that temporary faces stay around. */
4816 memoize_extent_face_internal (Lisp_Object list)
4820 Lisp_Object cons, thecons;
4821 Lisp_Object oldtail, tail;
4822 struct gcpro gcpro1;
4827 return Fget_face (list);
4829 /* To do the memoization, we use a hash table mapping from
4830 external lists to internal lists. We do `equal' comparisons
4831 on the keys so the memoization works correctly.
4833 Note that we canonicalize things so that the keys in the
4834 hash table (the external lists) always contain symbols and
4835 the values (the internal lists) always contain face objects.
4837 We also maintain a "reverse" table that maps from the internal
4838 lists to the external equivalents. The idea here is twofold:
4840 1) `extent-face' wants to return a list containing face symbols
4841 rather than face objects.
4842 2) We don't want things to get quite so messed up if the user
4843 maliciously side-effects the returned lists.
4846 len = XINT (Flength (list));
4847 thelen = XINT (Flength (Vextent_face_reusable_list));
4852 /* We canonicalize the given list into another list.
4853 We try to avoid consing except when necessary, so we have
4859 cons = Vextent_face_reusable_list;
4860 while (!NILP (XCDR (cons)))
4862 XCDR (cons) = Fmake_list (make_int (len - thelen), Qnil);
4864 else if (thelen > len)
4868 /* Truncate the list temporarily so it's the right length;
4869 remember the old tail. */
4870 cons = Vextent_face_reusable_list;
4871 for (i = 0; i < len - 1; i++)
4874 oldtail = XCDR (cons);
4878 thecons = Vextent_face_reusable_list;
4879 EXTERNAL_LIST_LOOP (cons, list)
4881 Lisp_Object face = Fget_face (XCAR (cons));
4883 XCAR (thecons) = Fface_name (face);
4884 thecons = XCDR (thecons);
4887 list = Fgethash (Vextent_face_reusable_list, Vextent_face_memoize_hash_table,
4891 Lisp_Object symlist = Fcopy_sequence (Vextent_face_reusable_list);
4892 Lisp_Object facelist = Fcopy_sequence (Vextent_face_reusable_list);
4894 LIST_LOOP (cons, facelist)
4896 XCAR (cons) = Fget_face (XCAR (cons));
4898 Fputhash (symlist, facelist, Vextent_face_memoize_hash_table);
4899 Fputhash (facelist, symlist, Vextent_face_reverse_memoize_hash_table);
4903 /* Now restore the truncated tail of the reusable list, if necessary. */
4905 XCDR (tail) = oldtail;
4912 external_of_internal_memoized_face (Lisp_Object face)
4916 else if (!CONSP (face))
4917 return XFACE (face)->name;
4920 face = Fgethash (face, Vextent_face_reverse_memoize_hash_table,
4922 assert (!UNBOUNDP (face));
4928 canonicalize_extent_property (Lisp_Object prop, Lisp_Object value)
4930 if (EQ (prop, Qface) || EQ (prop, Qmouse_face))
4931 value = (external_of_internal_memoized_face
4932 (memoize_extent_face_internal (value)));
4936 /* Do we need a lisp-level function ? */
4937 DEFUN ("set-extent-initial-redisplay-function", Fset_extent_initial_redisplay_function,
4939 Note: This feature is experimental!
4941 Set initial-redisplay-function of EXTENT to the function
4944 The first time the EXTENT is (re)displayed, an eval event will be
4945 dispatched calling FUNCTION with EXTENT as its only argument.
4949 EXTENT e = decode_extent(extent, DE_MUST_BE_ATTACHED);
4951 e = extent_ancestor (e); /* Is this needed? Macro also does chasing!*/
4952 set_extent_initial_redisplay_function(e,function);
4953 extent_in_red_event_p(e) = 0; /* If the function changed we can spawn
4955 extent_changed_for_redisplay(e,1,0); /* Do we need to mark children too ?*/
4960 DEFUN ("extent-face", Fextent_face, 1, 1, 0, /*
4961 Return the name of the face in which EXTENT is displayed, or nil
4962 if the extent's face is unspecified. This might also return a list
4969 CHECK_EXTENT (extent);
4970 face = extent_face (XEXTENT (extent));
4972 return external_of_internal_memoized_face (face);
4975 DEFUN ("set-extent-face", Fset_extent_face, 2, 2, 0, /*
4976 Make the given EXTENT have the graphic attributes specified by FACE.
4977 FACE can also be a list of faces, and all faces listed will apply,
4978 with faces earlier in the list taking priority over those later in the
4983 EXTENT e = decode_extent(extent, 0);
4984 Lisp_Object orig_face = face;
4986 /* retrieve the ancestor for efficiency and proper redisplay noting. */
4987 e = extent_ancestor (e);
4989 face = memoize_extent_face_internal (face);
4991 extent_face (e) = face;
4992 extent_changed_for_redisplay (e, 1, 0);
4998 DEFUN ("extent-mouse-face", Fextent_mouse_face, 1, 1, 0, /*
4999 Return the face used to highlight EXTENT when the mouse passes over it.
5000 The return value will be a face name, a list of face names, or nil
5001 if the extent's mouse face is unspecified.
5007 CHECK_EXTENT (extent);
5008 face = extent_mouse_face (XEXTENT (extent));
5010 return external_of_internal_memoized_face (face);
5013 DEFUN ("set-extent-mouse-face", Fset_extent_mouse_face, 2, 2, 0, /*
5014 Set the face used to highlight EXTENT when the mouse passes over it.
5015 FACE can also be a list of faces, and all faces listed will apply,
5016 with faces earlier in the list taking priority over those later in the
5022 Lisp_Object orig_face = face;
5024 CHECK_EXTENT (extent);
5025 e = XEXTENT (extent);
5026 /* retrieve the ancestor for efficiency and proper redisplay noting. */
5027 e = extent_ancestor (e);
5029 face = memoize_extent_face_internal (face);
5031 set_extent_mouse_face (e, face);
5032 extent_changed_for_redisplay (e, 1, 0);
5038 set_extent_glyph (EXTENT extent, Lisp_Object glyph, int endp,
5039 glyph_layout layout)
5041 extent = extent_ancestor (extent);
5045 set_extent_begin_glyph (extent, glyph);
5046 extent_begin_glyph_layout (extent) = layout;
5050 set_extent_end_glyph (extent, glyph);
5051 extent_end_glyph_layout (extent) = layout;
5054 extent_changed_for_redisplay (extent, 1, 0);
5058 glyph_layout_to_symbol (glyph_layout layout)
5062 case GL_TEXT: return Qtext;
5063 case GL_OUTSIDE_MARGIN: return Qoutside_margin;
5064 case GL_INSIDE_MARGIN: return Qinside_margin;
5065 case GL_WHITESPACE: return Qwhitespace;
5068 return Qnil; /* unreached */
5073 symbol_to_glyph_layout (Lisp_Object layout_obj)
5075 if (NILP (layout_obj))
5078 CHECK_SYMBOL (layout_obj);
5079 if (EQ (layout_obj, Qoutside_margin)) return GL_OUTSIDE_MARGIN;
5080 if (EQ (layout_obj, Qinside_margin)) return GL_INSIDE_MARGIN;
5081 if (EQ (layout_obj, Qwhitespace)) return GL_WHITESPACE;
5082 if (EQ (layout_obj, Qtext)) return GL_TEXT;
5084 invalid_argument ("Unknown glyph layout type", layout_obj);
5085 return GL_TEXT; /* unreached */
5089 set_extent_glyph_1 (Lisp_Object extent_obj, Lisp_Object glyph, int endp,
5090 Lisp_Object layout_obj)
5092 EXTENT extent = decode_extent (extent_obj, 0);
5093 glyph_layout layout = symbol_to_glyph_layout (layout_obj);
5095 /* Make sure we've actually been given a valid glyph or it's nil
5096 (meaning we're deleting a glyph from an extent). */
5098 CHECK_BUFFER_GLYPH (glyph);
5100 set_extent_glyph (extent, glyph, endp, layout);
5104 DEFUN ("set-extent-begin-glyph", Fset_extent_begin_glyph, 2, 3, 0, /*
5105 Display a bitmap, subwindow or string at the beginning of EXTENT.
5106 BEGIN-GLYPH must be a glyph object. The layout policy defaults to `text'.
5108 (extent, begin_glyph, layout))
5110 return set_extent_glyph_1 (extent, begin_glyph, 0, layout);
5113 DEFUN ("set-extent-end-glyph", Fset_extent_end_glyph, 2, 3, 0, /*
5114 Display a bitmap, subwindow or string at the end of EXTENT.
5115 END-GLYPH must be a glyph object. The layout policy defaults to `text'.
5117 (extent, end_glyph, layout))
5119 return set_extent_glyph_1 (extent, end_glyph, 1, layout);
5122 DEFUN ("extent-begin-glyph", Fextent_begin_glyph, 1, 1, 0, /*
5123 Return the glyph object displayed at the beginning of EXTENT.
5124 If there is none, nil is returned.
5128 return extent_begin_glyph (decode_extent (extent, 0));
5131 DEFUN ("extent-end-glyph", Fextent_end_glyph, 1, 1, 0, /*
5132 Return the glyph object displayed at the end of EXTENT.
5133 If there is none, nil is returned.
5137 return extent_end_glyph (decode_extent (extent, 0));
5140 DEFUN ("set-extent-begin-glyph-layout", Fset_extent_begin_glyph_layout, 2, 2, 0, /*
5141 Set the layout policy of EXTENT's begin glyph.
5142 Access this using the `extent-begin-glyph-layout' function.
5146 EXTENT e = decode_extent (extent, 0);
5147 e = extent_ancestor (e);
5148 extent_begin_glyph_layout (e) = symbol_to_glyph_layout (layout);
5149 extent_maybe_changed_for_redisplay (e, 1, 0);
5153 DEFUN ("set-extent-end-glyph-layout", Fset_extent_end_glyph_layout, 2, 2, 0, /*
5154 Set the layout policy of EXTENT's end glyph.
5155 Access this using the `extent-end-glyph-layout' function.
5159 EXTENT e = decode_extent (extent, 0);
5160 e = extent_ancestor (e);
5161 extent_end_glyph_layout (e) = symbol_to_glyph_layout (layout);
5162 extent_maybe_changed_for_redisplay (e, 1, 0);
5166 DEFUN ("extent-begin-glyph-layout", Fextent_begin_glyph_layout, 1, 1, 0, /*
5167 Return the layout policy associated with EXTENT's begin glyph.
5168 Set this using the `set-extent-begin-glyph-layout' function.
5172 EXTENT e = decode_extent (extent, 0);
5173 return glyph_layout_to_symbol ((glyph_layout) extent_begin_glyph_layout (e));
5176 DEFUN ("extent-end-glyph-layout", Fextent_end_glyph_layout, 1, 1, 0, /*
5177 Return the layout policy associated with EXTENT's end glyph.
5178 Set this using the `set-extent-end-glyph-layout' function.
5182 EXTENT e = decode_extent (extent, 0);
5183 return glyph_layout_to_symbol ((glyph_layout) extent_end_glyph_layout (e));
5186 DEFUN ("set-extent-priority", Fset_extent_priority, 2, 2, 0, /*
5187 Set the display priority of EXTENT to PRIORITY (an integer).
5188 When the extent attributes are being merged for display, the priority
5189 is used to determine which extent takes precedence in the event of a
5190 conflict (two extents whose faces both specify font, for example: the
5191 font of the extent with the higher priority will be used).
5192 Extents are created with priority 0; priorities may be negative.
5196 EXTENT e = decode_extent (extent, 0);
5198 CHECK_INT (priority);
5199 e = extent_ancestor (e);
5200 set_extent_priority (e, XINT (priority));
5201 extent_maybe_changed_for_redisplay (e, 1, 0);
5205 DEFUN ("extent-priority", Fextent_priority, 1, 1, 0, /*
5206 Return the display priority of EXTENT; see `set-extent-priority'.
5210 EXTENT e = decode_extent (extent, 0);
5211 return make_int (extent_priority (e));
5214 DEFUN ("set-extent-property", Fset_extent_property, 3, 3, 0, /*
5215 Change a property of an extent.
5216 PROPERTY may be any symbol; the value stored may be accessed with
5217 the `extent-property' function.
5218 The following symbols have predefined meanings:
5220 detached Removes the extent from its buffer; setting this is
5221 the same as calling `detach-extent'.
5223 destroyed Removes the extent from its buffer, and makes it
5224 unusable in the future; this is the same calling
5227 priority Change redisplay priority; same as `set-extent-priority'.
5229 start-open Whether the set of characters within the extent is
5230 treated being open on the left, that is, whether
5231 the start position is an exclusive, rather than
5232 inclusive, boundary. If true, then characters
5233 inserted exactly at the beginning of the extent
5234 will remain outside of the extent; otherwise they
5235 will go into the extent, extending it.
5237 end-open Whether the set of characters within the extent is
5238 treated being open on the right, that is, whether
5239 the end position is an exclusive, rather than
5240 inclusive, boundary. If true, then characters
5241 inserted exactly at the end of the extent will
5242 remain outside of the extent; otherwise they will
5243 go into the extent, extending it.
5245 By default, extents have the `end-open' but not the
5246 `start-open' property set.
5248 read-only Text within this extent will be unmodifiable.
5250 initial-redisplay-function (EXPERIMENTAL)
5251 function to be called the first time (part of) the extent
5252 is redisplayed. It will be called with the extent as its
5254 Note: The function will not be called immediately
5255 during redisplay, an eval event will be dispatched.
5257 detachable Whether the extent gets detached (as with
5258 `detach-extent') when all the text within the
5259 extent is deleted. This is true by default. If
5260 this property is not set, the extent becomes a
5261 zero-length extent when its text is deleted. (In
5262 such a case, the `start-open' property is
5263 automatically removed if both the `start-open' and
5264 `end-open' properties are set, since zero-length
5265 extents open on both ends are not allowed.)
5267 face The face in which to display the text. Setting
5268 this is the same as calling `set-extent-face'.
5270 mouse-face If non-nil, the extent will be highlighted in this
5271 face when the mouse moves over it.
5273 pointer If non-nil, and a valid pointer glyph, this specifies
5274 the shape of the mouse pointer while over the extent.
5276 highlight Obsolete: Setting this property is equivalent to
5277 setting a `mouse-face' property of `highlight'.
5278 Reading this property returns non-nil if
5279 the extent has a non-nil `mouse-face' property.
5281 duplicable Whether this extent should be copied into strings,
5282 so that kill, yank, and undo commands will restore
5283 or copy it. `duplicable' extents are copied from
5284 an extent into a string when `buffer-substring' or
5285 a similar function creates a string. The extents
5286 in a string are copied into other strings created
5287 from the string using `concat' or `substring'.
5288 When `insert' or a similar function inserts the
5289 string into a buffer, the extents are copied back
5292 unique Meaningful only in conjunction with `duplicable'.
5293 When this is set, there may be only one instance
5294 of this extent attached at a time: if it is copied
5295 to the kill ring and then yanked, the extent is
5296 not copied. If, however, it is killed (removed
5297 from the buffer) and then yanked, it will be
5298 re-attached at the new position.
5300 invisible If the value is non-nil, text under this extent
5301 may be treated as not present for the purpose of
5302 redisplay, or may be displayed using an ellipsis
5303 or other marker; see `buffer-invisibility-spec'
5304 and `invisible-text-glyph'. In all cases,
5305 however, the text is still visible to other
5306 functions that examine a buffer's text.
5308 keymap This keymap is consulted for mouse clicks on this
5309 extent, or keypresses made while point is within the
5312 copy-function This is a hook that is run when a duplicable extent
5313 is about to be copied from a buffer to a string (or
5314 the kill ring). It is called with three arguments,
5315 the extent, and the buffer-positions within it
5316 which are being copied. If this function returns
5317 nil, then the extent will not be copied; otherwise
5320 paste-function This is a hook that is run when a duplicable extent is
5321 about to be copied from a string (or the kill ring)
5322 into a buffer. It is called with three arguments,
5323 the original extent, and the buffer positions which
5324 the copied extent will occupy. (This hook is run
5325 after the corresponding text has already been
5326 inserted into the buffer.) Note that the extent
5327 argument may be detached when this function is run.
5328 If this function returns nil, no extent will be
5329 inserted. Otherwise, there will be an extent
5330 covering the range in question.
5332 If the original extent is not attached to a buffer,
5333 then it will be re-attached at this range.
5334 Otherwise, a copy will be made, and that copy
5337 The copy-function and paste-function are meaningful
5338 only for extents with the `duplicable' flag set,
5339 and if they are not specified, behave as if `t' was
5340 the returned value. When these hooks are invoked,
5341 the current buffer is the buffer which the extent
5342 is being copied from/to, respectively.
5344 begin-glyph A glyph to be displayed at the beginning of the extent,
5347 end-glyph A glyph to be displayed at the end of the extent,
5350 begin-glyph-layout The layout policy (one of `text', `whitespace',
5351 `inside-margin', or `outside-margin') of the extent's
5354 end-glyph-layout The layout policy of the extent's end glyph.
5356 syntax-table A cons or a syntax table object. If a cons, the car must
5357 be an integer (interpreted as a syntax code, applicable to
5358 all characters in the extent). Otherwise, syntax of
5359 characters in the extent is looked up in the syntax table.
5360 You should use the text property API to manipulate this
5361 property. (This may be required in the future.)
5363 (extent, property, value))
5365 /* This function can GC if property is `keymap' */
5366 EXTENT e = decode_extent (extent, 0);
5368 if (EQ (property, Qread_only))
5369 set_extent_read_only (e, value);
5370 else if (EQ (property, Qunique))
5371 extent_unique_p (e) = !NILP (value);
5372 else if (EQ (property, Qduplicable))
5373 extent_duplicable_p (e) = !NILP (value);
5374 else if (EQ (property, Qinvisible))
5375 set_extent_invisible (e, value);
5376 else if (EQ (property, Qdetachable))
5377 extent_detachable_p (e) = !NILP (value);
5379 else if (EQ (property, Qdetached))
5382 error ("can only set `detached' to t");
5383 Fdetach_extent (extent);
5385 else if (EQ (property, Qdestroyed))
5388 error ("can only set `destroyed' to t");
5389 Fdelete_extent (extent);
5391 else if (EQ (property, Qpriority))
5392 Fset_extent_priority (extent, value);
5393 else if (EQ (property, Qface))
5394 Fset_extent_face (extent, value);
5395 else if (EQ (property, Qinitial_redisplay_function))
5396 Fset_extent_initial_redisplay_function (extent, value);
5397 else if (EQ (property, Qbefore_change_functions))
5398 set_extent_before_change_functions (e, value);
5399 else if (EQ (property, Qafter_change_functions))
5400 set_extent_after_change_functions (e, value);
5401 else if (EQ (property, Qmouse_face))
5402 Fset_extent_mouse_face (extent, value);
5404 else if (EQ (property, Qhighlight))
5405 Fset_extent_mouse_face (extent, Qhighlight);
5406 else if (EQ (property, Qbegin_glyph_layout))
5407 Fset_extent_begin_glyph_layout (extent, value);
5408 else if (EQ (property, Qend_glyph_layout))
5409 Fset_extent_end_glyph_layout (extent, value);
5410 /* For backwards compatibility. We use begin glyph because it is by
5411 far the more used of the two. */
5412 else if (EQ (property, Qglyph_layout))
5413 Fset_extent_begin_glyph_layout (extent, value);
5414 else if (EQ (property, Qbegin_glyph))
5415 Fset_extent_begin_glyph (extent, value, Qnil);
5416 else if (EQ (property, Qend_glyph))
5417 Fset_extent_end_glyph (extent, value, Qnil);
5418 else if (EQ (property, Qstart_open))
5419 set_extent_openness (e, !NILP (value), -1);
5420 else if (EQ (property, Qend_open))
5421 set_extent_openness (e, -1, !NILP (value));
5422 /* Support (but don't document...) the obvious *_closed antonyms. */
5423 else if (EQ (property, Qstart_closed))
5424 set_extent_openness (e, NILP (value), -1);
5425 else if (EQ (property, Qend_closed))
5426 set_extent_openness (e, -1, NILP (value));
5429 if (EQ (property, Qkeymap))
5430 while (!NILP (value) && NILP (Fkeymapp (value)))
5431 value = wrong_type_argument (Qkeymapp, value);
5433 external_plist_put (extent_plist_addr (e), property, value, 0, ERROR_ME);
5439 DEFUN ("set-extent-properties", Fset_extent_properties, 2, 2, 0, /*
5440 Change some properties of EXTENT.
5441 PLIST is a property list.
5442 For a list of built-in properties, see `set-extent-property'.
5446 /* This function can GC, if one of the properties is `keymap' */
5447 Lisp_Object property, value;
5448 struct gcpro gcpro1;
5451 plist = Fcopy_sequence (plist);
5452 Fcanonicalize_plist (plist, Qnil);
5454 while (!NILP (plist))
5456 property = Fcar (plist); plist = Fcdr (plist);
5457 value = Fcar (plist); plist = Fcdr (plist);
5458 Fset_extent_property (extent, property, value);
5464 DEFUN ("extent-property", Fextent_property, 2, 3, 0, /*
5465 Return EXTENT's value for property PROPERTY.
5466 If no such property exists, DEFAULT is returned.
5467 See `set-extent-property' for the built-in property names.
5469 (extent, property, default_))
5471 EXTENT e = decode_extent (extent, 0);
5473 if (EQ (property, Qdetached))
5474 return extent_detached_p (e) ? Qt : Qnil;
5475 else if (EQ (property, Qdestroyed))
5476 return !EXTENT_LIVE_P (e) ? Qt : Qnil;
5477 else if (EQ (property, Qstart_open))
5478 return extent_normal_field (e, start_open) ? Qt : Qnil;
5479 else if (EQ (property, Qend_open))
5480 return extent_normal_field (e, end_open) ? Qt : Qnil;
5481 else if (EQ (property, Qunique))
5482 return extent_normal_field (e, unique) ? Qt : Qnil;
5483 else if (EQ (property, Qduplicable))
5484 return extent_normal_field (e, duplicable) ? Qt : Qnil;
5485 else if (EQ (property, Qdetachable))
5486 return extent_normal_field (e, detachable) ? Qt : Qnil;
5487 /* Support (but don't document...) the obvious *_closed antonyms. */
5488 else if (EQ (property, Qstart_closed))
5489 return extent_start_open_p (e) ? Qnil : Qt;
5490 else if (EQ (property, Qend_closed))
5491 return extent_end_open_p (e) ? Qnil : Qt;
5492 else if (EQ (property, Qpriority))
5493 return make_int (extent_priority (e));
5494 else if (EQ (property, Qread_only))
5495 return extent_read_only (e);
5496 else if (EQ (property, Qinvisible))
5497 return extent_invisible (e);
5498 else if (EQ (property, Qface))
5499 return Fextent_face (extent);
5500 else if (EQ (property, Qinitial_redisplay_function))
5501 return extent_initial_redisplay_function (e);
5502 else if (EQ (property, Qbefore_change_functions))
5503 return extent_before_change_functions (e);
5504 else if (EQ (property, Qafter_change_functions))
5505 return extent_after_change_functions (e);
5506 else if (EQ (property, Qmouse_face))
5507 return Fextent_mouse_face (extent);
5509 else if (EQ (property, Qhighlight))
5510 return !NILP (Fextent_mouse_face (extent)) ? Qt : Qnil;
5511 else if (EQ (property, Qbegin_glyph_layout))
5512 return Fextent_begin_glyph_layout (extent);
5513 else if (EQ (property, Qend_glyph_layout))
5514 return Fextent_end_glyph_layout (extent);
5515 /* For backwards compatibility. We use begin glyph because it is by
5516 far the more used of the two. */
5517 else if (EQ (property, Qglyph_layout))
5518 return Fextent_begin_glyph_layout (extent);
5519 else if (EQ (property, Qbegin_glyph))
5520 return extent_begin_glyph (e);
5521 else if (EQ (property, Qend_glyph))
5522 return extent_end_glyph (e);
5525 Lisp_Object value = external_plist_get (extent_plist_addr (e),
5526 property, 0, ERROR_ME);
5527 return UNBOUNDP (value) ? default_ : value;
5531 DEFUN ("extent-properties", Fextent_properties, 1, 1, 0, /*
5532 Return a property list of the attributes of EXTENT.
5533 Do not modify this list; use `set-extent-property' instead.
5538 Lisp_Object result, face, anc_obj;
5539 glyph_layout layout;
5541 CHECK_EXTENT (extent);
5542 e = XEXTENT (extent);
5543 if (!EXTENT_LIVE_P (e))
5544 return cons3 (Qdestroyed, Qt, Qnil);
5546 anc = extent_ancestor (e);
5547 XSETEXTENT (anc_obj, anc);
5549 /* For efficiency, use the ancestor for all properties except detached */
5551 result = extent_plist_slot (anc);
5553 if (!NILP (face = Fextent_face (anc_obj)))
5554 result = cons3 (Qface, face, result);
5556 if (!NILP (face = Fextent_mouse_face (anc_obj)))
5557 result = cons3 (Qmouse_face, face, result);
5559 if ((layout = (glyph_layout) extent_begin_glyph_layout (anc)) != GL_TEXT)
5561 Lisp_Object sym = glyph_layout_to_symbol (layout);
5562 result = cons3 (Qglyph_layout, sym, result); /* compatibility */
5563 result = cons3 (Qbegin_glyph_layout, sym, result);
5566 if ((layout = (glyph_layout) extent_end_glyph_layout (anc)) != GL_TEXT)
5567 result = cons3 (Qend_glyph_layout, glyph_layout_to_symbol (layout), result);
5569 if (!NILP (extent_end_glyph (anc)))
5570 result = cons3 (Qend_glyph, extent_end_glyph (anc), result);
5572 if (!NILP (extent_begin_glyph (anc)))
5573 result = cons3 (Qbegin_glyph, extent_begin_glyph (anc), result);
5575 if (extent_priority (anc) != 0)
5576 result = cons3 (Qpriority, make_int (extent_priority (anc)), result);
5578 if (!NILP (extent_initial_redisplay_function (anc)))
5579 result = cons3 (Qinitial_redisplay_function,
5580 extent_initial_redisplay_function (anc), result);
5582 if (!NILP (extent_before_change_functions (anc)))
5583 result = cons3 (Qbefore_change_functions,
5584 extent_before_change_functions (anc), result);
5586 if (!NILP (extent_after_change_functions (anc)))
5587 result = cons3 (Qafter_change_functions,
5588 extent_after_change_functions (anc), result);
5590 if (!NILP (extent_invisible (anc)))
5591 result = cons3 (Qinvisible, extent_invisible (anc), result);
5593 if (!NILP (extent_read_only (anc)))
5594 result = cons3 (Qread_only, extent_read_only (anc), result);
5596 if (extent_normal_field (anc, end_open))
5597 result = cons3 (Qend_open, Qt, result);
5599 if (extent_normal_field (anc, start_open))
5600 result = cons3 (Qstart_open, Qt, result);
5602 if (extent_normal_field (anc, detachable))
5603 result = cons3 (Qdetachable, Qt, result);
5605 if (extent_normal_field (anc, duplicable))
5606 result = cons3 (Qduplicable, Qt, result);
5608 if (extent_normal_field (anc, unique))
5609 result = cons3 (Qunique, Qt, result);
5611 /* detached is not an inherited property */
5612 if (extent_detached_p (e))
5613 result = cons3 (Qdetached, Qt, result);
5619 /************************************************************************/
5621 /************************************************************************/
5623 /* The display code looks into the Vlast_highlighted_extent variable to
5624 correctly display highlighted extents. This updates that variable,
5625 and marks the appropriate buffers as needing some redisplay.
5628 do_highlight (Lisp_Object extent_obj, int highlight_p)
5630 if (( highlight_p && (EQ (Vlast_highlighted_extent, extent_obj))) ||
5631 (!highlight_p && (EQ (Vlast_highlighted_extent, Qnil))))
5633 if (EXTENTP (Vlast_highlighted_extent) &&
5634 EXTENT_LIVE_P (XEXTENT (Vlast_highlighted_extent)))
5636 /* do not recurse on descendants. Only one extent is highlighted
5638 extent_changed_for_redisplay (XEXTENT (Vlast_highlighted_extent), 0, 0);
5640 Vlast_highlighted_extent = Qnil;
5641 if (!NILP (extent_obj)
5642 && BUFFERP (extent_object (XEXTENT (extent_obj)))
5645 extent_changed_for_redisplay (XEXTENT (extent_obj), 0, 0);
5646 Vlast_highlighted_extent = extent_obj;
5650 DEFUN ("force-highlight-extent", Fforce_highlight_extent, 1, 2, 0, /*
5651 Highlight or unhighlight the given extent.
5652 If the second arg is non-nil, it will be highlighted, else dehighlighted.
5653 This is the same as `highlight-extent', except that it will work even
5654 on extents without the `mouse-face' property.
5656 (extent, highlight_p))
5661 XSETEXTENT (extent, decode_extent (extent, DE_MUST_BE_ATTACHED));
5662 do_highlight (extent, !NILP (highlight_p));
5666 DEFUN ("highlight-extent", Fhighlight_extent, 1, 2, 0, /*
5667 Highlight EXTENT, if it is highlightable.
5668 \(that is, if it has the `mouse-face' property).
5669 If the second arg is non-nil, it will be highlighted, else dehighlighted.
5670 Highlighted extents are displayed as if they were merged with the face
5671 or faces specified by the `mouse-face' property.
5673 (extent, highlight_p))
5675 if (EXTENTP (extent) && NILP (extent_mouse_face (XEXTENT (extent))))
5678 return Fforce_highlight_extent (extent, highlight_p);
5682 /************************************************************************/
5683 /* strings and extents */
5684 /************************************************************************/
5686 /* copy/paste hooks */
5689 run_extent_copy_paste_internal (EXTENT e, Bufpos from, Bufpos to,
5693 /* This function can GC */
5695 Lisp_Object copy_fn;
5696 XSETEXTENT (extent, e);
5697 copy_fn = Fextent_property (extent, prop, Qnil);
5698 if (!NILP (copy_fn))
5701 struct gcpro gcpro1, gcpro2, gcpro3;
5702 GCPRO3 (extent, copy_fn, object);
5703 if (BUFFERP (object))
5704 flag = call3_in_buffer (XBUFFER (object), copy_fn, extent,
5705 make_int (from), make_int (to));
5707 flag = call3 (copy_fn, extent, make_int (from), make_int (to));
5709 if (NILP (flag) || !EXTENT_LIVE_P (XEXTENT (extent)))
5716 run_extent_copy_function (EXTENT e, Bytind from, Bytind to)
5718 Lisp_Object object = extent_object (e);
5719 /* This function can GC */
5720 return run_extent_copy_paste_internal
5721 (e, buffer_or_string_bytind_to_bufpos (object, from),
5722 buffer_or_string_bytind_to_bufpos (object, to), object,
5727 run_extent_paste_function (EXTENT e, Bytind from, Bytind to,
5730 /* This function can GC */
5731 return run_extent_copy_paste_internal
5732 (e, buffer_or_string_bytind_to_bufpos (object, from),
5733 buffer_or_string_bytind_to_bufpos (object, to), object,
5738 update_extent (EXTENT extent, Bytind from, Bytind to)
5740 set_extent_endpoints (extent, from, to, Qnil);
5743 /* Insert an extent, usually from the dup_list of a string which
5744 has just been inserted.
5745 This code does not handle the case of undo.
5748 insert_extent (EXTENT extent, Bytind new_start, Bytind new_end,
5749 Lisp_Object object, int run_hooks)
5751 /* This function can GC */
5754 if (!EQ (extent_object (extent), object))
5757 if (extent_detached_p (extent))
5760 !run_extent_paste_function (extent, new_start, new_end, object))
5761 /* The paste-function said don't re-attach this extent here. */
5764 update_extent (extent, new_start, new_end);
5768 Bytind exstart = extent_endpoint_bytind (extent, 0);
5769 Bytind exend = extent_endpoint_bytind (extent, 1);
5771 if (exend < new_start || exstart > new_end)
5775 new_start = min (exstart, new_start);
5776 new_end = max (exend, new_end);
5777 if (exstart != new_start || exend != new_end)
5778 update_extent (extent, new_start, new_end);
5782 XSETEXTENT (tmp, extent);
5787 !run_extent_paste_function (extent, new_start, new_end, object))
5788 /* The paste-function said don't attach a copy of the extent here. */
5792 XSETEXTENT (tmp, copy_extent (extent, new_start, new_end, object));
5797 DEFUN ("insert-extent", Finsert_extent, 1, 5, 0, /*
5798 Insert EXTENT from START to END in BUFFER-OR-STRING.
5799 BUFFER-OR-STRING defaults to the current buffer if omitted.
5800 This operation does not insert any characters,
5801 but otherwise acts as if there were a replicating extent whose
5802 parent is EXTENT in some string that was just inserted.
5803 Returns the newly-inserted extent.
5804 The fourth arg, NO-HOOKS, can be used to inhibit the running of the
5805 extent's `paste-function' property if it has one.
5806 See documentation on `detach-extent' for a discussion of undo recording.
5808 (extent, start, end, no_hooks, buffer_or_string))
5810 EXTENT ext = decode_extent (extent, 0);
5814 buffer_or_string = decode_buffer_or_string (buffer_or_string);
5815 get_buffer_or_string_range_byte (buffer_or_string, start, end, &s, &e,
5816 GB_ALLOW_PAST_ACCESSIBLE);
5818 copy = insert_extent (ext, s, e, buffer_or_string, NILP (no_hooks));
5821 if (extent_duplicable_p (XEXTENT (copy)))
5822 record_extent (copy, 1);
5828 /* adding buffer extents to a string */
5830 struct add_string_extents_arg
5838 add_string_extents_mapper (EXTENT extent, void *arg)
5840 /* This function can GC */
5841 struct add_string_extents_arg *closure =
5842 (struct add_string_extents_arg *) arg;
5843 Bytecount start = extent_endpoint_bytind (extent, 0) - closure->from;
5844 Bytecount end = extent_endpoint_bytind (extent, 1) - closure->from;
5846 if (extent_duplicable_p (extent))
5848 start = max (start, 0);
5849 end = min (end, closure->length);
5851 /* Run the copy-function to give an extent the option of
5852 not being copied into the string (or kill ring).
5854 if (extent_duplicable_p (extent) &&
5855 !run_extent_copy_function (extent, start + closure->from,
5856 end + closure->from))
5858 copy_extent (extent, start, end, closure->string);
5864 /* Add the extents in buffer BUF from OPOINT to OPOINT+LENGTH to
5865 the string STRING. */
5867 add_string_extents (Lisp_Object string, struct buffer *buf, Bytind opoint,
5870 /* This function can GC */
5871 struct add_string_extents_arg closure;
5872 struct gcpro gcpro1, gcpro2;
5875 closure.from = opoint;
5876 closure.length = length;
5877 closure.string = string;
5878 buffer = make_buffer (buf);
5879 GCPRO2 (buffer, string);
5880 map_extents_bytind (opoint, opoint + length, add_string_extents_mapper,
5881 (void *) &closure, buffer, 0,
5882 /* ignore extents that just abut the region */
5883 ME_END_CLOSED | ME_ALL_EXTENTS_OPEN |
5884 /* we are calling E-Lisp (the extent's copy function)
5885 so anything might happen */
5886 ME_MIGHT_CALL_ELISP);
5890 struct splice_in_string_extents_arg
5899 splice_in_string_extents_mapper (EXTENT extent, void *arg)
5901 /* This function can GC */
5902 struct splice_in_string_extents_arg *closure =
5903 (struct splice_in_string_extents_arg *) arg;
5904 /* BASE_START and BASE_END are the limits in the buffer of the string
5905 that was just inserted.
5907 NEW_START and NEW_END are the prospective buffer positions of the
5908 extent that is going into the buffer. */
5909 Bytind base_start = closure->opoint;
5910 Bytind base_end = base_start + closure->length;
5911 Bytind new_start = (base_start + extent_endpoint_bytind (extent, 0) -
5913 Bytind new_end = (base_start + extent_endpoint_bytind (extent, 1) -
5916 if (new_start < base_start)
5917 new_start = base_start;
5918 if (new_end > base_end)
5920 if (new_end <= new_start)
5923 if (!extent_duplicable_p (extent))
5927 !run_extent_paste_function (extent, new_start, new_end,
5930 copy_extent (extent, new_start, new_end, closure->buffer);
5935 /* We have just inserted a section of STRING (starting at POS, of
5936 length LENGTH) into buffer BUF at OPOINT. Do whatever is necessary
5937 to get the string's extents into the buffer. */
5940 splice_in_string_extents (Lisp_Object string, struct buffer *buf,
5941 Bytind opoint, Bytecount length, Bytecount pos)
5943 struct splice_in_string_extents_arg closure;
5944 struct gcpro gcpro1, gcpro2;
5947 buffer = make_buffer (buf);
5948 closure.opoint = opoint;
5950 closure.length = length;
5951 closure.buffer = buffer;
5952 GCPRO2 (buffer, string);
5953 map_extents_bytind (pos, pos + length,
5954 splice_in_string_extents_mapper,
5955 (void *) &closure, string, 0,
5956 /* ignore extents that just abut the region */
5957 ME_END_CLOSED | ME_ALL_EXTENTS_OPEN |
5958 /* we are calling E-Lisp (the extent's copy function)
5959 so anything might happen */
5960 ME_MIGHT_CALL_ELISP);
5964 struct copy_string_extents_arg
5969 Lisp_Object new_string;
5972 struct copy_string_extents_1_arg
5974 Lisp_Object parent_in_question;
5975 EXTENT found_extent;
5979 copy_string_extents_mapper (EXTENT extent, void *arg)
5981 struct copy_string_extents_arg *closure =
5982 (struct copy_string_extents_arg *) arg;
5983 Bytecount old_start, old_end, new_start, new_end;
5985 old_start = extent_endpoint_bytind (extent, 0);
5986 old_end = extent_endpoint_bytind (extent, 1);
5988 old_start = max (closure->old_pos, old_start);
5989 old_end = min (closure->old_pos + closure->length, old_end);
5991 if (old_start >= old_end)
5994 new_start = old_start + closure->new_pos - closure->old_pos;
5995 new_end = old_end + closure->new_pos - closure->old_pos;
5997 copy_extent (extent, new_start, new_end, closure->new_string);
6001 /* The string NEW_STRING was partially constructed from OLD_STRING.
6002 In particular, the section of length LEN starting at NEW_POS in
6003 NEW_STRING came from the section of the same length starting at
6004 OLD_POS in OLD_STRING. Copy the extents as appropriate. */
6007 copy_string_extents (Lisp_Object new_string, Lisp_Object old_string,
6008 Bytecount new_pos, Bytecount old_pos,
6011 struct copy_string_extents_arg closure;
6012 struct gcpro gcpro1, gcpro2;
6014 closure.new_pos = new_pos;
6015 closure.old_pos = old_pos;
6016 closure.new_string = new_string;
6017 closure.length = length;
6018 GCPRO2 (new_string, old_string);
6019 map_extents_bytind (old_pos, old_pos + length,
6020 copy_string_extents_mapper,
6021 (void *) &closure, old_string, 0,
6022 /* ignore extents that just abut the region */
6023 ME_END_CLOSED | ME_ALL_EXTENTS_OPEN |
6024 /* we are calling E-Lisp (the extent's copy function)
6025 so anything might happen */
6026 ME_MIGHT_CALL_ELISP);
6030 /* Checklist for sanity checking:
6031 - {kill, yank, copy} at {open, closed} {start, end} of {writable, read-only} extent
6032 - {kill, copy} & yank {once, repeatedly} duplicable extent in {same, different} buffer
6036 /************************************************************************/
6037 /* text properties */
6038 /************************************************************************/
6041 Originally this stuff was implemented in lisp (all of the functionality
6042 exists to make that possible) but speed was a problem.
6045 Lisp_Object Qtext_prop;
6046 Lisp_Object Qtext_prop_extent_paste_function;
6049 get_text_property_bytind (Bytind position, Lisp_Object prop,
6050 Lisp_Object object, enum extent_at_flag fl,
6051 int text_props_only)
6055 /* text_props_only specifies whether we only consider text-property
6056 extents (those with the 'text-prop property set) or all extents. */
6057 if (!text_props_only)
6058 extent = extent_at_bytind (position, object, prop, 0, fl, 0);
6064 extent = extent_at_bytind (position, object, Qtext_prop, prior,
6068 if (EQ (prop, Fextent_property (extent, Qtext_prop, Qnil)))
6070 prior = XEXTENT (extent);
6075 return Fextent_property (extent, prop, Qnil);
6076 if (!NILP (Vdefault_text_properties))
6077 return Fplist_get (Vdefault_text_properties, prop, Qnil);
6082 get_text_property_1 (Lisp_Object pos, Lisp_Object prop, Lisp_Object object,
6083 Lisp_Object at_flag, int text_props_only)
6088 object = decode_buffer_or_string (object);
6089 position = get_buffer_or_string_pos_byte (object, pos, GB_NO_ERROR_IF_BAD);
6091 /* We canonicalize the start/end-open/closed properties to the
6092 non-default version -- "adding" the default property really
6093 needs to remove the non-default one. See below for more
6095 if (EQ (prop, Qstart_closed))
6101 if (EQ (prop, Qend_open))
6109 get_text_property_bytind (position, prop, object,
6110 decode_extent_at_flag (at_flag),
6113 val = NILP (val) ? Qt : Qnil;
6118 DEFUN ("get-text-property", Fget_text_property, 2, 4, 0, /*
6119 Return the value of the PROP property at the given position.
6120 Optional arg OBJECT specifies the buffer or string to look in, and
6121 defaults to the current buffer.
6122 Optional arg AT-FLAG controls what it means for a property to be "at"
6123 a position, and has the same meaning as in `extent-at'.
6124 This examines only those properties added with `put-text-property'.
6125 See also `get-char-property'.
6127 (pos, prop, object, at_flag))
6129 return get_text_property_1 (pos, prop, object, at_flag, 1);
6132 DEFUN ("get-char-property", Fget_char_property, 2, 4, 0, /*
6133 Return the value of the PROP property at the given position.
6134 Optional arg OBJECT specifies the buffer or string to look in, and
6135 defaults to the current buffer.
6136 Optional arg AT-FLAG controls what it means for a property to be "at"
6137 a position, and has the same meaning as in `extent-at'.
6138 This examines properties on all extents.
6139 See also `get-text-property'.
6141 (pos, prop, object, at_flag))
6143 return get_text_property_1 (pos, prop, object, at_flag, 0);
6146 /* About start/end-open/closed:
6148 These properties have to be handled specially because of their
6149 strange behavior. If I put the "start-open" property on a region,
6150 then *all* text-property extents in the region have to have their
6151 start be open. This is unlike all other properties, which don't
6152 affect the extents of text properties other than their own.
6156 1) We have to map start-closed to (not start-open) and end-open
6157 to (not end-closed) -- i.e. adding the default is really the
6158 same as remove the non-default property. It won't work, for
6159 example, to have both "start-open" and "start-closed" on
6161 2) Whenever we add one of these properties, we go through all
6162 text-property extents in the region and set the appropriate
6163 open/closedness on them.
6164 3) Whenever we change a text-property extent for a property,
6165 we have to make sure we set the open/closedness properly.
6167 (2) and (3) together rely on, and maintain, the invariant
6168 that the open/closedness of text-property extents is correct
6169 at the beginning and end of each operation.
6172 struct put_text_prop_arg
6174 Lisp_Object prop, value; /* The property and value we are storing */
6175 Bytind start, end; /* The region into which we are storing it */
6177 Lisp_Object the_extent; /* Our chosen extent; this is used for
6178 communication between subsequent passes. */
6179 int changed_p; /* Output: whether we have modified anything */
6183 put_text_prop_mapper (EXTENT e, void *arg)
6185 struct put_text_prop_arg *closure = (struct put_text_prop_arg *) arg;
6187 Lisp_Object object = closure->object;
6188 Lisp_Object value = closure->value;
6189 Bytind e_start, e_end;
6190 Bytind start = closure->start;
6191 Bytind end = closure->end;
6192 Lisp_Object extent, e_val;
6195 XSETEXTENT (extent, e);
6197 /* Note: in some cases when the property itself is 'start-open
6198 or 'end-closed, the checks to set the openness may do a bit
6199 of extra work; but it won't hurt because we then fix up the
6200 openness later on in put_text_prop_openness_mapper(). */
6201 if (!EQ (Fextent_property (extent, Qtext_prop, Qnil), closure->prop))
6202 /* It's not for this property; do nothing. */
6205 e_start = extent_endpoint_bytind (e, 0);
6206 e_end = extent_endpoint_bytind (e, 1);
6207 e_val = Fextent_property (extent, closure->prop, Qnil);
6208 is_eq = EQ (value, e_val);
6210 if (!NILP (value) && NILP (closure->the_extent) && is_eq)
6212 /* We want there to be an extent here at the end, and we haven't picked
6213 one yet, so use this one. Extend it as necessary. We only reuse an
6214 extent which has an EQ value for the prop in question to avoid
6215 side-effecting the kill ring (that is, we never change the property
6216 on an extent after it has been created.)
6218 if (e_start != start || e_end != end)
6220 Bytind new_start = min (e_start, start);
6221 Bytind new_end = max (e_end, end);
6222 set_extent_endpoints (e, new_start, new_end, Qnil);
6223 /* If we changed the endpoint, then we need to set its
6225 set_extent_openness (e, new_start != e_start
6226 ? !NILP (get_text_property_bytind
6227 (start, Qstart_open, object,
6228 EXTENT_AT_AFTER, 1)) : -1,
6230 ? NILP (get_text_property_bytind
6231 (end - 1, Qend_closed, object,
6232 EXTENT_AT_AFTER, 1))
6234 closure->changed_p = 1;
6236 closure->the_extent = extent;
6239 /* Even if we're adding a prop, at this point, we want all other extents of
6240 this prop to go away (as now they overlap). So the theory here is that,
6241 when we are adding a prop to a region that has multiple (disjoint)
6242 occurrences of that prop in it already, we pick one of those and extend
6243 it, and remove the others.
6246 else if (EQ (extent, closure->the_extent))
6248 /* just in case map-extents hits it again (does that happen?) */
6251 else if (e_start >= start && e_end <= end)
6253 /* Extent is contained in region; remove it. Don't destroy or modify
6254 it, because we don't want to change the attributes pointed to by the
6255 duplicates in the kill ring.
6258 closure->changed_p = 1;
6260 else if (!NILP (closure->the_extent) &&
6265 EXTENT te = XEXTENT (closure->the_extent);
6266 /* This extent overlaps, and has the same prop/value as the extent we've
6267 decided to reuse, so we can remove this existing extent as well (the
6268 whole thing, even the part outside of the region) and extend
6269 the-extent to cover it, resulting in the minimum number of extents in
6272 Bytind the_start = extent_endpoint_bytind (te, 0);
6273 Bytind the_end = extent_endpoint_bytind (te, 1);
6274 if (e_start != the_start && /* note AND not OR -- hmm, why is this
6275 the case? I think it's because the
6276 assumption that the text-property
6277 extents don't overlap makes it
6278 OK; changing it to an OR would
6279 result in changed_p sometimes getting
6280 falsely marked. Is this bad? */
6283 Bytind new_start = min (e_start, the_start);
6284 Bytind new_end = max (e_end, the_end);
6285 set_extent_endpoints (te, new_start, new_end, Qnil);
6286 /* If we changed the endpoint, then we need to set its
6287 openness. We are setting the endpoint to be the same as
6288 that of the extent we're about to remove, and we assume
6289 (the invariant mentioned above) that extent has the
6290 proper endpoint setting, so we just use it. */
6291 set_extent_openness (te, new_start != e_start ?
6292 (int) extent_start_open_p (e) : -1,
6294 (int) extent_end_open_p (e) : -1);
6295 closure->changed_p = 1;
6299 else if (e_end <= end)
6301 /* Extent begins before start but ends before end, so we can just
6302 decrease its end position.
6306 set_extent_endpoints (e, e_start, start, Qnil);
6307 set_extent_openness (e, -1, NILP (get_text_property_bytind
6308 (start - 1, Qend_closed, object,
6309 EXTENT_AT_AFTER, 1)));
6310 closure->changed_p = 1;
6313 else if (e_start >= start)
6315 /* Extent ends after end but begins after start, so we can just
6316 increase its start position.
6320 set_extent_endpoints (e, end, e_end, Qnil);
6321 set_extent_openness (e, !NILP (get_text_property_bytind
6322 (end, Qstart_open, object,
6323 EXTENT_AT_AFTER, 1)), -1);
6324 closure->changed_p = 1;
6329 /* Otherwise, `extent' straddles the region. We need to split it.
6331 set_extent_endpoints (e, e_start, start, Qnil);
6332 set_extent_openness (e, -1, NILP (get_text_property_bytind
6333 (start - 1, Qend_closed, object,
6334 EXTENT_AT_AFTER, 1)));
6335 set_extent_openness (copy_extent (e, end, e_end, extent_object (e)),
6336 !NILP (get_text_property_bytind
6337 (end, Qstart_open, object,
6338 EXTENT_AT_AFTER, 1)), -1);
6339 closure->changed_p = 1;
6342 return 0; /* to continue mapping. */
6346 put_text_prop_openness_mapper (EXTENT e, void *arg)
6348 struct put_text_prop_arg *closure = (struct put_text_prop_arg *) arg;
6349 Bytind e_start, e_end;
6350 Bytind start = closure->start;
6351 Bytind end = closure->end;
6353 XSETEXTENT (extent, e);
6354 e_start = extent_endpoint_bytind (e, 0);
6355 e_end = extent_endpoint_bytind (e, 1);
6357 if (NILP (Fextent_property (extent, Qtext_prop, Qnil)))
6359 /* It's not a text-property extent; do nothing. */
6362 /* Note end conditions and NILP/!NILP's carefully. */
6363 else if (EQ (closure->prop, Qstart_open)
6364 && e_start >= start && e_start < end)
6365 set_extent_openness (e, !NILP (closure->value), -1);
6366 else if (EQ (closure->prop, Qend_closed)
6367 && e_end > start && e_end <= end)
6368 set_extent_openness (e, -1, NILP (closure->value));
6370 return 0; /* to continue mapping. */
6374 put_text_prop (Bytind start, Bytind end, Lisp_Object object,
6375 Lisp_Object prop, Lisp_Object value,
6378 /* This function can GC */
6379 struct put_text_prop_arg closure;
6381 if (start == end) /* There are no characters in the region. */
6384 /* convert to the non-default versions, since a nil property is
6385 the same as it not being present. */
6386 if (EQ (prop, Qstart_closed))
6389 value = NILP (value) ? Qt : Qnil;
6391 else if (EQ (prop, Qend_open))
6394 value = NILP (value) ? Qt : Qnil;
6397 value = canonicalize_extent_property (prop, value);
6399 closure.prop = prop;
6400 closure.value = value;
6401 closure.start = start;
6403 closure.object = object;
6404 closure.changed_p = 0;
6405 closure.the_extent = Qnil;
6407 map_extents_bytind (start, end,
6408 put_text_prop_mapper,
6409 (void *) &closure, object, 0,
6410 /* get all extents that abut the region */
6411 ME_ALL_EXTENTS_CLOSED | ME_END_CLOSED |
6412 /* it might QUIT or error if the user has
6413 fucked with the extent plist. */
6414 /* #### dmoore - I think this should include
6415 ME_MIGHT_MOVE_SOE, since the callback function
6416 might recurse back into map_extents_bytind. */
6418 ME_MIGHT_MODIFY_EXTENTS);
6420 /* If we made it through the loop without reusing an extent
6421 (and we want there to be one) make it now.
6423 if (!NILP (value) && NILP (closure.the_extent))
6427 XSETEXTENT (extent, make_extent_internal (object, start, end));
6428 closure.changed_p = 1;
6429 Fset_extent_property (extent, Qtext_prop, prop);
6430 Fset_extent_property (extent, prop, value);
6433 extent_duplicable_p (XEXTENT (extent)) = 1;
6434 Fset_extent_property (extent, Qpaste_function,
6435 Qtext_prop_extent_paste_function);
6437 set_extent_openness (XEXTENT (extent),
6438 !NILP (get_text_property_bytind
6439 (start, Qstart_open, object,
6440 EXTENT_AT_AFTER, 1)),
6441 NILP (get_text_property_bytind
6442 (end - 1, Qend_closed, object,
6443 EXTENT_AT_AFTER, 1)));
6446 if (EQ (prop, Qstart_open) || EQ (prop, Qend_closed))
6448 map_extents_bytind (start, end,
6449 put_text_prop_openness_mapper,
6450 (void *) &closure, object, 0,
6451 /* get all extents that abut the region */
6452 ME_ALL_EXTENTS_CLOSED | ME_END_CLOSED |
6453 ME_MIGHT_MODIFY_EXTENTS);
6456 return closure.changed_p;
6459 DEFUN ("put-text-property", Fput_text_property, 4, 5, 0, /*
6460 Adds the given property/value to all characters in the specified region.
6461 The property is conceptually attached to the characters rather than the
6462 region. The properties are copied when the characters are copied/pasted.
6463 Fifth argument OBJECT is the buffer or string containing the text, and
6464 defaults to the current buffer.
6466 (start, end, prop, value, object))
6468 /* This function can GC */
6471 object = decode_buffer_or_string (object);
6472 get_buffer_or_string_range_byte (object, start, end, &s, &e, 0);
6473 put_text_prop (s, e, object, prop, value, 1);
6477 DEFUN ("put-nonduplicable-text-property", Fput_nonduplicable_text_property,
6479 Adds the given property/value to all characters in the specified region.
6480 The property is conceptually attached to the characters rather than the
6481 region, however the properties will not be copied when the characters
6483 Fifth argument OBJECT is the buffer or string containing the text, and
6484 defaults to the current buffer.
6486 (start, end, prop, value, object))
6488 /* This function can GC */
6491 object = decode_buffer_or_string (object);
6492 get_buffer_or_string_range_byte (object, start, end, &s, &e, 0);
6493 put_text_prop (s, e, object, prop, value, 0);
6497 DEFUN ("add-text-properties", Fadd_text_properties, 3, 4, 0, /*
6498 Add properties to the characters from START to END.
6499 The third argument PROPS is a property list specifying the property values
6500 to add. The optional fourth argument, OBJECT, is the buffer or string
6501 containing the text and defaults to the current buffer. Returns t if
6502 any property was changed, nil otherwise.
6504 (start, end, props, object))
6506 /* This function can GC */
6510 object = decode_buffer_or_string (object);
6511 get_buffer_or_string_range_byte (object, start, end, &s, &e, 0);
6513 for (; !NILP (props); props = Fcdr (Fcdr (props)))
6515 Lisp_Object prop = XCAR (props);
6516 Lisp_Object value = Fcar (XCDR (props));
6517 changed |= put_text_prop (s, e, object, prop, value, 1);
6519 return changed ? Qt : Qnil;
6523 DEFUN ("add-nonduplicable-text-properties", Fadd_nonduplicable_text_properties,
6525 Add nonduplicable properties to the characters from START to END.
6526 \(The properties will not be copied when the characters are copied.)
6527 The third argument PROPS is a property list specifying the property values
6528 to add. The optional fourth argument, OBJECT, is the buffer or string
6529 containing the text and defaults to the current buffer. Returns t if
6530 any property was changed, nil otherwise.
6532 (start, end, props, object))
6534 /* This function can GC */
6538 object = decode_buffer_or_string (object);
6539 get_buffer_or_string_range_byte (object, start, end, &s, &e, 0);
6541 for (; !NILP (props); props = Fcdr (Fcdr (props)))
6543 Lisp_Object prop = XCAR (props);
6544 Lisp_Object value = Fcar (XCDR (props));
6545 changed |= put_text_prop (s, e, object, prop, value, 0);
6547 return changed ? Qt : Qnil;
6550 DEFUN ("remove-text-properties", Fremove_text_properties, 3, 4, 0, /*
6551 Remove the given properties from all characters in the specified region.
6552 PROPS should be a plist, but the values in that plist are ignored (treated
6553 as nil). Returns t if any property was changed, nil otherwise.
6554 Fourth argument OBJECT is the buffer or string containing the text, and
6555 defaults to the current buffer.
6557 (start, end, props, object))
6559 /* This function can GC */
6563 object = decode_buffer_or_string (object);
6564 get_buffer_or_string_range_byte (object, start, end, &s, &e, 0);
6566 for (; !NILP (props); props = Fcdr (Fcdr (props)))
6568 Lisp_Object prop = XCAR (props);
6569 changed |= put_text_prop (s, e, object, prop, Qnil, 1);
6571 return changed ? Qt : Qnil;
6574 /* Whenever a text-prop extent is pasted into a buffer (via `yank' or `insert'
6575 or whatever) we attach the properties to the buffer by calling
6576 `put-text-property' instead of by simply allowing the extent to be copied or
6577 re-attached. Then we return nil, telling the extents code not to attach it
6578 again. By handing the insertion hackery in this way, we make kill/yank
6579 behave consistently with put-text-property and not fragment the extents
6580 (since text-prop extents must partition, not overlap).
6582 The lisp implementation of this was probably fast enough, but since I moved
6583 the rest of the put-text-prop code here, I moved this as well for
6586 DEFUN ("text-prop-extent-paste-function", Ftext_prop_extent_paste_function,
6588 Used as the `paste-function' property of `text-prop' extents.
6592 /* This function can GC */
6593 Lisp_Object prop, val;
6595 prop = Fextent_property (extent, Qtext_prop, Qnil);
6597 signal_type_error (Qinternal_error,
6598 "Internal error: no text-prop", extent);
6599 val = Fextent_property (extent, prop, Qnil);
6601 /* removed by bill perry, 2/9/97
6602 ** This little bit of code would not allow you to have a text property
6603 ** with a value of Qnil. This is bad bad bad.
6606 signal_type_error_2 (Qinternal_error,
6607 "Internal error: no text-prop",
6610 Fput_text_property (from, to, prop, val, Qnil);
6611 return Qnil; /* important! */
6614 /* This function could easily be written in Lisp but the C code wants
6615 to use it in connection with invisible extents (at least currently).
6616 If this changes, consider moving this back into Lisp. */
6618 DEFUN ("next-single-property-change", Fnext_single_property_change,
6620 Return the position of next property change for a specific property.
6621 Scans characters forward from POS till it finds a change in the PROP
6622 property, then returns the position of the change. The optional third
6623 argument OBJECT is the buffer or string to scan (defaults to the current
6625 The property values are compared with `eq'.
6626 Return nil if the property is constant all the way to the end of OBJECT.
6627 If the value is non-nil, it is a position greater than POS, never equal.
6629 If the optional fourth argument LIMIT is non-nil, don't search
6630 past position LIMIT; return LIMIT if nothing is found before LIMIT.
6631 If two or more extents with conflicting non-nil values for PROP overlap
6632 a particular character, it is undefined which value is considered to be
6633 the value of PROP. (Note that this situation will not happen if you always
6634 use the text-property primitives.)
6636 (pos, prop, object, limit))
6640 Lisp_Object extent, value;
6643 object = decode_buffer_or_string (object);
6644 bpos = get_buffer_or_string_pos_char (object, pos, 0);
6647 blim = buffer_or_string_accessible_end_char (object);
6652 blim = get_buffer_or_string_pos_char (object, limit, 0);
6656 extent = Fextent_at (make_int (bpos), object, prop, Qnil, Qnil);
6658 value = Fextent_property (extent, prop, Qnil);
6664 bpos = XINT (Fnext_extent_change (make_int (bpos), object));
6666 break; /* property is the same all the way to the end */
6667 extent = Fextent_at (make_int (bpos), object, prop, Qnil, Qnil);
6668 if ((NILP (extent) && !NILP (value)) ||
6669 (!NILP (extent) && !EQ (value,
6670 Fextent_property (extent, prop, Qnil))))
6671 return make_int (bpos);
6674 /* I think it's more sensible for this function to return nil always
6675 in this situation and it used to do it this way, but it's been changed
6676 for FSF compatibility. */
6680 return make_int (blim);
6683 /* See comment on previous function about why this is written in C. */
6685 DEFUN ("previous-single-property-change", Fprevious_single_property_change,
6687 Return the position of next property change for a specific property.
6688 Scans characters backward from POS till it finds a change in the PROP
6689 property, then returns the position of the change. The optional third
6690 argument OBJECT is the buffer or string to scan (defaults to the current
6692 The property values are compared with `eq'.
6693 Return nil if the property is constant all the way to the start of OBJECT.
6694 If the value is non-nil, it is a position less than POS, never equal.
6696 If the optional fourth argument LIMIT is non-nil, don't search back
6697 past position LIMIT; return LIMIT if nothing is found until LIMIT.
6698 If two or more extents with conflicting non-nil values for PROP overlap
6699 a particular character, it is undefined which value is considered to be
6700 the value of PROP. (Note that this situation will not happen if you always
6701 use the text-property primitives.)
6703 (pos, prop, object, limit))
6707 Lisp_Object extent, value;
6710 object = decode_buffer_or_string (object);
6711 bpos = get_buffer_or_string_pos_char (object, pos, 0);
6714 blim = buffer_or_string_accessible_begin_char (object);
6719 blim = get_buffer_or_string_pos_char (object, limit, 0);
6723 /* extent-at refers to the character AFTER bpos, but we want the
6724 character before bpos. Thus the - 1. extent-at simply
6725 returns nil on bogus positions, so not to worry. */
6726 extent = Fextent_at (make_int (bpos - 1), object, prop, Qnil, Qnil);
6728 value = Fextent_property (extent, prop, Qnil);
6734 bpos = XINT (Fprevious_extent_change (make_int (bpos), object));
6736 break; /* property is the same all the way to the beginning */
6737 extent = Fextent_at (make_int (bpos - 1), object, prop, Qnil, Qnil);
6738 if ((NILP (extent) && !NILP (value)) ||
6739 (!NILP (extent) && !EQ (value,
6740 Fextent_property (extent, prop, Qnil))))
6741 return make_int (bpos);
6744 /* I think it's more sensible for this function to return nil always
6745 in this situation and it used to do it this way, but it's been changed
6746 for FSF compatibility. */
6750 return make_int (blim);
6753 #ifdef MEMORY_USAGE_STATS
6756 compute_buffer_extent_usage (struct buffer *b, struct overhead_stats *ovstats)
6758 /* #### not yet written */
6762 #endif /* MEMORY_USAGE_STATS */
6765 /************************************************************************/
6766 /* initialization */
6767 /************************************************************************/
6770 syms_of_extents (void)
6772 INIT_LRECORD_IMPLEMENTATION (extent);
6773 INIT_LRECORD_IMPLEMENTATION (extent_info);
6774 INIT_LRECORD_IMPLEMENTATION (extent_auxiliary);
6776 defsymbol (&Qextentp, "extentp");
6777 defsymbol (&Qextent_live_p, "extent-live-p");
6779 defsymbol (&Qall_extents_closed, "all-extents-closed");
6780 defsymbol (&Qall_extents_open, "all-extents-open");
6781 defsymbol (&Qall_extents_closed_open, "all-extents-closed-open");
6782 defsymbol (&Qall_extents_open_closed, "all-extents-open-closed");
6783 defsymbol (&Qstart_in_region, "start-in-region");
6784 defsymbol (&Qend_in_region, "end-in-region");
6785 defsymbol (&Qstart_and_end_in_region, "start-and-end-in-region");
6786 defsymbol (&Qstart_or_end_in_region, "start-or-end-in-region");
6787 defsymbol (&Qnegate_in_region, "negate-in-region");
6789 defsymbol (&Qdetached, "detached");
6790 defsymbol (&Qdestroyed, "destroyed");
6791 defsymbol (&Qbegin_glyph, "begin-glyph");
6792 defsymbol (&Qend_glyph, "end-glyph");
6793 defsymbol (&Qstart_open, "start-open");
6794 defsymbol (&Qend_open, "end-open");
6795 defsymbol (&Qstart_closed, "start-closed");
6796 defsymbol (&Qend_closed, "end-closed");
6797 defsymbol (&Qread_only, "read-only");
6798 /* defsymbol (&Qhighlight, "highlight"); in faces.c */
6799 defsymbol (&Qunique, "unique");
6800 defsymbol (&Qduplicable, "duplicable");
6801 defsymbol (&Qdetachable, "detachable");
6802 defsymbol (&Qpriority, "priority");
6803 defsymbol (&Qmouse_face, "mouse-face");
6804 defsymbol (&Qinitial_redisplay_function,"initial-redisplay-function");
6807 defsymbol (&Qglyph_layout, "glyph-layout"); /* backwards compatibility */
6808 defsymbol (&Qbegin_glyph_layout, "begin-glyph-layout");
6809 defsymbol (&Qend_glyph_layout, "end-glyph-layout");
6810 defsymbol (&Qoutside_margin, "outside-margin");
6811 defsymbol (&Qinside_margin, "inside-margin");
6812 defsymbol (&Qwhitespace, "whitespace");
6813 /* Qtext defined in general.c */
6815 defsymbol (&Qpaste_function, "paste-function");
6816 defsymbol (&Qcopy_function, "copy-function");
6818 defsymbol (&Qtext_prop, "text-prop");
6819 defsymbol (&Qtext_prop_extent_paste_function,
6820 "text-prop-extent-paste-function");
6823 DEFSUBR (Fextent_live_p);
6824 DEFSUBR (Fextent_detached_p);
6825 DEFSUBR (Fextent_start_position);
6826 DEFSUBR (Fextent_end_position);
6827 DEFSUBR (Fextent_object);
6828 DEFSUBR (Fextent_length);
6830 DEFSUBR (Fmake_extent);
6831 DEFSUBR (Fcopy_extent);
6832 DEFSUBR (Fdelete_extent);
6833 DEFSUBR (Fdetach_extent);
6834 DEFSUBR (Fset_extent_endpoints);
6835 DEFSUBR (Fnext_extent);
6836 DEFSUBR (Fprevious_extent);
6838 DEFSUBR (Fnext_e_extent);
6839 DEFSUBR (Fprevious_e_extent);
6841 DEFSUBR (Fnext_extent_change);
6842 DEFSUBR (Fprevious_extent_change);
6844 DEFSUBR (Fextent_parent);
6845 DEFSUBR (Fextent_children);
6846 DEFSUBR (Fset_extent_parent);
6848 DEFSUBR (Fextent_in_region_p);
6849 DEFSUBR (Fmap_extents);
6850 DEFSUBR (Fmap_extent_children);
6851 DEFSUBR (Fextent_at);
6852 DEFSUBR (Fextents_at);
6854 DEFSUBR (Fset_extent_initial_redisplay_function);
6855 DEFSUBR (Fextent_face);
6856 DEFSUBR (Fset_extent_face);
6857 DEFSUBR (Fextent_mouse_face);
6858 DEFSUBR (Fset_extent_mouse_face);
6859 DEFSUBR (Fset_extent_begin_glyph);
6860 DEFSUBR (Fset_extent_end_glyph);
6861 DEFSUBR (Fextent_begin_glyph);
6862 DEFSUBR (Fextent_end_glyph);
6863 DEFSUBR (Fset_extent_begin_glyph_layout);
6864 DEFSUBR (Fset_extent_end_glyph_layout);
6865 DEFSUBR (Fextent_begin_glyph_layout);
6866 DEFSUBR (Fextent_end_glyph_layout);
6867 DEFSUBR (Fset_extent_priority);
6868 DEFSUBR (Fextent_priority);
6869 DEFSUBR (Fset_extent_property);
6870 DEFSUBR (Fset_extent_properties);
6871 DEFSUBR (Fextent_property);
6872 DEFSUBR (Fextent_properties);
6874 DEFSUBR (Fhighlight_extent);
6875 DEFSUBR (Fforce_highlight_extent);
6877 DEFSUBR (Finsert_extent);
6879 DEFSUBR (Fget_text_property);
6880 DEFSUBR (Fget_char_property);
6881 DEFSUBR (Fput_text_property);
6882 DEFSUBR (Fput_nonduplicable_text_property);
6883 DEFSUBR (Fadd_text_properties);
6884 DEFSUBR (Fadd_nonduplicable_text_properties);
6885 DEFSUBR (Fremove_text_properties);
6886 DEFSUBR (Ftext_prop_extent_paste_function);
6887 DEFSUBR (Fnext_single_property_change);
6888 DEFSUBR (Fprevious_single_property_change);
6892 reinit_vars_of_extents (void)
6894 extent_auxiliary_defaults.begin_glyph = Qnil;
6895 extent_auxiliary_defaults.end_glyph = Qnil;
6896 extent_auxiliary_defaults.parent = Qnil;
6897 extent_auxiliary_defaults.children = Qnil;
6898 extent_auxiliary_defaults.priority = 0;
6899 extent_auxiliary_defaults.invisible = Qnil;
6900 extent_auxiliary_defaults.read_only = Qnil;
6901 extent_auxiliary_defaults.mouse_face = Qnil;
6902 extent_auxiliary_defaults.initial_redisplay_function = Qnil;
6903 extent_auxiliary_defaults.before_change_functions = Qnil;
6904 extent_auxiliary_defaults.after_change_functions = Qnil;
6908 vars_of_extents (void)
6910 reinit_vars_of_extents ();
6912 DEFVAR_INT ("mouse-highlight-priority", &mouse_highlight_priority /*
6913 The priority to use for the mouse-highlighting pseudo-extent
6914 that is used to highlight extents with the `mouse-face' attribute set.
6915 See `set-extent-priority'.
6917 /* Set mouse-highlight-priority (which ends up being used both for the
6918 mouse-highlighting pseudo-extent and the primary selection extent)
6919 to a very high value because very few extents should override it.
6920 1000 gives lots of room below it for different-prioritized extents.
6921 10 doesn't. ediff, for example, likes to use priorities around 100.
6923 mouse_highlight_priority = /* 10 */ 1000;
6925 DEFVAR_LISP ("default-text-properties", &Vdefault_text_properties /*
6926 Property list giving default values for text properties.
6927 Whenever a character does not specify a value for a property, the value
6928 stored in this list is used instead. This only applies when the
6929 functions `get-text-property' or `get-char-property' are called.
6931 Vdefault_text_properties = Qnil;
6933 staticpro (&Vlast_highlighted_extent);
6934 Vlast_highlighted_extent = Qnil;
6936 Vextent_face_reusable_list = Fcons (Qnil, Qnil);
6937 staticpro (&Vextent_face_reusable_list);
6941 complex_vars_of_extents (void)
6943 staticpro (&Vextent_face_memoize_hash_table);
6944 /* The memoize hash table maps from lists of symbols to lists of
6945 faces. It needs to be `equal' to implement the memoization.
6946 The reverse table maps in the other direction and just needs
6947 to do `eq' comparison because the lists of faces are already
6949 Vextent_face_memoize_hash_table =
6950 make_lisp_hash_table (100, HASH_TABLE_VALUE_WEAK, HASH_TABLE_EQUAL);
6951 staticpro (&Vextent_face_reverse_memoize_hash_table);
6952 Vextent_face_reverse_memoize_hash_table =
6953 make_lisp_hash_table (100, HASH_TABLE_KEY_WEAK, HASH_TABLE_EQ);