1 /* Copyright (c) 1994, 1995 Free Software Foundation, Inc.
2 Copyright (c) 1995 Sun Microsystems, Inc.
3 Copyright (c) 1995, 1996 Ben Wing.
5 This file is part of XEmacs.
7 XEmacs is free software; you can redistribute it and/or modify it
8 under the terms of the GNU General Public License as published by the
9 Free Software Foundation; either version 2, or (at your option) any
12 XEmacs is distributed in the hope that it will be useful, but WITHOUT
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
17 You should have received a copy of the GNU General Public License
18 along with XEmacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
22 /* Synched up with: Not in FSF. */
24 /* This file has been Mule-ized. */
26 /* Written by Ben Wing <ben@xemacs.org>.
28 [Originally written by some people at Lucid.
30 Start/end-open stuff added by John Rose (john.rose@eng.sun.com).
31 Rewritten from scratch by Ben Wing, December 1994.] */
35 Extents are regions over a buffer, with a start and an end position
36 denoting the region of the buffer included in the extent. In
37 addition, either end can be closed or open, meaning that the endpoint
38 is or is not logically included in the extent. Insertion of a character
39 at a closed endpoint causes the character to go inside the extent;
40 insertion at an open endpoint causes the character to go outside.
42 Extent endpoints are stored using memory indices (see insdel.c),
43 to minimize the amount of adjusting that needs to be done when
44 characters are inserted or deleted.
46 (Formerly, extent endpoints at the gap could be either before or
47 after the gap, depending on the open/closedness of the endpoint.
48 The intent of this was to make it so that insertions would
49 automatically go inside or out of extents as necessary with no
50 further work needing to be done. It didn't work out that way,
51 however, and just ended up complexifying and buggifying all the
54 Extents are compared using memory indices. There are two orderings
55 for extents and both orders are kept current at all times. The normal
56 or "display" order is as follows:
58 Extent A is "less than" extent B, that is, earlier in the display order,
59 if: A-start < B-start,
60 or if: A-start = B-start, and A-end > B-end
62 So if two extents begin at the same position, the larger of them is the
63 earlier one in the display order (EXTENT_LESS is true).
65 For the e-order, the same thing holds: Extent A is "less than" extent B
66 in e-order, that is, later in the buffer,
68 or if: A-end = B-end, and A-start > B-start
70 So if two extents end at the same position, the smaller of them is the
71 earlier one in the e-order (EXTENT_E_LESS is true).
73 The display order and the e-order are complementary orders: any
74 theorem about the display order also applies to the e-order if you
75 swap all occurrences of "display order" and "e-order", "less than"
76 and "greater than", and "extent start" and "extent end".
78 Extents can be zero-length, and will end up that way if their endpoints
79 are explicitly set that way or if their detachable property is nil
80 and all the text in the extent is deleted. (The exception is open-open
81 zero-length extents, which are barred from existing because there is
82 no sensible way to define their properties. Deletion of the text in
83 an open-open extent causes it to be converted into a closed-open
84 extent.) Zero-length extents are primarily used to represent
85 annotations, and behave as follows:
87 1) Insertion at the position of a zero-length extent expands the extent
88 if both endpoints are closed; goes after the extent if it is closed-open;
89 and goes before the extent if it is open-closed.
91 2) Deletion of a character on a side of a zero-length extent whose
92 corresponding endpoint is closed causes the extent to be detached if
93 it is detachable; if the extent is not detachable or the corresponding
94 endpoint is open, the extent remains in the buffer, moving as necessary.
96 Note that closed-open, non-detachable zero-length extents behave exactly
97 like markers and that open-closed, non-detachable zero-length extents
98 behave like the "point-type" marker in Mule.
101 #### The following information is wrong in places.
103 More about the different orders:
104 --------------------------------
106 The extents in a buffer are ordered by "display order" because that
107 is that order that the redisplay mechanism needs to process them in.
108 The e-order is an auxiliary ordering used to facilitate operations
109 over extents. The operations that can be performed on the ordered
110 list of extents in a buffer are
112 1) Locate where an extent would go if inserted into the list.
113 2) Insert an extent into the list.
114 3) Remove an extent from the list.
115 4) Map over all the extents that overlap a range.
117 (4) requires being able to determine the first and last extents
118 that overlap a range.
120 NOTE: "overlap" is used as follows:
122 -- two ranges overlap if they have at least one point in common.
123 Whether the endpoints are open or closed makes a difference here.
124 -- a point overlaps a range if the point is contained within the
125 range; this is equivalent to treating a point P as the range
127 -- In the case of an *extent* overlapping a point or range, the
128 extent is normally treated as having closed endpoints. This
129 applies consistently in the discussion of stacks of extents
130 and such below. Note that this definition of overlap is not
131 necessarily consistent with the extents that `map-extents'
132 maps over, since `map-extents' sometimes pays attention to
133 whether the endpoints of an extents are open or closed.
134 But for our purposes, it greatly simplifies things to treat
135 all extents as having closed endpoints.
137 First, define >, <, <=, etc. as applied to extents to mean
138 comparison according to the display order. Comparison between an
139 extent E and an index I means comparison between E and the range
141 Also define e>, e<, e<=, etc. to mean comparison according to the
143 For any range R, define R(0) to be the starting index of the range
144 and R(1) to be the ending index of the range.
145 For any extent E, define E(next) to be the extent directly following
146 E, and E(prev) to be the extent directly preceding E. Assume
147 E(next) and E(prev) can be determined from E in constant time.
148 (This is because we store the extent list as a doubly linked
150 Similarly, define E(e-next) and E(e-prev) to be the extents
151 directly following and preceding E in the e-order.
156 Let F be the first extent overlapping R.
157 Let L be the last extent overlapping R.
159 Theorem 1: R(1) lies between L and L(next), i.e. L <= R(1) < L(next).
161 This follows easily from the definition of display order. The
162 basic reason that this theorem applies is that the display order
163 sorts by increasing starting index.
165 Therefore, we can determine L just by looking at where we would
166 insert R(1) into the list, and if we know F and are moving forward
167 over extents, we can easily determine when we've hit L by comparing
168 the extent we're at to R(1).
170 Theorem 2: F(e-prev) e< [1, R(0)] e<= F.
172 This is the analog of Theorem 1, and applies because the e-order
173 sorts by increasing ending index.
175 Therefore, F can be found in the same amount of time as operation (1),
176 i.e. the time that it takes to locate where an extent would go if
177 inserted into the e-order list.
179 If the lists were stored as balanced binary trees, then operation (1)
180 would take logarithmic time, which is usually quite fast. However,
181 currently they're stored as simple doubly-linked lists, and instead
182 we do some caching to try to speed things up.
184 Define a "stack of extents" (or "SOE") as the set of extents
185 (ordered in the display order) that overlap an index I, together with
186 the SOE's "previous" extent, which is an extent that precedes I in
187 the e-order. (Hopefully there will not be very many extents between
188 I and the previous extent.)
192 Let I be an index, let S be the stack of extents on I, let F be
193 the first extent in S, and let P be S's previous extent.
195 Theorem 3: The first extent in S is the first extent that overlaps
198 Proof: Any extent that overlaps [I, J] but does not include I must
199 have a start index > I, and thus be greater than any extent in S.
201 Therefore, finding the first extent that overlaps a range R is the
202 same as finding the first extent that overlaps R(0).
204 Theorem 4: Let I2 be an index such that I2 > I, and let F2 be the
205 first extent that overlaps I2. Then, either F2 is in S or F2 is
206 greater than any extent in S.
208 Proof: If F2 does not include I then its start index is greater
209 than I and thus it is greater than any extent in S, including F.
210 Otherwise, F2 includes I and thus is in S, and thus F2 >= F.
230 #include "redisplay.h"
232 /* ------------------------------- */
234 /* ------------------------------- */
236 /* Note that this object is not extent-specific and should perhaps be
237 moved into another file. */
239 /* Holds a marker that moves as elements in the array are inserted and
240 deleted, similar to standard markers. */
242 typedef struct gap_array_marker
245 struct gap_array_marker *next;
248 /* Holds a "gap array", which is an array of elements with a gap located
249 in it. Insertions and deletions with a high degree of locality
250 are very fast, essentially in constant time. Array positions as
251 used and returned in the gap array functions are independent of
254 typedef struct gap_array
261 Gap_Array_Marker *markers;
264 Gap_Array_Marker *gap_array_marker_freelist;
266 /* Convert a "memory position" (i.e. taking the gap into account) into
267 the address of the element at (i.e. after) that position. "Memory
268 positions" are only used internally and are of type Memind.
269 "Array positions" are used externally and are of type int. */
270 #define GAP_ARRAY_MEMEL_ADDR(ga, memel) ((ga)->array + (ga)->elsize*(memel))
272 /* Number of elements currently in a gap array */
273 #define GAP_ARRAY_NUM_ELS(ga) ((ga)->numels)
275 #define GAP_ARRAY_ARRAY_TO_MEMORY_POS(ga, pos) \
276 ((pos) <= (ga)->gap ? (pos) : (pos) + (ga)->gapsize)
278 #define GAP_ARRAY_MEMORY_TO_ARRAY_POS(ga, pos) \
279 ((pos) <= (ga)->gap ? (pos) : (pos) - (ga)->gapsize)
281 /* Convert an array position into the address of the element at
282 (i.e. after) that position. */
283 #define GAP_ARRAY_EL_ADDR(ga, pos) ((pos) < (ga)->gap ? \
284 GAP_ARRAY_MEMEL_ADDR(ga, pos) : \
285 GAP_ARRAY_MEMEL_ADDR(ga, (pos) + (ga)->gapsize))
287 /* ------------------------------- */
289 /* ------------------------------- */
291 typedef struct extent_list_marker
295 struct extent_list_marker *next;
296 } Extent_List_Marker;
298 typedef struct extent_list
302 Extent_List_Marker *markers;
305 Extent_List_Marker *extent_list_marker_freelist;
307 #define EXTENT_LESS_VALS(e,st,nd) ((extent_start (e) < (st)) || \
308 ((extent_start (e) == (st)) && \
309 (extent_end (e) > (nd))))
311 #define EXTENT_EQUAL_VALS(e,st,nd) ((extent_start (e) == (st)) && \
312 (extent_end (e) == (nd)))
314 #define EXTENT_LESS_EQUAL_VALS(e,st,nd) ((extent_start (e) < (st)) || \
315 ((extent_start (e) == (st)) && \
316 (extent_end (e) >= (nd))))
318 /* Is extent E1 less than extent E2 in the display order? */
319 #define EXTENT_LESS(e1,e2) \
320 EXTENT_LESS_VALS (e1, extent_start (e2), extent_end (e2))
322 /* Is extent E1 equal to extent E2? */
323 #define EXTENT_EQUAL(e1,e2) \
324 EXTENT_EQUAL_VALS (e1, extent_start (e2), extent_end (e2))
326 /* Is extent E1 less than or equal to extent E2 in the display order? */
327 #define EXTENT_LESS_EQUAL(e1,e2) \
328 EXTENT_LESS_EQUAL_VALS (e1, extent_start (e2), extent_end (e2))
330 #define EXTENT_E_LESS_VALS(e,st,nd) ((extent_end (e) < (nd)) || \
331 ((extent_end (e) == (nd)) && \
332 (extent_start (e) > (st))))
334 #define EXTENT_E_LESS_EQUAL_VALS(e,st,nd) ((extent_end (e) < (nd)) || \
335 ((extent_end (e) == (nd)) && \
336 (extent_start (e) >= (st))))
338 /* Is extent E1 less than extent E2 in the e-order? */
339 #define EXTENT_E_LESS(e1,e2) \
340 EXTENT_E_LESS_VALS(e1, extent_start (e2), extent_end (e2))
342 /* Is extent E1 less than or equal to extent E2 in the e-order? */
343 #define EXTENT_E_LESS_EQUAL(e1,e2) \
344 EXTENT_E_LESS_EQUAL_VALS (e1, extent_start (e2), extent_end (e2))
346 #define EXTENT_GAP_ARRAY_AT(ga, pos) (* (EXTENT *) GAP_ARRAY_EL_ADDR(ga, pos))
348 /* ------------------------------- */
349 /* auxiliary extent structure */
350 /* ------------------------------- */
352 struct extent_auxiliary extent_auxiliary_defaults;
354 /* ------------------------------- */
355 /* buffer-extent primitives */
356 /* ------------------------------- */
358 typedef struct stack_of_extents
360 Extent_List *extents;
361 Memind pos; /* Position of stack of extents. EXTENTS is the list of
362 all extents that overlap this position. This position
363 can be -1 if the stack of extents is invalid (this
364 happens when a buffer is first created or a string's
365 stack of extents is created [a string's stack of extents
366 is nuked when a GC occurs, to conserve memory]). */
369 /* ------------------------------- */
371 /* ------------------------------- */
373 typedef int Endpoint_Index;
375 #define memind_to_startind(x, start_open) \
376 ((Endpoint_Index) (((x) << 1) + !!(start_open)))
377 #define memind_to_endind(x, end_open) \
378 ((Endpoint_Index) (((x) << 1) - !!(end_open)))
380 /* Combination macros */
381 #define bytind_to_startind(buf, x, start_open) \
382 memind_to_startind (bytind_to_memind (buf, x), start_open)
383 #define bytind_to_endind(buf, x, end_open) \
384 memind_to_endind (bytind_to_memind (buf, x), end_open)
386 /* ------------------------------- */
387 /* buffer-or-string primitives */
388 /* ------------------------------- */
390 /* Similar for Bytinds and start/end indices. */
392 #define buffer_or_string_bytind_to_startind(obj, ind, start_open) \
393 memind_to_startind (buffer_or_string_bytind_to_memind (obj, ind), \
396 #define buffer_or_string_bytind_to_endind(obj, ind, end_open) \
397 memind_to_endind (buffer_or_string_bytind_to_memind (obj, ind), \
400 /* ------------------------------- */
401 /* Lisp-level functions */
402 /* ------------------------------- */
404 /* flags for decode_extent() */
405 #define DE_MUST_HAVE_BUFFER 1
406 #define DE_MUST_BE_ATTACHED 2
408 Lisp_Object Vlast_highlighted_extent;
409 int mouse_highlight_priority;
411 Lisp_Object Qextentp;
412 Lisp_Object Qextent_live_p;
414 Lisp_Object Qall_extents_closed;
415 Lisp_Object Qall_extents_open;
416 Lisp_Object Qall_extents_closed_open;
417 Lisp_Object Qall_extents_open_closed;
418 Lisp_Object Qstart_in_region;
419 Lisp_Object Qend_in_region;
420 Lisp_Object Qstart_and_end_in_region;
421 Lisp_Object Qstart_or_end_in_region;
422 Lisp_Object Qnegate_in_region;
424 Lisp_Object Qdetached;
425 Lisp_Object Qdestroyed;
426 Lisp_Object Qbegin_glyph;
427 Lisp_Object Qend_glyph;
428 Lisp_Object Qstart_open;
429 Lisp_Object Qend_open;
430 Lisp_Object Qstart_closed;
431 Lisp_Object Qend_closed;
432 Lisp_Object Qread_only;
433 /* Qhighlight defined in general.c */
435 Lisp_Object Qduplicable;
436 Lisp_Object Qdetachable;
437 Lisp_Object Qpriority;
438 Lisp_Object Qmouse_face;
439 Lisp_Object Qinitial_redisplay_function;
441 Lisp_Object Qglyph_layout; /* This exists only for backwards compatibility. */
442 Lisp_Object Qbegin_glyph_layout, Qend_glyph_layout;
443 Lisp_Object Qoutside_margin;
444 Lisp_Object Qinside_margin;
445 Lisp_Object Qwhitespace;
446 /* Qtext defined in general.c */
448 /* partially used in redisplay */
449 Lisp_Object Qglyph_invisible;
451 Lisp_Object Qcopy_function;
452 Lisp_Object Qpaste_function;
454 /* The idea here is that if we're given a list of faces, we
455 need to "memoize" this so that two lists of faces that are `equal'
456 turn into the same object. When `set-extent-face' is called, we
457 "memoize" into a list of actual faces; when `extent-face' is called,
458 we do a reverse lookup to get the list of symbols. */
460 static Lisp_Object canonicalize_extent_property (Lisp_Object prop,
462 Lisp_Object Vextent_face_memoize_hash_table;
463 Lisp_Object Vextent_face_reverse_memoize_hash_table;
464 Lisp_Object Vextent_face_reusable_list;
465 /* FSFmacs bogosity */
466 Lisp_Object Vdefault_text_properties;
469 EXFUN (Fextent_properties, 1);
470 EXFUN (Fset_extent_property, 3);
473 /************************************************************************/
474 /* Generalized gap array */
475 /************************************************************************/
477 /* This generalizes the "array with a gap" model used to store buffer
478 characters. This is based on the stuff in insdel.c and should
479 probably be merged with it. This is not extent-specific and should
480 perhaps be moved into a separate file. */
482 /* ------------------------------- */
483 /* internal functions */
484 /* ------------------------------- */
486 /* Adjust the gap array markers in the range (FROM, TO]. Parallel to
487 adjust_markers() in insdel.c. */
490 gap_array_adjust_markers (Gap_Array *ga, Memind from,
491 Memind to, int amount)
495 for (m = ga->markers; m; m = m->next)
496 m->pos = do_marker_adjustment (m->pos, from, to, amount);
499 /* Move the gap to array position POS. Parallel to move_gap() in
500 insdel.c but somewhat simplified. */
503 gap_array_move_gap (Gap_Array *ga, int pos)
506 int gapsize = ga->gapsize;
511 memmove (GAP_ARRAY_MEMEL_ADDR (ga, pos + gapsize),
512 GAP_ARRAY_MEMEL_ADDR (ga, pos),
513 (gap - pos)*ga->elsize);
514 gap_array_adjust_markers (ga, (Memind) pos, (Memind) gap,
519 memmove (GAP_ARRAY_MEMEL_ADDR (ga, gap),
520 GAP_ARRAY_MEMEL_ADDR (ga, gap + gapsize),
521 (pos - gap)*ga->elsize);
522 gap_array_adjust_markers (ga, (Memind) (gap + gapsize),
523 (Memind) (pos + gapsize), - gapsize);
528 /* Make the gap INCREMENT characters longer. Parallel to make_gap() in
532 gap_array_make_gap (Gap_Array *ga, int increment)
534 char *ptr = ga->array;
538 /* If we have to get more space, get enough to last a while. We use
539 a geometric progession that saves on realloc space. */
540 increment += 100 + ga->numels / 8;
542 ptr = (char *) xrealloc (ptr,
543 (ga->numels + ga->gapsize + increment)*ga->elsize);
548 real_gap_loc = ga->gap;
549 old_gap_size = ga->gapsize;
551 /* Call the newly allocated space a gap at the end of the whole space. */
552 ga->gap = ga->numels + ga->gapsize;
553 ga->gapsize = increment;
555 /* Move the new gap down to be consecutive with the end of the old one.
556 This adjusts the markers properly too. */
557 gap_array_move_gap (ga, real_gap_loc + old_gap_size);
559 /* Now combine the two into one large gap. */
560 ga->gapsize += old_gap_size;
561 ga->gap = real_gap_loc;
564 /* ------------------------------- */
565 /* external functions */
566 /* ------------------------------- */
568 /* Insert NUMELS elements (pointed to by ELPTR) into the specified
572 gap_array_insert_els (Gap_Array *ga, int pos, void *elptr, int numels)
574 assert (pos >= 0 && pos <= ga->numels);
575 if (ga->gapsize < numels)
576 gap_array_make_gap (ga, numels - ga->gapsize);
578 gap_array_move_gap (ga, pos);
580 memcpy (GAP_ARRAY_MEMEL_ADDR (ga, ga->gap), (char *) elptr,
582 ga->gapsize -= numels;
584 ga->numels += numels;
585 /* This is the equivalent of insert-before-markers.
587 #### Should only happen if marker is "moves forward at insert" type.
590 gap_array_adjust_markers (ga, pos - 1, pos, numels);
593 /* Delete NUMELS elements from the specified gap array, starting at FROM. */
596 gap_array_delete_els (Gap_Array *ga, int from, int numdel)
598 int to = from + numdel;
599 int gapsize = ga->gapsize;
602 assert (numdel >= 0);
603 assert (to <= ga->numels);
605 /* Make sure the gap is somewhere in or next to what we are deleting. */
607 gap_array_move_gap (ga, to);
609 gap_array_move_gap (ga, from);
611 /* Relocate all markers pointing into the new, larger gap
612 to point at the end of the text before the gap. */
613 gap_array_adjust_markers (ga, to + gapsize, to + gapsize,
616 ga->gapsize += numdel;
617 ga->numels -= numdel;
621 static Gap_Array_Marker *
622 gap_array_make_marker (Gap_Array *ga, int pos)
626 assert (pos >= 0 && pos <= ga->numels);
627 if (gap_array_marker_freelist)
629 m = gap_array_marker_freelist;
630 gap_array_marker_freelist = gap_array_marker_freelist->next;
633 m = xnew (Gap_Array_Marker);
635 m->pos = GAP_ARRAY_ARRAY_TO_MEMORY_POS (ga, pos);
636 m->next = ga->markers;
642 gap_array_delete_marker (Gap_Array *ga, Gap_Array_Marker *m)
644 Gap_Array_Marker *p, *prev;
646 for (prev = 0, p = ga->markers; p && p != m; prev = p, p = p->next)
650 prev->next = p->next;
652 ga->markers = p->next;
653 m->next = gap_array_marker_freelist;
654 m->pos = 0xDEADBEEF; /* -559038737 as an int */
655 gap_array_marker_freelist = m;
659 gap_array_delete_all_markers (Gap_Array *ga)
661 Gap_Array_Marker *p, *next;
663 for (p = ga->markers; p; p = next)
666 p->next = gap_array_marker_freelist;
667 p->pos = 0xDEADBEEF; /* -559038737 as an int */
668 gap_array_marker_freelist = p;
673 gap_array_move_marker (Gap_Array *ga, Gap_Array_Marker *m, int pos)
675 assert (pos >= 0 && pos <= ga->numels);
676 m->pos = GAP_ARRAY_ARRAY_TO_MEMORY_POS (ga, pos);
679 #define gap_array_marker_pos(ga, m) \
680 GAP_ARRAY_MEMORY_TO_ARRAY_POS (ga, (m)->pos)
683 make_gap_array (int elsize)
685 Gap_Array *ga = xnew_and_zero (Gap_Array);
691 free_gap_array (Gap_Array *ga)
695 gap_array_delete_all_markers (ga);
700 /************************************************************************/
701 /* Extent list primitives */
702 /************************************************************************/
704 /* A list of extents is maintained as a double gap array: one gap array
705 is ordered by start index (the "display order") and the other is
706 ordered by end index (the "e-order"). Note that positions in an
707 extent list should logically be conceived of as referring *to*
708 a particular extent (as is the norm in programs) rather than
709 sitting between two extents. Note also that callers of these
710 functions should not be aware of the fact that the extent list is
711 implemented as an array, except for the fact that positions are
712 integers (this should be generalized to handle integers and linked
716 /* Number of elements in an extent list */
717 #define extent_list_num_els(el) GAP_ARRAY_NUM_ELS(el->start)
719 /* Return the position at which EXTENT is located in the specified extent
720 list (in the display order if ENDP is 0, in the e-order otherwise).
721 If the extent is not found, the position where the extent would
722 be inserted is returned. If ENDP is 0, the insertion would go after
723 all other equal extents. If ENDP is not 0, the insertion would go
724 before all other equal extents. If FOUNDP is not 0, then whether
725 the extent was found will get written into it. */
728 extent_list_locate (Extent_List *el, EXTENT extent, int endp, int *foundp)
730 Gap_Array *ga = endp ? el->end : el->start;
731 int left = 0, right = GAP_ARRAY_NUM_ELS (ga);
732 int oldfoundpos, foundpos;
735 while (left != right)
737 /* RIGHT might not point to a valid extent (i.e. it's at the end
738 of the list), so NEWPOS must round down. */
739 unsigned int newpos = (left + right) >> 1;
740 EXTENT e = EXTENT_GAP_ARRAY_AT (ga, (int) newpos);
742 if (endp ? EXTENT_E_LESS (e, extent) : EXTENT_LESS (e, extent))
748 /* Now we're at the beginning of all equal extents. */
750 oldfoundpos = foundpos = left;
751 while (foundpos < GAP_ARRAY_NUM_ELS (ga))
753 EXTENT e = EXTENT_GAP_ARRAY_AT (ga, foundpos);
759 if (!EXTENT_EQUAL (e, extent))
771 /* Return the position of the first extent that begins at or after POS
772 (or ends at or after POS, if ENDP is not 0).
774 An out-of-range value for POS is allowed, and guarantees that the
775 position at the beginning or end of the extent list is returned. */
778 extent_list_locate_from_pos (Extent_List *el, Memind pos, int endp)
780 struct extent fake_extent;
783 Note that if we search for [POS, POS], then we get the following:
785 -- if ENDP is 0, then all extents whose start position is <= POS
786 lie before the returned position, and all extents whose start
787 position is > POS lie at or after the returned position.
789 -- if ENDP is not 0, then all extents whose end position is < POS
790 lie before the returned position, and all extents whose end
791 position is >= POS lie at or after the returned position.
794 set_extent_start (&fake_extent, endp ? pos : pos-1);
795 set_extent_end (&fake_extent, endp ? pos : pos-1);
796 return extent_list_locate (el, &fake_extent, endp, 0);
799 /* Return the extent at POS. */
802 extent_list_at (Extent_List *el, Memind pos, int endp)
804 Gap_Array *ga = endp ? el->end : el->start;
806 assert (pos >= 0 && pos < GAP_ARRAY_NUM_ELS (ga));
807 return EXTENT_GAP_ARRAY_AT (ga, pos);
810 /* Insert an extent into an extent list. */
813 extent_list_insert (Extent_List *el, EXTENT extent)
817 pos = extent_list_locate (el, extent, 0, &foundp);
819 gap_array_insert_els (el->start, pos, &extent, 1);
820 pos = extent_list_locate (el, extent, 1, &foundp);
822 gap_array_insert_els (el->end, pos, &extent, 1);
825 /* Delete an extent from an extent list. */
828 extent_list_delete (Extent_List *el, EXTENT extent)
832 pos = extent_list_locate (el, extent, 0, &foundp);
834 gap_array_delete_els (el->start, pos, 1);
835 pos = extent_list_locate (el, extent, 1, &foundp);
837 gap_array_delete_els (el->end, pos, 1);
841 extent_list_delete_all (Extent_List *el)
843 gap_array_delete_els (el->start, 0, GAP_ARRAY_NUM_ELS (el->start));
844 gap_array_delete_els (el->end, 0, GAP_ARRAY_NUM_ELS (el->end));
847 static Extent_List_Marker *
848 extent_list_make_marker (Extent_List *el, int pos, int endp)
850 Extent_List_Marker *m;
852 if (extent_list_marker_freelist)
854 m = extent_list_marker_freelist;
855 extent_list_marker_freelist = extent_list_marker_freelist->next;
858 m = xnew (Extent_List_Marker);
860 m->m = gap_array_make_marker (endp ? el->end : el->start, pos);
862 m->next = el->markers;
867 #define extent_list_move_marker(el, mkr, pos) \
868 gap_array_move_marker((mkr)->endp ? (el)->end : (el)->start, (mkr)->m, pos)
871 extent_list_delete_marker (Extent_List *el, Extent_List_Marker *m)
873 Extent_List_Marker *p, *prev;
875 for (prev = 0, p = el->markers; p && p != m; prev = p, p = p->next)
879 prev->next = p->next;
881 el->markers = p->next;
882 m->next = extent_list_marker_freelist;
883 extent_list_marker_freelist = m;
884 gap_array_delete_marker (m->endp ? el->end : el->start, m->m);
887 #define extent_list_marker_pos(el, mkr) \
888 gap_array_marker_pos ((mkr)->endp ? (el)->end : (el)->start, (mkr)->m)
891 allocate_extent_list (void)
893 Extent_List *el = xnew (Extent_List);
894 el->start = make_gap_array (sizeof(EXTENT));
895 el->end = make_gap_array (sizeof(EXTENT));
901 free_extent_list (Extent_List *el)
903 free_gap_array (el->start);
904 free_gap_array (el->end);
909 /************************************************************************/
910 /* Auxiliary extent structure */
911 /************************************************************************/
914 mark_extent_auxiliary (Lisp_Object obj, void (*markobj) (Lisp_Object))
916 struct extent_auxiliary *data = XEXTENT_AUXILIARY (obj);
917 ((markobj) (data->begin_glyph));
918 ((markobj) (data->end_glyph));
919 ((markobj) (data->invisible));
920 ((markobj) (data->children));
921 ((markobj) (data->read_only));
922 ((markobj) (data->mouse_face));
923 ((markobj) (data->initial_redisplay_function));
924 ((markobj) (data->before_change_functions));
925 ((markobj) (data->after_change_functions));
929 DEFINE_LRECORD_IMPLEMENTATION ("extent-auxiliary", extent_auxiliary,
930 mark_extent_auxiliary, internal_object_printer,
931 0, 0, 0, struct extent_auxiliary);
934 allocate_extent_auxiliary (EXTENT ext)
936 Lisp_Object extent_aux;
937 struct extent_auxiliary *data =
938 alloc_lcrecord_type (struct extent_auxiliary, lrecord_extent_auxiliary);
940 copy_lcrecord (data, &extent_auxiliary_defaults);
941 XSETEXTENT_AUXILIARY (extent_aux, data);
942 ext->plist = Fcons (extent_aux, ext->plist);
943 ext->flags.has_aux = 1;
947 /************************************************************************/
948 /* Extent info structure */
949 /************************************************************************/
951 /* An extent-info structure consists of a list of the buffer or string's
952 extents and a "stack of extents" that lists all of the extents over
953 a particular position. The stack-of-extents info is used for
954 optimization purposes -- it basically caches some info that might
955 be expensive to compute. Certain otherwise hard computations are easy
956 given the stack of extents over a particular position, and if the
957 stack of extents over a nearby position is known (because it was
958 calculated at some prior point in time), it's easy to move the stack
959 of extents to the proper position.
961 Given that the stack of extents is an optimization, and given that
962 it requires memory, a string's stack of extents is wiped out each
963 time a garbage collection occurs. Therefore, any time you retrieve
964 the stack of extents, it might not be there. If you need it to
965 be there, use the _force version.
967 Similarly, a string may or may not have an extent_info structure.
968 (Generally it won't if there haven't been any extents added to the
969 string.) So use the _force version if you need the extent_info
970 structure to be there. */
972 static struct stack_of_extents *allocate_soe (void);
973 static void free_soe (struct stack_of_extents *soe);
974 static void soe_invalidate (Lisp_Object obj);
977 mark_extent_info (Lisp_Object obj, void (*markobj) (Lisp_Object))
979 struct extent_info *data =
980 (struct extent_info *) XEXTENT_INFO (obj);
984 /* Vbuffer_defaults and Vbuffer_local_symbols are buffer-like
985 objects that are created specially and never have their extent
986 list initialized (or rather, it is set to zero in
987 nuke_all_buffer_slots()). However, these objects get
988 garbage-collected so we have to deal.
990 (Also the list can be zero when we're dealing with a destroyed
993 list = data->extents;
996 for (i = 0; i < extent_list_num_els (list); i++)
998 struct extent *extent = extent_list_at (list, i, 0);
1001 XSETEXTENT (exobj, extent);
1002 ((markobj) (exobj));
1010 finalize_extent_info (void *header, int for_disksave)
1012 struct extent_info *data = (struct extent_info *) header;
1019 free_soe (data->soe);
1024 free_extent_list (data->extents);
1029 DEFINE_LRECORD_IMPLEMENTATION ("extent-info", extent_info,
1030 mark_extent_info, internal_object_printer,
1031 finalize_extent_info, 0, 0,
1032 struct extent_info);
1035 allocate_extent_info (void)
1037 Lisp_Object extent_info;
1038 struct extent_info *data =
1039 alloc_lcrecord_type (struct extent_info, lrecord_extent_info);
1041 XSETEXTENT_INFO (extent_info, data);
1042 data->extents = allocate_extent_list ();
1048 flush_cached_extent_info (Lisp_Object extent_info)
1050 struct extent_info *data = XEXTENT_INFO (extent_info);
1054 free_soe (data->soe);
1060 /************************************************************************/
1061 /* Buffer/string extent primitives */
1062 /************************************************************************/
1064 /* The functions in this section are the ONLY ones that should know
1065 about the internal implementation of the extent lists. Other functions
1066 should only know that there are two orderings on extents, the "display"
1067 order (sorted by start position, basically) and the e-order (sorted
1068 by end position, basically), and that certain operations are provided
1069 to manipulate the list. */
1071 /* ------------------------------- */
1072 /* basic primitives */
1073 /* ------------------------------- */
1076 decode_buffer_or_string (Lisp_Object object)
1079 XSETBUFFER (object, current_buffer);
1080 else if (BUFFERP (object))
1081 CHECK_LIVE_BUFFER (object);
1082 else if (STRINGP (object))
1085 dead_wrong_type_argument (Qbuffer_or_string_p, object);
1091 extent_ancestor_1 (EXTENT e)
1093 while (e->flags.has_parent)
1095 /* There should be no circularities except in case of a logic
1096 error somewhere in the extent code */
1097 e = XEXTENT (XEXTENT_AUXILIARY (XCAR (e->plist))->parent);
1102 /* Given an extent object (string or buffer or nil), return its extent info.
1103 This may be 0 for a string. */
1105 static struct extent_info *
1106 buffer_or_string_extent_info (Lisp_Object object)
1108 if (STRINGP (object))
1110 Lisp_Object plist = XSTRING (object)->plist;
1111 if (!CONSP (plist) || !EXTENT_INFOP (XCAR (plist)))
1113 return XEXTENT_INFO (XCAR (plist));
1115 else if (NILP (object))
1118 return XEXTENT_INFO (XBUFFER (object)->extent_info);
1121 /* Given a string or buffer, return its extent list. This may be
1124 static Extent_List *
1125 buffer_or_string_extent_list (Lisp_Object object)
1127 struct extent_info *info = buffer_or_string_extent_info (object);
1131 return info->extents;
1134 /* Given a string or buffer, return its extent info. If it's not there,
1137 static struct extent_info *
1138 buffer_or_string_extent_info_force (Lisp_Object object)
1140 struct extent_info *info = buffer_or_string_extent_info (object);
1144 Lisp_Object extent_info;
1146 assert (STRINGP (object)); /* should never happen for buffers --
1147 the only buffers without an extent
1148 info are those after finalization,
1149 destroyed buffers, or special
1150 Lisp-inaccessible buffer objects. */
1151 extent_info = allocate_extent_info ();
1152 XSTRING (object)->plist = Fcons (extent_info, XSTRING (object)->plist);
1153 return XEXTENT_INFO (extent_info);
1159 /* Detach all the extents in OBJECT. Called from redisplay. */
1162 detach_all_extents (Lisp_Object object)
1164 struct extent_info *data = buffer_or_string_extent_info (object);
1172 for (i = 0; i < extent_list_num_els (data->extents); i++)
1174 EXTENT e = extent_list_at (data->extents, i, 0);
1175 /* No need to do detach_extent(). Just nuke the damn things,
1176 which results in the equivalent but faster. */
1177 set_extent_start (e, -1);
1178 set_extent_end (e, -1);
1182 /* But we need to clear all the lists containing extents or
1183 havoc will result. */
1184 extent_list_delete_all (data->extents);
1185 soe_invalidate (object);
1191 init_buffer_extents (struct buffer *b)
1193 b->extent_info = allocate_extent_info ();
1197 uninit_buffer_extents (struct buffer *b)
1199 struct extent_info *data = XEXTENT_INFO (b->extent_info);
1201 /* Don't destroy the extents here -- there may still be children
1202 extents pointing to the extents. */
1203 detach_all_extents (make_buffer (b));
1204 finalize_extent_info (data, 0);
1207 /* Retrieve the extent list that an extent is a member of; the
1208 return value will never be 0 except in destroyed buffers (in which
1209 case the only extents that can refer to this buffer are detached
1212 #define extent_extent_list(e) buffer_or_string_extent_list (extent_object (e))
1214 /* ------------------------------- */
1215 /* stack of extents */
1216 /* ------------------------------- */
1218 #ifdef ERROR_CHECK_EXTENTS
1221 sledgehammer_extent_check (Lisp_Object object)
1225 Extent_List *el = buffer_or_string_extent_list (object);
1226 struct buffer *buf = 0;
1231 if (BUFFERP (object))
1232 buf = XBUFFER (object);
1234 for (endp = 0; endp < 2; endp++)
1235 for (i = 1; i < extent_list_num_els (el); i++)
1237 EXTENT e1 = extent_list_at (el, i-1, endp);
1238 EXTENT e2 = extent_list_at (el, i, endp);
1241 assert (extent_start (e1) <= buf->text->gpt ||
1242 extent_start (e1) > buf->text->gpt + buf->text->gap_size);
1243 assert (extent_end (e1) <= buf->text->gpt ||
1244 extent_end (e1) > buf->text->gpt + buf->text->gap_size);
1246 assert (extent_start (e1) <= extent_end (e1));
1247 assert (endp ? (EXTENT_E_LESS_EQUAL (e1, e2)) :
1248 (EXTENT_LESS_EQUAL (e1, e2)));
1254 static Stack_Of_Extents *
1255 buffer_or_string_stack_of_extents (Lisp_Object object)
1257 struct extent_info *info = buffer_or_string_extent_info (object);
1263 static Stack_Of_Extents *
1264 buffer_or_string_stack_of_extents_force (Lisp_Object object)
1266 struct extent_info *info = buffer_or_string_extent_info_force (object);
1268 info->soe = allocate_soe ();
1272 /* #define SOE_DEBUG */
1276 static void print_extent_1 (char *buf, Lisp_Object extent);
1279 print_extent_2 (EXTENT e)
1284 XSETEXTENT (extent, e);
1285 print_extent_1 (buf, extent);
1286 fputs (buf, stdout);
1290 soe_dump (Lisp_Object obj)
1293 Stack_Of_Extents *soe = buffer_or_string_stack_of_extents (obj);
1303 printf ("SOE pos is %d (memind %d)\n",
1304 soe->pos < 0 ? soe->pos :
1305 buffer_or_string_memind_to_bytind (obj, soe->pos),
1307 for (endp = 0; endp < 2; endp++)
1309 printf (endp ? "SOE end:" : "SOE start:");
1310 for (i = 0; i < extent_list_num_els (sel); i++)
1312 EXTENT e = extent_list_at (sel, i, endp);
1323 /* Insert EXTENT into OBJ's stack of extents, if necessary. */
1326 soe_insert (Lisp_Object obj, EXTENT extent)
1328 Stack_Of_Extents *soe = buffer_or_string_stack_of_extents (obj);
1331 printf ("Inserting into SOE: ");
1332 print_extent_2 (extent);
1335 if (!soe || soe->pos < extent_start (extent) ||
1336 soe->pos > extent_end (extent))
1339 printf ("(not needed)\n\n");
1343 extent_list_insert (soe->extents, extent);
1345 puts ("SOE afterwards is:");
1350 /* Delete EXTENT from OBJ's stack of extents, if necessary. */
1353 soe_delete (Lisp_Object obj, EXTENT extent)
1355 Stack_Of_Extents *soe = buffer_or_string_stack_of_extents (obj);
1358 printf ("Deleting from SOE: ");
1359 print_extent_2 (extent);
1362 if (!soe || soe->pos < extent_start (extent) ||
1363 soe->pos > extent_end (extent))
1366 puts ("(not needed)\n");
1370 extent_list_delete (soe->extents, extent);
1372 puts ("SOE afterwards is:");
1377 /* Move OBJ's stack of extents to lie over the specified position. */
1380 soe_move (Lisp_Object obj, Memind pos)
1382 Stack_Of_Extents *soe = buffer_or_string_stack_of_extents_force (obj);
1383 Extent_List *sel = soe->extents;
1384 int numsoe = extent_list_num_els (sel);
1385 Extent_List *bel = buffer_or_string_extent_list (obj);
1389 #ifdef ERROR_CHECK_EXTENTS
1394 printf ("Moving SOE from %d (memind %d) to %d (memind %d)\n",
1395 soe->pos < 0 ? soe->pos :
1396 buffer_or_string_memind_to_bytind (obj, soe->pos), soe->pos,
1397 buffer_or_string_memind_to_bytind (obj, pos), pos);
1404 else if (soe->pos > pos)
1412 puts ("(not needed)\n");
1417 /* For DIRECTION = 1: Any extent that overlaps POS is either in the
1418 SOE (if the extent starts at or before SOE->POS) or is greater
1419 (in the display order) than any extent in the SOE (if it starts
1422 For DIRECTION = -1: Any extent that overlaps POS is either in the
1423 SOE (if the extent ends at or after SOE->POS) or is less (in the
1424 e-order) than any extent in the SOE (if it ends before SOE->POS).
1426 We proceed in two stages:
1428 1) delete all extents in the SOE that don't overlap POS.
1429 2) insert all extents into the SOE that start (or end, when
1430 DIRECTION = -1) in (SOE->POS, POS] and that overlap
1431 POS. (Don't include SOE->POS in the range because those
1432 extents would already be in the SOE.)
1439 /* Delete all extents in the SOE that don't overlap POS.
1440 This is all extents that end before (or start after,
1441 if DIRECTION = -1) POS.
1444 /* Deleting extents from the SOE is tricky because it changes
1445 the positions of extents. If we are deleting in the forward
1446 direction we have to call extent_list_at() on the same position
1447 over and over again because positions after the deleted element
1448 get shifted back by 1. To make life simplest, we delete forward
1449 irrespective of DIRECTION.
1457 end = extent_list_locate_from_pos (sel, pos, 1);
1461 start = extent_list_locate_from_pos (sel, pos+1, 0);
1465 for (i = start; i < end; i++)
1466 extent_list_delete (sel, extent_list_at (sel, start /* see above */,
1476 start_pos = extent_list_locate_from_pos (bel, soe->pos, endp) - 1;
1478 start_pos = extent_list_locate_from_pos (bel, soe->pos + 1, endp);
1480 for (; start_pos >= 0 && start_pos < extent_list_num_els (bel);
1481 start_pos += direction)
1483 EXTENT e = extent_list_at (bel, start_pos, endp);
1484 if ((direction > 0) ?
1485 (extent_start (e) > pos) :
1486 (extent_end (e) < pos))
1487 break; /* All further extents lie on the far side of POS
1488 and thus can't overlap. */
1489 if ((direction > 0) ?
1490 (extent_end (e) >= pos) :
1491 (extent_start (e) <= pos))
1492 extent_list_insert (sel, e);
1498 puts ("SOE afterwards is:");
1504 soe_invalidate (Lisp_Object obj)
1506 Stack_Of_Extents *soe = buffer_or_string_stack_of_extents (obj);
1510 extent_list_delete_all (soe->extents);
1515 static struct stack_of_extents *
1518 struct stack_of_extents *soe = xnew_and_zero (struct stack_of_extents);
1519 soe->extents = allocate_extent_list ();
1525 free_soe (struct stack_of_extents *soe)
1527 free_extent_list (soe->extents);
1531 /* ------------------------------- */
1532 /* other primitives */
1533 /* ------------------------------- */
1535 /* Return the start (endp == 0) or end (endp == 1) of an extent as
1536 a byte index. If you want the value as a memory index, use
1537 extent_endpoint(). If you want the value as a buffer position,
1538 use extent_endpoint_bufpos(). */
1541 extent_endpoint_bytind (EXTENT extent, int endp)
1543 assert (EXTENT_LIVE_P (extent));
1544 assert (!extent_detached_p (extent));
1546 Memind i = (endp) ? (extent_end (extent)) :
1547 (extent_start (extent));
1548 Lisp_Object obj = extent_object (extent);
1549 return buffer_or_string_memind_to_bytind (obj, i);
1554 extent_endpoint_bufpos (EXTENT extent, int endp)
1556 assert (EXTENT_LIVE_P (extent));
1557 assert (!extent_detached_p (extent));
1559 Memind i = (endp) ? (extent_end (extent)) :
1560 (extent_start (extent));
1561 Lisp_Object obj = extent_object (extent);
1562 return buffer_or_string_memind_to_bufpos (obj, i);
1566 /* A change to an extent occurred that will change the display, so
1567 notify redisplay. Maybe also recurse over all the extent's
1571 extent_changed_for_redisplay (EXTENT extent, int descendants_too,
1572 int invisibility_change)
1577 /* we could easily encounter a detached extent while traversing the
1578 children, but we should never be able to encounter a dead extent. */
1579 assert (EXTENT_LIVE_P (extent));
1581 if (descendants_too)
1583 Lisp_Object children = extent_children (extent);
1585 if (!NILP (children))
1587 /* first mark all of the extent's children. We will lose big-time
1588 if there are any circularities here, so we sure as hell better
1589 ensure that there aren't. */
1590 LIST_LOOP (rest, XWEAK_LIST_LIST (children))
1591 extent_changed_for_redisplay (XEXTENT (XCAR (rest)), 1,
1592 invisibility_change);
1596 /* now mark the extent itself. */
1598 object = extent_object (extent);
1600 if (!BUFFERP (object) || extent_detached_p (extent))
1601 /* #### Can changes to string extents affect redisplay?
1602 I will have to think about this. What about string glyphs?
1603 Things in the modeline? etc. */
1604 /* #### changes to string extents can certainly affect redisplay
1605 if the extent is in some generated-modeline-string: when
1606 we change an extent in generated-modeline-string, this changes
1607 its parent, which is in `modeline-format', so we should
1608 force the modeline to be updated. But how to determine whether
1609 a string is a `generated-modeline-string'? Looping through
1610 all buffers is not very efficient. Should we add all
1611 `generated-modeline-string' strings to a hashtable?
1612 Maybe efficiency is not the greatest concern here and there's
1613 no big loss in looping over the buffers. */
1618 b = XBUFFER (object);
1619 BUF_FACECHANGE (b)++;
1620 MARK_EXTENTS_CHANGED;
1621 if (invisibility_change)
1623 buffer_extent_signal_changed_region (b,
1624 extent_endpoint_bufpos (extent, 0),
1625 extent_endpoint_bufpos (extent, 1));
1629 /* A change to an extent occurred that might affect redisplay.
1630 This is called when properties such as the endpoints, the layout,
1631 or the priority changes. Redisplay will be affected only if
1632 the extent has any displayable attributes. */
1635 extent_maybe_changed_for_redisplay (EXTENT extent, int descendants_too,
1636 int invisibility_change)
1638 /* Retrieve the ancestor for efficiency */
1639 EXTENT anc = extent_ancestor (extent);
1640 if (!NILP (extent_face (anc)) ||
1641 !NILP (extent_begin_glyph (anc)) ||
1642 !NILP (extent_end_glyph (anc)) ||
1643 !NILP (extent_mouse_face (anc)) ||
1644 !NILP (extent_invisible (anc)) ||
1645 !NILP (extent_initial_redisplay_function (anc)) ||
1646 invisibility_change)
1647 extent_changed_for_redisplay (extent, descendants_too,
1648 invisibility_change);
1652 make_extent_detached (Lisp_Object object)
1654 EXTENT extent = allocate_extent ();
1656 assert (NILP (object) || STRINGP (object) ||
1657 (BUFFERP (object) && BUFFER_LIVE_P (XBUFFER (object))));
1658 extent_object (extent) = object;
1659 /* Now make sure the extent info exists. */
1661 buffer_or_string_extent_info_force (object);
1665 /* A "real" extent is any extent other than the internal (not-user-visible)
1666 extents used by `map-extents'. */
1669 real_extent_at_forward (Extent_List *el, int pos, int endp)
1671 for (; pos < extent_list_num_els (el); pos++)
1673 EXTENT e = extent_list_at (el, pos, endp);
1674 if (!extent_internal_p (e))
1681 real_extent_at_backward (Extent_List *el, int pos, int endp)
1683 for (; pos >= 0; pos--)
1685 EXTENT e = extent_list_at (el, pos, endp);
1686 if (!extent_internal_p (e))
1693 extent_first (Lisp_Object obj)
1695 Extent_List *el = buffer_or_string_extent_list (obj);
1699 return real_extent_at_forward (el, 0, 0);
1704 extent_e_first (Lisp_Object obj)
1706 Extent_List *el = buffer_or_string_extent_list (obj);
1710 return real_extent_at_forward (el, 0, 1);
1715 extent_next (EXTENT e)
1717 Extent_List *el = extent_extent_list (e);
1719 int pos = extent_list_locate (el, e, 0, &foundp);
1721 return real_extent_at_forward (el, pos+1, 0);
1726 extent_e_next (EXTENT e)
1728 Extent_List *el = extent_extent_list (e);
1730 int pos = extent_list_locate (el, e, 1, &foundp);
1732 return real_extent_at_forward (el, pos+1, 1);
1737 extent_last (Lisp_Object obj)
1739 Extent_List *el = buffer_or_string_extent_list (obj);
1743 return real_extent_at_backward (el, extent_list_num_els (el) - 1, 0);
1748 extent_e_last (Lisp_Object obj)
1750 Extent_List *el = buffer_or_string_extent_list (obj);
1754 return real_extent_at_backward (el, extent_list_num_els (el) - 1, 1);
1759 extent_previous (EXTENT e)
1761 Extent_List *el = extent_extent_list (e);
1763 int pos = extent_list_locate (el, e, 0, &foundp);
1765 return real_extent_at_backward (el, pos-1, 0);
1770 extent_e_previous (EXTENT e)
1772 Extent_List *el = extent_extent_list (e);
1774 int pos = extent_list_locate (el, e, 1, &foundp);
1776 return real_extent_at_backward (el, pos-1, 1);
1781 extent_attach (EXTENT extent)
1783 Extent_List *el = extent_extent_list (extent);
1785 extent_list_insert (el, extent);
1786 soe_insert (extent_object (extent), extent);
1787 /* only this extent changed */
1788 extent_maybe_changed_for_redisplay (extent, 0,
1789 !NILP (extent_invisible (extent)));
1793 extent_detach (EXTENT extent)
1797 if (extent_detached_p (extent))
1799 el = extent_extent_list (extent);
1801 /* call this before messing with the extent. */
1802 extent_maybe_changed_for_redisplay (extent, 0,
1803 !NILP (extent_invisible (extent)));
1804 extent_list_delete (el, extent);
1805 soe_delete (extent_object (extent), extent);
1806 set_extent_start (extent, -1);
1807 set_extent_end (extent, -1);
1810 /* ------------------------------- */
1811 /* map-extents et al. */
1812 /* ------------------------------- */
1814 /* Returns true iff map_extents() would visit the given extent.
1815 See the comments at map_extents() for info on the overlap rule.
1816 Assumes that all validation on the extent and buffer positions has
1817 already been performed (see Fextent_in_region_p ()).
1820 extent_in_region_p (EXTENT extent, Bytind from, Bytind to,
1823 Lisp_Object obj = extent_object (extent);
1824 Endpoint_Index start, end, exs, exe;
1825 int start_open, end_open;
1826 unsigned int all_extents_flags = flags & ME_ALL_EXTENTS_MASK;
1827 unsigned int in_region_flags = flags & ME_IN_REGION_MASK;
1830 /* A zero-length region is treated as closed-closed. */
1833 flags |= ME_END_CLOSED;
1834 flags &= ~ME_START_OPEN;
1837 switch (all_extents_flags)
1839 case ME_ALL_EXTENTS_CLOSED:
1840 start_open = end_open = 0; break;
1841 case ME_ALL_EXTENTS_OPEN:
1842 start_open = end_open = 1; break;
1843 case ME_ALL_EXTENTS_CLOSED_OPEN:
1844 start_open = 0; end_open = 1; break;
1845 case ME_ALL_EXTENTS_OPEN_CLOSED:
1846 start_open = 1; end_open = 0; break;
1848 start_open = extent_start_open_p (extent);
1849 end_open = extent_end_open_p (extent);
1853 /* So is a zero-length extent. */
1854 if (extent_start (extent) == extent_end (extent))
1855 start_open = end_open = 0;
1857 start = buffer_or_string_bytind_to_startind (obj, from,
1858 flags & ME_START_OPEN);
1859 end = buffer_or_string_bytind_to_endind (obj, to, ! (flags & ME_END_CLOSED));
1860 exs = memind_to_startind (extent_start (extent), start_open);
1861 exe = memind_to_endind (extent_end (extent), end_open);
1863 /* It's easy to determine whether an extent lies *outside* the
1864 region -- just determine whether it's completely before
1865 or completely after the region. Reject all such extents, so
1866 we're now left with only the extents that overlap the region.
1869 if (exs > end || exe < start)
1872 /* See if any further restrictions are called for. */
1873 switch (in_region_flags)
1875 case ME_START_IN_REGION:
1876 retval = start <= exs && exs <= end; break;
1877 case ME_END_IN_REGION:
1878 retval = start <= exe && exe <= end; break;
1879 case ME_START_AND_END_IN_REGION:
1880 retval = start <= exs && exe <= end; break;
1881 case ME_START_OR_END_IN_REGION:
1882 retval = (start <= exs && exs <= end) || (start <= exe && exe <= end);
1887 return flags & ME_NEGATE_IN_REGION ? !retval : retval;
1890 struct map_extents_struct
1893 Extent_List_Marker *mkr;
1898 map_extents_unwind (Lisp_Object obj)
1900 struct map_extents_struct *closure =
1901 (struct map_extents_struct *) get_opaque_ptr (obj);
1902 free_opaque_ptr (obj);
1904 extent_detach (closure->range);
1906 extent_list_delete_marker (closure->el, closure->mkr);
1910 /* This is the guts of `map-extents' and the other functions that
1911 map over extents. In theory the operation of this function is
1912 simple: just figure out what extents we're mapping over, and
1913 call the function on each one of them in the range. Unfortunately
1914 there are a wide variety of things that the mapping function
1915 might do, and we have to be very tricky to avoid getting messed
1916 up. Furthermore, this function needs to be very fast (it is
1917 called multiple times every time text is inserted or deleted
1918 from a buffer), and so we can't always afford the overhead of
1919 dealing with all the possible things that the mapping function
1920 might do; thus, there are many flags that can be specified
1921 indicating what the mapping function might or might not do.
1923 The result of all this is that this is the most complicated
1924 function in this file. Change it at your own risk!
1926 A potential simplification to the logic below is to determine
1927 all the extents that the mapping function should be called on
1928 before any calls are actually made and save them in an array.
1929 That introduces its own complications, however (the array
1930 needs to be marked for garbage-collection, and a static array
1931 cannot be used because map_extents() needs to be reentrant).
1932 Furthermore, the results might be a little less sensible than
1937 map_extents_bytind (Bytind from, Bytind to, map_extents_fun fn, void *arg,
1938 Lisp_Object obj, EXTENT after, unsigned int flags)
1940 Memind st, en; /* range we're mapping over */
1941 EXTENT range = 0; /* extent for this, if ME_MIGHT_MODIFY_TEXT */
1942 Extent_List *el = 0; /* extent list we're iterating over */
1943 Extent_List_Marker *posm = 0; /* marker for extent list,
1944 if ME_MIGHT_MODIFY_EXTENTS */
1945 /* count and struct for unwind-protect, if ME_MIGHT_THROW */
1947 struct map_extents_struct closure;
1949 #ifdef ERROR_CHECK_EXTENTS
1950 assert (from <= to);
1951 assert (from >= buffer_or_string_absolute_begin_byte (obj) &&
1952 from <= buffer_or_string_absolute_end_byte (obj) &&
1953 to >= buffer_or_string_absolute_begin_byte (obj) &&
1954 to <= buffer_or_string_absolute_end_byte (obj));
1959 assert (EQ (obj, extent_object (after)));
1960 assert (!extent_detached_p (after));
1963 el = buffer_or_string_extent_list (obj);
1964 if (!el || !extent_list_num_els(el))
1968 st = buffer_or_string_bytind_to_memind (obj, from);
1969 en = buffer_or_string_bytind_to_memind (obj, to);
1971 if (flags & ME_MIGHT_MODIFY_TEXT)
1973 /* The mapping function might change the text in the buffer,
1974 so make an internal extent to hold the range we're mapping
1976 range = make_extent_detached (obj);
1977 set_extent_start (range, st);
1978 set_extent_end (range, en);
1979 range->flags.start_open = flags & ME_START_OPEN;
1980 range->flags.end_open = !(flags & ME_END_CLOSED);
1981 range->flags.internal = 1;
1982 range->flags.detachable = 0;
1983 extent_attach (range);
1986 if (flags & ME_MIGHT_THROW)
1988 /* The mapping function might throw past us so we need to use an
1989 unwind_protect() to eliminate the internal extent and range
1991 count = specpdl_depth ();
1992 closure.range = range;
1994 record_unwind_protect (map_extents_unwind,
1995 make_opaque_ptr (&closure));
1998 /* ---------- Figure out where we start and what direction
1999 we move in. This is the trickiest part of this
2000 function. ---------- */
2002 /* If ME_START_IN_REGION, ME_END_IN_REGION or ME_START_AND_END_IN_REGION
2003 was specified and ME_NEGATE_IN_REGION was not specified, our job
2004 is simple because of the presence of the display order and e-order.
2005 (Note that theoretically do something similar for
2006 ME_START_OR_END_IN_REGION, but that would require more trickiness
2007 than it's worth to avoid hitting the same extent twice.)
2009 In the general case, all the extents that overlap a range can be
2010 divided into two classes: those whose start position lies within
2011 the range (including the range's end but not including the
2012 range's start), and those that overlap the start position,
2013 i.e. those in the SOE for the start position. Or equivalently,
2014 the extents can be divided into those whose end position lies
2015 within the range and those in the SOE for the end position. Note
2016 that for this purpose we treat both the range and all extents in
2017 the buffer as closed on both ends. If this is not what the ME_
2018 flags specified, then we've mapped over a few too many extents,
2019 but no big deal because extent_in_region_p() will filter them
2020 out. Ideally, we could move the SOE to the closer of the range's
2021 two ends and work forwards or backwards from there. However, in
2022 order to make the semantics of the AFTER argument work out, we
2023 have to always go in the same direction; so we choose to always
2024 move the SOE to the start position.
2026 When it comes time to do the SOE stage, we first call soe_move()
2027 so that the SOE gets set up. Note that the SOE might get
2028 changed while we are mapping over its contents. If we can
2029 guarantee that the SOE won't get moved to a new position, we
2030 simply need to put a marker in the SOE and we will track deletions
2031 and insertions of extents in the SOE. If the SOE might get moved,
2032 however (this would happen as a result of a recursive invocation
2033 of map-extents or a call to a redisplay-type function), then
2034 trying to track its changes is hopeless, so we just keep a
2035 marker to the first (or last) extent in the SOE and use that as
2038 Finally, if DONT_USE_SOE is defined, we don't use the SOE at all
2039 and instead just map from the beginning of the buffer. This is
2040 used for testing purposes and allows the SOE to be calculated
2041 using map_extents() instead of the other way around. */
2044 int range_flag; /* ME_*_IN_REGION subset of flags */
2045 int do_soe_stage = 0; /* Are we mapping over the SOE? */
2046 /* Does the range stage map over start or end positions? */
2048 /* If type == 0, we include the start position in the range stage mapping.
2049 If type == 1, we exclude the start position in the range stage mapping.
2050 If type == 2, we begin at range_start_pos, an extent-list position.
2052 int range_start_type = 0;
2053 int range_start_pos = 0;
2056 range_flag = flags & ME_IN_REGION_MASK;
2057 if ((range_flag == ME_START_IN_REGION ||
2058 range_flag == ME_START_AND_END_IN_REGION) &&
2059 !(flags & ME_NEGATE_IN_REGION))
2061 /* map over start position in [range-start, range-end]. No SOE
2065 else if (range_flag == ME_END_IN_REGION && !(flags & ME_NEGATE_IN_REGION))
2067 /* map over end position in [range-start, range-end]. No SOE
2073 /* Need to include the SOE extents. */
2075 /* Just brute-force it: start from the beginning. */
2077 range_start_type = 2;
2078 range_start_pos = 0;
2080 Stack_Of_Extents *soe = buffer_or_string_stack_of_extents_force (obj);
2083 /* Move the SOE to the closer end of the range. This dictates
2084 whether we map over start positions or end positions. */
2087 numsoe = extent_list_num_els (soe->extents);
2090 if (flags & ME_MIGHT_MOVE_SOE)
2093 /* Can't map over SOE, so just extend range to cover the
2095 EXTENT e = extent_list_at (soe->extents, 0, 0);
2097 extent_list_locate (buffer_or_string_extent_list (obj), e, 0,
2100 range_start_type = 2;
2104 /* We can map over the SOE. */
2106 range_start_type = 1;
2111 /* No extents in the SOE to map over, so we act just as if
2112 ME_START_IN_REGION or ME_END_IN_REGION was specified.
2113 RANGE_ENDP already specified so no need to do anything else. */
2118 /* ---------- Now loop over the extents. ---------- */
2120 /* We combine the code for the two stages because much of it
2122 for (stage = 0; stage < 2; stage++)
2124 int pos = 0; /* Position in extent list */
2126 /* First set up start conditions */
2128 { /* The SOE stage */
2131 el = buffer_or_string_stack_of_extents_force (obj)->extents;
2132 /* We will always be looping over start extents here. */
2133 assert (!range_endp);
2137 { /* The range stage */
2138 el = buffer_or_string_extent_list (obj);
2139 switch (range_start_type)
2142 pos = extent_list_locate_from_pos (el, st, range_endp);
2145 pos = extent_list_locate_from_pos (el, st + 1, range_endp);
2148 pos = range_start_pos;
2153 if (flags & ME_MIGHT_MODIFY_EXTENTS)
2155 /* Create a marker to track changes to the extent list */
2157 /* Delete the marker used in the SOE stage. */
2158 extent_list_delete_marker
2159 (buffer_or_string_stack_of_extents_force (obj)->extents, posm);
2160 posm = extent_list_make_marker (el, pos, range_endp);
2161 /* tell the unwind function about the marker. */
2172 /* ----- update position in extent list
2173 and fetch next extent ----- */
2176 /* fetch POS again to track extent insertions or deletions */
2177 pos = extent_list_marker_pos (el, posm);
2178 if (pos >= extent_list_num_els (el))
2180 e = extent_list_at (el, pos, range_endp);
2183 /* now point the marker to the next one we're going to process.
2184 This ensures graceful behavior if this extent is deleted. */
2185 extent_list_move_marker (el, posm, pos);
2187 /* ----- deal with internal extents ----- */
2189 if (extent_internal_p (e))
2191 if (!(flags & ME_INCLUDE_INTERNAL))
2193 else if (e == range)
2195 /* We're processing internal extents and we've
2196 come across our own special range extent.
2197 (This happens only in adjust_extents*() and
2198 process_extents*(), which handle text
2199 insertion and deletion.) We need to omit
2200 processing of this extent; otherwise
2201 we will probably end up prematurely
2202 terminating this loop. */
2207 /* ----- deal with AFTER condition ----- */
2211 /* if e > after, then we can stop skipping extents. */
2212 if (EXTENT_LESS (after, e))
2214 else /* otherwise, skip this extent. */
2218 /* ----- stop if we're completely outside the range ----- */
2220 /* fetch ST and EN again to track text insertions or deletions */
2223 st = extent_start (range);
2224 en = extent_end (range);
2226 if (extent_endpoint (e, range_endp) > en)
2228 /* Can't be mapping over SOE because all extents in
2229 there should overlap ST */
2230 assert (stage == 1);
2234 /* ----- Now actually call the function ----- */
2236 obj2 = extent_object (e);
2237 if (extent_in_region_p (e,
2238 buffer_or_string_memind_to_bytind (obj2,
2240 buffer_or_string_memind_to_bytind (obj2,
2246 /* Function wants us to stop mapping. */
2247 stage = 1; /* so outer for loop will terminate */
2253 /* ---------- Finished looping. ---------- */
2256 if (flags & ME_MIGHT_THROW)
2257 /* This deletes the range extent and frees the marker. */
2258 unbind_to (count, Qnil);
2261 /* Delete them ourselves */
2263 extent_detach (range);
2265 extent_list_delete_marker (el, posm);
2270 map_extents (Bufpos from, Bufpos to, map_extents_fun fn,
2271 void *arg, Lisp_Object obj, EXTENT after, unsigned int flags)
2273 map_extents_bytind (buffer_or_string_bufpos_to_bytind (obj, from),
2274 buffer_or_string_bufpos_to_bytind (obj, to), fn, arg,
2278 /* ------------------------------- */
2279 /* adjust_extents() */
2280 /* ------------------------------- */
2282 /* Add AMOUNT to all extent endpoints in the range (FROM, TO]. This
2283 happens whenever the gap is moved or (under Mule) a character in a
2284 string is substituted for a different-length one. The reason for
2285 this is that extent endpoints behave just like markers (all memory
2286 indices do) and this adjustment correct for markers -- see
2287 adjust_markers(). Note that it is important that we visit all
2288 extent endpoints in the range, irrespective of whether the
2289 endpoints are open or closed.
2291 We could use map_extents() for this (and in fact the function
2292 was originally written that way), but the gap is in an incoherent
2293 state when this function is called and this function plays
2294 around with extent endpoints without detaching and reattaching
2295 the extents (this is provably correct and saves lots of time),
2296 so for safety we make it just look at the extent lists directly. */
2299 adjust_extents (Lisp_Object obj, Memind from, Memind to, int amount)
2305 Stack_Of_Extents *soe;
2307 #ifdef ERROR_CHECK_EXTENTS
2308 sledgehammer_extent_check (obj);
2310 el = buffer_or_string_extent_list (obj);
2312 if (!el || !extent_list_num_els(el))
2315 /* IMPORTANT! Compute the starting positions of the extents to
2316 modify BEFORE doing any modification! Otherwise the starting
2317 position for the second time through the loop might get
2318 incorrectly calculated (I got bit by this bug real bad). */
2319 startpos[0] = extent_list_locate_from_pos (el, from+1, 0);
2320 startpos[1] = extent_list_locate_from_pos (el, from+1, 1);
2321 for (endp = 0; endp < 2; endp++)
2323 for (pos = startpos[endp]; pos < extent_list_num_els (el);
2326 EXTENT e = extent_list_at (el, pos, endp);
2327 if (extent_endpoint (e, endp) > to)
2329 set_extent_endpoint (e,
2330 do_marker_adjustment (extent_endpoint (e, endp),
2336 /* The index for the buffer's SOE is a memory index and thus
2337 needs to be adjusted like a marker. */
2338 soe = buffer_or_string_stack_of_extents (obj);
2339 if (soe && soe->pos >= 0)
2340 soe->pos = do_marker_adjustment (soe->pos, from, to, amount);
2343 /* ------------------------------- */
2344 /* adjust_extents_for_deletion() */
2345 /* ------------------------------- */
2347 struct adjust_extents_for_deletion_arg
2349 EXTENT_dynarr *list;
2353 adjust_extents_for_deletion_mapper (EXTENT extent, void *arg)
2355 struct adjust_extents_for_deletion_arg *closure =
2356 (struct adjust_extents_for_deletion_arg *) arg;
2358 Dynarr_add (closure->list, extent);
2359 return 0; /* continue mapping */
2362 /* For all extent endpoints in the range (FROM, TO], move them to the beginning
2363 of the new gap. Note that it is important that we visit all extent
2364 endpoints in the range, irrespective of whether the endpoints are open or
2367 This function deals with weird stuff such as the fact that extents
2370 There is no string correspondent for this because you can't
2371 delete characters from a string.
2375 adjust_extents_for_deletion (Lisp_Object object, Bytind from,
2376 Bytind to, int gapsize, int numdel,
2379 struct adjust_extents_for_deletion_arg closure;
2381 Memind adjust_to = (Memind) (to + gapsize);
2382 Bytecount amount = - numdel - movegapsize;
2383 Memind oldsoe = 0, newsoe = 0;
2384 Stack_Of_Extents *soe = buffer_or_string_stack_of_extents (object);
2386 #ifdef ERROR_CHECK_EXTENTS
2387 sledgehammer_extent_check (object);
2389 closure.list = Dynarr_new (EXTENT);
2391 /* We're going to be playing weird games below with extents and the SOE
2392 and such, so compute the list now of all the extents that we're going
2393 to muck with. If we do the mapping and adjusting together, things can
2394 get all screwed up. */
2396 map_extents_bytind (from, to, adjust_extents_for_deletion_mapper,
2397 (void *) &closure, object, 0,
2398 /* extent endpoints move like markers regardless
2399 of their open/closeness. */
2400 ME_ALL_EXTENTS_CLOSED | ME_END_CLOSED |
2401 ME_START_OR_END_IN_REGION | ME_INCLUDE_INTERNAL);
2404 Old and new values for the SOE's position. (It gets adjusted
2405 like a marker, just like extent endpoints.)
2412 newsoe = do_marker_adjustment (soe->pos,
2413 adjust_to, adjust_to,
2419 for (i = 0; i < Dynarr_length (closure.list); i++)
2421 EXTENT extent = Dynarr_at (closure.list, i);
2422 Memind new_start = extent_start (extent);
2423 Memind new_end = extent_end (extent);
2425 /* do_marker_adjustment() will not adjust values that should not be
2426 adjusted. We're passing the same funky arguments to
2427 do_marker_adjustment() as buffer_delete_range() does. */
2429 do_marker_adjustment (new_start,
2430 adjust_to, adjust_to,
2433 do_marker_adjustment (new_end,
2434 adjust_to, adjust_to,
2437 /* We need to be very careful here so that the SOE doesn't get
2438 corrupted. We are shrinking extents out of the deleted region
2439 and simultaneously moving the SOE's pos out of the deleted
2440 region, so the SOE should contain the same extents at the end
2441 as at the beginning. However, extents may get reordered
2442 by this process, so we have to operate by pulling the extents
2443 out of the buffer and SOE, changing their bounds, and then
2444 reinserting them. In order for the SOE not to get screwed up,
2445 we have to make sure that the SOE's pos points to its old
2446 location whenever we pull an extent out, and points to its
2447 new location whenever we put the extent back in.
2450 if (new_start != extent_start (extent) ||
2451 new_end != extent_end (extent))
2453 extent_detach (extent);
2454 set_extent_start (extent, new_start);
2455 set_extent_end (extent, new_end);
2458 extent_attach (extent);
2467 #ifdef ERROR_CHECK_EXTENTS
2468 sledgehammer_extent_check (object);
2470 Dynarr_free (closure.list);
2473 /* ------------------------------- */
2474 /* extent fragments */
2475 /* ------------------------------- */
2477 /* Imagine that the buffer is divided up into contiguous,
2478 nonoverlapping "runs" of text such that no extent
2479 starts or ends within a run (extents that abut the
2482 An extent fragment is a structure that holds data about
2483 the run that contains a particular buffer position (if
2484 the buffer position is at the junction of two runs, the
2485 run after the position is used) -- the beginning and
2486 end of the run, a list of all of the extents in that
2487 run, the "merged face" that results from merging all of
2488 the faces corresponding to those extents, the begin and
2489 end glyphs at the beginning of the run, etc. This is
2490 the information that redisplay needs in order to
2493 Extent fragments have to be very quick to update to
2494 a new buffer position when moving linearly through
2495 the buffer. They rely on the stack-of-extents code,
2496 which does the heavy-duty algorithmic work of determining
2497 which extents overly a particular position. */
2499 /* This function returns the position of the beginning of
2500 the first run that begins after POS, or returns POS if
2501 there are no such runs. */
2504 extent_find_end_of_run (Lisp_Object obj, Bytind pos, int outside_accessible)
2507 Extent_List *bel = buffer_or_string_extent_list (obj);
2510 Memind mempos = buffer_or_string_bytind_to_memind (obj, pos);
2511 Bytind limit = outside_accessible ?
2512 buffer_or_string_absolute_end_byte (obj) :
2513 buffer_or_string_accessible_end_byte (obj);
2515 if (!bel || !extent_list_num_els(bel))
2518 sel = buffer_or_string_stack_of_extents_force (obj)->extents;
2519 soe_move (obj, mempos);
2521 /* Find the first start position after POS. */
2522 elind1 = extent_list_locate_from_pos (bel, mempos+1, 0);
2523 if (elind1 < extent_list_num_els (bel))
2524 pos1 = buffer_or_string_memind_to_bytind
2525 (obj, extent_start (extent_list_at (bel, elind1, 0)));
2529 /* Find the first end position after POS. The extent corresponding
2530 to this position is either in the SOE or is greater than or
2531 equal to POS1, so we just have to look in the SOE. */
2532 elind2 = extent_list_locate_from_pos (sel, mempos+1, 1);
2533 if (elind2 < extent_list_num_els (sel))
2534 pos2 = buffer_or_string_memind_to_bytind
2535 (obj, extent_end (extent_list_at (sel, elind2, 1)));
2539 return min (min (pos1, pos2), limit);
2543 extent_find_beginning_of_run (Lisp_Object obj, Bytind pos,
2544 int outside_accessible)
2547 Extent_List *bel = buffer_or_string_extent_list (obj);
2550 Memind mempos = buffer_or_string_bytind_to_memind (obj, pos);
2551 Bytind limit = outside_accessible ?
2552 buffer_or_string_absolute_begin_byte (obj) :
2553 buffer_or_string_accessible_begin_byte (obj);
2555 if (!bel || !extent_list_num_els(bel))
2558 sel = buffer_or_string_stack_of_extents_force (obj)->extents;
2559 soe_move (obj, mempos);
2561 /* Find the first end position before POS. */
2562 elind1 = extent_list_locate_from_pos (bel, mempos, 1);
2564 pos1 = buffer_or_string_memind_to_bytind
2565 (obj, extent_end (extent_list_at (bel, elind1 - 1, 1)));
2569 /* Find the first start position before POS. The extent corresponding
2570 to this position is either in the SOE or is less than or
2571 equal to POS1, so we just have to look in the SOE. */
2572 elind2 = extent_list_locate_from_pos (sel, mempos, 0);
2574 pos2 = buffer_or_string_memind_to_bytind
2575 (obj, extent_start (extent_list_at (sel, elind2 - 1, 0)));
2579 return max (max (pos1, pos2), limit);
2582 struct extent_fragment *
2583 extent_fragment_new (Lisp_Object buffer_or_string, struct frame *frm)
2585 struct extent_fragment *ef = xnew_and_zero (struct extent_fragment);
2587 ef->object = buffer_or_string;
2589 ef->extents = Dynarr_new (EXTENT);
2590 ef->begin_glyphs = Dynarr_new (glyph_block);
2591 ef->end_glyphs = Dynarr_new (glyph_block);
2597 extent_fragment_delete (struct extent_fragment *ef)
2599 Dynarr_free (ef->extents);
2600 Dynarr_free (ef->begin_glyphs);
2601 Dynarr_free (ef->end_glyphs);
2605 /* Note: CONST is losing, but `const' is part of the interface of qsort() */
2607 extent_priority_sort_function (const void *humpty, const void *dumpty)
2609 CONST EXTENT foo = * (CONST EXTENT *) humpty;
2610 CONST EXTENT bar = * (CONST EXTENT *) dumpty;
2611 if (extent_priority (foo) < extent_priority (bar))
2613 return extent_priority (foo) > extent_priority (bar);
2617 extent_fragment_sort_by_priority (EXTENT_dynarr *extarr)
2621 /* Sort our copy of the stack by extent_priority. We use a bubble
2622 sort here because it's going to be faster than qsort() for small
2623 numbers of extents (less than 10 or so), and 99.999% of the time
2624 there won't ever be more extents than this in the stack. */
2625 if (Dynarr_length (extarr) < 10)
2627 for (i = 1; i < Dynarr_length (extarr); i++)
2631 (extent_priority (Dynarr_at (extarr, j)) >
2632 extent_priority (Dynarr_at (extarr, j+1))))
2634 EXTENT tmp = Dynarr_at (extarr, j);
2635 Dynarr_at (extarr, j) = Dynarr_at (extarr, j+1);
2636 Dynarr_at (extarr, j+1) = tmp;
2642 /* But some loser programs mess up and may create a large number
2643 of extents overlapping the same spot. This will result in
2644 catastrophic behavior if we use the bubble sort above. */
2645 qsort (Dynarr_atp (extarr, 0), Dynarr_length (extarr),
2646 sizeof (EXTENT), extent_priority_sort_function);
2649 /* If PROP is the `invisible' property of an extent,
2650 this is 1 if the extent should be treated as invisible. */
2652 #define EXTENT_PROP_MEANS_INVISIBLE(buf, prop) \
2653 (EQ (buf->invisibility_spec, Qt) \
2655 : invisible_p (prop, buf->invisibility_spec))
2657 /* If PROP is the `invisible' property of a extent,
2658 this is 1 if the extent should be treated as invisible
2659 and should have an ellipsis. */
2661 #define EXTENT_PROP_MEANS_INVISIBLE_WITH_ELLIPSIS(buf, prop) \
2662 (EQ (buf->invisibility_spec, Qt) \
2664 : invisible_ellipsis_p (prop, buf->invisibility_spec))
2666 /* This is like a combination of memq and assq.
2667 Return 1 if PROPVAL appears as an element of LIST
2668 or as the car of an element of LIST.
2669 If PROPVAL is a list, compare each element against LIST
2670 in that way, and return 1 if any element of PROPVAL is found in LIST.
2672 This function cannot quit. */
2675 invisible_p (REGISTER Lisp_Object propval, Lisp_Object list)
2677 REGISTER Lisp_Object tail, proptail;
2678 for (tail = list; CONSP (tail); tail = XCDR (tail))
2680 REGISTER Lisp_Object tem;
2682 if (EQ (propval, tem))
2684 if (CONSP (tem) && EQ (propval, XCAR (tem)))
2687 if (CONSP (propval))
2688 for (proptail = propval; CONSP (proptail);
2689 proptail = XCDR (proptail))
2691 Lisp_Object propelt;
2692 propelt = XCAR (proptail);
2693 for (tail = list; CONSP (tail); tail = XCDR (tail))
2695 REGISTER Lisp_Object tem;
2697 if (EQ (propelt, tem))
2699 if (CONSP (tem) && EQ (propelt, XCAR (tem)))
2706 /* Return 1 if PROPVAL appears as the car of an element of LIST
2707 and the cdr of that element is non-nil.
2708 If PROPVAL is a list, check each element of PROPVAL in that way,
2709 and the first time some element is found,
2710 return 1 if the cdr of that element is non-nil.
2712 This function cannot quit. */
2715 invisible_ellipsis_p (REGISTER Lisp_Object propval, Lisp_Object list)
2717 REGISTER Lisp_Object tail, proptail;
2718 for (tail = list; CONSP (tail); tail = XCDR (tail))
2720 REGISTER Lisp_Object tem;
2722 if (CONSP (tem) && EQ (propval, XCAR (tem)))
2723 return ! NILP (XCDR (tem));
2725 if (CONSP (propval))
2726 for (proptail = propval; CONSP (proptail);
2727 proptail = XCDR (proptail))
2729 Lisp_Object propelt;
2730 propelt = XCAR (proptail);
2731 for (tail = list; CONSP (tail); tail = XCDR (tail))
2733 REGISTER Lisp_Object tem;
2735 if (CONSP (tem) && EQ (propelt, XCAR (tem)))
2736 return ! NILP (XCDR (tem));
2743 extent_fragment_update (struct window *w, struct extent_fragment *ef,
2748 buffer_or_string_stack_of_extents_force (ef->object)->extents;
2750 struct extent dummy_lhe_extent;
2751 Memind mempos = buffer_or_string_bytind_to_memind (ef->object, pos);
2753 #ifdef ERROR_CHECK_EXTENTS
2754 assert (pos >= buffer_or_string_accessible_begin_byte (ef->object)
2755 && pos <= buffer_or_string_accessible_end_byte (ef->object));
2758 Dynarr_reset (ef->extents);
2759 Dynarr_reset (ef->begin_glyphs);
2760 Dynarr_reset (ef->end_glyphs);
2762 ef->previously_invisible = ef->invisible;
2765 if (ef->invisible_ellipses)
2766 ef->invisible_ellipses_already_displayed = 1;
2769 ef->invisible_ellipses_already_displayed = 0;
2771 ef->invisible_ellipses = 0;
2773 /* Set up the begin and end positions. */
2775 ef->end = extent_find_end_of_run (ef->object, pos, 0);
2777 /* Note that extent_find_end_of_run() already moved the SOE for us. */
2778 /* soe_move (ef->object, mempos); */
2780 /* Determine the begin glyphs at POS. */
2781 for (i = 0; i < extent_list_num_els (sel); i++)
2783 EXTENT e = extent_list_at (sel, i, 0);
2784 if (extent_start (e) == mempos && !NILP (extent_begin_glyph (e)))
2786 Lisp_Object glyph = extent_begin_glyph (e);
2787 struct glyph_block gb;
2790 XSETEXTENT (gb.extent, e);
2791 Dynarr_add (ef->begin_glyphs, gb);
2795 /* Determine the end glyphs at POS. */
2796 for (i = 0; i < extent_list_num_els (sel); i++)
2798 EXTENT e = extent_list_at (sel, i, 1);
2799 if (extent_end (e) == mempos && !NILP (extent_end_glyph (e)))
2801 Lisp_Object glyph = extent_end_glyph (e);
2802 struct glyph_block gb;
2805 XSETEXTENT (gb.extent, e);
2806 Dynarr_add (ef->end_glyphs, gb);
2810 /* We tried determining all the charsets used in the run here,
2811 but that fails even if we only do the current line -- display
2812 tables or non-printable characters might cause other charsets
2815 /* Determine whether the last-highlighted-extent is present. */
2816 if (EXTENTP (Vlast_highlighted_extent))
2817 lhe = XEXTENT (Vlast_highlighted_extent);
2819 /* Now add all extents that overlap the character after POS and
2820 have a non-nil face. Also check if the character is invisible. */
2821 for (i = 0; i < extent_list_num_els (sel); i++)
2823 EXTENT e = extent_list_at (sel, i, 0);
2824 if (extent_end (e) > mempos)
2826 Lisp_Object invis_prop = extent_invisible (e);
2828 if (!NILP (invis_prop))
2830 if (!BUFFERP (ef->object))
2831 /* #### no `string-invisibility-spec' */
2835 if (!ef->invisible_ellipses_already_displayed &&
2836 EXTENT_PROP_MEANS_INVISIBLE_WITH_ELLIPSIS
2837 (XBUFFER (ef->object), invis_prop))
2840 ef->invisible_ellipses = 1;
2842 else if (EXTENT_PROP_MEANS_INVISIBLE
2843 (XBUFFER (ef->object), invis_prop))
2848 /* Remember that one of the extents in the list might be our
2849 dummy extent representing the highlighting that is
2850 attached to some other extent that is currently
2851 mouse-highlighted. When an extent is mouse-highlighted,
2852 it is as if there are two extents there, of potentially
2853 different priorities: the extent being highlighted, with
2854 whatever face and priority it has; and an ephemeral
2855 extent in the `mouse-face' face with
2856 `mouse-highlight-priority'.
2859 if (!NILP (extent_face (e)))
2860 Dynarr_add (ef->extents, e);
2864 /* zeroing isn't really necessary; we only deref `priority'
2866 xzero (dummy_lhe_extent);
2867 set_extent_priority (&dummy_lhe_extent,
2868 mouse_highlight_priority);
2869 /* Need to break up thefollowing expression, due to an */
2870 /* error in the Digital UNIX 3.2g C compiler (Digital */
2871 /* UNIX Compiler Driver 3.11). */
2872 f = extent_mouse_face (lhe);
2873 extent_face (&dummy_lhe_extent) = f;
2874 Dynarr_add (ef->extents, &dummy_lhe_extent);
2876 /* since we are looping anyway, we might as well do this here */
2877 if ((!NILP(extent_initial_redisplay_function (e))) &&
2878 !extent_in_red_event_p(e))
2880 Lisp_Object function = extent_initial_redisplay_function (e);
2883 /* printf ("initial redisplay function called!\n "); */
2885 /* print_extent_2 (e);
2888 /* FIXME: One should probably inhibit the displaying of
2889 this extent to reduce flicker */
2890 extent_in_red_event_p(e) = 1;
2892 /* call the function */
2895 Fenqueue_eval_event(function,obj);
2900 extent_fragment_sort_by_priority (ef->extents);
2902 /* Now merge the faces together into a single face. The code to
2903 do this is in faces.c because it involves manipulating faces. */
2904 return get_extent_fragment_face_cache_index (w, ef);
2908 /************************************************************************/
2909 /* extent-object methods */
2910 /************************************************************************/
2912 /* These are the basic helper functions for handling the allocation of
2913 extent objects. They are similar to the functions for other
2914 lrecord objects. allocate_extent() is in alloc.c, not here. */
2916 static Lisp_Object mark_extent (Lisp_Object, void (*) (Lisp_Object));
2917 static int extent_equal (Lisp_Object, Lisp_Object, int depth);
2918 static unsigned long extent_hash (Lisp_Object obj, int depth);
2919 static void print_extent (Lisp_Object obj, Lisp_Object printcharfun,
2921 static Lisp_Object extent_getprop (Lisp_Object obj, Lisp_Object prop);
2922 static int extent_putprop (Lisp_Object obj, Lisp_Object prop,
2924 static int extent_remprop (Lisp_Object obj, Lisp_Object prop);
2925 static Lisp_Object extent_plist (Lisp_Object obj);
2927 DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS ("extent", extent,
2930 /* NOTE: If you declare a
2931 finalization method here,
2932 it will NOT be called.
2935 extent_equal, extent_hash,
2936 extent_getprop, extent_putprop,
2937 extent_remprop, extent_plist,
2941 mark_extent (Lisp_Object obj, void (*markobj) (Lisp_Object))
2943 struct extent *extent = XEXTENT (obj);
2945 ((markobj) (extent_object (extent)));
2946 ((markobj) (extent_no_chase_normal_field (extent, face)));
2947 return extent->plist;
2951 print_extent_1 (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
2953 EXTENT ext = XEXTENT (obj);
2954 EXTENT anc = extent_ancestor (ext);
2956 char buf[64], *bp = buf;
2958 /* Retrieve the ancestor and use it, for faster retrieval of properties */
2960 if (!NILP (extent_begin_glyph (anc))) *bp++ = '*';
2961 *bp++ = (extent_start_open_p (anc) ? '(': '[');
2962 if (extent_detached_p (ext))
2963 strcpy (bp, "detached");
2966 Bufpos from = XINT (Fextent_start_position (obj));
2967 Bufpos to = XINT (Fextent_end_position (obj));
2968 sprintf (bp, "%d, %d", from, to);
2971 *bp++ = (extent_end_open_p (anc) ? ')': ']');
2972 if (!NILP (extent_end_glyph (anc))) *bp++ = '*';
2975 if (!NILP (extent_read_only (anc))) *bp++ = '%';
2976 if (!NILP (extent_mouse_face (anc))) *bp++ = 'H';
2977 if (extent_unique_p (anc)) *bp++ = 'U';
2978 else if (extent_duplicable_p (anc)) *bp++ = 'D';
2979 if (!NILP (extent_invisible (anc))) *bp++ = 'I';
2981 if (!NILP (extent_read_only (anc)) || !NILP (extent_mouse_face (anc)) ||
2982 extent_unique_p (anc) ||
2983 extent_duplicable_p (anc) || !NILP (extent_invisible (anc)))
2986 write_c_string (buf, printcharfun);
2988 tail = extent_plist_slot (anc);
2990 for (; !NILP (tail); tail = Fcdr (Fcdr (tail)))
2992 Lisp_Object v = XCAR (XCDR (tail));
2993 if (NILP (v)) continue;
2994 print_internal (XCAR (tail), printcharfun, escapeflag);
2995 write_c_string (" ", printcharfun);
2998 sprintf (buf, "0x%lx", (unsigned long int) ext);
2999 write_c_string (buf, printcharfun);
3003 print_extent (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
3007 CONST char *title = "";
3008 CONST char *name = "";
3009 CONST char *posttitle = "";
3010 Lisp_Object obj2 = Qnil;
3012 /* Destroyed extents have 't' in the object field, causing
3013 extent_object() to abort (maybe). */
3014 if (EXTENT_LIVE_P (XEXTENT (obj)))
3015 obj2 = extent_object (XEXTENT (obj));
3018 title = "no buffer";
3019 else if (BUFFERP (obj2))
3021 if (BUFFER_LIVE_P (XBUFFER (obj2)))
3024 name = (char *) XSTRING_DATA (XBUFFER (obj2)->name);
3028 title = "Killed Buffer";
3034 assert (STRINGP (obj2));
3035 title = "string \"";
3037 name = (char *) XSTRING_DATA (obj2);
3042 if (!EXTENT_LIVE_P (XEXTENT (obj)))
3043 error ("printing unreadable object #<destroyed extent>");
3045 error ("printing unreadable object #<extent 0x%p>",
3049 if (!EXTENT_LIVE_P (XEXTENT (obj)))
3050 write_c_string ("#<destroyed extent", printcharfun);
3053 char *buf = (char *)
3054 alloca (strlen (title) + strlen (name) + strlen (posttitle) + 1);
3055 write_c_string ("#<extent ", printcharfun);
3056 print_extent_1 (obj, printcharfun, escapeflag);
3057 write_c_string (extent_detached_p (XEXTENT (obj))
3058 ? " from " : " in ", printcharfun);
3059 sprintf (buf, "%s%s%s", title, name, posttitle);
3060 write_c_string (buf, printcharfun);
3066 error ("printing unreadable object #<extent>");
3067 write_c_string ("#<extent", printcharfun);
3069 write_c_string (">", printcharfun);
3073 properties_equal (EXTENT e1, EXTENT e2, int depth)
3075 /* When this function is called, all indirections have been followed.
3076 Thus, the indirection checks in the various macros below will not
3077 amount to anything, and could be removed. However, the time
3078 savings would probably not be significant. */
3079 if (!(EQ (extent_face (e1), extent_face (e2)) &&
3080 extent_priority (e1) == extent_priority (e2) &&
3081 internal_equal (extent_begin_glyph (e1), extent_begin_glyph (e2),
3083 internal_equal (extent_end_glyph (e1), extent_end_glyph (e2),
3087 /* compare the bit flags. */
3089 /* The has_aux field should not be relevant. */
3090 int e1_has_aux = e1->flags.has_aux;
3091 int e2_has_aux = e2->flags.has_aux;
3094 e1->flags.has_aux = e2->flags.has_aux = 0;
3095 value = memcmp (&e1->flags, &e2->flags, sizeof (e1->flags));
3096 e1->flags.has_aux = e1_has_aux;
3097 e2->flags.has_aux = e2_has_aux;
3102 /* compare the random elements of the plists. */
3103 return !plists_differ (extent_no_chase_plist (e1),
3104 extent_no_chase_plist (e2),
3109 extent_equal (Lisp_Object o1, Lisp_Object o2, int depth)
3111 struct extent *e1 = XEXTENT (o1);
3112 struct extent *e2 = XEXTENT (o2);
3114 (extent_start (e1) == extent_start (e2) &&
3115 extent_end (e1) == extent_end (e2) &&
3116 internal_equal (extent_object (e1), extent_object (e2), depth + 1) &&
3117 properties_equal (extent_ancestor (e1), extent_ancestor (e2),
3121 static unsigned long
3122 extent_hash (Lisp_Object obj, int depth)
3124 struct extent *e = XEXTENT (obj);
3125 /* No need to hash all of the elements; that would take too long.
3126 Just hash the most common ones. */
3127 return HASH3 (extent_start (e), extent_end (e),
3128 internal_hash (extent_object (e), depth + 1));
3132 extent_getprop (Lisp_Object obj, Lisp_Object prop)
3134 return Fextent_property (obj, prop, Qunbound);
3138 extent_putprop (Lisp_Object obj, Lisp_Object prop, Lisp_Object value)
3140 Fset_extent_property (obj, prop, value);
3145 extent_remprop (Lisp_Object obj, Lisp_Object prop)
3147 EXTENT ext = XEXTENT (obj);
3149 /* This list is taken from Fset_extent_property, and should be kept
3151 if (EQ (prop, Qread_only)
3152 || EQ (prop, Qunique)
3153 || EQ (prop, Qduplicable)
3154 || EQ (prop, Qinvisible)
3155 || EQ (prop, Qdetachable)
3156 || EQ (prop, Qdetached)
3157 || EQ (prop, Qdestroyed)
3158 || EQ (prop, Qpriority)
3160 || EQ (prop, Qinitial_redisplay_function)
3161 || EQ (prop, Qafter_change_functions)
3162 || EQ (prop, Qbefore_change_functions)
3163 || EQ (prop, Qmouse_face)
3164 || EQ (prop, Qhighlight)
3165 || EQ (prop, Qbegin_glyph_layout)
3166 || EQ (prop, Qend_glyph_layout)
3167 || EQ (prop, Qglyph_layout)
3168 || EQ (prop, Qbegin_glyph)
3169 || EQ (prop, Qend_glyph)
3170 || EQ (prop, Qstart_open)
3171 || EQ (prop, Qend_open)
3172 || EQ (prop, Qstart_closed)
3173 || EQ (prop, Qend_closed)
3174 || EQ (prop, Qkeymap))
3176 /* #### Is this correct, anyway? */
3180 return external_remprop (&ext->plist, prop, 0, ERROR_ME);
3184 extent_plist (Lisp_Object obj)
3186 return Fextent_properties (obj);
3190 /************************************************************************/
3191 /* basic extent accessors */
3192 /************************************************************************/
3194 /* These functions are for checking externally-passed extent objects
3195 and returning an extent's basic properties, which include the
3196 buffer the extent is associated with, the endpoints of the extent's
3197 range, the open/closed-ness of those endpoints, and whether the
3198 extent is detached. Manipulating these properties requires
3199 manipulating the ordered lists that hold extents; thus, functions
3200 to do that are in a later section. */
3202 /* Given a Lisp_Object that is supposed to be an extent, make sure it
3203 is OK and return an extent pointer. Extents can be in one of four
3207 2) detached and not associated with a buffer
3208 3) detached and associated with a buffer
3209 4) attached to a buffer
3211 If FLAGS is 0, types 2-4 are allowed. If FLAGS is DE_MUST_HAVE_BUFFER,
3212 types 3-4 are allowed. If FLAGS is DE_MUST_BE_ATTACHED, only type 4
3217 decode_extent (Lisp_Object extent_obj, unsigned int flags)
3222 CHECK_LIVE_EXTENT (extent_obj);
3223 extent = XEXTENT (extent_obj);
3224 obj = extent_object (extent);
3226 /* the following condition will fail if we're dealing with a freed extent */
3227 assert (NILP (obj) || BUFFERP (obj) || STRINGP (obj));
3229 if (flags & DE_MUST_BE_ATTACHED)
3230 flags |= DE_MUST_HAVE_BUFFER;
3232 /* if buffer is dead, then convert extent to have no buffer. */
3233 if (BUFFERP (obj) && !BUFFER_LIVE_P (XBUFFER (obj)))
3234 obj = extent_object (extent) = Qnil;
3236 assert (!NILP (obj) || extent_detached_p (extent));
3238 if ((NILP (obj) && (flags & DE_MUST_HAVE_BUFFER))
3239 || (extent_detached_p (extent) && (flags & DE_MUST_BE_ATTACHED)))
3241 signal_simple_error ("extent doesn't belong to a buffer or string",
3248 /* Note that the returned value is a buffer position, not a byte index. */
3251 extent_endpoint_external (Lisp_Object extent_obj, int endp)
3253 EXTENT extent = decode_extent (extent_obj, 0);
3255 if (extent_detached_p (extent))
3258 return make_int (extent_endpoint_bufpos (extent, endp));
3261 DEFUN ("extentp", Fextentp, 1, 1, 0, /*
3262 Return t if OBJECT is an extent.
3266 return EXTENTP (object) ? Qt : Qnil;
3269 DEFUN ("extent-live-p", Fextent_live_p, 1, 1, 0, /*
3270 Return t if OBJECT is an extent that has not been destroyed.
3274 return EXTENTP (object) && EXTENT_LIVE_P (XEXTENT (object)) ? Qt : Qnil;
3277 DEFUN ("extent-detached-p", Fextent_detached_p, 1, 1, 0, /*
3278 Return t if EXTENT is detached.
3282 return extent_detached_p (decode_extent (extent, 0)) ? Qt : Qnil;
3285 DEFUN ("extent-object", Fextent_object, 1, 1, 0, /*
3286 Return object (buffer or string) that EXTENT refers to.
3290 return extent_object (decode_extent (extent, 0));
3293 DEFUN ("extent-start-position", Fextent_start_position, 1, 1, 0, /*
3294 Return start position of EXTENT, or nil if EXTENT is detached.
3298 return extent_endpoint_external (extent, 0);
3301 DEFUN ("extent-end-position", Fextent_end_position, 1, 1, 0, /*
3302 Return end position of EXTENT, or nil if EXTENT is detached.
3306 return extent_endpoint_external (extent, 1);
3309 DEFUN ("extent-length", Fextent_length, 1, 1, 0, /*
3310 Return length of EXTENT in characters.
3314 EXTENT e = decode_extent (extent, DE_MUST_BE_ATTACHED);
3315 return make_int (extent_endpoint_bufpos (e, 1)
3316 - extent_endpoint_bufpos (e, 0));
3319 DEFUN ("next-extent", Fnext_extent, 1, 1, 0, /*
3320 Find next extent after EXTENT.
3321 If EXTENT is a buffer return the first extent in the buffer; likewise
3323 Extents in a buffer are ordered in what is called the "display"
3324 order, which sorts by increasing start positions and then by *decreasing*
3326 If you want to perform an operation on a series of extents, use
3327 `map-extents' instead of this function; it is much more efficient.
3328 The primary use of this function should be to enumerate all the
3329 extents in a buffer.
3330 Note: The display order is not necessarily the order that `map-extents'
3331 processes extents in!
3338 if (EXTENTP (extent))
3339 next = extent_next (decode_extent (extent, DE_MUST_BE_ATTACHED));
3341 next = extent_first (decode_buffer_or_string (extent));
3345 XSETEXTENT (val, next);
3349 DEFUN ("previous-extent", Fprevious_extent, 1, 1, 0, /*
3350 Find last extent before EXTENT.
3351 If EXTENT is a buffer return the last extent in the buffer; likewise
3353 This function is analogous to `next-extent'.
3360 if (EXTENTP (extent))
3361 prev = extent_previous (decode_extent (extent, DE_MUST_BE_ATTACHED));
3363 prev = extent_last (decode_buffer_or_string (extent));
3367 XSETEXTENT (val, prev);
3373 DEFUN ("next-e-extent", Fnext_e_extent, 1, 1, 0, /*
3374 Find next extent after EXTENT using the "e" order.
3375 If EXTENT is a buffer return the first extent in the buffer; likewise
3383 if (EXTENTP (extent))
3384 next = extent_e_next (decode_extent (extent, DE_MUST_BE_ATTACHED));
3386 next = extent_e_first (decode_buffer_or_string (extent));
3390 XSETEXTENT (val, next);
3394 DEFUN ("previous-e-extent", Fprevious_e_extent, 1, 1, 0, /*
3395 Find last extent before EXTENT using the "e" order.
3396 If EXTENT is a buffer return the last extent in the buffer; likewise
3398 This function is analogous to `next-e-extent'.
3405 if (EXTENTP (extent))
3406 prev = extent_e_previous (decode_extent (extent, DE_MUST_BE_ATTACHED));
3408 prev = extent_e_last (decode_buffer_or_string (extent));
3412 XSETEXTENT (val, prev);
3418 DEFUN ("next-extent-change", Fnext_extent_change, 1, 2, 0, /*
3419 Return the next position after POS where an extent begins or ends.
3420 If POS is at the end of the buffer or string, POS will be returned;
3421 otherwise a position greater than POS will always be returned.
3422 If BUFFER is nil, the current buffer is assumed.
3426 Lisp_Object obj = decode_buffer_or_string (object);
3429 bpos = get_buffer_or_string_pos_byte (obj, pos, GB_ALLOW_PAST_ACCESSIBLE);
3430 bpos = extent_find_end_of_run (obj, bpos, 1);
3431 return make_int (buffer_or_string_bytind_to_bufpos (obj, bpos));
3434 DEFUN ("previous-extent-change", Fprevious_extent_change, 1, 2, 0, /*
3435 Return the last position before POS where an extent begins or ends.
3436 If POS is at the beginning of the buffer or string, POS will be returned;
3437 otherwise a position less than POS will always be returned.
3438 If OBJECT is nil, the current buffer is assumed.
3442 Lisp_Object obj = decode_buffer_or_string (object);
3445 bpos = get_buffer_or_string_pos_byte (obj, pos, GB_ALLOW_PAST_ACCESSIBLE);
3446 bpos = extent_find_beginning_of_run (obj, bpos, 1);
3447 return make_int (buffer_or_string_bytind_to_bufpos (obj, bpos));
3451 /************************************************************************/
3452 /* parent and children stuff */
3453 /************************************************************************/
3455 DEFUN ("extent-parent", Fextent_parent, 1, 1, 0, /*
3456 Return the parent (if any) of EXTENT.
3457 If an extent has a parent, it derives all its properties from that extent
3458 and has no properties of its own. (The only "properties" that the
3459 extent keeps are the buffer/string it refers to and the start and end
3460 points.) It is possible for an extent's parent to itself have a parent.
3463 /* do I win the prize for the strangest split infinitive? */
3465 EXTENT e = decode_extent (extent, 0);
3466 return extent_parent (e);
3469 DEFUN ("extent-children", Fextent_children, 1, 1, 0, /*
3470 Return a list of the children (if any) of EXTENT.
3471 The children of an extent are all those extents whose parent is that extent.
3472 This function does not recursively trace children of children.
3473 \(To do that, use `extent-descendants'.)
3477 EXTENT e = decode_extent (extent, 0);
3478 Lisp_Object children = extent_children (e);
3480 if (!NILP (children))
3481 return Fcopy_sequence (XWEAK_LIST_LIST (children));
3487 remove_extent_from_children_list (EXTENT e, Lisp_Object child)
3489 Lisp_Object children = extent_children (e);
3491 #ifdef ERROR_CHECK_EXTENTS
3492 assert (!NILP (memq_no_quit (child, XWEAK_LIST_LIST (children))));
3494 XWEAK_LIST_LIST (children) =
3495 delq_no_quit (child, XWEAK_LIST_LIST (children));
3499 add_extent_to_children_list (EXTENT e, Lisp_Object child)
3501 Lisp_Object children = extent_children (e);
3503 if (NILP (children))
3505 children = make_weak_list (WEAK_LIST_SIMPLE);
3506 set_extent_no_chase_aux_field (e, children, children);
3509 #ifdef ERROR_CHECK_EXTENTS
3510 assert (NILP (memq_no_quit (child, XWEAK_LIST_LIST (children))));
3512 XWEAK_LIST_LIST (children) = Fcons (child, XWEAK_LIST_LIST (children));
3515 DEFUN ("set-extent-parent", Fset_extent_parent, 2, 2, 0, /*
3516 Set the parent of EXTENT to PARENT (may be nil).
3517 See `extent-parent'.
3521 EXTENT e = decode_extent (extent, 0);
3522 Lisp_Object cur_parent = extent_parent (e);
3525 XSETEXTENT (extent, e);
3527 CHECK_LIVE_EXTENT (parent);
3528 if (EQ (parent, cur_parent))
3530 for (rest = parent; !NILP (rest); rest = extent_parent (XEXTENT (rest)))
3531 if (EQ (rest, extent))
3532 signal_simple_error ("Circular parent chain would result", extent);
3535 remove_extent_from_children_list (XEXTENT (cur_parent), extent);
3536 set_extent_no_chase_aux_field (e, parent, Qnil);
3537 e->flags.has_parent = 0;
3541 add_extent_to_children_list (XEXTENT (parent), extent);
3542 set_extent_no_chase_aux_field (e, parent, parent);
3543 e->flags.has_parent = 1;
3545 /* changing the parent also changes the properties of all children. */
3547 int old_invis = (!NILP (cur_parent) &&
3548 !NILP (extent_invisible (XEXTENT (cur_parent))));
3549 int new_invis = (!NILP (parent) &&
3550 !NILP (extent_invisible (XEXTENT (parent))));
3552 extent_maybe_changed_for_redisplay (e, 1, new_invis != old_invis);
3559 /************************************************************************/
3560 /* basic extent mutators */
3561 /************************************************************************/
3563 /* Note: If you track non-duplicable extents by undo, you'll get bogus
3564 undo records for transient extents via update-extent.
3565 For example, query-replace will do this.
3569 set_extent_endpoints_1 (EXTENT extent, Memind start, Memind end)
3571 #ifdef ERROR_CHECK_EXTENTS
3572 Lisp_Object obj = extent_object (extent);
3574 assert (start <= end);
3577 assert (valid_memind_p (XBUFFER (obj), start));
3578 assert (valid_memind_p (XBUFFER (obj), end));
3582 /* Optimization: if the extent is already where we want it to be,
3584 if (!extent_detached_p (extent) && extent_start (extent) == start &&
3585 extent_end (extent) == end)
3588 if (extent_detached_p (extent))
3590 if (extent_duplicable_p (extent))
3592 Lisp_Object extent_obj;
3593 XSETEXTENT (extent_obj, extent);
3594 record_extent (extent_obj, 1);
3598 extent_detach (extent);
3600 set_extent_start (extent, start);
3601 set_extent_end (extent, end);
3602 extent_attach (extent);
3605 /* Set extent's endpoints to S and E, and put extent in buffer or string
3606 OBJECT. (If OBJECT is nil, do not change the extent's object.) */
3609 set_extent_endpoints (EXTENT extent, Bytind s, Bytind e, Lisp_Object object)
3615 object = extent_object (extent);
3616 assert (!NILP (object));
3618 else if (!EQ (object, extent_object (extent)))
3620 extent_detach (extent);
3621 extent_object (extent) = object;
3624 start = s < 0 ? extent_start (extent) :
3625 buffer_or_string_bytind_to_memind (object, s);
3626 end = e < 0 ? extent_end (extent) :
3627 buffer_or_string_bytind_to_memind (object, e);
3628 set_extent_endpoints_1 (extent, start, end);
3632 set_extent_openness (EXTENT extent, int start_open, int end_open)
3634 if (start_open != -1)
3635 extent_start_open_p (extent) = start_open;
3637 extent_end_open_p (extent) = end_open;
3638 /* changing the open/closedness of an extent does not affect
3643 make_extent_internal (Lisp_Object object, Bytind from, Bytind to)
3647 extent = make_extent_detached (object);
3648 set_extent_endpoints (extent, from, to, Qnil);
3653 copy_extent (EXTENT original, Bytind from, Bytind to, Lisp_Object object)
3657 e = make_extent_detached (object);
3659 set_extent_endpoints (e, from, to, Qnil);
3661 e->plist = Fcopy_sequence (original->plist);
3662 memcpy (&e->flags, &original->flags, sizeof (e->flags));
3663 if (e->flags.has_aux)
3665 /* also need to copy the aux struct. It won't work for
3666 this extent to share the same aux struct as the original
3668 struct extent_auxiliary *data =
3669 alloc_lcrecord_type (struct extent_auxiliary,
3670 lrecord_extent_auxiliary);
3672 copy_lcrecord (data, XEXTENT_AUXILIARY (XCAR (original->plist)));
3673 XSETEXTENT_AUXILIARY (XCAR (e->plist), data);
3677 /* we may have just added another child to the parent extent. */
3678 Lisp_Object parent = extent_parent (e);
3682 XSETEXTENT (extent, e);
3683 add_extent_to_children_list (XEXTENT (parent), extent);
3691 destroy_extent (EXTENT extent)
3693 Lisp_Object rest, nextrest, children;
3694 Lisp_Object extent_obj;
3696 if (!extent_detached_p (extent))
3697 extent_detach (extent);
3698 /* disassociate the extent from its children and parent */
3699 children = extent_children (extent);
3700 if (!NILP (children))
3702 LIST_LOOP_DELETING (rest, nextrest, XWEAK_LIST_LIST (children))
3703 Fset_extent_parent (XCAR (rest), Qnil);
3705 XSETEXTENT (extent_obj, extent);
3706 Fset_extent_parent (extent_obj, Qnil);
3707 /* mark the extent as destroyed */
3708 extent_object (extent) = Qt;
3711 DEFUN ("make-extent", Fmake_extent, 2, 3, 0, /*
3712 Make an extent for the range [FROM, TO) in BUFFER-OR-STRING.
3713 BUFFER-OR-STRING defaults to the current buffer. Insertions at point
3714 TO will be outside of the extent; insertions at FROM will be inside the
3715 extent, causing the extent to grow. (This is the same way that markers
3716 behave.) You can change the behavior of insertions at the endpoints
3717 using `set-extent-property'. The extent is initially detached if both
3718 FROM and TO are nil, and in this case BUFFER-OR-STRING defaults to nil,
3719 meaning the extent is in no buffer and no string.
3721 (from, to, buffer_or_string))
3723 Lisp_Object extent_obj;
3726 obj = decode_buffer_or_string (buffer_or_string);
3727 if (NILP (from) && NILP (to))
3729 if (NILP (buffer_or_string))
3731 XSETEXTENT (extent_obj, make_extent_detached (obj));
3737 get_buffer_or_string_range_byte (obj, from, to, &start, &end,
3738 GB_ALLOW_PAST_ACCESSIBLE);
3739 XSETEXTENT (extent_obj, make_extent_internal (obj, start, end));
3744 DEFUN ("copy-extent", Fcopy_extent, 1, 2, 0, /*
3745 Make a copy of EXTENT. It is initially detached.
3746 Optional argument BUFFER-OR-STRING defaults to EXTENT's buffer or string.
3748 (extent, buffer_or_string))
3750 EXTENT ext = decode_extent (extent, 0);
3752 if (NILP (buffer_or_string))
3753 buffer_or_string = extent_object (ext);
3755 buffer_or_string = decode_buffer_or_string (buffer_or_string);
3757 XSETEXTENT (extent, copy_extent (ext, -1, -1, buffer_or_string));
3761 DEFUN ("delete-extent", Fdelete_extent, 1, 1, 0, /*
3762 Remove EXTENT from its buffer and destroy it.
3763 This does not modify the buffer's text, only its display properties.
3764 The extent cannot be used thereafter.
3770 /* We do not call decode_extent() here because already-destroyed
3772 CHECK_EXTENT (extent);
3773 ext = XEXTENT (extent);
3775 if (!EXTENT_LIVE_P (ext))
3777 destroy_extent (ext);
3781 DEFUN ("detach-extent", Fdetach_extent, 1, 1, 0, /*
3782 Remove EXTENT from its buffer in such a way that it can be re-inserted.
3783 An extent is also detached when all of its characters are all killed by a
3784 deletion, unless its `detachable' property has been unset.
3786 Extents which have the `duplicable' attribute are tracked by the undo
3787 mechanism. Detachment via `detach-extent' and string deletion is recorded,
3788 as is attachment via `insert-extent' and string insertion. Extent motion,
3789 face changes, and attachment via `make-extent' and `set-extent-endpoints'
3790 are not recorded. This means that extent changes which are to be undo-able
3791 must be performed by character editing, or by insertion and detachment of
3796 EXTENT ext = decode_extent (extent, 0);
3798 if (extent_detached_p (ext))
3800 if (extent_duplicable_p (ext))
3801 record_extent (extent, 0);
3802 extent_detach (ext);
3807 DEFUN ("set-extent-endpoints", Fset_extent_endpoints, 3, 4, 0, /*
3808 Set the endpoints of EXTENT to START, END.
3809 If START and END are null, call detach-extent on EXTENT.
3810 BUFFER-OR-STRING specifies the new buffer or string that the extent should
3811 be in, and defaults to EXTENT's buffer or string. (If nil, and EXTENT
3812 is in no buffer and no string, it defaults to the current buffer.)
3813 See documentation on `detach-extent' for a discussion of undo recording.
3815 (extent, start, end, buffer_or_string))
3820 ext = decode_extent (extent, 0);
3822 if (NILP (buffer_or_string))
3824 buffer_or_string = extent_object (ext);
3825 if (NILP (buffer_or_string))
3826 buffer_or_string = Fcurrent_buffer ();
3829 buffer_or_string = decode_buffer_or_string (buffer_or_string);
3831 if (NILP (start) && NILP (end))
3832 return Fdetach_extent (extent);
3834 get_buffer_or_string_range_byte (buffer_or_string, start, end, &s, &e,
3835 GB_ALLOW_PAST_ACCESSIBLE);
3837 set_extent_endpoints (ext, s, e, buffer_or_string);
3842 /************************************************************************/
3843 /* mapping over extents */
3844 /************************************************************************/
3847 decode_map_extents_flags (Lisp_Object flags)
3849 unsigned int retval = 0;
3850 unsigned int all_extents_specified = 0;
3851 unsigned int in_region_specified = 0;
3853 if (EQ (flags, Qt)) /* obsoleteness compatibility */
3854 return ME_END_CLOSED;
3857 if (SYMBOLP (flags))
3858 flags = Fcons (flags, Qnil);
3859 while (!NILP (flags))
3865 if (EQ (sym, Qall_extents_closed) || EQ (sym, Qall_extents_open) ||
3866 EQ (sym, Qall_extents_closed_open) ||
3867 EQ (sym, Qall_extents_open_closed))
3869 if (all_extents_specified)
3870 error ("Only one `all-extents-*' flag may be specified");
3871 all_extents_specified = 1;
3873 if (EQ (sym, Qstart_in_region) || EQ (sym, Qend_in_region) ||
3874 EQ (sym, Qstart_and_end_in_region) ||
3875 EQ (sym, Qstart_or_end_in_region))
3877 if (in_region_specified)
3878 error ("Only one `*-in-region' flag may be specified");
3879 in_region_specified = 1;
3882 /* I do so love that conditional operator ... */
3884 EQ (sym, Qend_closed) ? ME_END_CLOSED :
3885 EQ (sym, Qstart_open) ? ME_START_OPEN :
3886 EQ (sym, Qall_extents_closed) ? ME_ALL_EXTENTS_CLOSED :
3887 EQ (sym, Qall_extents_open) ? ME_ALL_EXTENTS_OPEN :
3888 EQ (sym, Qall_extents_closed_open) ? ME_ALL_EXTENTS_CLOSED_OPEN :
3889 EQ (sym, Qall_extents_open_closed) ? ME_ALL_EXTENTS_OPEN_CLOSED :
3890 EQ (sym, Qstart_in_region) ? ME_START_IN_REGION :
3891 EQ (sym, Qend_in_region) ? ME_END_IN_REGION :
3892 EQ (sym, Qstart_and_end_in_region) ? ME_START_AND_END_IN_REGION :
3893 EQ (sym, Qstart_or_end_in_region) ? ME_START_OR_END_IN_REGION :
3894 EQ (sym, Qnegate_in_region) ? ME_NEGATE_IN_REGION :
3895 (signal_simple_error ("Invalid `map-extents' flag", sym), 0);
3897 flags = XCDR (flags);
3902 DEFUN ("extent-in-region-p", Fextent_in_region_p, 1, 4, 0, /*
3903 Return whether EXTENT overlaps a specified region.
3904 This is equivalent to whether `map-extents' would visit EXTENT when called
3907 (extent, from, to, flags))
3910 EXTENT ext = decode_extent (extent, DE_MUST_BE_ATTACHED);
3911 Lisp_Object obj = extent_object (ext);
3913 get_buffer_or_string_range_byte (obj, from, to, &start, &end, GB_ALLOW_NIL |
3914 GB_ALLOW_PAST_ACCESSIBLE);
3916 return extent_in_region_p (ext, start, end, decode_map_extents_flags (flags)) ?
3920 struct slow_map_extents_arg
3922 Lisp_Object map_arg;
3923 Lisp_Object map_routine;
3925 Lisp_Object property;
3930 slow_map_extents_function (EXTENT extent, void *arg)
3932 /* This function can GC */
3933 struct slow_map_extents_arg *closure = (struct slow_map_extents_arg *) arg;
3934 Lisp_Object extent_obj;
3936 XSETEXTENT (extent_obj, extent);
3938 /* make sure this extent qualifies according to the PROPERTY
3941 if (!NILP (closure->property))
3943 Lisp_Object value = Fextent_property (extent_obj, closure->property,
3945 if ((NILP (closure->value) && NILP (value)) ||
3946 (!NILP (closure->value) && !EQ (value, closure->value)))
3950 closure->result = call2 (closure->map_routine, extent_obj,
3952 return !NILP (closure->result);
3955 DEFUN ("map-extents", Fmap_extents, 1, 8, 0, /*
3956 Map FUNCTION over the extents which overlap a region in OBJECT.
3957 OBJECT is normally a buffer or string but could be an extent (see below).
3958 The region is normally bounded by [FROM, TO) (i.e. the beginning of the
3959 region is closed and the end of the region is open), but this can be
3960 changed with the FLAGS argument (see below for a complete discussion).
3962 FUNCTION is called with the arguments (extent, MAPARG). The arguments
3963 OBJECT, FROM, TO, MAPARG, and FLAGS are all optional and default to
3964 the current buffer, the beginning of OBJECT, the end of OBJECT, nil,
3965 and nil, respectively. `map-extents' returns the first non-nil result
3966 produced by FUNCTION, and no more calls to FUNCTION are made after it
3969 If OBJECT is an extent, FROM and TO default to the extent's endpoints,
3970 and the mapping omits that extent and its predecessors. This feature
3971 supports restarting a loop based on `map-extents'. Note: OBJECT must
3972 be attached to a buffer or string, and the mapping is done over that
3975 An extent overlaps the region if there is any point in the extent that is
3976 also in the region. (For the purpose of overlap, zero-length extents and
3977 regions are treated as closed on both ends regardless of their endpoints'
3978 specified open/closedness.) Note that the endpoints of an extent or region
3979 are considered to be in that extent or region if and only if the
3980 corresponding end is closed. For example, the extent [5,7] overlaps the
3981 region [2,5] because 5 is in both the extent and the region. However, (5,7]
3982 does not overlap [2,5] because 5 is not in the extent, and neither [5,7] nor
3983 \(5,7] overlaps the region [2,5) because 5 is not in the region.
3985 The optional FLAGS can be a symbol or a list of one or more symbols,
3986 modifying the behavior of `map-extents'. Allowed symbols are:
3988 end-closed The region's end is closed.
3990 start-open The region's start is open.
3992 all-extents-closed Treat all extents as closed on both ends for the
3993 purpose of determining whether they overlap the
3994 region, irrespective of their actual open- or
3996 all-extents-open Treat all extents as open on both ends.
3997 all-extents-closed-open Treat all extents as start-closed, end-open.
3998 all-extents-open-closed Treat all extents as start-open, end-closed.
4000 start-in-region In addition to the above conditions for extent
4001 overlap, the extent's start position must lie within
4002 the specified region. Note that, for this
4003 condition, open start positions are treated as if
4004 0.5 was added to the endpoint's value, and open
4005 end positions are treated as if 0.5 was subtracted
4006 from the endpoint's value.
4007 end-in-region The extent's end position must lie within the
4009 start-and-end-in-region Both the extent's start and end positions must lie
4011 start-or-end-in-region Either the extent's start or end position must lie
4014 negate-in-region The condition specified by a `*-in-region' flag
4015 must NOT hold for the extent to be considered.
4018 At most one of `all-extents-closed', `all-extents-open',
4019 `all-extents-closed-open', and `all-extents-open-closed' may be specified.
4021 At most one of `start-in-region', `end-in-region',
4022 `start-and-end-in-region', and `start-or-end-in-region' may be specified.
4024 If optional arg PROPERTY is non-nil, only extents with that property set
4025 on them will be visited. If optional arg VALUE is non-nil, only extents
4026 whose value for that property is `eq' to VALUE will be visited.
4028 (function, object, from, to, maparg, flags, property, value))
4030 /* This function can GC */
4031 struct slow_map_extents_arg closure;
4032 unsigned int me_flags;
4034 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
4037 if (EXTENTP (object))
4039 after = decode_extent (object, DE_MUST_BE_ATTACHED);
4041 from = Fextent_start_position (object);
4043 to = Fextent_end_position (object);
4044 object = extent_object (after);
4047 object = decode_buffer_or_string (object);
4049 get_buffer_or_string_range_byte (object, from, to, &start, &end,
4050 GB_ALLOW_NIL | GB_ALLOW_PAST_ACCESSIBLE);
4052 me_flags = decode_map_extents_flags (flags);
4054 if (!NILP (property))
4057 value = canonicalize_extent_property (property, value);
4060 GCPRO5 (function, maparg, object, property, value);
4062 closure.map_arg = maparg;
4063 closure.map_routine = function;
4064 closure.result = Qnil;
4065 closure.property = property;
4066 closure.value = value;
4068 map_extents_bytind (start, end, slow_map_extents_function,
4069 (void *) &closure, object, after,
4070 /* You never know what the user might do ... */
4071 me_flags | ME_MIGHT_CALL_ELISP);
4074 return closure.result;
4078 /************************************************************************/
4079 /* mapping over extents -- other functions */
4080 /************************************************************************/
4082 /* ------------------------------- */
4083 /* map-extent-children */
4084 /* ------------------------------- */
4086 struct slow_map_extent_children_arg
4088 Lisp_Object map_arg;
4089 Lisp_Object map_routine;
4091 Lisp_Object property;
4099 slow_map_extent_children_function (EXTENT extent, void *arg)
4101 /* This function can GC */
4102 struct slow_map_extent_children_arg *closure =
4103 (struct slow_map_extent_children_arg *) arg;
4104 Lisp_Object extent_obj;
4105 Bytind start = extent_endpoint_bytind (extent, 0);
4106 Bytind end = extent_endpoint_bytind (extent, 1);
4107 /* Make sure the extent starts inside the region of interest,
4108 rather than just overlaps it.
4110 if (start < closure->start_min)
4112 /* Make sure the extent is not a child of a previous visited one.
4113 We know already, because of extent ordering,
4114 that start >= prev_start, and that if
4115 start == prev_start, then end <= prev_end.
4117 if (start == closure->prev_start)
4119 if (end < closure->prev_end)
4122 else /* start > prev_start */
4124 if (start < closure->prev_end)
4126 /* corner case: prev_end can be -1 if there is no prev */
4128 XSETEXTENT (extent_obj, extent);
4130 /* make sure this extent qualifies according to the PROPERTY
4133 if (!NILP (closure->property))
4135 Lisp_Object value = Fextent_property (extent_obj, closure->property,
4137 if ((NILP (closure->value) && NILP (value)) ||
4138 (!NILP (closure->value) && !EQ (value, closure->value)))
4142 closure->result = call2 (closure->map_routine, extent_obj,
4145 /* Since the callback may change the buffer, compute all stored
4146 buffer positions here.
4148 closure->start_min = -1; /* no need for this any more */
4149 closure->prev_start = extent_endpoint_bytind (extent, 0);
4150 closure->prev_end = extent_endpoint_bytind (extent, 1);
4152 return !NILP (closure->result);
4155 DEFUN ("map-extent-children", Fmap_extent_children, 1, 8, 0, /*
4156 Map FUNCTION over the extents in the region from FROM to TO.
4157 FUNCTION is called with arguments (extent, MAPARG). See `map-extents'
4158 for a full discussion of the arguments FROM, TO, and FLAGS.
4160 The arguments are the same as for `map-extents', but this function differs
4161 in that it only visits extents which start in the given region, and also
4162 in that, after visiting an extent E, it skips all other extents which start
4163 inside E but end before E's end.
4165 Thus, this function may be used to walk a tree of extents in a buffer:
4166 (defun walk-extents (buffer &optional ignore)
4167 (map-extent-children 'walk-extents buffer))
4169 (function, object, from, to, maparg, flags, property, value))
4171 /* This function can GC */
4172 struct slow_map_extent_children_arg closure;
4173 unsigned int me_flags;
4175 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
4178 if (EXTENTP (object))
4180 after = decode_extent (object, DE_MUST_BE_ATTACHED);
4182 from = Fextent_start_position (object);
4184 to = Fextent_end_position (object);
4185 object = extent_object (after);
4188 object = decode_buffer_or_string (object);
4190 get_buffer_or_string_range_byte (object, from, to, &start, &end,
4191 GB_ALLOW_NIL | GB_ALLOW_PAST_ACCESSIBLE);
4193 me_flags = decode_map_extents_flags (flags);
4195 if (!NILP (property))
4198 value = canonicalize_extent_property (property, value);
4201 GCPRO5 (function, maparg, object, property, value);
4203 closure.map_arg = maparg;
4204 closure.map_routine = function;
4205 closure.result = Qnil;
4206 closure.property = property;
4207 closure.value = value;
4208 closure.start_min = start;
4209 closure.prev_start = -1;
4210 closure.prev_end = -1;
4211 map_extents_bytind (start, end, slow_map_extent_children_function,
4212 (void *) &closure, object, after,
4213 /* You never know what the user might do ... */
4214 me_flags | ME_MIGHT_CALL_ELISP);
4217 return closure.result;
4220 /* ------------------------------- */
4222 /* ------------------------------- */
4224 /* find "smallest" matching extent containing pos -- (flag == 0) means
4225 all extents match, else (EXTENT_FLAGS (extent) & flag) must be true;
4226 for more than one matching extent with precisely the same endpoints,
4227 we choose the last extent in the extents_list.
4228 The search stops just before "before", if that is non-null.
4231 struct extent_at_arg
4247 static enum extent_at_flag
4248 decode_extent_at_flag (Lisp_Object at_flag)
4251 return EXTENT_AT_AFTER;
4253 CHECK_SYMBOL (at_flag);
4254 if (EQ (at_flag, Qafter)) return EXTENT_AT_AFTER;
4255 if (EQ (at_flag, Qbefore)) return EXTENT_AT_BEFORE;
4256 if (EQ (at_flag, Qat)) return EXTENT_AT_AT;
4258 signal_simple_error ("Invalid AT-FLAG in `extent-at'", at_flag);
4259 return EXTENT_AT_AFTER; /* unreached */
4263 extent_at_mapper (EXTENT e, void *arg)
4265 struct extent_at_arg *closure = (struct extent_at_arg *) arg;
4267 if (e == closure->before)
4270 /* If closure->prop is non-nil, then the extent is only acceptable
4271 if it has a non-nil value for that property. */
4272 if (!NILP (closure->prop))
4275 XSETEXTENT (extent, e);
4276 if (NILP (Fextent_property (extent, closure->prop, Qnil)))
4281 EXTENT current = closure->best_match;
4285 /* redundant but quick test */
4286 else if (extent_start (current) > extent_start (e))
4289 /* we return the "last" best fit, instead of the first --
4290 this is because then the glyph closest to two equivalent
4291 extents corresponds to the "extent-at" the text just past
4293 else if (!EXTENT_LESS_VALS (e, closure->best_start,
4299 closure->best_match = e;
4300 closure->best_start = extent_start (e);
4301 closure->best_end = extent_end (e);
4308 extent_at_bytind (Bytind position, Lisp_Object object, Lisp_Object property,
4309 EXTENT before, enum extent_at_flag at_flag)
4311 struct extent_at_arg closure;
4312 Lisp_Object extent_obj;
4314 /* it might be argued that invalid positions should cause
4315 errors, but the principle of least surprise dictates that
4316 nil should be returned (extent-at is often used in
4317 response to a mouse event, and in many cases previous events
4318 have changed the buffer contents).
4320 Also, the openness stuff in the text-property code currently
4321 does not check its limits and might go off the end. */
4322 if ((at_flag == EXTENT_AT_BEFORE
4323 ? position <= buffer_or_string_absolute_begin_byte (object)
4324 : position < buffer_or_string_absolute_begin_byte (object))
4325 || (at_flag == EXTENT_AT_AFTER
4326 ? position >= buffer_or_string_absolute_end_byte (object)
4327 : position > buffer_or_string_absolute_end_byte (object)))
4330 closure.best_match = 0;
4331 closure.prop = property;
4332 closure.before = before;
4334 map_extents_bytind (at_flag == EXTENT_AT_BEFORE ? position - 1 : position,
4335 at_flag == EXTENT_AT_AFTER ? position + 1 : position,
4336 extent_at_mapper, (void *) &closure, object, 0,
4337 ME_START_OPEN | ME_ALL_EXTENTS_CLOSED);
4339 if (!closure.best_match)
4342 XSETEXTENT (extent_obj, closure.best_match);
4346 DEFUN ("extent-at", Fextent_at, 1, 5, 0, /*
4347 Find "smallest" extent at POS in OBJECT having PROPERTY set.
4348 Normally, an extent is "at" POS if it overlaps the region (POS, POS+1);
4349 i.e. if it covers the character after POS. (However, see the definition
4350 of AT-FLAG.) "Smallest" means the extent that comes last in the display
4351 order; this normally means the extent whose start position is closest to
4352 POS. See `next-extent' for more information.
4353 OBJECT specifies a buffer or string and defaults to the current buffer.
4354 PROPERTY defaults to nil, meaning that any extent will do.
4355 Properties are attached to extents with `set-extent-property', which see.
4356 Returns nil if POS is invalid or there is no matching extent at POS.
4357 If the fourth argument BEFORE is not nil, it must be an extent; any returned
4358 extent will precede that extent. This feature allows `extent-at' to be
4359 used by a loop over extents.
4360 AT-FLAG controls how end cases are handled, and should be one of:
4362 nil or `after' An extent is at POS if it covers the character
4363 after POS. This is consistent with the way
4364 that text properties work.
4365 `before' An extent is at POS if it covers the character
4367 `at' An extent is at POS if it overlaps or abuts POS.
4368 This includes all zero-length extents at POS.
4370 Note that in all cases, the start-openness and end-openness of the extents
4371 considered is ignored. If you want to pay attention to those properties,
4372 you should use `map-extents', which gives you more control.
4374 (pos, object, property, before, at_flag))
4377 EXTENT before_extent;
4378 enum extent_at_flag fl;
4380 object = decode_buffer_or_string (object);
4381 position = get_buffer_or_string_pos_byte (object, pos, GB_NO_ERROR_IF_BAD);
4385 before_extent = decode_extent (before, DE_MUST_BE_ATTACHED);
4386 if (before_extent && !EQ (object, extent_object (before_extent)))
4387 signal_simple_error ("extent not in specified buffer or string", object);
4388 fl = decode_extent_at_flag (at_flag);
4390 return extent_at_bytind (position, object, property, before_extent, fl);
4393 /* ------------------------------- */
4394 /* verify_extent_modification() */
4395 /* ------------------------------- */
4397 /* verify_extent_modification() is called when a buffer or string is
4398 modified to check whether the modification is occuring inside a
4402 struct verify_extents_arg
4407 Lisp_Object iro; /* value of inhibit-read-only */
4411 verify_extent_mapper (EXTENT extent, void *arg)
4413 struct verify_extents_arg *closure = (struct verify_extents_arg *) arg;
4414 Lisp_Object prop = extent_read_only (extent);
4419 if (CONSP (closure->iro) && !NILP (Fmemq (prop, closure->iro)))
4422 #if 0 /* Nobody seems to care for this any more -sb */
4423 /* Allow deletion if the extent is completely contained in
4424 the region being deleted.
4425 This is important for supporting tokens which are internally
4426 write-protected, but which can be killed and yanked as a whole.
4427 Ignore open/closed distinctions at this point.
4430 if (closure->start != closure->end &&
4431 extent_start (extent) >= closure->start &&
4432 extent_end (extent) <= closure->end)
4437 Fsignal (Qbuffer_read_only, (list1 (closure->object)));
4439 RETURN_NOT_REACHED(0)
4442 /* Value of Vinhibit_read_only is precomputed and passed in for
4446 verify_extent_modification (Lisp_Object object, Bytind from, Bytind to,
4447 Lisp_Object inhibit_read_only_value)
4450 struct verify_extents_arg closure;
4452 /* If insertion, visit closed-endpoint extents touching the insertion
4453 point because the text would go inside those extents. If deletion,
4454 treat the range as open on both ends so that touching extents are not
4455 visited. Note that we assume that an insertion is occurring if the
4456 changed range has zero length, and a deletion otherwise. This
4457 fails if a change (i.e. non-insertion, non-deletion) is happening.
4458 As far as I know, this doesn't currently occur in XEmacs. --ben */
4459 closed = (from==to);
4460 closure.object = object;
4461 closure.start = buffer_or_string_bytind_to_memind (object, from);
4462 closure.end = buffer_or_string_bytind_to_memind (object, to);
4463 closure.iro = inhibit_read_only_value;
4465 map_extents_bytind (from, to, verify_extent_mapper, (void *) &closure,
4466 object, 0, closed ? ME_END_CLOSED : ME_START_OPEN);
4469 /* ------------------------------------ */
4470 /* process_extents_for_insertion() */
4471 /* ------------------------------------ */
4473 struct process_extents_for_insertion_arg
4480 /* A region of length LENGTH was just inserted at OPOINT. Modify all
4481 of the extents as required for the insertion, based on their
4482 start-open/end-open properties.
4486 process_extents_for_insertion_mapper (EXTENT extent, void *arg)
4488 struct process_extents_for_insertion_arg *closure =
4489 (struct process_extents_for_insertion_arg *) arg;
4490 Memind indice = buffer_or_string_bytind_to_memind (closure->object,
4493 /* When this function is called, one end of the newly-inserted text should
4494 be adjacent to some endpoint of the extent, or disjoint from it. If
4495 the insertion overlaps any existing extent, something is wrong.
4497 #ifdef ERROR_CHECK_EXTENTS
4498 if (extent_start (extent) > indice &&
4499 extent_start (extent) < indice + closure->length)
4501 if (extent_end (extent) > indice &&
4502 extent_end (extent) < indice + closure->length)
4506 /* The extent-adjustment code adjusted the extent's endpoints as if
4507 they were markers -- endpoints at the gap (i.e. the insertion
4508 point) go to the left of the insertion point, which is correct
4509 for [) extents. We need to fix the other kinds of extents.
4511 Note that both conditions below will hold for zero-length (]
4512 extents at the gap. Zero-length () extents would get adjusted
4513 such that their start is greater than their end; we treat them
4514 as [) extents. This is unfortunately an inelegant part of the
4515 extent model, but there is no way around it. */
4518 Memind new_start, new_end;
4520 new_start = extent_start (extent);
4521 new_end = extent_end (extent);
4522 if (indice == extent_start (extent) && extent_start_open_p (extent) &&
4523 /* coerce zero-length () extents to [) */
4524 new_start != new_end)
4525 new_start += closure->length;
4526 if (indice == extent_end (extent) && !extent_end_open_p (extent))
4527 new_end += closure->length;
4528 set_extent_endpoints_1 (extent, new_start, new_end);
4535 process_extents_for_insertion (Lisp_Object object, Bytind opoint,
4538 struct process_extents_for_insertion_arg closure;
4540 closure.opoint = opoint;
4541 closure.length = length;
4542 closure.object = object;
4544 map_extents_bytind (opoint, opoint + length,
4545 process_extents_for_insertion_mapper,
4546 (void *) &closure, object, 0,
4547 ME_END_CLOSED | ME_MIGHT_MODIFY_EXTENTS |
4548 ME_INCLUDE_INTERNAL);
4551 /* ------------------------------------ */
4552 /* process_extents_for_deletion() */
4553 /* ------------------------------------ */
4555 struct process_extents_for_deletion_arg
4558 int destroy_included_extents;
4561 /* This function is called when we're about to delete the range [from, to].
4562 Detach all of the extents that are completely inside the range [from, to],
4563 if they're detachable or open-open. */
4566 process_extents_for_deletion_mapper (EXTENT extent, void *arg)
4568 struct process_extents_for_deletion_arg *closure =
4569 (struct process_extents_for_deletion_arg *) arg;
4571 /* If the extent lies completely within the range that
4572 is being deleted, then nuke the extent if it's detachable
4573 (otherwise, it will become a zero-length extent). */
4575 if (closure->start <= extent_start (extent) &&
4576 extent_end (extent) <= closure->end)
4578 if (extent_detachable_p (extent))
4580 if (closure->destroy_included_extents)
4581 destroy_extent (extent);
4583 extent_detach (extent);
4590 /* DESTROY_THEM means destroy the extents instead of just deleting them.
4591 It is unused currently, but perhaps might be used (there used to
4592 be a function process_extents_for_destruction(), #if 0'd out,
4593 that did the equivalent). */
4595 process_extents_for_deletion (Lisp_Object object, Bytind from,
4596 Bytind to, int destroy_them)
4598 struct process_extents_for_deletion_arg closure;
4600 closure.start = buffer_or_string_bytind_to_memind (object, from);
4601 closure.end = buffer_or_string_bytind_to_memind (object, to);
4602 closure.destroy_included_extents = destroy_them;
4604 map_extents_bytind (from, to, process_extents_for_deletion_mapper,
4605 (void *) &closure, object, 0,
4606 ME_END_CLOSED | ME_MIGHT_MODIFY_EXTENTS);
4609 /* ------------------------------- */
4610 /* report_extent_modification() */
4611 /* ------------------------------- */
4612 struct report_extent_modification_closure {
4619 /* This juggling with the pointer to another file's global variable is
4620 kind of yucky. Perhaps I should just export the variable. */
4621 static int *inside_change_hook_pointer;
4624 report_extent_modification_restore (Lisp_Object buffer)
4626 *inside_change_hook_pointer = 0;
4627 if (current_buffer != XBUFFER (buffer))
4628 Fset_buffer (buffer);
4633 report_extent_modification_mapper (EXTENT extent, void *arg)
4635 struct report_extent_modification_closure *closure =
4636 (struct report_extent_modification_closure *)arg;
4637 Lisp_Object exobj, startobj, endobj;
4638 Lisp_Object hook = (closure->afterp
4639 ? extent_after_change_functions (extent)
4640 : extent_before_change_functions (extent));
4644 XSETEXTENT (exobj, extent);
4645 XSETINT (startobj, closure->start);
4646 XSETINT (endobj, closure->end);
4648 /* Now that we are sure to call elisp, set up an unwind-protect so
4649 inside_change_hook gets restored in case we throw. Also record
4650 the current buffer, in case we change it. Do the recording only
4652 if (closure->speccount == -1)
4654 closure->speccount = specpdl_depth ();
4655 record_unwind_protect (report_extent_modification_restore,
4656 Fcurrent_buffer ());
4659 /* The functions will expect closure->buffer to be the current
4660 buffer, so change it if it isn't. */
4661 if (current_buffer != XBUFFER (closure->buffer))
4662 Fset_buffer (closure->buffer);
4664 /* #### It's a shame that we can't use any of the existing run_hook*
4665 functions here. This is so because all of them work with
4666 symbols, to be able to retrieve default values of local hooks.
4669 if (!CONSP (hook) || EQ (XCAR (hook), Qlambda))
4670 call3 (hook, exobj, startobj, endobj);
4674 EXTERNAL_LIST_LOOP (tail, hook)
4675 call3 (XCAR (tail), exobj, startobj, endobj);
4681 report_extent_modification (Lisp_Object buffer, Bufpos start, Bufpos end,
4682 int *inside, int afterp)
4684 struct report_extent_modification_closure closure;
4686 closure.buffer = buffer;
4687 closure.start = start;
4689 closure.afterp = afterp;
4690 closure.speccount = -1;
4692 inside_change_hook_pointer = inside;
4695 map_extents (start, end, report_extent_modification_mapper, (void *)&closure,
4696 buffer, NULL, ME_MIGHT_CALL_ELISP);
4698 if (closure.speccount == -1)
4702 /* We mustn't unbind when closure.speccount != -1 because
4703 map_extents_bytind has already done that. */
4704 assert (*inside == 0);
4709 /************************************************************************/
4710 /* extent properties */
4711 /************************************************************************/
4714 set_extent_invisible (EXTENT extent, Lisp_Object value)
4716 if (!EQ (extent_invisible (extent), value))
4718 set_extent_invisible_1 (extent, value);
4719 extent_changed_for_redisplay (extent, 1, 1);
4723 /* This function does "memoization" -- similar to the interning
4724 that happens with symbols. Given a list of faces, an equivalent
4725 list is returned such that if this function is called twice with
4726 input that is `equal', the resulting outputs will be `eq'.
4728 Note that the inputs and outputs are in general *not* `equal' --
4729 faces in symbol form become actual face objects in the output.
4730 This is necessary so that temporary faces stay around. */
4733 memoize_extent_face_internal (Lisp_Object list)
4737 Lisp_Object cons, thecons;
4738 Lisp_Object oldtail, tail;
4739 struct gcpro gcpro1;
4744 return Fget_face (list);
4746 /* To do the memoization, we use a hash table mapping from
4747 external lists to internal lists. We do `equal' comparisons
4748 on the keys so the memoization works correctly.
4750 Note that we canonicalize things so that the keys in the
4751 hashtable (the external lists) always contain symbols and
4752 the values (the internal lists) always contain face objects.
4754 We also maintain a "reverse" table that maps from the internal
4755 lists to the external equivalents. The idea here is twofold:
4757 1) `extent-face' wants to return a list containing face symbols
4758 rather than face objects.
4759 2) We don't want things to get quite so messed up if the user
4760 maliciously side-effects the returned lists.
4763 len = XINT (Flength (list));
4764 thelen = XINT (Flength (Vextent_face_reusable_list));
4769 /* We canonicalize the given list into another list.
4770 We try to avoid consing except when necessary, so we have
4776 cons = Vextent_face_reusable_list;
4777 while (!NILP (XCDR (cons)))
4779 XCDR (cons) = Fmake_list (make_int (len - thelen), Qnil);
4781 else if (thelen > len)
4785 /* Truncate the list temporarily so it's the right length;
4786 remember the old tail. */
4787 cons = Vextent_face_reusable_list;
4788 for (i = 0; i < len - 1; i++)
4791 oldtail = XCDR (cons);
4795 thecons = Vextent_face_reusable_list;
4796 EXTERNAL_LIST_LOOP (cons, list)
4798 Lisp_Object face = Fget_face (XCAR (cons));
4800 XCAR (thecons) = Fface_name (face);
4801 thecons = XCDR (thecons);
4804 list = Fgethash (Vextent_face_reusable_list, Vextent_face_memoize_hash_table,
4808 Lisp_Object symlist = Fcopy_sequence (Vextent_face_reusable_list);
4809 Lisp_Object facelist = Fcopy_sequence (Vextent_face_reusable_list);
4811 LIST_LOOP (cons, facelist)
4813 XCAR (cons) = Fget_face (XCAR (cons));
4815 Fputhash (symlist, facelist, Vextent_face_memoize_hash_table);
4816 Fputhash (facelist, symlist, Vextent_face_reverse_memoize_hash_table);
4820 /* Now restore the truncated tail of the reusable list, if necessary. */
4822 XCDR (tail) = oldtail;
4829 external_of_internal_memoized_face (Lisp_Object face)
4833 else if (!CONSP (face))
4834 return XFACE (face)->name;
4837 face = Fgethash (face, Vextent_face_reverse_memoize_hash_table,
4839 assert (!UNBOUNDP (face));
4845 canonicalize_extent_property (Lisp_Object prop, Lisp_Object value)
4847 if (EQ (prop, Qface) || EQ (prop, Qmouse_face))
4848 value = (external_of_internal_memoized_face
4849 (memoize_extent_face_internal (value)));
4853 /* Do we need a lisp-level function ? */
4854 DEFUN ("set-extent-initial-redisplay-function", Fset_extent_initial_redisplay_function,
4856 Note: This feature is experimental!
4858 Set initial-redisplay-function of EXTENT to the function
4861 The first time the EXTENT is (re)displayed, an eval event will be
4862 dispatched calling FUNCTION with EXTENT as its only argument.
4866 EXTENT e = decode_extent(extent, DE_MUST_BE_ATTACHED);
4868 e = extent_ancestor (e); /* Is this needed? Macro also does chasing!*/
4869 set_extent_initial_redisplay_function(e,function);
4870 extent_in_red_event_p(e) = 0; /* If the function changed we can spawn
4872 extent_changed_for_redisplay(e,1,0); /* Do we need to mark children too ?*/
4877 DEFUN ("extent-face", Fextent_face, 1, 1, 0, /*
4878 Return the name of the face in which EXTENT is displayed, or nil
4879 if the extent's face is unspecified. This might also return a list
4886 CHECK_EXTENT (extent);
4887 face = extent_face (XEXTENT (extent));
4889 return external_of_internal_memoized_face (face);
4892 DEFUN ("set-extent-face", Fset_extent_face, 2, 2, 0, /*
4893 Make the given EXTENT have the graphic attributes specified by FACE.
4894 FACE can also be a list of faces, and all faces listed will apply,
4895 with faces earlier in the list taking priority over those later in the
4900 EXTENT e = decode_extent(extent, 0);
4901 Lisp_Object orig_face = face;
4903 /* retrieve the ancestor for efficiency and proper redisplay noting. */
4904 e = extent_ancestor (e);
4906 face = memoize_extent_face_internal (face);
4908 extent_face (e) = face;
4909 extent_changed_for_redisplay (e, 1, 0);
4915 DEFUN ("extent-mouse-face", Fextent_mouse_face, 1, 1, 0, /*
4916 Return the face used to highlight EXTENT when the mouse passes over it.
4917 The return value will be a face name, a list of face names, or nil
4918 if the extent's mouse face is unspecified.
4924 CHECK_EXTENT (extent);
4925 face = extent_mouse_face (XEXTENT (extent));
4927 return external_of_internal_memoized_face (face);
4930 DEFUN ("set-extent-mouse-face", Fset_extent_mouse_face, 2, 2, 0, /*
4931 Set the face used to highlight EXTENT when the mouse passes over it.
4932 FACE can also be a list of faces, and all faces listed will apply,
4933 with faces earlier in the list taking priority over those later in the
4939 Lisp_Object orig_face = face;
4941 CHECK_EXTENT (extent);
4942 e = XEXTENT (extent);
4943 /* retrieve the ancestor for efficiency and proper redisplay noting. */
4944 e = extent_ancestor (e);
4946 face = memoize_extent_face_internal (face);
4948 set_extent_mouse_face (e, face);
4949 extent_changed_for_redisplay (e, 1, 0);
4955 set_extent_glyph (EXTENT extent, Lisp_Object glyph, int endp,
4956 glyph_layout layout)
4958 extent = extent_ancestor (extent);
4962 set_extent_begin_glyph (extent, glyph);
4963 extent_begin_glyph_layout (extent) = layout;
4967 set_extent_end_glyph (extent, glyph);
4968 extent_end_glyph_layout (extent) = layout;
4971 extent_changed_for_redisplay (extent, 1, 0);
4975 glyph_layout_to_symbol (glyph_layout layout)
4979 case GL_TEXT: return Qtext;
4980 case GL_OUTSIDE_MARGIN: return Qoutside_margin;
4981 case GL_INSIDE_MARGIN: return Qinside_margin;
4982 case GL_WHITESPACE: return Qwhitespace;
4985 return Qnil; /* unreached */
4990 symbol_to_glyph_layout (Lisp_Object layout_obj)
4992 if (NILP (layout_obj))
4995 CHECK_SYMBOL (layout_obj);
4996 if (EQ (layout_obj, Qoutside_margin)) return GL_OUTSIDE_MARGIN;
4997 if (EQ (layout_obj, Qinside_margin)) return GL_INSIDE_MARGIN;
4998 if (EQ (layout_obj, Qwhitespace)) return GL_WHITESPACE;
4999 if (EQ (layout_obj, Qtext)) return GL_TEXT;
5001 signal_simple_error ("unknown glyph layout type", layout_obj);
5002 return GL_TEXT; /* unreached */
5006 set_extent_glyph_1 (Lisp_Object extent_obj, Lisp_Object glyph, int endp,
5007 Lisp_Object layout_obj)
5009 EXTENT extent = decode_extent (extent_obj, DE_MUST_HAVE_BUFFER);
5010 glyph_layout layout = symbol_to_glyph_layout (layout_obj);
5012 /* Make sure we've actually been given a glyph or it's nil (meaning
5013 we're deleting a glyph from an extent). */
5015 CHECK_GLYPH (glyph);
5017 set_extent_glyph (extent, glyph, endp, layout);
5021 DEFUN ("set-extent-begin-glyph", Fset_extent_begin_glyph, 2, 3, 0, /*
5022 Display a bitmap, subwindow or string at the beginning of EXTENT.
5023 BEGIN-GLYPH must be a glyph object. The layout policy defaults to `text'.
5025 (extent, begin_glyph, layout))
5027 return set_extent_glyph_1 (extent, begin_glyph, 0, layout);
5030 DEFUN ("set-extent-end-glyph", Fset_extent_end_glyph, 2, 3, 0, /*
5031 Display a bitmap, subwindow or string at the end of EXTENT.
5032 END-GLYPH must be a glyph object. The layout policy defaults to `text'.
5034 (extent, end_glyph, layout))
5036 return set_extent_glyph_1 (extent, end_glyph, 1, layout);
5039 DEFUN ("extent-begin-glyph", Fextent_begin_glyph, 1, 1, 0, /*
5040 Return the glyph object displayed at the beginning of EXTENT.
5041 If there is none, nil is returned.
5045 return extent_begin_glyph (decode_extent (extent, 0));
5048 DEFUN ("extent-end-glyph", Fextent_end_glyph, 1, 1, 0, /*
5049 Return the glyph object displayed at the end of EXTENT.
5050 If there is none, nil is returned.
5054 return extent_end_glyph (decode_extent (extent, 0));
5057 DEFUN ("set-extent-begin-glyph-layout", Fset_extent_begin_glyph_layout, 2, 2, 0, /*
5058 Set the layout policy of EXTENT's begin glyph.
5059 Access this using the `extent-begin-glyph-layout' function.
5063 EXTENT e = decode_extent (extent, 0);
5064 e = extent_ancestor (e);
5065 extent_begin_glyph_layout (e) = symbol_to_glyph_layout (layout);
5066 extent_maybe_changed_for_redisplay (e, 1, 0);
5070 DEFUN ("set-extent-end-glyph-layout", Fset_extent_end_glyph_layout, 2, 2, 0, /*
5071 Set the layout policy of EXTENT's end glyph.
5072 Access this using the `extent-end-glyph-layout' function.
5076 EXTENT e = decode_extent (extent, 0);
5077 e = extent_ancestor (e);
5078 extent_end_glyph_layout (e) = symbol_to_glyph_layout (layout);
5079 extent_maybe_changed_for_redisplay (e, 1, 0);
5083 DEFUN ("extent-begin-glyph-layout", Fextent_begin_glyph_layout, 1, 1, 0, /*
5084 Return the layout policy associated with EXTENT's begin glyph.
5085 Set this using the `set-extent-begin-glyph-layout' function.
5089 EXTENT e = decode_extent (extent, 0);
5090 return glyph_layout_to_symbol ((glyph_layout) extent_begin_glyph_layout (e));
5093 DEFUN ("extent-end-glyph-layout", Fextent_end_glyph_layout, 1, 1, 0, /*
5094 Return the layout policy associated with EXTENT's end glyph.
5095 Set this using the `set-extent-end-glyph-layout' function.
5099 EXTENT e = decode_extent (extent, 0);
5100 return glyph_layout_to_symbol ((glyph_layout) extent_end_glyph_layout (e));
5103 DEFUN ("set-extent-priority", Fset_extent_priority, 2, 2, 0, /*
5104 Set the display priority of EXTENT to PRIORITY (an integer).
5105 When the extent attributes are being merged for display, the priority
5106 is used to determine which extent takes precedence in the event of a
5107 conflict (two extents whose faces both specify font, for example: the
5108 font of the extent with the higher priority will be used).
5109 Extents are created with priority 0; priorities may be negative.
5113 EXTENT e = decode_extent (extent, 0);
5115 CHECK_INT (priority);
5116 e = extent_ancestor (e);
5117 set_extent_priority (e, XINT (priority));
5118 extent_maybe_changed_for_redisplay (e, 1, 0);
5122 DEFUN ("extent-priority", Fextent_priority, 1, 1, 0, /*
5123 Return the display priority of EXTENT; see `set-extent-priority'.
5127 EXTENT e = decode_extent (extent, 0);
5128 return make_int (extent_priority (e));
5131 DEFUN ("set-extent-property", Fset_extent_property, 3, 3, 0, /*
5132 Change a property of an extent.
5133 PROPERTY may be any symbol; the value stored may be accessed with
5134 the `extent-property' function.
5135 The following symbols have predefined meanings:
5137 detached Removes the extent from its buffer; setting this is
5138 the same as calling `detach-extent'.
5140 destroyed Removes the extent from its buffer, and makes it
5141 unusable in the future; this is the same calling
5144 priority Change redisplay priority; same as `set-extent-priority'.
5146 start-open Whether the set of characters within the extent is
5147 treated being open on the left, that is, whether
5148 the start position is an exclusive, rather than
5149 inclusive, boundary. If true, then characters
5150 inserted exactly at the beginning of the extent
5151 will remain outside of the extent; otherwise they
5152 will go into the extent, extending it.
5154 end-open Whether the set of characters within the extent is
5155 treated being open on the right, that is, whether
5156 the end position is an exclusive, rather than
5157 inclusive, boundary. If true, then characters
5158 inserted exactly at the end of the extent will
5159 remain outside of the extent; otherwise they will
5160 go into the extent, extending it.
5162 By default, extents have the `end-open' but not the
5163 `start-open' property set.
5165 read-only Text within this extent will be unmodifiable.
5167 initial-redisplay-function (EXPERIMENTAL)
5168 function to be called the first time (part of) the extent
5169 is redisplayed. It will be called with the extent as its
5171 Note: The function will not be called immediately
5172 during redisplay, an eval event will be dispatched.
5174 detachable Whether the extent gets detached (as with
5175 `detach-extent') when all the text within the
5176 extent is deleted. This is true by default. If
5177 this property is not set, the extent becomes a
5178 zero-length extent when its text is deleted. (In
5179 such a case, the `start-open' property is
5180 automatically removed if both the `start-open' and
5181 `end-open' properties are set, since zero-length
5182 extents open on both ends are not allowed.)
5184 face The face in which to display the text. Setting
5185 this is the same as calling `set-extent-face'.
5187 mouse-face If non-nil, the extent will be highlighted in this
5188 face when the mouse moves over it.
5190 pointer If non-nil, and a valid pointer glyph, this specifies
5191 the shape of the mouse pointer while over the extent.
5193 highlight Obsolete: Setting this property is equivalent to
5194 setting a `mouse-face' property of `highlight'.
5195 Reading this property returns non-nil if
5196 the extent has a non-nil `mouse-face' property.
5198 duplicable Whether this extent should be copied into strings,
5199 so that kill, yank, and undo commands will restore
5200 or copy it. `duplicable' extents are copied from
5201 an extent into a string when `buffer-substring' or
5202 a similar function creates a string. The extents
5203 in a string are copied into other strings created
5204 from the string using `concat' or `substring'.
5205 When `insert' or a similar function inserts the
5206 string into a buffer, the extents are copied back
5209 unique Meaningful only in conjunction with `duplicable'.
5210 When this is set, there may be only one instance
5211 of this extent attached at a time: if it is copied
5212 to the kill ring and then yanked, the extent is
5213 not copied. If, however, it is killed (removed
5214 from the buffer) and then yanked, it will be
5215 re-attached at the new position.
5217 invisible If the value is non-nil, text under this extent
5218 may be treated as not present for the purpose of
5219 redisplay, or may be displayed using an ellipsis
5220 or other marker; see `buffer-invisibility-spec'
5221 and `invisible-text-glyph'. In all cases,
5222 however, the text is still visible to other
5223 functions that examine a buffer's text.
5225 keymap This keymap is consulted for mouse clicks on this
5226 extent, or keypresses made while point is within the
5229 copy-function This is a hook that is run when a duplicable extent
5230 is about to be copied from a buffer to a string (or
5231 the kill ring). It is called with three arguments,
5232 the extent, and the buffer-positions within it
5233 which are being copied. If this function returns
5234 nil, then the extent will not be copied; otherwise
5237 paste-function This is a hook that is run when a duplicable extent is
5238 about to be copied from a string (or the kill ring)
5239 into a buffer. It is called with three arguments,
5240 the original extent, and the buffer positions which
5241 the copied extent will occupy. (This hook is run
5242 after the corresponding text has already been
5243 inserted into the buffer.) Note that the extent
5244 argument may be detached when this function is run.
5245 If this function returns nil, no extent will be
5246 inserted. Otherwise, there will be an extent
5247 covering the range in question.
5249 If the original extent is not attached to a buffer,
5250 then it will be re-attached at this range.
5251 Otherwise, a copy will be made, and that copy
5254 The copy-function and paste-function are meaningful
5255 only for extents with the `duplicable' flag set,
5256 and if they are not specified, behave as if `t' was
5257 the returned value. When these hooks are invoked,
5258 the current buffer is the buffer which the extent
5259 is being copied from/to, respectively.
5261 begin-glyph A glyph to be displayed at the beginning of the extent,
5264 end-glyph A glyph to be displayed at the end of the extent,
5267 begin-glyph-layout The layout policy (one of `text', `whitespace',
5268 `inside-margin', or `outside-margin') of the extent's
5271 end-glyph-layout The layout policy of the extent's end glyph.
5273 (extent, property, value))
5275 /* This function can GC if property is `keymap' */
5276 EXTENT e = decode_extent (extent, 0);
5278 if (EQ (property, Qread_only))
5279 set_extent_read_only (e, value);
5280 else if (EQ (property, Qunique))
5281 extent_unique_p (e) = !NILP (value);
5282 else if (EQ (property, Qduplicable))
5283 extent_duplicable_p (e) = !NILP (value);
5284 else if (EQ (property, Qinvisible))
5285 set_extent_invisible (e, value);
5286 else if (EQ (property, Qdetachable))
5287 extent_detachable_p (e) = !NILP (value);
5289 else if (EQ (property, Qdetached))
5292 error ("can only set `detached' to t");
5293 Fdetach_extent (extent);
5295 else if (EQ (property, Qdestroyed))
5298 error ("can only set `destroyed' to t");
5299 Fdelete_extent (extent);
5301 else if (EQ (property, Qpriority))
5302 Fset_extent_priority (extent, value);
5303 else if (EQ (property, Qface))
5304 Fset_extent_face (extent, value);
5305 else if (EQ (property, Qinitial_redisplay_function))
5306 Fset_extent_initial_redisplay_function (extent, value);
5307 else if (EQ (property, Qbefore_change_functions))
5308 set_extent_before_change_functions (e, value);
5309 else if (EQ (property, Qafter_change_functions))
5310 set_extent_after_change_functions (e, value);
5311 else if (EQ (property, Qmouse_face))
5312 Fset_extent_mouse_face (extent, value);
5314 else if (EQ (property, Qhighlight))
5315 Fset_extent_mouse_face (extent, Qhighlight);
5316 else if (EQ (property, Qbegin_glyph_layout))
5317 Fset_extent_begin_glyph_layout (extent, value);
5318 else if (EQ (property, Qend_glyph_layout))
5319 Fset_extent_end_glyph_layout (extent, value);
5320 /* For backwards compatibility. We use begin glyph because it is by
5321 far the more used of the two. */
5322 else if (EQ (property, Qglyph_layout))
5323 Fset_extent_begin_glyph_layout (extent, value);
5324 else if (EQ (property, Qbegin_glyph))
5325 Fset_extent_begin_glyph (extent, value, Qnil);
5326 else if (EQ (property, Qend_glyph))
5327 Fset_extent_end_glyph (extent, value, Qnil);
5328 else if (EQ (property, Qstart_open) ||
5329 EQ (property, Qend_open) ||
5330 EQ (property, Qstart_closed) ||
5331 EQ (property, Qend_closed))
5333 int start_open = -1, end_open = -1;
5334 if (EQ (property, Qstart_open))
5335 start_open = !NILP (value);
5336 else if (EQ (property, Qend_open))
5337 end_open = !NILP (value);
5338 /* Support (but don't document...) the obvious antonyms. */
5339 else if (EQ (property, Qstart_closed))
5340 start_open = NILP (value);
5342 end_open = NILP (value);
5343 set_extent_openness (e, start_open, end_open);
5347 if (EQ (property, Qkeymap))
5348 while (!NILP (value) && NILP (Fkeymapp (value)))
5349 value = wrong_type_argument (Qkeymapp, value);
5351 external_plist_put (extent_plist_addr (e), property, value, 0, ERROR_ME);
5357 DEFUN ("set-extent-properties", Fset_extent_properties, 2, 2, 0, /*
5358 Change some properties of EXTENT.
5359 PLIST is a property list.
5360 For a list of built-in properties, see `set-extent-property'.
5364 /* This function can GC, if one of the properties is `keymap' */
5365 Lisp_Object property, value;
5366 struct gcpro gcpro1;
5369 plist = Fcopy_sequence (plist);
5370 Fcanonicalize_plist (plist, Qnil);
5372 while (!NILP (plist))
5374 property = Fcar (plist); plist = Fcdr (plist);
5375 value = Fcar (plist); plist = Fcdr (plist);
5376 Fset_extent_property (extent, property, value);
5382 DEFUN ("extent-property", Fextent_property, 2, 3, 0, /*
5383 Return EXTENT's value for property PROPERTY.
5384 See `set-extent-property' for the built-in property names.
5386 (extent, property, default_))
5388 EXTENT e = decode_extent (extent, 0);
5390 if (EQ (property, Qdetached))
5391 return extent_detached_p (e) ? Qt : Qnil;
5392 else if (EQ (property, Qdestroyed))
5393 return !EXTENT_LIVE_P (e) ? Qt : Qnil;
5394 #define RETURN_FLAG(flag) return extent_normal_field (e, flag) ? Qt : Qnil
5395 else if (EQ (property, Qstart_open)) RETURN_FLAG (start_open);
5396 else if (EQ (property, Qend_open)) RETURN_FLAG (end_open);
5397 else if (EQ (property, Qunique)) RETURN_FLAG (unique);
5398 else if (EQ (property, Qduplicable)) RETURN_FLAG (duplicable);
5399 else if (EQ (property, Qdetachable)) RETURN_FLAG (detachable);
5401 /* Support (but don't document...) the obvious antonyms. */
5402 else if (EQ (property, Qstart_closed))
5403 return extent_start_open_p (e) ? Qnil : Qt;
5404 else if (EQ (property, Qend_closed))
5405 return extent_end_open_p (e) ? Qnil : Qt;
5406 else if (EQ (property, Qpriority))
5407 return make_int (extent_priority (e));
5408 else if (EQ (property, Qread_only))
5409 return extent_read_only (e);
5410 else if (EQ (property, Qinvisible))
5411 return extent_invisible (e);
5412 else if (EQ (property, Qface))
5413 return Fextent_face (extent);
5414 else if (EQ (property, Qinitial_redisplay_function))
5415 return extent_initial_redisplay_function (e);
5416 else if (EQ (property, Qbefore_change_functions))
5417 return extent_before_change_functions (e);
5418 else if (EQ (property, Qafter_change_functions))
5419 return extent_after_change_functions (e);
5420 else if (EQ (property, Qmouse_face))
5421 return Fextent_mouse_face (extent);
5423 else if (EQ (property, Qhighlight))
5424 return !NILP (Fextent_mouse_face (extent)) ? Qt : Qnil;
5425 else if (EQ (property, Qbegin_glyph_layout))
5426 return Fextent_begin_glyph_layout (extent);
5427 else if (EQ (property, Qend_glyph_layout))
5428 return Fextent_end_glyph_layout (extent);
5429 /* For backwards compatibility. We use begin glyph because it is by
5430 far the more used of the two. */
5431 else if (EQ (property, Qglyph_layout))
5432 return Fextent_begin_glyph_layout (extent);
5433 else if (EQ (property, Qbegin_glyph))
5434 return extent_begin_glyph (e);
5435 else if (EQ (property, Qend_glyph))
5436 return extent_end_glyph (e);
5439 Lisp_Object value = external_plist_get (extent_plist_addr (e),
5440 property, 0, ERROR_ME);
5441 return UNBOUNDP (value) ? default_ : value;
5445 DEFUN ("extent-properties", Fextent_properties, 1, 1, 0, /*
5446 Return a property list of the attributes of EXTENT.
5447 Do not modify this list; use `set-extent-property' instead.
5452 Lisp_Object result, face, anc_obj;
5453 glyph_layout layout;
5455 CHECK_EXTENT (extent);
5456 e = XEXTENT (extent);
5457 if (!EXTENT_LIVE_P (e))
5458 return cons3 (Qdestroyed, Qt, Qnil);
5460 anc = extent_ancestor (e);
5461 XSETEXTENT (anc_obj, anc);
5463 /* For efficiency, use the ancestor for all properties except detached */
5465 result = extent_plist_slot (anc);
5467 if (!NILP (face = Fextent_face (anc_obj)))
5468 result = cons3 (Qface, face, result);
5470 if (!NILP (face = Fextent_mouse_face (anc_obj)))
5471 result = cons3 (Qmouse_face, face, result);
5473 if ((layout = (glyph_layout) extent_begin_glyph_layout (anc)) != GL_TEXT)
5475 Lisp_Object sym = glyph_layout_to_symbol (layout);
5476 result = cons3 (Qglyph_layout, sym, result); /* compatibility */
5477 result = cons3 (Qbegin_glyph_layout, sym, result);
5480 if ((layout = (glyph_layout) extent_end_glyph_layout (anc)) != GL_TEXT)
5481 result = cons3 (Qend_glyph_layout, glyph_layout_to_symbol (layout), result);
5483 if (!NILP (extent_end_glyph (anc)))
5484 result = cons3 (Qend_glyph, extent_end_glyph (anc), result);
5486 if (!NILP (extent_begin_glyph (anc)))
5487 result = cons3 (Qbegin_glyph, extent_begin_glyph (anc), result);
5489 if (extent_priority (anc) != 0)
5490 result = cons3 (Qpriority, make_int (extent_priority (anc)), result);
5492 if (!NILP (extent_initial_redisplay_function (anc)))
5493 result = cons3 (Qinitial_redisplay_function,
5494 extent_initial_redisplay_function (anc), result);
5496 if (!NILP (extent_before_change_functions (anc)))
5497 result = cons3 (Qbefore_change_functions,
5498 extent_before_change_functions (anc), result);
5500 if (!NILP (extent_after_change_functions (anc)))
5501 result = cons3 (Qafter_change_functions,
5502 extent_after_change_functions (anc), result);
5504 if (!NILP (extent_invisible (anc)))
5505 result = cons3 (Qinvisible, extent_invisible (anc), result);
5507 if (!NILP (extent_read_only (anc)))
5508 result = cons3 (Qread_only, extent_read_only (anc), result);
5510 if (extent_normal_field (anc, end_open))
5511 result = cons3 (Qend_open, Qt, result);
5513 if (extent_normal_field (anc, start_open))
5514 result = cons3 (Qstart_open, Qt, result);
5516 if (extent_normal_field (anc, detachable))
5517 result = cons3 (Qdetachable, Qt, result);
5519 if (extent_normal_field (anc, duplicable))
5520 result = cons3 (Qduplicable, Qt, result);
5522 if (extent_normal_field (anc, unique))
5523 result = cons3 (Qunique, Qt, result);
5525 /* detached is not an inherited property */
5526 if (extent_detached_p (e))
5527 result = cons3 (Qdetached, Qt, result);
5533 /************************************************************************/
5535 /************************************************************************/
5537 /* The display code looks into the Vlast_highlighted_extent variable to
5538 correctly display highlighted extents. This updates that variable,
5539 and marks the appropriate buffers as needing some redisplay.
5542 do_highlight (Lisp_Object extent_obj, int highlight_p)
5544 if (( highlight_p && (EQ (Vlast_highlighted_extent, extent_obj))) ||
5545 (!highlight_p && (EQ (Vlast_highlighted_extent, Qnil))))
5547 if (EXTENTP (Vlast_highlighted_extent) &&
5548 EXTENT_LIVE_P (XEXTENT (Vlast_highlighted_extent)))
5550 /* do not recurse on descendants. Only one extent is highlighted
5552 extent_changed_for_redisplay (XEXTENT (Vlast_highlighted_extent), 0, 0);
5554 Vlast_highlighted_extent = Qnil;
5555 if (!NILP (extent_obj)
5556 && BUFFERP (extent_object (XEXTENT (extent_obj)))
5559 extent_changed_for_redisplay (XEXTENT (extent_obj), 0, 0);
5560 Vlast_highlighted_extent = extent_obj;
5564 DEFUN ("force-highlight-extent", Fforce_highlight_extent, 1, 2, 0, /*
5565 Highlight or unhighlight the given extent.
5566 If the second arg is non-nil, it will be highlighted, else dehighlighted.
5567 This is the same as `highlight-extent', except that it will work even
5568 on extents without the `mouse-face' property.
5570 (extent, highlight_p))
5575 XSETEXTENT (extent, decode_extent (extent, DE_MUST_BE_ATTACHED));
5576 do_highlight (extent, !NILP (highlight_p));
5580 DEFUN ("highlight-extent", Fhighlight_extent, 1, 2, 0, /*
5581 Highlight EXTENT, if it is highlightable.
5582 \(that is, if it has the `mouse-face' property).
5583 If the second arg is non-nil, it will be highlighted, else dehighlighted.
5584 Highlighted extents are displayed as if they were merged with the face
5585 or faces specified by the `mouse-face' property.
5587 (extent, highlight_p))
5589 if (EXTENTP (extent) && NILP (extent_mouse_face (XEXTENT (extent))))
5592 return Fforce_highlight_extent (extent, highlight_p);
5596 /************************************************************************/
5597 /* strings and extents */
5598 /************************************************************************/
5600 /* copy/paste hooks */
5603 run_extent_copy_paste_internal (EXTENT e, Bufpos from, Bufpos to,
5607 /* This function can GC */
5609 Lisp_Object copy_fn;
5610 XSETEXTENT (extent, e);
5611 copy_fn = Fextent_property (extent, prop, Qnil);
5612 if (!NILP (copy_fn))
5615 struct gcpro gcpro1, gcpro2, gcpro3;
5616 GCPRO3 (extent, copy_fn, object);
5617 if (BUFFERP (object))
5618 flag = call3_in_buffer (XBUFFER (object), copy_fn, extent,
5619 make_int (from), make_int (to));
5621 flag = call3 (copy_fn, extent, make_int (from), make_int (to));
5623 if (NILP (flag) || !EXTENT_LIVE_P (XEXTENT (extent)))
5630 run_extent_copy_function (EXTENT e, Bytind from, Bytind to)
5632 Lisp_Object object = extent_object (e);
5633 /* This function can GC */
5634 return run_extent_copy_paste_internal
5635 (e, buffer_or_string_bytind_to_bufpos (object, from),
5636 buffer_or_string_bytind_to_bufpos (object, to), object,
5641 run_extent_paste_function (EXTENT e, Bytind from, Bytind to,
5644 /* This function can GC */
5645 return run_extent_copy_paste_internal
5646 (e, buffer_or_string_bytind_to_bufpos (object, from),
5647 buffer_or_string_bytind_to_bufpos (object, to), object,
5652 update_extent (EXTENT extent, Bytind from, Bytind to)
5654 set_extent_endpoints (extent, from, to, Qnil);
5657 /* Insert an extent, usually from the dup_list of a string which
5658 has just been inserted.
5659 This code does not handle the case of undo.
5662 insert_extent (EXTENT extent, Bytind new_start, Bytind new_end,
5663 Lisp_Object object, int run_hooks)
5665 /* This function can GC */
5668 if (!EQ (extent_object (extent), object))
5671 if (extent_detached_p (extent))
5674 !run_extent_paste_function (extent, new_start, new_end, object))
5675 /* The paste-function said don't re-attach this extent here. */
5678 update_extent (extent, new_start, new_end);
5682 Bytind exstart = extent_endpoint_bytind (extent, 0);
5683 Bytind exend = extent_endpoint_bytind (extent, 1);
5685 if (exend < new_start || exstart > new_end)
5689 new_start = min (exstart, new_start);
5690 new_end = max (exend, new_end);
5691 if (exstart != new_start || exend != new_end)
5692 update_extent (extent, new_start, new_end);
5696 XSETEXTENT (tmp, extent);
5701 !run_extent_paste_function (extent, new_start, new_end, object))
5702 /* The paste-function said don't attach a copy of the extent here. */
5706 XSETEXTENT (tmp, copy_extent (extent, new_start, new_end, object));
5711 DEFUN ("insert-extent", Finsert_extent, 1, 5, 0, /*
5712 Insert EXTENT from START to END in BUFFER-OR-STRING.
5713 BUFFER-OR-STRING defaults to the current buffer if omitted.
5714 This operation does not insert any characters,
5715 but otherwise acts as if there were a replicating extent whose
5716 parent is EXTENT in some string that was just inserted.
5717 Returns the newly-inserted extent.
5718 The fourth arg, NO-HOOKS, can be used to inhibit the running of the
5719 extent's `paste-function' property if it has one.
5720 See documentation on `detach-extent' for a discussion of undo recording.
5722 (extent, start, end, no_hooks, buffer_or_string))
5724 EXTENT ext = decode_extent (extent, 0);
5728 buffer_or_string = decode_buffer_or_string (buffer_or_string);
5729 get_buffer_or_string_range_byte (buffer_or_string, start, end, &s, &e,
5730 GB_ALLOW_PAST_ACCESSIBLE);
5732 copy = insert_extent (ext, s, e, buffer_or_string, NILP (no_hooks));
5735 if (extent_duplicable_p (XEXTENT (copy)))
5736 record_extent (copy, 1);
5742 /* adding buffer extents to a string */
5744 struct add_string_extents_arg
5752 add_string_extents_mapper (EXTENT extent, void *arg)
5754 /* This function can GC */
5755 struct add_string_extents_arg *closure =
5756 (struct add_string_extents_arg *) arg;
5757 Bytecount start = extent_endpoint_bytind (extent, 0) - closure->from;
5758 Bytecount end = extent_endpoint_bytind (extent, 1) - closure->from;
5760 if (extent_duplicable_p (extent))
5764 start = max (start, 0);
5765 end = min (end, closure->length);
5767 /* Run the copy-function to give an extent the option of
5768 not being copied into the string (or kill ring).
5770 if (extent_duplicable_p (extent) &&
5771 !run_extent_copy_function (extent, start + closure->from,
5772 end + closure->from))
5774 e = copy_extent (extent, start, end, closure->string);
5780 /* Add the extents in buffer BUF from OPOINT to OPOINT+LENGTH to
5781 the string STRING. */
5783 add_string_extents (Lisp_Object string, struct buffer *buf, Bytind opoint,
5786 /* This function can GC */
5787 struct add_string_extents_arg closure;
5788 struct gcpro gcpro1, gcpro2;
5791 closure.from = opoint;
5792 closure.length = length;
5793 closure.string = string;
5794 buffer = make_buffer (buf);
5795 GCPRO2 (buffer, string);
5796 map_extents_bytind (opoint, opoint + length, add_string_extents_mapper,
5797 (void *) &closure, buffer, 0,
5798 /* ignore extents that just abut the region */
5799 ME_END_CLOSED | ME_ALL_EXTENTS_OPEN |
5800 /* we are calling E-Lisp (the extent's copy function)
5801 so anything might happen */
5802 ME_MIGHT_CALL_ELISP);
5806 struct splice_in_string_extents_arg
5815 splice_in_string_extents_mapper (EXTENT extent, void *arg)
5817 /* This function can GC */
5818 struct splice_in_string_extents_arg *closure =
5819 (struct splice_in_string_extents_arg *) arg;
5820 /* BASE_START and BASE_END are the limits in the buffer of the string
5821 that was just inserted.
5823 NEW_START and NEW_END are the prospective buffer positions of the
5824 extent that is going into the buffer. */
5825 Bytind base_start = closure->opoint;
5826 Bytind base_end = base_start + closure->length;
5827 Bytind new_start = (base_start + extent_endpoint_bytind (extent, 0) -
5829 Bytind new_end = (base_start + extent_endpoint_bytind (extent, 1) -
5832 if (new_start < base_start)
5833 new_start = base_start;
5834 if (new_end > base_end)
5836 if (new_end <= new_start)
5839 if (!extent_duplicable_p (extent))
5843 !run_extent_paste_function (extent, new_start, new_end,
5846 copy_extent (extent, new_start, new_end, closure->buffer);
5851 /* We have just inserted a section of STRING (starting at POS, of
5852 length LENGTH) into buffer BUF at OPOINT. Do whatever is necessary
5853 to get the string's extents into the buffer. */
5856 splice_in_string_extents (Lisp_Object string, struct buffer *buf,
5857 Bytind opoint, Bytecount length, Bytecount pos)
5859 struct splice_in_string_extents_arg closure;
5860 struct gcpro gcpro1, gcpro2;
5863 buffer = make_buffer (buf);
5864 closure.opoint = opoint;
5866 closure.length = length;
5867 closure.buffer = buffer;
5868 GCPRO2 (buffer, string);
5869 map_extents_bytind (pos, pos + length,
5870 splice_in_string_extents_mapper,
5871 (void *) &closure, string, 0,
5872 /* ignore extents that just abut the region */
5873 ME_END_CLOSED | ME_ALL_EXTENTS_OPEN |
5874 /* we are calling E-Lisp (the extent's copy function)
5875 so anything might happen */
5876 ME_MIGHT_CALL_ELISP);
5880 struct copy_string_extents_arg
5885 Lisp_Object new_string;
5888 struct copy_string_extents_1_arg
5890 Lisp_Object parent_in_question;
5891 EXTENT found_extent;
5895 copy_string_extents_mapper (EXTENT extent, void *arg)
5897 struct copy_string_extents_arg *closure =
5898 (struct copy_string_extents_arg *) arg;
5899 Bytecount old_start, old_end;
5900 Bytecount new_start, new_end;
5902 old_start = extent_endpoint_bytind (extent, 0);
5903 old_end = extent_endpoint_bytind (extent, 1);
5905 old_start = max (closure->old_pos, old_start);
5906 old_end = min (closure->old_pos + closure->length, old_end);
5908 if (old_start >= old_end)
5911 new_start = old_start + closure->new_pos - closure->old_pos;
5912 new_end = old_end + closure->new_pos - closure->old_pos;
5914 copy_extent (extent,
5915 old_start + closure->new_pos - closure->old_pos,
5916 old_end + closure->new_pos - closure->old_pos,
5917 closure->new_string);
5921 /* The string NEW_STRING was partially constructed from OLD_STRING.
5922 In particular, the section of length LEN starting at NEW_POS in
5923 NEW_STRING came from the section of the same length starting at
5924 OLD_POS in OLD_STRING. Copy the extents as appropriate. */
5927 copy_string_extents (Lisp_Object new_string, Lisp_Object old_string,
5928 Bytecount new_pos, Bytecount old_pos,
5931 struct copy_string_extents_arg closure;
5932 struct gcpro gcpro1, gcpro2;
5934 closure.new_pos = new_pos;
5935 closure.old_pos = old_pos;
5936 closure.new_string = new_string;
5937 closure.length = length;
5938 GCPRO2 (new_string, old_string);
5939 map_extents_bytind (old_pos, old_pos + length,
5940 copy_string_extents_mapper,
5941 (void *) &closure, old_string, 0,
5942 /* ignore extents that just abut the region */
5943 ME_END_CLOSED | ME_ALL_EXTENTS_OPEN |
5944 /* we are calling E-Lisp (the extent's copy function)
5945 so anything might happen */
5946 ME_MIGHT_CALL_ELISP);
5950 /* Checklist for sanity checking:
5951 - {kill, yank, copy} at {open, closed} {start, end} of {writable, read-only} extent
5952 - {kill, copy} & yank {once, repeatedly} duplicable extent in {same, different} buffer
5956 /************************************************************************/
5957 /* text properties */
5958 /************************************************************************/
5961 Originally this stuff was implemented in lisp (all of the functionality
5962 exists to make that possible) but speed was a problem.
5965 Lisp_Object Qtext_prop;
5966 Lisp_Object Qtext_prop_extent_paste_function;
5969 get_text_property_bytind (Bytind position, Lisp_Object prop,
5970 Lisp_Object object, enum extent_at_flag fl,
5971 int text_props_only)
5975 /* text_props_only specifies whether we only consider text-property
5976 extents (those with the 'text-prop property set) or all extents. */
5977 if (!text_props_only)
5978 extent = extent_at_bytind (position, object, prop, 0, fl);
5984 extent = extent_at_bytind (position, object, Qtext_prop, prior,
5988 if (EQ (prop, Fextent_property (extent, Qtext_prop, Qnil)))
5990 prior = XEXTENT (extent);
5995 return Fextent_property (extent, prop, Qnil);
5996 if (!NILP (Vdefault_text_properties))
5997 return Fplist_get (Vdefault_text_properties, prop, Qnil);
6002 get_text_property_1 (Lisp_Object pos, Lisp_Object prop, Lisp_Object object,
6003 Lisp_Object at_flag, int text_props_only)
6008 object = decode_buffer_or_string (object);
6009 position = get_buffer_or_string_pos_byte (object, pos, GB_NO_ERROR_IF_BAD);
6011 /* We canonicalize the start/end-open/closed properties to the
6012 non-default version -- "adding" the default property really
6013 needs to remove the non-default one. See below for more
6015 if (EQ (prop, Qstart_closed))
6021 if (EQ (prop, Qend_open))
6029 get_text_property_bytind (position, prop, object,
6030 decode_extent_at_flag (at_flag),
6033 val = NILP (val) ? Qt : Qnil;
6038 DEFUN ("get-text-property", Fget_text_property, 2, 4, 0, /*
6039 Return the value of the PROP property at the given position.
6040 Optional arg OBJECT specifies the buffer or string to look in, and
6041 defaults to the current buffer.
6042 Optional arg AT-FLAG controls what it means for a property to be "at"
6043 a position, and has the same meaning as in `extent-at'.
6044 This examines only those properties added with `put-text-property'.
6045 See also `get-char-property'.
6047 (pos, prop, object, at_flag))
6049 return get_text_property_1 (pos, prop, object, at_flag, 1);
6052 DEFUN ("get-char-property", Fget_char_property, 2, 4, 0, /*
6053 Return the value of the PROP property at the given position.
6054 Optional arg OBJECT specifies the buffer or string to look in, and
6055 defaults to the current buffer.
6056 Optional arg AT-FLAG controls what it means for a property to be "at"
6057 a position, and has the same meaning as in `extent-at'.
6058 This examines properties on all extents.
6059 See also `get-text-property'.
6061 (pos, prop, object, at_flag))
6063 return get_text_property_1 (pos, prop, object, at_flag, 0);
6066 /* About start/end-open/closed:
6068 These properties have to be handled specially because of their
6069 strange behavior. If I put the "start-open" property on a region,
6070 then *all* text-property extents in the region have to have their
6071 start be open. This is unlike all other properties, which don't
6072 affect the extents of text properties other than their own.
6076 1) We have to map start-closed to (not start-open) and end-open
6077 to (not end-closed) -- i.e. adding the default is really the
6078 same as remove the non-default property. It won't work, for
6079 example, to have both "start-open" and "start-closed" on
6081 2) Whenever we add one of these properties, we go through all
6082 text-property extents in the region and set the appropriate
6083 open/closedness on them.
6084 3) Whenever we change a text-property extent for a property,
6085 we have to make sure we set the open/closedness properly.
6087 (2) and (3) together rely on, and maintain, the invariant
6088 that the open/closedness of text-property extents is correct
6089 at the beginning and end of each operation.
6092 struct put_text_prop_arg
6094 Lisp_Object prop, value; /* The property and value we are storing */
6095 Bytind start, end; /* The region into which we are storing it */
6097 Lisp_Object the_extent; /* Our chosen extent; this is used for
6098 communication between subsequent passes. */
6099 int changed_p; /* Output: whether we have modified anything */
6103 put_text_prop_mapper (EXTENT e, void *arg)
6105 struct put_text_prop_arg *closure = (struct put_text_prop_arg *) arg;
6107 Lisp_Object object = closure->object;
6108 Lisp_Object value = closure->value;
6109 Bytind e_start, e_end;
6110 Bytind start = closure->start;
6111 Bytind end = closure->end;
6112 Lisp_Object extent, e_val;
6115 XSETEXTENT (extent, e);
6117 /* Note: in some cases when the property itself is 'start-open
6118 or 'end-closed, the checks to set the openness may do a bit
6119 of extra work; but it won't hurt because we then fix up the
6120 openness later on in put_text_prop_openness_mapper(). */
6121 if (!EQ (Fextent_property (extent, Qtext_prop, Qnil), closure->prop))
6122 /* It's not for this property; do nothing. */
6125 e_start = extent_endpoint_bytind (e, 0);
6126 e_end = extent_endpoint_bytind (e, 1);
6127 e_val = Fextent_property (extent, closure->prop, Qnil);
6128 is_eq = EQ (value, e_val);
6130 if (!NILP (value) && NILP (closure->the_extent) && is_eq)
6132 /* We want there to be an extent here at the end, and we haven't picked
6133 one yet, so use this one. Extend it as necessary. We only reuse an
6134 extent which has an EQ value for the prop in question to avoid
6135 side-effecting the kill ring (that is, we never change the property
6136 on an extent after it has been created.)
6138 if (e_start != start || e_end != end)
6140 Bytind new_start = min (e_start, start);
6141 Bytind new_end = max (e_end, end);
6142 set_extent_endpoints (e, new_start, new_end, Qnil);
6143 /* If we changed the endpoint, then we need to set its
6145 set_extent_openness (e, new_start != e_start
6146 ? !NILP (get_text_property_bytind
6147 (start, Qstart_open, object,
6148 EXTENT_AT_AFTER, 1)) : -1,
6150 ? NILP (get_text_property_bytind
6151 (end - 1, Qend_closed, object,
6152 EXTENT_AT_AFTER, 1))
6154 closure->changed_p = 1;
6156 closure->the_extent = extent;
6159 /* Even if we're adding a prop, at this point, we want all other extents of
6160 this prop to go away (as now they overlap). So the theory here is that,
6161 when we are adding a prop to a region that has multiple (disjoint)
6162 occurrences of that prop in it already, we pick one of those and extend
6163 it, and remove the others.
6166 else if (EQ (extent, closure->the_extent))
6168 /* just in case map-extents hits it again (does that happen?) */
6171 else if (e_start >= start && e_end <= end)
6173 /* Extent is contained in region; remove it. Don't destroy or modify
6174 it, because we don't want to change the attributes pointed to by the
6175 duplicates in the kill ring.
6178 closure->changed_p = 1;
6180 else if (!NILP (closure->the_extent) &&
6185 EXTENT te = XEXTENT (closure->the_extent);
6186 /* This extent overlaps, and has the same prop/value as the extent we've
6187 decided to reuse, so we can remove this existing extent as well (the
6188 whole thing, even the part outside of the region) and extend
6189 the-extent to cover it, resulting in the minimum number of extents in
6192 Bytind the_start = extent_endpoint_bytind (te, 0);
6193 Bytind the_end = extent_endpoint_bytind (te, 1);
6194 if (e_start != the_start && /* note AND not OR -- hmm, why is this
6195 the case? I think it's because the
6196 assumption that the text-property
6197 extents don't overlap makes it
6198 OK; changing it to an OR would
6199 result in changed_p sometimes getting
6200 falsely marked. Is this bad? */
6203 Bytind new_start = min (e_start, the_start);
6204 Bytind new_end = max (e_end, the_end);
6205 set_extent_endpoints (te, new_start, new_end, Qnil);
6206 /* If we changed the endpoint, then we need to set its
6207 openness. We are setting the endpoint to be the same as
6208 that of the extent we're about to remove, and we assume
6209 (the invariant mentioned above) that extent has the
6210 proper endpoint setting, so we just use it. */
6211 set_extent_openness (te, new_start != e_start ?
6212 (int) extent_start_open_p (e) : -1,
6214 (int) extent_end_open_p (e) : -1);
6215 closure->changed_p = 1;
6219 else if (e_end <= end)
6221 /* Extent begins before start but ends before end, so we can just
6222 decrease its end position.
6226 set_extent_endpoints (e, e_start, start, Qnil);
6227 set_extent_openness (e, -1, NILP (get_text_property_bytind
6228 (start - 1, Qend_closed, object,
6229 EXTENT_AT_AFTER, 1)));
6230 closure->changed_p = 1;
6233 else if (e_start >= start)
6235 /* Extent ends after end but begins after start, so we can just
6236 increase its start position.
6240 set_extent_endpoints (e, end, e_end, Qnil);
6241 set_extent_openness (e, !NILP (get_text_property_bytind
6242 (end, Qstart_open, object,
6243 EXTENT_AT_AFTER, 1)), -1);
6244 closure->changed_p = 1;
6249 /* Otherwise, `extent' straddles the region. We need to split it.
6251 set_extent_endpoints (e, e_start, start, Qnil);
6252 set_extent_openness (e, -1, NILP (get_text_property_bytind
6253 (start - 1, Qend_closed, object,
6254 EXTENT_AT_AFTER, 1)));
6255 set_extent_openness (copy_extent (e, end, e_end, extent_object (e)),
6256 !NILP (get_text_property_bytind
6257 (end, Qstart_open, object,
6258 EXTENT_AT_AFTER, 1)), -1);
6259 closure->changed_p = 1;
6262 return 0; /* to continue mapping. */
6266 put_text_prop_openness_mapper (EXTENT e, void *arg)
6268 struct put_text_prop_arg *closure = (struct put_text_prop_arg *) arg;
6269 Bytind e_start, e_end;
6270 Bytind start = closure->start;
6271 Bytind end = closure->end;
6273 XSETEXTENT (extent, e);
6274 e_start = extent_endpoint_bytind (e, 0);
6275 e_end = extent_endpoint_bytind (e, 1);
6277 if (NILP (Fextent_property (extent, Qtext_prop, Qnil)))
6279 /* It's not a text-property extent; do nothing. */
6282 /* Note end conditions and NILP/!NILP's carefully. */
6283 else if (EQ (closure->prop, Qstart_open)
6284 && e_start >= start && e_start < end)
6285 set_extent_openness (e, !NILP (closure->value), -1);
6286 else if (EQ (closure->prop, Qend_closed)
6287 && e_end > start && e_end <= end)
6288 set_extent_openness (e, -1, NILP (closure->value));
6290 return 0; /* to continue mapping. */
6294 put_text_prop (Bytind start, Bytind end, Lisp_Object object,
6295 Lisp_Object prop, Lisp_Object value,
6298 /* This function can GC */
6299 struct put_text_prop_arg closure;
6301 if (start == end) /* There are no characters in the region. */
6304 /* convert to the non-default versions, since a nil property is
6305 the same as it not being present. */
6306 if (EQ (prop, Qstart_closed))
6309 value = NILP (value) ? Qt : Qnil;
6311 else if (EQ (prop, Qend_open))
6314 value = NILP (value) ? Qt : Qnil;
6317 value = canonicalize_extent_property (prop, value);
6319 closure.prop = prop;
6320 closure.value = value;
6321 closure.start = start;
6323 closure.object = object;
6324 closure.changed_p = 0;
6325 closure.the_extent = Qnil;
6327 map_extents_bytind (start, end,
6328 put_text_prop_mapper,
6329 (void *) &closure, object, 0,
6330 /* get all extents that abut the region */
6331 ME_ALL_EXTENTS_CLOSED | ME_END_CLOSED |
6332 /* it might QUIT or error if the user has
6333 fucked with the extent plist. */
6334 /* #### dmoore - I think this should include
6335 ME_MIGHT_MOVE_SOE, since the callback function
6336 might recurse back into map_extents_bytind. */
6338 ME_MIGHT_MODIFY_EXTENTS);
6340 /* If we made it through the loop without reusing an extent
6341 (and we want there to be one) make it now.
6343 if (!NILP (value) && NILP (closure.the_extent))
6347 XSETEXTENT (extent, make_extent_internal (object, start, end));
6348 closure.changed_p = 1;
6349 Fset_extent_property (extent, Qtext_prop, prop);
6350 Fset_extent_property (extent, prop, value);
6353 extent_duplicable_p (XEXTENT (extent)) = 1;
6354 Fset_extent_property (extent, Qpaste_function,
6355 Qtext_prop_extent_paste_function);
6357 set_extent_openness (XEXTENT (extent),
6358 !NILP (get_text_property_bytind
6359 (start, Qstart_open, object,
6360 EXTENT_AT_AFTER, 1)),
6361 NILP (get_text_property_bytind
6362 (end - 1, Qend_closed, object,
6363 EXTENT_AT_AFTER, 1)));
6366 if (EQ (prop, Qstart_open) || EQ (prop, Qend_closed))
6368 map_extents_bytind (start, end,
6369 put_text_prop_openness_mapper,
6370 (void *) &closure, object, 0,
6371 /* get all extents that abut the region */
6372 ME_ALL_EXTENTS_CLOSED | ME_END_CLOSED |
6373 ME_MIGHT_MODIFY_EXTENTS);
6376 return closure.changed_p;
6379 DEFUN ("put-text-property", Fput_text_property, 4, 5, 0, /*
6380 Adds the given property/value to all characters in the specified region.
6381 The property is conceptually attached to the characters rather than the
6382 region. The properties are copied when the characters are copied/pasted.
6383 Fifth argument OBJECT is the buffer or string containing the text, and
6384 defaults to the current buffer.
6386 (start, end, prop, value, object))
6388 /* This function can GC */
6391 object = decode_buffer_or_string (object);
6392 get_buffer_or_string_range_byte (object, start, end, &s, &e, 0);
6393 put_text_prop (s, e, object, prop, value, 1);
6397 DEFUN ("put-nonduplicable-text-property", Fput_nonduplicable_text_property,
6399 Adds the given property/value to all characters in the specified region.
6400 The property is conceptually attached to the characters rather than the
6401 region, however the properties will not be copied when the characters
6403 Fifth argument OBJECT is the buffer or string containing the text, and
6404 defaults to the current buffer.
6406 (start, end, prop, value, object))
6408 /* This function can GC */
6411 object = decode_buffer_or_string (object);
6412 get_buffer_or_string_range_byte (object, start, end, &s, &e, 0);
6413 put_text_prop (s, e, object, prop, value, 0);
6417 DEFUN ("add-text-properties", Fadd_text_properties, 3, 4, 0, /*
6418 Add properties to the characters from START to END.
6419 The third argument PROPS is a property list specifying the property values
6420 to add. The optional fourth argument, OBJECT, is the buffer or string
6421 containing the text and defaults to the current buffer. Returns t if
6422 any property was changed, nil otherwise.
6424 (start, end, props, object))
6426 /* This function can GC */
6430 object = decode_buffer_or_string (object);
6431 get_buffer_or_string_range_byte (object, start, end, &s, &e, 0);
6433 for (; !NILP (props); props = Fcdr (Fcdr (props)))
6435 Lisp_Object prop = XCAR (props);
6436 Lisp_Object value = Fcar (XCDR (props));
6437 changed |= put_text_prop (s, e, object, prop, value, 1);
6439 return changed ? Qt : Qnil;
6443 DEFUN ("add-nonduplicable-text-properties", Fadd_nonduplicable_text_properties,
6445 Add nonduplicable properties to the characters from START to END.
6446 \(The properties will not be copied when the characters are copied.)
6447 The third argument PROPS is a property list specifying the property values
6448 to add. The optional fourth argument, OBJECT, is the buffer or string
6449 containing the text and defaults to the current buffer. Returns t if
6450 any property was changed, nil otherwise.
6452 (start, end, props, object))
6454 /* This function can GC */
6458 object = decode_buffer_or_string (object);
6459 get_buffer_or_string_range_byte (object, start, end, &s, &e, 0);
6461 for (; !NILP (props); props = Fcdr (Fcdr (props)))
6463 Lisp_Object prop = XCAR (props);
6464 Lisp_Object value = Fcar (XCDR (props));
6465 changed |= put_text_prop (s, e, object, prop, value, 0);
6467 return changed ? Qt : Qnil;
6470 DEFUN ("remove-text-properties", Fremove_text_properties, 3, 4, 0, /*
6471 Remove the given properties from all characters in the specified region.
6472 PROPS should be a plist, but the values in that plist are ignored (treated
6473 as nil). Returns t if any property was changed, nil otherwise.
6474 Fourth argument OBJECT is the buffer or string containing the text, and
6475 defaults to the current buffer.
6477 (start, end, props, object))
6479 /* This function can GC */
6483 object = decode_buffer_or_string (object);
6484 get_buffer_or_string_range_byte (object, start, end, &s, &e, 0);
6486 for (; !NILP (props); props = Fcdr (Fcdr (props)))
6488 Lisp_Object prop = XCAR (props);
6489 changed |= put_text_prop (s, e, object, prop, Qnil, 1);
6491 return changed ? Qt : Qnil;
6494 /* Whenever a text-prop extent is pasted into a buffer (via `yank' or `insert'
6495 or whatever) we attach the properties to the buffer by calling
6496 `put-text-property' instead of by simply allowing the extent to be copied or
6497 re-attached. Then we return nil, telling the extents code not to attach it
6498 again. By handing the insertion hackery in this way, we make kill/yank
6499 behave consistently with put-text-property and not fragment the extents
6500 (since text-prop extents must partition, not overlap).
6502 The lisp implementation of this was probably fast enough, but since I moved
6503 the rest of the put-text-prop code here, I moved this as well for
6506 DEFUN ("text-prop-extent-paste-function", Ftext_prop_extent_paste_function,
6508 Used as the `paste-function' property of `text-prop' extents.
6512 /* This function can GC */
6513 Lisp_Object prop, val;
6515 prop = Fextent_property (extent, Qtext_prop, Qnil);
6517 signal_simple_error ("internal error: no text-prop", extent);
6518 val = Fextent_property (extent, prop, Qnil);
6520 /* removed by bill perry, 2/9/97
6521 ** This little bit of code would not allow you to have a text property
6522 ** with a value of Qnil. This is bad bad bad.
6525 signal_simple_error_2 ("internal error: no text-prop",
6528 Fput_text_property (from, to, prop, val, Qnil);
6529 return Qnil; /* important! */
6532 /* This function could easily be written in Lisp but the C code wants
6533 to use it in connection with invisible extents (at least currently).
6534 If this changes, consider moving this back into Lisp. */
6536 DEFUN ("next-single-property-change", Fnext_single_property_change,
6538 Return the position of next property change for a specific property.
6539 Scans characters forward from POS till it finds a change in the PROP
6540 property, then returns the position of the change. The optional third
6541 argument OBJECT is the buffer or string to scan (defaults to the current
6543 The property values are compared with `eq'.
6544 Return nil if the property is constant all the way to the end of BUFFER.
6545 If the value is non-nil, it is a position greater than POS, never equal.
6547 If the optional fourth argument LIMIT is non-nil, don't search
6548 past position LIMIT; return LIMIT if nothing is found before LIMIT.
6549 If two or more extents with conflicting non-nil values for PROP overlap
6550 a particular character, it is undefined which value is considered to be
6551 the value of PROP. (Note that this situation will not happen if you always
6552 use the text-property primitives.)
6554 (pos, prop, object, limit))
6558 Lisp_Object extent, value;
6561 object = decode_buffer_or_string (object);
6562 bpos = get_buffer_or_string_pos_char (object, pos, 0);
6565 blim = buffer_or_string_accessible_end_char (object);
6570 blim = get_buffer_or_string_pos_char (object, limit, 0);
6574 extent = Fextent_at (make_int (bpos), object, prop, Qnil, Qnil);
6576 value = Fextent_property (extent, prop, Qnil);
6582 bpos = XINT (Fnext_extent_change (make_int (bpos), object));
6584 break; /* property is the same all the way to the end */
6585 extent = Fextent_at (make_int (bpos), object, prop, Qnil, Qnil);
6586 if ((NILP (extent) && !NILP (value)) ||
6587 (!NILP (extent) && !EQ (value,
6588 Fextent_property (extent, prop, Qnil))))
6589 return make_int (bpos);
6592 /* I think it's more sensible for this function to return nil always
6593 in this situation and it used to do it this way, but it's been changed
6594 for FSF compatibility. */
6598 return make_int (blim);
6601 /* See comment on previous function about why this is written in C. */
6603 DEFUN ("previous-single-property-change", Fprevious_single_property_change,
6605 Return the position of next property change for a specific property.
6606 Scans characters backward from POS till it finds a change in the PROP
6607 property, then returns the position of the change. The optional third
6608 argument OBJECT is the buffer or string to scan (defaults to the current
6610 The property values are compared with `eq'.
6611 Return nil if the property is constant all the way to the start of BUFFER.
6612 If the value is non-nil, it is a position less than POS, never equal.
6614 If the optional fourth argument LIMIT is non-nil, don't search back
6615 past position LIMIT; return LIMIT if nothing is found until LIMIT.
6616 If two or more extents with conflicting non-nil values for PROP overlap
6617 a particular character, it is undefined which value is considered to be
6618 the value of PROP. (Note that this situation will not happen if you always
6619 use the text-property primitives.)
6621 (pos, prop, object, limit))
6625 Lisp_Object extent, value;
6628 object = decode_buffer_or_string (object);
6629 bpos = get_buffer_or_string_pos_char (object, pos, 0);
6632 blim = buffer_or_string_accessible_begin_char (object);
6637 blim = get_buffer_or_string_pos_char (object, limit, 0);
6641 /* extent-at refers to the character AFTER bpos, but we want the
6642 character before bpos. Thus the - 1. extent-at simply
6643 returns nil on bogus positions, so not to worry. */
6644 extent = Fextent_at (make_int (bpos - 1), object, prop, Qnil, Qnil);
6646 value = Fextent_property (extent, prop, Qnil);
6652 bpos = XINT (Fprevious_extent_change (make_int (bpos), object));
6654 break; /* property is the same all the way to the beginning */
6655 extent = Fextent_at (make_int (bpos - 1), object, prop, Qnil, Qnil);
6656 if ((NILP (extent) && !NILP (value)) ||
6657 (!NILP (extent) && !EQ (value,
6658 Fextent_property (extent, prop, Qnil))))
6659 return make_int (bpos);
6662 /* I think it's more sensible for this function to return nil always
6663 in this situation and it used to do it this way, but it's been changed
6664 for FSF compatibility. */
6668 return make_int (blim);
6671 #ifdef MEMORY_USAGE_STATS
6674 compute_buffer_extent_usage (struct buffer *b, struct overhead_stats *ovstats)
6676 /* #### not yet written */
6680 #endif /* MEMORY_USAGE_STATS */
6683 /************************************************************************/
6684 /* initialization */
6685 /************************************************************************/
6688 syms_of_extents (void)
6690 defsymbol (&Qextentp, "extentp");
6691 defsymbol (&Qextent_live_p, "extent-live-p");
6693 defsymbol (&Qall_extents_closed, "all-extents-closed");
6694 defsymbol (&Qall_extents_open, "all-extents-open");
6695 defsymbol (&Qall_extents_closed_open, "all-extents-closed-open");
6696 defsymbol (&Qall_extents_open_closed, "all-extents-open-closed");
6697 defsymbol (&Qstart_in_region, "start-in-region");
6698 defsymbol (&Qend_in_region, "end-in-region");
6699 defsymbol (&Qstart_and_end_in_region, "start-and-end-in-region");
6700 defsymbol (&Qstart_or_end_in_region, "start-or-end-in-region");
6701 defsymbol (&Qnegate_in_region, "negate-in-region");
6703 defsymbol (&Qdetached, "detached");
6704 defsymbol (&Qdestroyed, "destroyed");
6705 defsymbol (&Qbegin_glyph, "begin-glyph");
6706 defsymbol (&Qend_glyph, "end-glyph");
6707 defsymbol (&Qstart_open, "start-open");
6708 defsymbol (&Qend_open, "end-open");
6709 defsymbol (&Qstart_closed, "start-closed");
6710 defsymbol (&Qend_closed, "end-closed");
6711 defsymbol (&Qread_only, "read-only");
6712 /* defsymbol (&Qhighlight, "highlight"); in faces.c */
6713 defsymbol (&Qunique, "unique");
6714 defsymbol (&Qduplicable, "duplicable");
6715 defsymbol (&Qdetachable, "detachable");
6716 defsymbol (&Qpriority, "priority");
6717 defsymbol (&Qmouse_face, "mouse-face");
6718 defsymbol (&Qinitial_redisplay_function,"initial-redisplay-function");
6721 defsymbol (&Qglyph_layout, "glyph-layout"); /* backwards compatibility */
6722 defsymbol (&Qbegin_glyph_layout, "begin-glyph-layout");
6723 defsymbol (&Qend_glyph_layout, "end-glyph-layout");
6724 defsymbol (&Qoutside_margin, "outside-margin");
6725 defsymbol (&Qinside_margin, "inside-margin");
6726 defsymbol (&Qwhitespace, "whitespace");
6727 /* Qtext defined in general.c */
6729 defsymbol (&Qglyph_invisible, "glyph-invisible");
6731 defsymbol (&Qpaste_function, "paste-function");
6732 defsymbol (&Qcopy_function, "copy-function");
6734 defsymbol (&Qtext_prop, "text-prop");
6735 defsymbol (&Qtext_prop_extent_paste_function,
6736 "text-prop-extent-paste-function");
6739 DEFSUBR (Fextent_live_p);
6740 DEFSUBR (Fextent_detached_p);
6741 DEFSUBR (Fextent_start_position);
6742 DEFSUBR (Fextent_end_position);
6743 DEFSUBR (Fextent_object);
6744 DEFSUBR (Fextent_length);
6746 DEFSUBR (Fmake_extent);
6747 DEFSUBR (Fcopy_extent);
6748 DEFSUBR (Fdelete_extent);
6749 DEFSUBR (Fdetach_extent);
6750 DEFSUBR (Fset_extent_endpoints);
6751 DEFSUBR (Fnext_extent);
6752 DEFSUBR (Fprevious_extent);
6754 DEFSUBR (Fnext_e_extent);
6755 DEFSUBR (Fprevious_e_extent);
6757 DEFSUBR (Fnext_extent_change);
6758 DEFSUBR (Fprevious_extent_change);
6760 DEFSUBR (Fextent_parent);
6761 DEFSUBR (Fextent_children);
6762 DEFSUBR (Fset_extent_parent);
6764 DEFSUBR (Fextent_in_region_p);
6765 DEFSUBR (Fmap_extents);
6766 DEFSUBR (Fmap_extent_children);
6767 DEFSUBR (Fextent_at);
6769 DEFSUBR (Fset_extent_initial_redisplay_function);
6770 DEFSUBR (Fextent_face);
6771 DEFSUBR (Fset_extent_face);
6772 DEFSUBR (Fextent_mouse_face);
6773 DEFSUBR (Fset_extent_mouse_face);
6774 DEFSUBR (Fset_extent_begin_glyph);
6775 DEFSUBR (Fset_extent_end_glyph);
6776 DEFSUBR (Fextent_begin_glyph);
6777 DEFSUBR (Fextent_end_glyph);
6778 DEFSUBR (Fset_extent_begin_glyph_layout);
6779 DEFSUBR (Fset_extent_end_glyph_layout);
6780 DEFSUBR (Fextent_begin_glyph_layout);
6781 DEFSUBR (Fextent_end_glyph_layout);
6782 DEFSUBR (Fset_extent_priority);
6783 DEFSUBR (Fextent_priority);
6784 DEFSUBR (Fset_extent_property);
6785 DEFSUBR (Fset_extent_properties);
6786 DEFSUBR (Fextent_property);
6787 DEFSUBR (Fextent_properties);
6789 DEFSUBR (Fhighlight_extent);
6790 DEFSUBR (Fforce_highlight_extent);
6792 DEFSUBR (Finsert_extent);
6794 DEFSUBR (Fget_text_property);
6795 DEFSUBR (Fget_char_property);
6796 DEFSUBR (Fput_text_property);
6797 DEFSUBR (Fput_nonduplicable_text_property);
6798 DEFSUBR (Fadd_text_properties);
6799 DEFSUBR (Fadd_nonduplicable_text_properties);
6800 DEFSUBR (Fremove_text_properties);
6801 DEFSUBR (Ftext_prop_extent_paste_function);
6802 DEFSUBR (Fnext_single_property_change);
6803 DEFSUBR (Fprevious_single_property_change);
6807 vars_of_extents (void)
6809 DEFVAR_INT ("mouse-highlight-priority", &mouse_highlight_priority /*
6810 The priority to use for the mouse-highlighting pseudo-extent
6811 that is used to highlight extents with the `mouse-face' attribute set.
6812 See `set-extent-priority'.
6814 /* Set mouse-highlight-priority (which ends up being used both for the
6815 mouse-highlighting pseudo-extent and the primary selection extent)
6816 to a very high value because very few extents should override it.
6817 1000 gives lots of room below it for different-prioritied extents.
6818 10 doesn't. ediff, for example, likes to use priorities around 100.
6820 mouse_highlight_priority = /* 10 */ 1000;
6822 DEFVAR_LISP ("default-text-properties", &Vdefault_text_properties /*
6823 Property list giving default values for text properties.
6824 Whenever a character does not specify a value for a property, the value
6825 stored in this list is used instead. This only applies when the
6826 functions `get-text-property' or `get-char-property' are called.
6828 Vdefault_text_properties = Qnil;
6830 staticpro (&Vlast_highlighted_extent);
6831 Vlast_highlighted_extent = Qnil;
6833 Vextent_face_reusable_list = Fcons (Qnil, Qnil);
6834 staticpro (&Vextent_face_reusable_list);
6836 extent_auxiliary_defaults.begin_glyph = Qnil;
6837 extent_auxiliary_defaults.end_glyph = Qnil;
6838 extent_auxiliary_defaults.parent = Qnil;
6839 extent_auxiliary_defaults.children = Qnil;
6840 extent_auxiliary_defaults.priority = 0;
6841 extent_auxiliary_defaults.invisible = Qnil;
6842 extent_auxiliary_defaults.read_only = Qnil;
6843 extent_auxiliary_defaults.mouse_face = Qnil;
6844 extent_auxiliary_defaults.initial_redisplay_function = Qnil;
6845 extent_auxiliary_defaults.before_change_functions = Qnil;
6846 extent_auxiliary_defaults.after_change_functions = Qnil;
6850 complex_vars_of_extents (void)
6852 staticpro (&Vextent_face_memoize_hash_table);
6853 /* The memoize hash-table maps from lists of symbols to lists of
6854 faces. It needs to be `equal' to implement the memoization.
6855 The reverse table maps in the other direction and just needs
6856 to do `eq' comparison because the lists of faces are already
6858 Vextent_face_memoize_hash_table =
6859 make_lisp_hashtable (100, HASHTABLE_VALUE_WEAK, HASHTABLE_EQUAL);
6860 staticpro (&Vextent_face_reverse_memoize_hash_table);
6861 Vextent_face_reverse_memoize_hash_table =
6862 make_lisp_hashtable (100, HASHTABLE_KEY_WEAK, HASHTABLE_EQ);