1 /* Copyright (c) 1994, 1995 Free Software Foundation, Inc.
2 Copyright (c) 1995 Sun Microsystems, Inc.
3 Copyright (c) 1995, 1996 Ben Wing.
5 This file is part of XEmacs.
7 XEmacs is free software; you can redistribute it and/or modify it
8 under the terms of the GNU General Public License as published by the
9 Free Software Foundation; either version 2, or (at your option) any
12 XEmacs is distributed in the hope that it will be useful, but WITHOUT
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
17 You should have received a copy of the GNU General Public License
18 along with XEmacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
22 /* Synched up with: Not in FSF. */
24 /* This file has been Mule-ized. */
26 /* Written by Ben Wing <ben@xemacs.org>.
28 [Originally written by some people at Lucid.
30 Start/end-open stuff added by John Rose (john.rose@eng.sun.com).
31 Rewritten from scratch by Ben Wing, December 1994.] */
35 Extents are regions over a buffer, with a start and an end position
36 denoting the region of the buffer included in the extent. In
37 addition, either end can be closed or open, meaning that the endpoint
38 is or is not logically included in the extent. Insertion of a character
39 at a closed endpoint causes the character to go inside the extent;
40 insertion at an open endpoint causes the character to go outside.
42 Extent endpoints are stored using memory indices (see insdel.c),
43 to minimize the amount of adjusting that needs to be done when
44 characters are inserted or deleted.
46 (Formerly, extent endpoints at the gap could be either before or
47 after the gap, depending on the open/closedness of the endpoint.
48 The intent of this was to make it so that insertions would
49 automatically go inside or out of extents as necessary with no
50 further work needing to be done. It didn't work out that way,
51 however, and just ended up complexifying and buggifying all the
54 Extents are compared using memory indices. There are two orderings
55 for extents and both orders are kept current at all times. The normal
56 or "display" order is as follows:
58 Extent A is "less than" extent B, that is, earlier in the display order,
59 if: A-start < B-start,
60 or if: A-start = B-start, and A-end > B-end
62 So if two extents begin at the same position, the larger of them is the
63 earlier one in the display order (EXTENT_LESS is true).
65 For the e-order, the same thing holds: Extent A is "less than" extent B
66 in e-order, that is, later in the buffer,
68 or if: A-end = B-end, and A-start > B-start
70 So if two extents end at the same position, the smaller of them is the
71 earlier one in the e-order (EXTENT_E_LESS is true).
73 The display order and the e-order are complementary orders: any
74 theorem about the display order also applies to the e-order if you
75 swap all occurrences of "display order" and "e-order", "less than"
76 and "greater than", and "extent start" and "extent end".
78 Extents can be zero-length, and will end up that way if their endpoints
79 are explicitly set that way or if their detachable property is nil
80 and all the text in the extent is deleted. (The exception is open-open
81 zero-length extents, which are barred from existing because there is
82 no sensible way to define their properties. Deletion of the text in
83 an open-open extent causes it to be converted into a closed-open
84 extent.) Zero-length extents are primarily used to represent
85 annotations, and behave as follows:
87 1) Insertion at the position of a zero-length extent expands the extent
88 if both endpoints are closed; goes after the extent if it is closed-open;
89 and goes before the extent if it is open-closed.
91 2) Deletion of a character on a side of a zero-length extent whose
92 corresponding endpoint is closed causes the extent to be detached if
93 it is detachable; if the extent is not detachable or the corresponding
94 endpoint is open, the extent remains in the buffer, moving as necessary.
96 Note that closed-open, non-detachable zero-length extents behave exactly
97 like markers and that open-closed, non-detachable zero-length extents
98 behave like the "point-type" marker in Mule.
101 #### The following information is wrong in places.
103 More about the different orders:
104 --------------------------------
106 The extents in a buffer are ordered by "display order" because that
107 is that order that the redisplay mechanism needs to process them in.
108 The e-order is an auxiliary ordering used to facilitate operations
109 over extents. The operations that can be performed on the ordered
110 list of extents in a buffer are
112 1) Locate where an extent would go if inserted into the list.
113 2) Insert an extent into the list.
114 3) Remove an extent from the list.
115 4) Map over all the extents that overlap a range.
117 (4) requires being able to determine the first and last extents
118 that overlap a range.
120 NOTE: "overlap" is used as follows:
122 -- two ranges overlap if they have at least one point in common.
123 Whether the endpoints are open or closed makes a difference here.
124 -- a point overlaps a range if the point is contained within the
125 range; this is equivalent to treating a point P as the range
127 -- In the case of an *extent* overlapping a point or range, the
128 extent is normally treated as having closed endpoints. This
129 applies consistently in the discussion of stacks of extents
130 and such below. Note that this definition of overlap is not
131 necessarily consistent with the extents that `map-extents'
132 maps over, since `map-extents' sometimes pays attention to
133 whether the endpoints of an extents are open or closed.
134 But for our purposes, it greatly simplifies things to treat
135 all extents as having closed endpoints.
137 First, define >, <, <=, etc. as applied to extents to mean
138 comparison according to the display order. Comparison between an
139 extent E and an index I means comparison between E and the range
141 Also define e>, e<, e<=, etc. to mean comparison according to the
143 For any range R, define R(0) to be the starting index of the range
144 and R(1) to be the ending index of the range.
145 For any extent E, define E(next) to be the extent directly following
146 E, and E(prev) to be the extent directly preceding E. Assume
147 E(next) and E(prev) can be determined from E in constant time.
148 (This is because we store the extent list as a doubly linked
150 Similarly, define E(e-next) and E(e-prev) to be the extents
151 directly following and preceding E in the e-order.
156 Let F be the first extent overlapping R.
157 Let L be the last extent overlapping R.
159 Theorem 1: R(1) lies between L and L(next), i.e. L <= R(1) < L(next).
161 This follows easily from the definition of display order. The
162 basic reason that this theorem applies is that the display order
163 sorts by increasing starting index.
165 Therefore, we can determine L just by looking at where we would
166 insert R(1) into the list, and if we know F and are moving forward
167 over extents, we can easily determine when we've hit L by comparing
168 the extent we're at to R(1).
170 Theorem 2: F(e-prev) e< [1, R(0)] e<= F.
172 This is the analog of Theorem 1, and applies because the e-order
173 sorts by increasing ending index.
175 Therefore, F can be found in the same amount of time as operation (1),
176 i.e. the time that it takes to locate where an extent would go if
177 inserted into the e-order list.
179 If the lists were stored as balanced binary trees, then operation (1)
180 would take logarithmic time, which is usually quite fast. However,
181 currently they're stored as simple doubly-linked lists, and instead
182 we do some caching to try to speed things up.
184 Define a "stack of extents" (or "SOE") as the set of extents
185 (ordered in the display order) that overlap an index I, together with
186 the SOE's "previous" extent, which is an extent that precedes I in
187 the e-order. (Hopefully there will not be very many extents between
188 I and the previous extent.)
192 Let I be an index, let S be the stack of extents on I, let F be
193 the first extent in S, and let P be S's previous extent.
195 Theorem 3: The first extent in S is the first extent that overlaps
198 Proof: Any extent that overlaps [I, J] but does not include I must
199 have a start index > I, and thus be greater than any extent in S.
201 Therefore, finding the first extent that overlaps a range R is the
202 same as finding the first extent that overlaps R(0).
204 Theorem 4: Let I2 be an index such that I2 > I, and let F2 be the
205 first extent that overlaps I2. Then, either F2 is in S or F2 is
206 greater than any extent in S.
208 Proof: If F2 does not include I then its start index is greater
209 than I and thus it is greater than any extent in S, including F.
210 Otherwise, F2 includes I and thus is in S, and thus F2 >= F.
229 #include "redisplay.h"
231 /* ------------------------------- */
233 /* ------------------------------- */
235 /* Note that this object is not extent-specific and should perhaps be
236 moved into another file. */
238 /* Holds a marker that moves as elements in the array are inserted and
239 deleted, similar to standard markers. */
241 typedef struct gap_array_marker
244 struct gap_array_marker *next;
247 /* Holds a "gap array", which is an array of elements with a gap located
248 in it. Insertions and deletions with a high degree of locality
249 are very fast, essentially in constant time. Array positions as
250 used and returned in the gap array functions are independent of
253 typedef struct gap_array
260 Gap_Array_Marker *markers;
263 static Gap_Array_Marker *gap_array_marker_freelist;
265 /* Convert a "memory position" (i.e. taking the gap into account) into
266 the address of the element at (i.e. after) that position. "Memory
267 positions" are only used internally and are of type Memind.
268 "Array positions" are used externally and are of type int. */
269 #define GAP_ARRAY_MEMEL_ADDR(ga, memel) ((ga)->array + (ga)->elsize*(memel))
271 /* Number of elements currently in a gap array */
272 #define GAP_ARRAY_NUM_ELS(ga) ((ga)->numels)
274 #define GAP_ARRAY_ARRAY_TO_MEMORY_POS(ga, pos) \
275 ((pos) <= (ga)->gap ? (pos) : (pos) + (ga)->gapsize)
277 #define GAP_ARRAY_MEMORY_TO_ARRAY_POS(ga, pos) \
278 ((pos) <= (ga)->gap ? (pos) : (pos) - (ga)->gapsize)
280 /* Convert an array position into the address of the element at
281 (i.e. after) that position. */
282 #define GAP_ARRAY_EL_ADDR(ga, pos) ((pos) < (ga)->gap ? \
283 GAP_ARRAY_MEMEL_ADDR(ga, pos) : \
284 GAP_ARRAY_MEMEL_ADDR(ga, (pos) + (ga)->gapsize))
286 /* ------------------------------- */
288 /* ------------------------------- */
290 typedef struct extent_list_marker
294 struct extent_list_marker *next;
295 } Extent_List_Marker;
297 typedef struct extent_list
301 Extent_List_Marker *markers;
304 static Extent_List_Marker *extent_list_marker_freelist;
306 #define EXTENT_LESS_VALS(e,st,nd) ((extent_start (e) < (st)) || \
307 ((extent_start (e) == (st)) && \
308 (extent_end (e) > (nd))))
310 #define EXTENT_EQUAL_VALS(e,st,nd) ((extent_start (e) == (st)) && \
311 (extent_end (e) == (nd)))
313 #define EXTENT_LESS_EQUAL_VALS(e,st,nd) ((extent_start (e) < (st)) || \
314 ((extent_start (e) == (st)) && \
315 (extent_end (e) >= (nd))))
317 /* Is extent E1 less than extent E2 in the display order? */
318 #define EXTENT_LESS(e1,e2) \
319 EXTENT_LESS_VALS (e1, extent_start (e2), extent_end (e2))
321 /* Is extent E1 equal to extent E2? */
322 #define EXTENT_EQUAL(e1,e2) \
323 EXTENT_EQUAL_VALS (e1, extent_start (e2), extent_end (e2))
325 /* Is extent E1 less than or equal to extent E2 in the display order? */
326 #define EXTENT_LESS_EQUAL(e1,e2) \
327 EXTENT_LESS_EQUAL_VALS (e1, extent_start (e2), extent_end (e2))
329 #define EXTENT_E_LESS_VALS(e,st,nd) ((extent_end (e) < (nd)) || \
330 ((extent_end (e) == (nd)) && \
331 (extent_start (e) > (st))))
333 #define EXTENT_E_LESS_EQUAL_VALS(e,st,nd) ((extent_end (e) < (nd)) || \
334 ((extent_end (e) == (nd)) && \
335 (extent_start (e) >= (st))))
337 /* Is extent E1 less than extent E2 in the e-order? */
338 #define EXTENT_E_LESS(e1,e2) \
339 EXTENT_E_LESS_VALS(e1, extent_start (e2), extent_end (e2))
341 /* Is extent E1 less than or equal to extent E2 in the e-order? */
342 #define EXTENT_E_LESS_EQUAL(e1,e2) \
343 EXTENT_E_LESS_EQUAL_VALS (e1, extent_start (e2), extent_end (e2))
345 #define EXTENT_GAP_ARRAY_AT(ga, pos) (* (EXTENT *) GAP_ARRAY_EL_ADDR(ga, pos))
347 /* ------------------------------- */
348 /* auxiliary extent structure */
349 /* ------------------------------- */
351 struct extent_auxiliary extent_auxiliary_defaults;
353 /* ------------------------------- */
354 /* buffer-extent primitives */
355 /* ------------------------------- */
357 typedef struct stack_of_extents
359 Extent_List *extents;
360 Memind pos; /* Position of stack of extents. EXTENTS is the list of
361 all extents that overlap this position. This position
362 can be -1 if the stack of extents is invalid (this
363 happens when a buffer is first created or a string's
364 stack of extents is created [a string's stack of extents
365 is nuked when a GC occurs, to conserve memory]). */
368 /* ------------------------------- */
370 /* ------------------------------- */
372 typedef int Endpoint_Index;
374 #define memind_to_startind(x, start_open) \
375 ((Endpoint_Index) (((x) << 1) + !!(start_open)))
376 #define memind_to_endind(x, end_open) \
377 ((Endpoint_Index) (((x) << 1) - !!(end_open)))
379 /* Combination macros */
380 #define bytind_to_startind(buf, x, start_open) \
381 memind_to_startind (bytind_to_memind (buf, x), start_open)
382 #define bytind_to_endind(buf, x, end_open) \
383 memind_to_endind (bytind_to_memind (buf, x), end_open)
385 /* ------------------------------- */
386 /* buffer-or-string primitives */
387 /* ------------------------------- */
389 /* Similar for Bytinds and start/end indices. */
391 #define buffer_or_string_bytind_to_startind(obj, ind, start_open) \
392 memind_to_startind (buffer_or_string_bytind_to_memind (obj, ind), \
395 #define buffer_or_string_bytind_to_endind(obj, ind, end_open) \
396 memind_to_endind (buffer_or_string_bytind_to_memind (obj, ind), \
399 /* ------------------------------- */
400 /* Lisp-level functions */
401 /* ------------------------------- */
403 /* flags for decode_extent() */
404 #define DE_MUST_HAVE_BUFFER 1
405 #define DE_MUST_BE_ATTACHED 2
407 Lisp_Object Vlast_highlighted_extent;
408 int mouse_highlight_priority;
410 Lisp_Object Qextentp;
411 Lisp_Object Qextent_live_p;
413 Lisp_Object Qall_extents_closed;
414 Lisp_Object Qall_extents_open;
415 Lisp_Object Qall_extents_closed_open;
416 Lisp_Object Qall_extents_open_closed;
417 Lisp_Object Qstart_in_region;
418 Lisp_Object Qend_in_region;
419 Lisp_Object Qstart_and_end_in_region;
420 Lisp_Object Qstart_or_end_in_region;
421 Lisp_Object Qnegate_in_region;
423 Lisp_Object Qdetached;
424 Lisp_Object Qdestroyed;
425 Lisp_Object Qbegin_glyph;
426 Lisp_Object Qend_glyph;
427 Lisp_Object Qstart_open;
428 Lisp_Object Qend_open;
429 Lisp_Object Qstart_closed;
430 Lisp_Object Qend_closed;
431 Lisp_Object Qread_only;
432 /* Qhighlight defined in general.c */
434 Lisp_Object Qduplicable;
435 Lisp_Object Qdetachable;
436 Lisp_Object Qpriority;
437 Lisp_Object Qmouse_face;
438 Lisp_Object Qinitial_redisplay_function;
440 Lisp_Object Qglyph_layout; /* This exists only for backwards compatibility. */
441 Lisp_Object Qbegin_glyph_layout, Qend_glyph_layout;
442 Lisp_Object Qoutside_margin;
443 Lisp_Object Qinside_margin;
444 Lisp_Object Qwhitespace;
445 /* Qtext defined in general.c */
447 Lisp_Object Qcopy_function;
448 Lisp_Object Qpaste_function;
450 /* The idea here is that if we're given a list of faces, we
451 need to "memoize" this so that two lists of faces that are `equal'
452 turn into the same object. When `set-extent-face' is called, we
453 "memoize" into a list of actual faces; when `extent-face' is called,
454 we do a reverse lookup to get the list of symbols. */
456 static Lisp_Object canonicalize_extent_property (Lisp_Object prop,
458 Lisp_Object Vextent_face_memoize_hash_table;
459 Lisp_Object Vextent_face_reverse_memoize_hash_table;
460 Lisp_Object Vextent_face_reusable_list;
461 /* FSFmacs bogosity */
462 Lisp_Object Vdefault_text_properties;
465 EXFUN (Fextent_properties, 1);
466 EXFUN (Fset_extent_property, 3);
469 /************************************************************************/
470 /* Generalized gap array */
471 /************************************************************************/
473 /* This generalizes the "array with a gap" model used to store buffer
474 characters. This is based on the stuff in insdel.c and should
475 probably be merged with it. This is not extent-specific and should
476 perhaps be moved into a separate file. */
478 /* ------------------------------- */
479 /* internal functions */
480 /* ------------------------------- */
482 /* Adjust the gap array markers in the range (FROM, TO]. Parallel to
483 adjust_markers() in insdel.c. */
486 gap_array_adjust_markers (Gap_Array *ga, Memind from,
487 Memind to, int amount)
491 for (m = ga->markers; m; m = m->next)
492 m->pos = do_marker_adjustment (m->pos, from, to, amount);
495 /* Move the gap to array position POS. Parallel to move_gap() in
496 insdel.c but somewhat simplified. */
499 gap_array_move_gap (Gap_Array *ga, int pos)
502 int gapsize = ga->gapsize;
507 memmove (GAP_ARRAY_MEMEL_ADDR (ga, pos + gapsize),
508 GAP_ARRAY_MEMEL_ADDR (ga, pos),
509 (gap - pos)*ga->elsize);
510 gap_array_adjust_markers (ga, (Memind) pos, (Memind) gap,
515 memmove (GAP_ARRAY_MEMEL_ADDR (ga, gap),
516 GAP_ARRAY_MEMEL_ADDR (ga, gap + gapsize),
517 (pos - gap)*ga->elsize);
518 gap_array_adjust_markers (ga, (Memind) (gap + gapsize),
519 (Memind) (pos + gapsize), - gapsize);
524 /* Make the gap INCREMENT characters longer. Parallel to make_gap() in
528 gap_array_make_gap (Gap_Array *ga, int increment)
530 char *ptr = ga->array;
534 /* If we have to get more space, get enough to last a while. We use
535 a geometric progression that saves on realloc space. */
536 increment += 100 + ga->numels / 8;
538 ptr = (char *) xrealloc (ptr,
539 (ga->numels + ga->gapsize + increment)*ga->elsize);
544 real_gap_loc = ga->gap;
545 old_gap_size = ga->gapsize;
547 /* Call the newly allocated space a gap at the end of the whole space. */
548 ga->gap = ga->numels + ga->gapsize;
549 ga->gapsize = increment;
551 /* Move the new gap down to be consecutive with the end of the old one.
552 This adjusts the markers properly too. */
553 gap_array_move_gap (ga, real_gap_loc + old_gap_size);
555 /* Now combine the two into one large gap. */
556 ga->gapsize += old_gap_size;
557 ga->gap = real_gap_loc;
560 /* ------------------------------- */
561 /* external functions */
562 /* ------------------------------- */
564 /* Insert NUMELS elements (pointed to by ELPTR) into the specified
568 gap_array_insert_els (Gap_Array *ga, int pos, void *elptr, int numels)
570 assert (pos >= 0 && pos <= ga->numels);
571 if (ga->gapsize < numels)
572 gap_array_make_gap (ga, numels - ga->gapsize);
574 gap_array_move_gap (ga, pos);
576 memcpy (GAP_ARRAY_MEMEL_ADDR (ga, ga->gap), (char *) elptr,
578 ga->gapsize -= numels;
580 ga->numels += numels;
581 /* This is the equivalent of insert-before-markers.
583 #### Should only happen if marker is "moves forward at insert" type.
586 gap_array_adjust_markers (ga, pos - 1, pos, numels);
589 /* Delete NUMELS elements from the specified gap array, starting at FROM. */
592 gap_array_delete_els (Gap_Array *ga, int from, int numdel)
594 int to = from + numdel;
595 int gapsize = ga->gapsize;
598 assert (numdel >= 0);
599 assert (to <= ga->numels);
601 /* Make sure the gap is somewhere in or next to what we are deleting. */
603 gap_array_move_gap (ga, to);
605 gap_array_move_gap (ga, from);
607 /* Relocate all markers pointing into the new, larger gap
608 to point at the end of the text before the gap. */
609 gap_array_adjust_markers (ga, to + gapsize, to + gapsize,
612 ga->gapsize += numdel;
613 ga->numels -= numdel;
617 static Gap_Array_Marker *
618 gap_array_make_marker (Gap_Array *ga, int pos)
622 assert (pos >= 0 && pos <= ga->numels);
623 if (gap_array_marker_freelist)
625 m = gap_array_marker_freelist;
626 gap_array_marker_freelist = gap_array_marker_freelist->next;
629 m = xnew (Gap_Array_Marker);
631 m->pos = GAP_ARRAY_ARRAY_TO_MEMORY_POS (ga, pos);
632 m->next = ga->markers;
638 gap_array_delete_marker (Gap_Array *ga, Gap_Array_Marker *m)
640 Gap_Array_Marker *p, *prev;
642 for (prev = 0, p = ga->markers; p && p != m; prev = p, p = p->next)
646 prev->next = p->next;
648 ga->markers = p->next;
649 m->next = gap_array_marker_freelist;
650 m->pos = 0xDEADBEEF; /* -559038737 as an int */
651 gap_array_marker_freelist = m;
655 gap_array_delete_all_markers (Gap_Array *ga)
657 Gap_Array_Marker *p, *next;
659 for (p = ga->markers; p; p = next)
662 p->next = gap_array_marker_freelist;
663 p->pos = 0xDEADBEEF; /* -559038737 as an int */
664 gap_array_marker_freelist = p;
669 gap_array_move_marker (Gap_Array *ga, Gap_Array_Marker *m, int pos)
671 assert (pos >= 0 && pos <= ga->numels);
672 m->pos = GAP_ARRAY_ARRAY_TO_MEMORY_POS (ga, pos);
675 #define gap_array_marker_pos(ga, m) \
676 GAP_ARRAY_MEMORY_TO_ARRAY_POS (ga, (m)->pos)
679 make_gap_array (int elsize)
681 Gap_Array *ga = xnew_and_zero (Gap_Array);
687 free_gap_array (Gap_Array *ga)
691 gap_array_delete_all_markers (ga);
696 /************************************************************************/
697 /* Extent list primitives */
698 /************************************************************************/
700 /* A list of extents is maintained as a double gap array: one gap array
701 is ordered by start index (the "display order") and the other is
702 ordered by end index (the "e-order"). Note that positions in an
703 extent list should logically be conceived of as referring *to*
704 a particular extent (as is the norm in programs) rather than
705 sitting between two extents. Note also that callers of these
706 functions should not be aware of the fact that the extent list is
707 implemented as an array, except for the fact that positions are
708 integers (this should be generalized to handle integers and linked
712 /* Number of elements in an extent list */
713 #define extent_list_num_els(el) GAP_ARRAY_NUM_ELS(el->start)
715 /* Return the position at which EXTENT is located in the specified extent
716 list (in the display order if ENDP is 0, in the e-order otherwise).
717 If the extent is not found, the position where the extent would
718 be inserted is returned. If ENDP is 0, the insertion would go after
719 all other equal extents. If ENDP is not 0, the insertion would go
720 before all other equal extents. If FOUNDP is not 0, then whether
721 the extent was found will get written into it. */
724 extent_list_locate (Extent_List *el, EXTENT extent, int endp, int *foundp)
726 Gap_Array *ga = endp ? el->end : el->start;
727 int left = 0, right = GAP_ARRAY_NUM_ELS (ga);
728 int oldfoundpos, foundpos;
731 while (left != right)
733 /* RIGHT might not point to a valid extent (i.e. it's at the end
734 of the list), so NEWPOS must round down. */
735 unsigned int newpos = (left + right) >> 1;
736 EXTENT e = EXTENT_GAP_ARRAY_AT (ga, (int) newpos);
738 if (endp ? EXTENT_E_LESS (e, extent) : EXTENT_LESS (e, extent))
744 /* Now we're at the beginning of all equal extents. */
746 oldfoundpos = foundpos = left;
747 while (foundpos < GAP_ARRAY_NUM_ELS (ga))
749 EXTENT e = EXTENT_GAP_ARRAY_AT (ga, foundpos);
755 if (!EXTENT_EQUAL (e, extent))
767 /* Return the position of the first extent that begins at or after POS
768 (or ends at or after POS, if ENDP is not 0).
770 An out-of-range value for POS is allowed, and guarantees that the
771 position at the beginning or end of the extent list is returned. */
774 extent_list_locate_from_pos (Extent_List *el, Memind pos, int endp)
776 struct extent fake_extent;
779 Note that if we search for [POS, POS], then we get the following:
781 -- if ENDP is 0, then all extents whose start position is <= POS
782 lie before the returned position, and all extents whose start
783 position is > POS lie at or after the returned position.
785 -- if ENDP is not 0, then all extents whose end position is < POS
786 lie before the returned position, and all extents whose end
787 position is >= POS lie at or after the returned position.
790 set_extent_start (&fake_extent, endp ? pos : pos-1);
791 set_extent_end (&fake_extent, endp ? pos : pos-1);
792 return extent_list_locate (el, &fake_extent, endp, 0);
795 /* Return the extent at POS. */
798 extent_list_at (Extent_List *el, Memind pos, int endp)
800 Gap_Array *ga = endp ? el->end : el->start;
802 assert (pos >= 0 && pos < GAP_ARRAY_NUM_ELS (ga));
803 return EXTENT_GAP_ARRAY_AT (ga, pos);
806 /* Insert an extent into an extent list. */
809 extent_list_insert (Extent_List *el, EXTENT extent)
813 pos = extent_list_locate (el, extent, 0, &foundp);
815 gap_array_insert_els (el->start, pos, &extent, 1);
816 pos = extent_list_locate (el, extent, 1, &foundp);
818 gap_array_insert_els (el->end, pos, &extent, 1);
821 /* Delete an extent from an extent list. */
824 extent_list_delete (Extent_List *el, EXTENT extent)
828 pos = extent_list_locate (el, extent, 0, &foundp);
830 gap_array_delete_els (el->start, pos, 1);
831 pos = extent_list_locate (el, extent, 1, &foundp);
833 gap_array_delete_els (el->end, pos, 1);
837 extent_list_delete_all (Extent_List *el)
839 gap_array_delete_els (el->start, 0, GAP_ARRAY_NUM_ELS (el->start));
840 gap_array_delete_els (el->end, 0, GAP_ARRAY_NUM_ELS (el->end));
843 static Extent_List_Marker *
844 extent_list_make_marker (Extent_List *el, int pos, int endp)
846 Extent_List_Marker *m;
848 if (extent_list_marker_freelist)
850 m = extent_list_marker_freelist;
851 extent_list_marker_freelist = extent_list_marker_freelist->next;
854 m = xnew (Extent_List_Marker);
856 m->m = gap_array_make_marker (endp ? el->end : el->start, pos);
858 m->next = el->markers;
863 #define extent_list_move_marker(el, mkr, pos) \
864 gap_array_move_marker((mkr)->endp ? (el)->end : (el)->start, (mkr)->m, pos)
867 extent_list_delete_marker (Extent_List *el, Extent_List_Marker *m)
869 Extent_List_Marker *p, *prev;
871 for (prev = 0, p = el->markers; p && p != m; prev = p, p = p->next)
875 prev->next = p->next;
877 el->markers = p->next;
878 m->next = extent_list_marker_freelist;
879 extent_list_marker_freelist = m;
880 gap_array_delete_marker (m->endp ? el->end : el->start, m->m);
883 #define extent_list_marker_pos(el, mkr) \
884 gap_array_marker_pos ((mkr)->endp ? (el)->end : (el)->start, (mkr)->m)
887 allocate_extent_list (void)
889 Extent_List *el = xnew (Extent_List);
890 el->start = make_gap_array (sizeof (EXTENT));
891 el->end = make_gap_array (sizeof (EXTENT));
897 free_extent_list (Extent_List *el)
899 free_gap_array (el->start);
900 free_gap_array (el->end);
905 /************************************************************************/
906 /* Auxiliary extent structure */
907 /************************************************************************/
910 mark_extent_auxiliary (Lisp_Object obj)
912 struct extent_auxiliary *data = XEXTENT_AUXILIARY (obj);
913 mark_object (data->begin_glyph);
914 mark_object (data->end_glyph);
915 mark_object (data->invisible);
916 mark_object (data->children);
917 mark_object (data->read_only);
918 mark_object (data->mouse_face);
919 mark_object (data->initial_redisplay_function);
920 mark_object (data->before_change_functions);
921 mark_object (data->after_change_functions);
925 DEFINE_LRECORD_IMPLEMENTATION ("extent-auxiliary", extent_auxiliary,
926 mark_extent_auxiliary, internal_object_printer,
927 0, 0, 0, 0, struct extent_auxiliary);
930 allocate_extent_auxiliary (EXTENT ext)
932 Lisp_Object extent_aux;
933 struct extent_auxiliary *data =
934 alloc_lcrecord_type (struct extent_auxiliary, &lrecord_extent_auxiliary);
936 copy_lcrecord (data, &extent_auxiliary_defaults);
937 XSETEXTENT_AUXILIARY (extent_aux, data);
938 ext->plist = Fcons (extent_aux, ext->plist);
939 ext->flags.has_aux = 1;
943 /************************************************************************/
944 /* Extent info structure */
945 /************************************************************************/
947 /* An extent-info structure consists of a list of the buffer or string's
948 extents and a "stack of extents" that lists all of the extents over
949 a particular position. The stack-of-extents info is used for
950 optimization purposes -- it basically caches some info that might
951 be expensive to compute. Certain otherwise hard computations are easy
952 given the stack of extents over a particular position, and if the
953 stack of extents over a nearby position is known (because it was
954 calculated at some prior point in time), it's easy to move the stack
955 of extents to the proper position.
957 Given that the stack of extents is an optimization, and given that
958 it requires memory, a string's stack of extents is wiped out each
959 time a garbage collection occurs. Therefore, any time you retrieve
960 the stack of extents, it might not be there. If you need it to
961 be there, use the _force version.
963 Similarly, a string may or may not have an extent_info structure.
964 (Generally it won't if there haven't been any extents added to the
965 string.) So use the _force version if you need the extent_info
966 structure to be there. */
968 static struct stack_of_extents *allocate_soe (void);
969 static void free_soe (struct stack_of_extents *soe);
970 static void soe_invalidate (Lisp_Object obj);
973 mark_extent_info (Lisp_Object obj)
975 struct extent_info *data = (struct extent_info *) XEXTENT_INFO (obj);
977 Extent_List *list = data->extents;
979 /* Vbuffer_defaults and Vbuffer_local_symbols are buffer-like
980 objects that are created specially and never have their extent
981 list initialized (or rather, it is set to zero in
982 nuke_all_buffer_slots()). However, these objects get
983 garbage-collected so we have to deal.
985 (Also the list can be zero when we're dealing with a destroyed
990 for (i = 0; i < extent_list_num_els (list); i++)
992 struct extent *extent = extent_list_at (list, i, 0);
995 XSETEXTENT (exobj, extent);
1004 finalize_extent_info (void *header, int for_disksave)
1006 struct extent_info *data = (struct extent_info *) header;
1013 free_soe (data->soe);
1018 free_extent_list (data->extents);
1023 DEFINE_LRECORD_IMPLEMENTATION ("extent-info", extent_info,
1024 mark_extent_info, internal_object_printer,
1025 finalize_extent_info, 0, 0, 0,
1026 struct extent_info);
1029 allocate_extent_info (void)
1031 Lisp_Object extent_info;
1032 struct extent_info *data =
1033 alloc_lcrecord_type (struct extent_info, &lrecord_extent_info);
1035 XSETEXTENT_INFO (extent_info, data);
1036 data->extents = allocate_extent_list ();
1042 flush_cached_extent_info (Lisp_Object extent_info)
1044 struct extent_info *data = XEXTENT_INFO (extent_info);
1048 free_soe (data->soe);
1054 /************************************************************************/
1055 /* Buffer/string extent primitives */
1056 /************************************************************************/
1058 /* The functions in this section are the ONLY ones that should know
1059 about the internal implementation of the extent lists. Other functions
1060 should only know that there are two orderings on extents, the "display"
1061 order (sorted by start position, basically) and the e-order (sorted
1062 by end position, basically), and that certain operations are provided
1063 to manipulate the list. */
1065 /* ------------------------------- */
1066 /* basic primitives */
1067 /* ------------------------------- */
1070 decode_buffer_or_string (Lisp_Object object)
1073 XSETBUFFER (object, current_buffer);
1074 else if (BUFFERP (object))
1075 CHECK_LIVE_BUFFER (object);
1076 else if (STRINGP (object))
1079 dead_wrong_type_argument (Qbuffer_or_string_p, object);
1085 extent_ancestor_1 (EXTENT e)
1087 while (e->flags.has_parent)
1089 /* There should be no circularities except in case of a logic
1090 error somewhere in the extent code */
1091 e = XEXTENT (XEXTENT_AUXILIARY (XCAR (e->plist))->parent);
1096 /* Given an extent object (string or buffer or nil), return its extent info.
1097 This may be 0 for a string. */
1099 static struct extent_info *
1100 buffer_or_string_extent_info (Lisp_Object object)
1102 if (STRINGP (object))
1104 Lisp_Object plist = XSTRING (object)->plist;
1105 if (!CONSP (plist) || !EXTENT_INFOP (XCAR (plist)))
1107 return XEXTENT_INFO (XCAR (plist));
1109 else if (NILP (object))
1112 return XEXTENT_INFO (XBUFFER (object)->extent_info);
1115 /* Given a string or buffer, return its extent list. This may be
1118 static Extent_List *
1119 buffer_or_string_extent_list (Lisp_Object object)
1121 struct extent_info *info = buffer_or_string_extent_info (object);
1125 return info->extents;
1128 /* Given a string or buffer, return its extent info. If it's not there,
1131 static struct extent_info *
1132 buffer_or_string_extent_info_force (Lisp_Object object)
1134 struct extent_info *info = buffer_or_string_extent_info (object);
1138 Lisp_Object extent_info;
1140 assert (STRINGP (object)); /* should never happen for buffers --
1141 the only buffers without an extent
1142 info are those after finalization,
1143 destroyed buffers, or special
1144 Lisp-inaccessible buffer objects. */
1145 extent_info = allocate_extent_info ();
1146 XSTRING (object)->plist = Fcons (extent_info, XSTRING (object)->plist);
1147 return XEXTENT_INFO (extent_info);
1153 /* Detach all the extents in OBJECT. Called from redisplay. */
1156 detach_all_extents (Lisp_Object object)
1158 struct extent_info *data = buffer_or_string_extent_info (object);
1166 for (i = 0; i < extent_list_num_els (data->extents); i++)
1168 EXTENT e = extent_list_at (data->extents, i, 0);
1169 /* No need to do detach_extent(). Just nuke the damn things,
1170 which results in the equivalent but faster. */
1171 set_extent_start (e, -1);
1172 set_extent_end (e, -1);
1176 /* But we need to clear all the lists containing extents or
1177 havoc will result. */
1178 extent_list_delete_all (data->extents);
1179 soe_invalidate (object);
1185 init_buffer_extents (struct buffer *b)
1187 b->extent_info = allocate_extent_info ();
1191 uninit_buffer_extents (struct buffer *b)
1193 struct extent_info *data = XEXTENT_INFO (b->extent_info);
1195 /* Don't destroy the extents here -- there may still be children
1196 extents pointing to the extents. */
1197 detach_all_extents (make_buffer (b));
1198 finalize_extent_info (data, 0);
1201 /* Retrieve the extent list that an extent is a member of; the
1202 return value will never be 0 except in destroyed buffers (in which
1203 case the only extents that can refer to this buffer are detached
1206 #define extent_extent_list(e) buffer_or_string_extent_list (extent_object (e))
1208 /* ------------------------------- */
1209 /* stack of extents */
1210 /* ------------------------------- */
1212 #ifdef ERROR_CHECK_EXTENTS
1215 sledgehammer_extent_check (Lisp_Object object)
1219 Extent_List *el = buffer_or_string_extent_list (object);
1220 struct buffer *buf = 0;
1225 if (BUFFERP (object))
1226 buf = XBUFFER (object);
1228 for (endp = 0; endp < 2; endp++)
1229 for (i = 1; i < extent_list_num_els (el); i++)
1231 EXTENT e1 = extent_list_at (el, i-1, endp);
1232 EXTENT e2 = extent_list_at (el, i, endp);
1235 assert (extent_start (e1) <= buf->text->gpt ||
1236 extent_start (e1) > buf->text->gpt + buf->text->gap_size);
1237 assert (extent_end (e1) <= buf->text->gpt ||
1238 extent_end (e1) > buf->text->gpt + buf->text->gap_size);
1240 assert (extent_start (e1) <= extent_end (e1));
1241 assert (endp ? (EXTENT_E_LESS_EQUAL (e1, e2)) :
1242 (EXTENT_LESS_EQUAL (e1, e2)));
1248 static Stack_Of_Extents *
1249 buffer_or_string_stack_of_extents (Lisp_Object object)
1251 struct extent_info *info = buffer_or_string_extent_info (object);
1257 static Stack_Of_Extents *
1258 buffer_or_string_stack_of_extents_force (Lisp_Object object)
1260 struct extent_info *info = buffer_or_string_extent_info_force (object);
1262 info->soe = allocate_soe ();
1266 /* #define SOE_DEBUG */
1270 static void print_extent_1 (char *buf, Lisp_Object extent);
1273 print_extent_2 (EXTENT e)
1278 XSETEXTENT (extent, e);
1279 print_extent_1 (buf, extent);
1280 fputs (buf, stdout);
1284 soe_dump (Lisp_Object obj)
1287 Stack_Of_Extents *soe = buffer_or_string_stack_of_extents (obj);
1297 printf ("SOE pos is %d (memind %d)\n",
1298 soe->pos < 0 ? soe->pos :
1299 buffer_or_string_memind_to_bytind (obj, soe->pos),
1301 for (endp = 0; endp < 2; endp++)
1303 printf (endp ? "SOE end:" : "SOE start:");
1304 for (i = 0; i < extent_list_num_els (sel); i++)
1306 EXTENT e = extent_list_at (sel, i, endp);
1317 /* Insert EXTENT into OBJ's stack of extents, if necessary. */
1320 soe_insert (Lisp_Object obj, EXTENT extent)
1322 Stack_Of_Extents *soe = buffer_or_string_stack_of_extents (obj);
1325 printf ("Inserting into SOE: ");
1326 print_extent_2 (extent);
1329 if (!soe || soe->pos < extent_start (extent) ||
1330 soe->pos > extent_end (extent))
1333 printf ("(not needed)\n\n");
1337 extent_list_insert (soe->extents, extent);
1339 puts ("SOE afterwards is:");
1344 /* Delete EXTENT from OBJ's stack of extents, if necessary. */
1347 soe_delete (Lisp_Object obj, EXTENT extent)
1349 Stack_Of_Extents *soe = buffer_or_string_stack_of_extents (obj);
1352 printf ("Deleting from SOE: ");
1353 print_extent_2 (extent);
1356 if (!soe || soe->pos < extent_start (extent) ||
1357 soe->pos > extent_end (extent))
1360 puts ("(not needed)\n");
1364 extent_list_delete (soe->extents, extent);
1366 puts ("SOE afterwards is:");
1371 /* Move OBJ's stack of extents to lie over the specified position. */
1374 soe_move (Lisp_Object obj, Memind pos)
1376 Stack_Of_Extents *soe = buffer_or_string_stack_of_extents_force (obj);
1377 Extent_List *sel = soe->extents;
1378 int numsoe = extent_list_num_els (sel);
1379 Extent_List *bel = buffer_or_string_extent_list (obj);
1383 #ifdef ERROR_CHECK_EXTENTS
1388 printf ("Moving SOE from %d (memind %d) to %d (memind %d)\n",
1389 soe->pos < 0 ? soe->pos :
1390 buffer_or_string_memind_to_bytind (obj, soe->pos), soe->pos,
1391 buffer_or_string_memind_to_bytind (obj, pos), pos);
1398 else if (soe->pos > pos)
1406 puts ("(not needed)\n");
1411 /* For DIRECTION = 1: Any extent that overlaps POS is either in the
1412 SOE (if the extent starts at or before SOE->POS) or is greater
1413 (in the display order) than any extent in the SOE (if it starts
1416 For DIRECTION = -1: Any extent that overlaps POS is either in the
1417 SOE (if the extent ends at or after SOE->POS) or is less (in the
1418 e-order) than any extent in the SOE (if it ends before SOE->POS).
1420 We proceed in two stages:
1422 1) delete all extents in the SOE that don't overlap POS.
1423 2) insert all extents into the SOE that start (or end, when
1424 DIRECTION = -1) in (SOE->POS, POS] and that overlap
1425 POS. (Don't include SOE->POS in the range because those
1426 extents would already be in the SOE.)
1433 /* Delete all extents in the SOE that don't overlap POS.
1434 This is all extents that end before (or start after,
1435 if DIRECTION = -1) POS.
1438 /* Deleting extents from the SOE is tricky because it changes
1439 the positions of extents. If we are deleting in the forward
1440 direction we have to call extent_list_at() on the same position
1441 over and over again because positions after the deleted element
1442 get shifted back by 1. To make life simplest, we delete forward
1443 irrespective of DIRECTION.
1451 end = extent_list_locate_from_pos (sel, pos, 1);
1455 start = extent_list_locate_from_pos (sel, pos+1, 0);
1459 for (i = start; i < end; i++)
1460 extent_list_delete (sel, extent_list_at (sel, start /* see above */,
1470 start_pos = extent_list_locate_from_pos (bel, soe->pos, endp) - 1;
1472 start_pos = extent_list_locate_from_pos (bel, soe->pos + 1, endp);
1474 for (; start_pos >= 0 && start_pos < extent_list_num_els (bel);
1475 start_pos += direction)
1477 EXTENT e = extent_list_at (bel, start_pos, endp);
1478 if ((direction > 0) ?
1479 (extent_start (e) > pos) :
1480 (extent_end (e) < pos))
1481 break; /* All further extents lie on the far side of POS
1482 and thus can't overlap. */
1483 if ((direction > 0) ?
1484 (extent_end (e) >= pos) :
1485 (extent_start (e) <= pos))
1486 extent_list_insert (sel, e);
1492 puts ("SOE afterwards is:");
1498 soe_invalidate (Lisp_Object obj)
1500 Stack_Of_Extents *soe = buffer_or_string_stack_of_extents (obj);
1504 extent_list_delete_all (soe->extents);
1509 static struct stack_of_extents *
1512 struct stack_of_extents *soe = xnew_and_zero (struct stack_of_extents);
1513 soe->extents = allocate_extent_list ();
1519 free_soe (struct stack_of_extents *soe)
1521 free_extent_list (soe->extents);
1525 /* ------------------------------- */
1526 /* other primitives */
1527 /* ------------------------------- */
1529 /* Return the start (endp == 0) or end (endp == 1) of an extent as
1530 a byte index. If you want the value as a memory index, use
1531 extent_endpoint(). If you want the value as a buffer position,
1532 use extent_endpoint_bufpos(). */
1535 extent_endpoint_bytind (EXTENT extent, int endp)
1537 assert (EXTENT_LIVE_P (extent));
1538 assert (!extent_detached_p (extent));
1540 Memind i = endp ? extent_end (extent) : extent_start (extent);
1541 Lisp_Object obj = extent_object (extent);
1542 return buffer_or_string_memind_to_bytind (obj, i);
1547 extent_endpoint_bufpos (EXTENT extent, int endp)
1549 assert (EXTENT_LIVE_P (extent));
1550 assert (!extent_detached_p (extent));
1552 Memind i = endp ? extent_end (extent) : extent_start (extent);
1553 Lisp_Object obj = extent_object (extent);
1554 return buffer_or_string_memind_to_bufpos (obj, i);
1558 /* A change to an extent occurred that will change the display, so
1559 notify redisplay. Maybe also recurse over all the extent's
1563 extent_changed_for_redisplay (EXTENT extent, int descendants_too,
1564 int invisibility_change)
1569 /* we could easily encounter a detached extent while traversing the
1570 children, but we should never be able to encounter a dead extent. */
1571 assert (EXTENT_LIVE_P (extent));
1573 if (descendants_too)
1575 Lisp_Object children = extent_children (extent);
1577 if (!NILP (children))
1579 /* first mark all of the extent's children. We will lose big-time
1580 if there are any circularities here, so we sure as hell better
1581 ensure that there aren't. */
1582 LIST_LOOP (rest, XWEAK_LIST_LIST (children))
1583 extent_changed_for_redisplay (XEXTENT (XCAR (rest)), 1,
1584 invisibility_change);
1588 /* now mark the extent itself. */
1590 object = extent_object (extent);
1592 if (!BUFFERP (object) || extent_detached_p (extent))
1593 /* #### Can changes to string extents affect redisplay?
1594 I will have to think about this. What about string glyphs?
1595 Things in the modeline? etc. */
1596 /* #### changes to string extents can certainly affect redisplay
1597 if the extent is in some generated-modeline-string: when
1598 we change an extent in generated-modeline-string, this changes
1599 its parent, which is in `modeline-format', so we should
1600 force the modeline to be updated. But how to determine whether
1601 a string is a `generated-modeline-string'? Looping through
1602 all buffers is not very efficient. Should we add all
1603 `generated-modeline-string' strings to a hash table?
1604 Maybe efficiency is not the greatest concern here and there's
1605 no big loss in looping over the buffers. */
1610 b = XBUFFER (object);
1611 BUF_FACECHANGE (b)++;
1612 MARK_EXTENTS_CHANGED;
1613 if (invisibility_change)
1615 buffer_extent_signal_changed_region (b,
1616 extent_endpoint_bufpos (extent, 0),
1617 extent_endpoint_bufpos (extent, 1));
1621 /* A change to an extent occurred that might affect redisplay.
1622 This is called when properties such as the endpoints, the layout,
1623 or the priority changes. Redisplay will be affected only if
1624 the extent has any displayable attributes. */
1627 extent_maybe_changed_for_redisplay (EXTENT extent, int descendants_too,
1628 int invisibility_change)
1630 /* Retrieve the ancestor for efficiency */
1631 EXTENT anc = extent_ancestor (extent);
1632 if (!NILP (extent_face (anc)) ||
1633 !NILP (extent_begin_glyph (anc)) ||
1634 !NILP (extent_end_glyph (anc)) ||
1635 !NILP (extent_mouse_face (anc)) ||
1636 !NILP (extent_invisible (anc)) ||
1637 !NILP (extent_initial_redisplay_function (anc)) ||
1638 invisibility_change)
1639 extent_changed_for_redisplay (extent, descendants_too,
1640 invisibility_change);
1644 make_extent_detached (Lisp_Object object)
1646 EXTENT extent = allocate_extent ();
1648 assert (NILP (object) || STRINGP (object) ||
1649 (BUFFERP (object) && BUFFER_LIVE_P (XBUFFER (object))));
1650 extent_object (extent) = object;
1651 /* Now make sure the extent info exists. */
1653 buffer_or_string_extent_info_force (object);
1657 /* A "real" extent is any extent other than the internal (not-user-visible)
1658 extents used by `map-extents'. */
1661 real_extent_at_forward (Extent_List *el, int pos, int endp)
1663 for (; pos < extent_list_num_els (el); pos++)
1665 EXTENT e = extent_list_at (el, pos, endp);
1666 if (!extent_internal_p (e))
1673 real_extent_at_backward (Extent_List *el, int pos, int endp)
1675 for (; pos >= 0; pos--)
1677 EXTENT e = extent_list_at (el, pos, endp);
1678 if (!extent_internal_p (e))
1685 extent_first (Lisp_Object obj)
1687 Extent_List *el = buffer_or_string_extent_list (obj);
1691 return real_extent_at_forward (el, 0, 0);
1696 extent_e_first (Lisp_Object obj)
1698 Extent_List *el = buffer_or_string_extent_list (obj);
1702 return real_extent_at_forward (el, 0, 1);
1707 extent_next (EXTENT e)
1709 Extent_List *el = extent_extent_list (e);
1711 int pos = extent_list_locate (el, e, 0, &foundp);
1713 return real_extent_at_forward (el, pos+1, 0);
1718 extent_e_next (EXTENT e)
1720 Extent_List *el = extent_extent_list (e);
1722 int pos = extent_list_locate (el, e, 1, &foundp);
1724 return real_extent_at_forward (el, pos+1, 1);
1729 extent_last (Lisp_Object obj)
1731 Extent_List *el = buffer_or_string_extent_list (obj);
1735 return real_extent_at_backward (el, extent_list_num_els (el) - 1, 0);
1740 extent_e_last (Lisp_Object obj)
1742 Extent_List *el = buffer_or_string_extent_list (obj);
1746 return real_extent_at_backward (el, extent_list_num_els (el) - 1, 1);
1751 extent_previous (EXTENT e)
1753 Extent_List *el = extent_extent_list (e);
1755 int pos = extent_list_locate (el, e, 0, &foundp);
1757 return real_extent_at_backward (el, pos-1, 0);
1762 extent_e_previous (EXTENT e)
1764 Extent_List *el = extent_extent_list (e);
1766 int pos = extent_list_locate (el, e, 1, &foundp);
1768 return real_extent_at_backward (el, pos-1, 1);
1773 extent_attach (EXTENT extent)
1775 Extent_List *el = extent_extent_list (extent);
1777 extent_list_insert (el, extent);
1778 soe_insert (extent_object (extent), extent);
1779 /* only this extent changed */
1780 extent_maybe_changed_for_redisplay (extent, 0,
1781 !NILP (extent_invisible (extent)));
1785 extent_detach (EXTENT extent)
1789 if (extent_detached_p (extent))
1791 el = extent_extent_list (extent);
1793 /* call this before messing with the extent. */
1794 extent_maybe_changed_for_redisplay (extent, 0,
1795 !NILP (extent_invisible (extent)));
1796 extent_list_delete (el, extent);
1797 soe_delete (extent_object (extent), extent);
1798 set_extent_start (extent, -1);
1799 set_extent_end (extent, -1);
1802 /* ------------------------------- */
1803 /* map-extents et al. */
1804 /* ------------------------------- */
1806 /* Returns true iff map_extents() would visit the given extent.
1807 See the comments at map_extents() for info on the overlap rule.
1808 Assumes that all validation on the extent and buffer positions has
1809 already been performed (see Fextent_in_region_p ()).
1812 extent_in_region_p (EXTENT extent, Bytind from, Bytind to,
1815 Lisp_Object obj = extent_object (extent);
1816 Endpoint_Index start, end, exs, exe;
1817 int start_open, end_open;
1818 unsigned int all_extents_flags = flags & ME_ALL_EXTENTS_MASK;
1819 unsigned int in_region_flags = flags & ME_IN_REGION_MASK;
1822 /* A zero-length region is treated as closed-closed. */
1825 flags |= ME_END_CLOSED;
1826 flags &= ~ME_START_OPEN;
1829 /* So is a zero-length extent. */
1830 if (extent_start (extent) == extent_end (extent))
1831 start_open = 0, end_open = 0;
1832 /* `all_extents_flags' will almost always be zero. */
1833 else if (all_extents_flags == 0)
1835 start_open = extent_start_open_p (extent);
1836 end_open = extent_end_open_p (extent);
1839 switch (all_extents_flags)
1841 case ME_ALL_EXTENTS_CLOSED: start_open = 0, end_open = 0; break;
1842 case ME_ALL_EXTENTS_OPEN: start_open = 1, end_open = 1; break;
1843 case ME_ALL_EXTENTS_CLOSED_OPEN: start_open = 0, end_open = 1; break;
1844 case ME_ALL_EXTENTS_OPEN_CLOSED: start_open = 1, end_open = 0; break;
1845 default: abort(); break;
1848 start = buffer_or_string_bytind_to_startind (obj, from,
1849 flags & ME_START_OPEN);
1850 end = buffer_or_string_bytind_to_endind (obj, to, ! (flags & ME_END_CLOSED));
1851 exs = memind_to_startind (extent_start (extent), start_open);
1852 exe = memind_to_endind (extent_end (extent), end_open);
1854 /* It's easy to determine whether an extent lies *outside* the
1855 region -- just determine whether it's completely before
1856 or completely after the region. Reject all such extents, so
1857 we're now left with only the extents that overlap the region.
1860 if (exs > end || exe < start)
1863 /* See if any further restrictions are called for. */
1864 /* in_region_flags will almost always be zero. */
1865 if (in_region_flags == 0)
1868 switch (in_region_flags)
1870 case ME_START_IN_REGION:
1871 retval = start <= exs && exs <= end; break;
1872 case ME_END_IN_REGION:
1873 retval = start <= exe && exe <= end; break;
1874 case ME_START_AND_END_IN_REGION:
1875 retval = start <= exs && exe <= end; break;
1876 case ME_START_OR_END_IN_REGION:
1877 retval = (start <= exs && exs <= end) || (start <= exe && exe <= end);
1882 return flags & ME_NEGATE_IN_REGION ? !retval : retval;
1885 struct map_extents_struct
1888 Extent_List_Marker *mkr;
1893 map_extents_unwind (Lisp_Object obj)
1895 struct map_extents_struct *closure =
1896 (struct map_extents_struct *) get_opaque_ptr (obj);
1897 free_opaque_ptr (obj);
1899 extent_detach (closure->range);
1901 extent_list_delete_marker (closure->el, closure->mkr);
1905 /* This is the guts of `map-extents' and the other functions that
1906 map over extents. In theory the operation of this function is
1907 simple: just figure out what extents we're mapping over, and
1908 call the function on each one of them in the range. Unfortunately
1909 there are a wide variety of things that the mapping function
1910 might do, and we have to be very tricky to avoid getting messed
1911 up. Furthermore, this function needs to be very fast (it is
1912 called multiple times every time text is inserted or deleted
1913 from a buffer), and so we can't always afford the overhead of
1914 dealing with all the possible things that the mapping function
1915 might do; thus, there are many flags that can be specified
1916 indicating what the mapping function might or might not do.
1918 The result of all this is that this is the most complicated
1919 function in this file. Change it at your own risk!
1921 A potential simplification to the logic below is to determine
1922 all the extents that the mapping function should be called on
1923 before any calls are actually made and save them in an array.
1924 That introduces its own complications, however (the array
1925 needs to be marked for garbage-collection, and a static array
1926 cannot be used because map_extents() needs to be reentrant).
1927 Furthermore, the results might be a little less sensible than
1932 map_extents_bytind (Bytind from, Bytind to, map_extents_fun fn, void *arg,
1933 Lisp_Object obj, EXTENT after, unsigned int flags)
1935 Memind st, en; /* range we're mapping over */
1936 EXTENT range = 0; /* extent for this, if ME_MIGHT_MODIFY_TEXT */
1937 Extent_List *el = 0; /* extent list we're iterating over */
1938 Extent_List_Marker *posm = 0; /* marker for extent list,
1939 if ME_MIGHT_MODIFY_EXTENTS */
1940 /* count and struct for unwind-protect, if ME_MIGHT_THROW */
1942 struct map_extents_struct closure;
1944 #ifdef ERROR_CHECK_EXTENTS
1945 assert (from <= to);
1946 assert (from >= buffer_or_string_absolute_begin_byte (obj) &&
1947 from <= buffer_or_string_absolute_end_byte (obj) &&
1948 to >= buffer_or_string_absolute_begin_byte (obj) &&
1949 to <= buffer_or_string_absolute_end_byte (obj));
1954 assert (EQ (obj, extent_object (after)));
1955 assert (!extent_detached_p (after));
1958 el = buffer_or_string_extent_list (obj);
1959 if (!el || !extent_list_num_els(el))
1963 st = buffer_or_string_bytind_to_memind (obj, from);
1964 en = buffer_or_string_bytind_to_memind (obj, to);
1966 if (flags & ME_MIGHT_MODIFY_TEXT)
1968 /* The mapping function might change the text in the buffer,
1969 so make an internal extent to hold the range we're mapping
1971 range = make_extent_detached (obj);
1972 set_extent_start (range, st);
1973 set_extent_end (range, en);
1974 range->flags.start_open = flags & ME_START_OPEN;
1975 range->flags.end_open = !(flags & ME_END_CLOSED);
1976 range->flags.internal = 1;
1977 range->flags.detachable = 0;
1978 extent_attach (range);
1981 if (flags & ME_MIGHT_THROW)
1983 /* The mapping function might throw past us so we need to use an
1984 unwind_protect() to eliminate the internal extent and range
1986 count = specpdl_depth ();
1987 closure.range = range;
1989 record_unwind_protect (map_extents_unwind,
1990 make_opaque_ptr (&closure));
1993 /* ---------- Figure out where we start and what direction
1994 we move in. This is the trickiest part of this
1995 function. ---------- */
1997 /* If ME_START_IN_REGION, ME_END_IN_REGION or ME_START_AND_END_IN_REGION
1998 was specified and ME_NEGATE_IN_REGION was not specified, our job
1999 is simple because of the presence of the display order and e-order.
2000 (Note that theoretically do something similar for
2001 ME_START_OR_END_IN_REGION, but that would require more trickiness
2002 than it's worth to avoid hitting the same extent twice.)
2004 In the general case, all the extents that overlap a range can be
2005 divided into two classes: those whose start position lies within
2006 the range (including the range's end but not including the
2007 range's start), and those that overlap the start position,
2008 i.e. those in the SOE for the start position. Or equivalently,
2009 the extents can be divided into those whose end position lies
2010 within the range and those in the SOE for the end position. Note
2011 that for this purpose we treat both the range and all extents in
2012 the buffer as closed on both ends. If this is not what the ME_
2013 flags specified, then we've mapped over a few too many extents,
2014 but no big deal because extent_in_region_p() will filter them
2015 out. Ideally, we could move the SOE to the closer of the range's
2016 two ends and work forwards or backwards from there. However, in
2017 order to make the semantics of the AFTER argument work out, we
2018 have to always go in the same direction; so we choose to always
2019 move the SOE to the start position.
2021 When it comes time to do the SOE stage, we first call soe_move()
2022 so that the SOE gets set up. Note that the SOE might get
2023 changed while we are mapping over its contents. If we can
2024 guarantee that the SOE won't get moved to a new position, we
2025 simply need to put a marker in the SOE and we will track deletions
2026 and insertions of extents in the SOE. If the SOE might get moved,
2027 however (this would happen as a result of a recursive invocation
2028 of map-extents or a call to a redisplay-type function), then
2029 trying to track its changes is hopeless, so we just keep a
2030 marker to the first (or last) extent in the SOE and use that as
2033 Finally, if DONT_USE_SOE is defined, we don't use the SOE at all
2034 and instead just map from the beginning of the buffer. This is
2035 used for testing purposes and allows the SOE to be calculated
2036 using map_extents() instead of the other way around. */
2039 int range_flag; /* ME_*_IN_REGION subset of flags */
2040 int do_soe_stage = 0; /* Are we mapping over the SOE? */
2041 /* Does the range stage map over start or end positions? */
2043 /* If type == 0, we include the start position in the range stage mapping.
2044 If type == 1, we exclude the start position in the range stage mapping.
2045 If type == 2, we begin at range_start_pos, an extent-list position.
2047 int range_start_type = 0;
2048 int range_start_pos = 0;
2051 range_flag = flags & ME_IN_REGION_MASK;
2052 if ((range_flag == ME_START_IN_REGION ||
2053 range_flag == ME_START_AND_END_IN_REGION) &&
2054 !(flags & ME_NEGATE_IN_REGION))
2056 /* map over start position in [range-start, range-end]. No SOE
2060 else if (range_flag == ME_END_IN_REGION && !(flags & ME_NEGATE_IN_REGION))
2062 /* map over end position in [range-start, range-end]. No SOE
2068 /* Need to include the SOE extents. */
2070 /* Just brute-force it: start from the beginning. */
2072 range_start_type = 2;
2073 range_start_pos = 0;
2075 Stack_Of_Extents *soe = buffer_or_string_stack_of_extents_force (obj);
2078 /* Move the SOE to the closer end of the range. This dictates
2079 whether we map over start positions or end positions. */
2082 numsoe = extent_list_num_els (soe->extents);
2085 if (flags & ME_MIGHT_MOVE_SOE)
2088 /* Can't map over SOE, so just extend range to cover the
2090 EXTENT e = extent_list_at (soe->extents, 0, 0);
2092 extent_list_locate (buffer_or_string_extent_list (obj), e, 0,
2095 range_start_type = 2;
2099 /* We can map over the SOE. */
2101 range_start_type = 1;
2106 /* No extents in the SOE to map over, so we act just as if
2107 ME_START_IN_REGION or ME_END_IN_REGION was specified.
2108 RANGE_ENDP already specified so no need to do anything else. */
2113 /* ---------- Now loop over the extents. ---------- */
2115 /* We combine the code for the two stages because much of it
2117 for (stage = 0; stage < 2; stage++)
2119 int pos = 0; /* Position in extent list */
2121 /* First set up start conditions */
2123 { /* The SOE stage */
2126 el = buffer_or_string_stack_of_extents_force (obj)->extents;
2127 /* We will always be looping over start extents here. */
2128 assert (!range_endp);
2132 { /* The range stage */
2133 el = buffer_or_string_extent_list (obj);
2134 switch (range_start_type)
2137 pos = extent_list_locate_from_pos (el, st, range_endp);
2140 pos = extent_list_locate_from_pos (el, st + 1, range_endp);
2143 pos = range_start_pos;
2148 if (flags & ME_MIGHT_MODIFY_EXTENTS)
2150 /* Create a marker to track changes to the extent list */
2152 /* Delete the marker used in the SOE stage. */
2153 extent_list_delete_marker
2154 (buffer_or_string_stack_of_extents_force (obj)->extents, posm);
2155 posm = extent_list_make_marker (el, pos, range_endp);
2156 /* tell the unwind function about the marker. */
2167 /* ----- update position in extent list
2168 and fetch next extent ----- */
2171 /* fetch POS again to track extent insertions or deletions */
2172 pos = extent_list_marker_pos (el, posm);
2173 if (pos >= extent_list_num_els (el))
2175 e = extent_list_at (el, pos, range_endp);
2178 /* now point the marker to the next one we're going to process.
2179 This ensures graceful behavior if this extent is deleted. */
2180 extent_list_move_marker (el, posm, pos);
2182 /* ----- deal with internal extents ----- */
2184 if (extent_internal_p (e))
2186 if (!(flags & ME_INCLUDE_INTERNAL))
2188 else if (e == range)
2190 /* We're processing internal extents and we've
2191 come across our own special range extent.
2192 (This happens only in adjust_extents*() and
2193 process_extents*(), which handle text
2194 insertion and deletion.) We need to omit
2195 processing of this extent; otherwise
2196 we will probably end up prematurely
2197 terminating this loop. */
2202 /* ----- deal with AFTER condition ----- */
2206 /* if e > after, then we can stop skipping extents. */
2207 if (EXTENT_LESS (after, e))
2209 else /* otherwise, skip this extent. */
2213 /* ----- stop if we're completely outside the range ----- */
2215 /* fetch ST and EN again to track text insertions or deletions */
2218 st = extent_start (range);
2219 en = extent_end (range);
2221 if (extent_endpoint (e, range_endp) > en)
2223 /* Can't be mapping over SOE because all extents in
2224 there should overlap ST */
2225 assert (stage == 1);
2229 /* ----- Now actually call the function ----- */
2231 obj2 = extent_object (e);
2232 if (extent_in_region_p (e,
2233 buffer_or_string_memind_to_bytind (obj2,
2235 buffer_or_string_memind_to_bytind (obj2,
2241 /* Function wants us to stop mapping. */
2242 stage = 1; /* so outer for loop will terminate */
2248 /* ---------- Finished looping. ---------- */
2251 if (flags & ME_MIGHT_THROW)
2252 /* This deletes the range extent and frees the marker. */
2253 unbind_to (count, Qnil);
2256 /* Delete them ourselves */
2258 extent_detach (range);
2260 extent_list_delete_marker (el, posm);
2265 map_extents (Bufpos from, Bufpos to, map_extents_fun fn,
2266 void *arg, Lisp_Object obj, EXTENT after, unsigned int flags)
2268 map_extents_bytind (buffer_or_string_bufpos_to_bytind (obj, from),
2269 buffer_or_string_bufpos_to_bytind (obj, to), fn, arg,
2273 /* ------------------------------- */
2274 /* adjust_extents() */
2275 /* ------------------------------- */
2277 /* Add AMOUNT to all extent endpoints in the range (FROM, TO]. This
2278 happens whenever the gap is moved or (under Mule) a character in a
2279 string is substituted for a different-length one. The reason for
2280 this is that extent endpoints behave just like markers (all memory
2281 indices do) and this adjustment correct for markers -- see
2282 adjust_markers(). Note that it is important that we visit all
2283 extent endpoints in the range, irrespective of whether the
2284 endpoints are open or closed.
2286 We could use map_extents() for this (and in fact the function
2287 was originally written that way), but the gap is in an incoherent
2288 state when this function is called and this function plays
2289 around with extent endpoints without detaching and reattaching
2290 the extents (this is provably correct and saves lots of time),
2291 so for safety we make it just look at the extent lists directly. */
2294 adjust_extents (Lisp_Object obj, Memind from, Memind to, int amount)
2300 Stack_Of_Extents *soe;
2302 #ifdef ERROR_CHECK_EXTENTS
2303 sledgehammer_extent_check (obj);
2305 el = buffer_or_string_extent_list (obj);
2307 if (!el || !extent_list_num_els(el))
2310 /* IMPORTANT! Compute the starting positions of the extents to
2311 modify BEFORE doing any modification! Otherwise the starting
2312 position for the second time through the loop might get
2313 incorrectly calculated (I got bit by this bug real bad). */
2314 startpos[0] = extent_list_locate_from_pos (el, from+1, 0);
2315 startpos[1] = extent_list_locate_from_pos (el, from+1, 1);
2316 for (endp = 0; endp < 2; endp++)
2318 for (pos = startpos[endp]; pos < extent_list_num_els (el);
2321 EXTENT e = extent_list_at (el, pos, endp);
2322 if (extent_endpoint (e, endp) > to)
2324 set_extent_endpoint (e,
2325 do_marker_adjustment (extent_endpoint (e, endp),
2331 /* The index for the buffer's SOE is a memory index and thus
2332 needs to be adjusted like a marker. */
2333 soe = buffer_or_string_stack_of_extents (obj);
2334 if (soe && soe->pos >= 0)
2335 soe->pos = do_marker_adjustment (soe->pos, from, to, amount);
2338 /* ------------------------------- */
2339 /* adjust_extents_for_deletion() */
2340 /* ------------------------------- */
2342 struct adjust_extents_for_deletion_arg
2344 EXTENT_dynarr *list;
2348 adjust_extents_for_deletion_mapper (EXTENT extent, void *arg)
2350 struct adjust_extents_for_deletion_arg *closure =
2351 (struct adjust_extents_for_deletion_arg *) arg;
2353 Dynarr_add (closure->list, extent);
2354 return 0; /* continue mapping */
2357 /* For all extent endpoints in the range (FROM, TO], move them to the beginning
2358 of the new gap. Note that it is important that we visit all extent
2359 endpoints in the range, irrespective of whether the endpoints are open or
2362 This function deals with weird stuff such as the fact that extents
2365 There is no string correspondent for this because you can't
2366 delete characters from a string.
2370 adjust_extents_for_deletion (Lisp_Object object, Bytind from,
2371 Bytind to, int gapsize, int numdel,
2374 struct adjust_extents_for_deletion_arg closure;
2376 Memind adjust_to = (Memind) (to + gapsize);
2377 Bytecount amount = - numdel - movegapsize;
2378 Memind oldsoe = 0, newsoe = 0;
2379 Stack_Of_Extents *soe = buffer_or_string_stack_of_extents (object);
2381 #ifdef ERROR_CHECK_EXTENTS
2382 sledgehammer_extent_check (object);
2384 closure.list = Dynarr_new (EXTENT);
2386 /* We're going to be playing weird games below with extents and the SOE
2387 and such, so compute the list now of all the extents that we're going
2388 to muck with. If we do the mapping and adjusting together, things can
2389 get all screwed up. */
2391 map_extents_bytind (from, to, adjust_extents_for_deletion_mapper,
2392 (void *) &closure, object, 0,
2393 /* extent endpoints move like markers regardless
2394 of their open/closeness. */
2395 ME_ALL_EXTENTS_CLOSED | ME_END_CLOSED |
2396 ME_START_OR_END_IN_REGION | ME_INCLUDE_INTERNAL);
2399 Old and new values for the SOE's position. (It gets adjusted
2400 like a marker, just like extent endpoints.)
2407 newsoe = do_marker_adjustment (soe->pos,
2408 adjust_to, adjust_to,
2414 for (i = 0; i < Dynarr_length (closure.list); i++)
2416 EXTENT extent = Dynarr_at (closure.list, i);
2417 Memind new_start = extent_start (extent);
2418 Memind new_end = extent_end (extent);
2420 /* do_marker_adjustment() will not adjust values that should not be
2421 adjusted. We're passing the same funky arguments to
2422 do_marker_adjustment() as buffer_delete_range() does. */
2424 do_marker_adjustment (new_start,
2425 adjust_to, adjust_to,
2428 do_marker_adjustment (new_end,
2429 adjust_to, adjust_to,
2432 /* We need to be very careful here so that the SOE doesn't get
2433 corrupted. We are shrinking extents out of the deleted region
2434 and simultaneously moving the SOE's pos out of the deleted
2435 region, so the SOE should contain the same extents at the end
2436 as at the beginning. However, extents may get reordered
2437 by this process, so we have to operate by pulling the extents
2438 out of the buffer and SOE, changing their bounds, and then
2439 reinserting them. In order for the SOE not to get screwed up,
2440 we have to make sure that the SOE's pos points to its old
2441 location whenever we pull an extent out, and points to its
2442 new location whenever we put the extent back in.
2445 if (new_start != extent_start (extent) ||
2446 new_end != extent_end (extent))
2448 extent_detach (extent);
2449 set_extent_start (extent, new_start);
2450 set_extent_end (extent, new_end);
2453 extent_attach (extent);
2462 #ifdef ERROR_CHECK_EXTENTS
2463 sledgehammer_extent_check (object);
2465 Dynarr_free (closure.list);
2468 /* ------------------------------- */
2469 /* extent fragments */
2470 /* ------------------------------- */
2472 /* Imagine that the buffer is divided up into contiguous,
2473 nonoverlapping "runs" of text such that no extent
2474 starts or ends within a run (extents that abut the
2477 An extent fragment is a structure that holds data about
2478 the run that contains a particular buffer position (if
2479 the buffer position is at the junction of two runs, the
2480 run after the position is used) -- the beginning and
2481 end of the run, a list of all of the extents in that
2482 run, the "merged face" that results from merging all of
2483 the faces corresponding to those extents, the begin and
2484 end glyphs at the beginning of the run, etc. This is
2485 the information that redisplay needs in order to
2488 Extent fragments have to be very quick to update to
2489 a new buffer position when moving linearly through
2490 the buffer. They rely on the stack-of-extents code,
2491 which does the heavy-duty algorithmic work of determining
2492 which extents overly a particular position. */
2494 /* This function returns the position of the beginning of
2495 the first run that begins after POS, or returns POS if
2496 there are no such runs. */
2499 extent_find_end_of_run (Lisp_Object obj, Bytind pos, int outside_accessible)
2502 Extent_List *bel = buffer_or_string_extent_list (obj);
2505 Memind mempos = buffer_or_string_bytind_to_memind (obj, pos);
2506 Bytind limit = outside_accessible ?
2507 buffer_or_string_absolute_end_byte (obj) :
2508 buffer_or_string_accessible_end_byte (obj);
2510 if (!bel || !extent_list_num_els(bel))
2513 sel = buffer_or_string_stack_of_extents_force (obj)->extents;
2514 soe_move (obj, mempos);
2516 /* Find the first start position after POS. */
2517 elind1 = extent_list_locate_from_pos (bel, mempos+1, 0);
2518 if (elind1 < extent_list_num_els (bel))
2519 pos1 = buffer_or_string_memind_to_bytind
2520 (obj, extent_start (extent_list_at (bel, elind1, 0)));
2524 /* Find the first end position after POS. The extent corresponding
2525 to this position is either in the SOE or is greater than or
2526 equal to POS1, so we just have to look in the SOE. */
2527 elind2 = extent_list_locate_from_pos (sel, mempos+1, 1);
2528 if (elind2 < extent_list_num_els (sel))
2529 pos2 = buffer_or_string_memind_to_bytind
2530 (obj, extent_end (extent_list_at (sel, elind2, 1)));
2534 return min (min (pos1, pos2), limit);
2538 extent_find_beginning_of_run (Lisp_Object obj, Bytind pos,
2539 int outside_accessible)
2542 Extent_List *bel = buffer_or_string_extent_list (obj);
2545 Memind mempos = buffer_or_string_bytind_to_memind (obj, pos);
2546 Bytind limit = outside_accessible ?
2547 buffer_or_string_absolute_begin_byte (obj) :
2548 buffer_or_string_accessible_begin_byte (obj);
2550 if (!bel || !extent_list_num_els(bel))
2553 sel = buffer_or_string_stack_of_extents_force (obj)->extents;
2554 soe_move (obj, mempos);
2556 /* Find the first end position before POS. */
2557 elind1 = extent_list_locate_from_pos (bel, mempos, 1);
2559 pos1 = buffer_or_string_memind_to_bytind
2560 (obj, extent_end (extent_list_at (bel, elind1 - 1, 1)));
2564 /* Find the first start position before POS. The extent corresponding
2565 to this position is either in the SOE or is less than or
2566 equal to POS1, so we just have to look in the SOE. */
2567 elind2 = extent_list_locate_from_pos (sel, mempos, 0);
2569 pos2 = buffer_or_string_memind_to_bytind
2570 (obj, extent_start (extent_list_at (sel, elind2 - 1, 0)));
2574 return max (max (pos1, pos2), limit);
2577 struct extent_fragment *
2578 extent_fragment_new (Lisp_Object buffer_or_string, struct frame *frm)
2580 struct extent_fragment *ef = xnew_and_zero (struct extent_fragment);
2582 ef->object = buffer_or_string;
2584 ef->extents = Dynarr_new (EXTENT);
2585 ef->begin_glyphs = Dynarr_new (glyph_block);
2586 ef->end_glyphs = Dynarr_new (glyph_block);
2592 extent_fragment_delete (struct extent_fragment *ef)
2594 Dynarr_free (ef->extents);
2595 Dynarr_free (ef->begin_glyphs);
2596 Dynarr_free (ef->end_glyphs);
2601 extent_priority_sort_function (const void *humpty, const void *dumpty)
2603 const EXTENT foo = * (const EXTENT *) humpty;
2604 const EXTENT bar = * (const EXTENT *) dumpty;
2605 if (extent_priority (foo) < extent_priority (bar))
2607 return extent_priority (foo) > extent_priority (bar);
2611 extent_fragment_sort_by_priority (EXTENT_dynarr *extarr)
2615 /* Sort our copy of the stack by extent_priority. We use a bubble
2616 sort here because it's going to be faster than qsort() for small
2617 numbers of extents (less than 10 or so), and 99.999% of the time
2618 there won't ever be more extents than this in the stack. */
2619 if (Dynarr_length (extarr) < 10)
2621 for (i = 1; i < Dynarr_length (extarr); i++)
2625 (extent_priority (Dynarr_at (extarr, j)) >
2626 extent_priority (Dynarr_at (extarr, j+1))))
2628 EXTENT tmp = Dynarr_at (extarr, j);
2629 Dynarr_at (extarr, j) = Dynarr_at (extarr, j+1);
2630 Dynarr_at (extarr, j+1) = tmp;
2636 /* But some loser programs mess up and may create a large number
2637 of extents overlapping the same spot. This will result in
2638 catastrophic behavior if we use the bubble sort above. */
2639 qsort (Dynarr_atp (extarr, 0), Dynarr_length (extarr),
2640 sizeof (EXTENT), extent_priority_sort_function);
2643 /* If PROP is the `invisible' property of an extent,
2644 this is 1 if the extent should be treated as invisible. */
2646 #define EXTENT_PROP_MEANS_INVISIBLE(buf, prop) \
2647 (EQ (buf->invisibility_spec, Qt) \
2649 : invisible_p (prop, buf->invisibility_spec))
2651 /* If PROP is the `invisible' property of a extent,
2652 this is 1 if the extent should be treated as invisible
2653 and should have an ellipsis. */
2655 #define EXTENT_PROP_MEANS_INVISIBLE_WITH_ELLIPSIS(buf, prop) \
2656 (EQ (buf->invisibility_spec, Qt) \
2658 : invisible_ellipsis_p (prop, buf->invisibility_spec))
2660 /* This is like a combination of memq and assq.
2661 Return 1 if PROPVAL appears as an element of LIST
2662 or as the car of an element of LIST.
2663 If PROPVAL is a list, compare each element against LIST
2664 in that way, and return 1 if any element of PROPVAL is found in LIST.
2666 This function cannot quit. */
2669 invisible_p (REGISTER Lisp_Object propval, Lisp_Object list)
2671 REGISTER Lisp_Object tail, proptail;
2672 for (tail = list; CONSP (tail); tail = XCDR (tail))
2674 REGISTER Lisp_Object tem;
2676 if (EQ (propval, tem))
2678 if (CONSP (tem) && EQ (propval, XCAR (tem)))
2681 if (CONSP (propval))
2682 for (proptail = propval; CONSP (proptail);
2683 proptail = XCDR (proptail))
2685 Lisp_Object propelt;
2686 propelt = XCAR (proptail);
2687 for (tail = list; CONSP (tail); tail = XCDR (tail))
2689 REGISTER Lisp_Object tem;
2691 if (EQ (propelt, tem))
2693 if (CONSP (tem) && EQ (propelt, XCAR (tem)))
2700 /* Return 1 if PROPVAL appears as the car of an element of LIST
2701 and the cdr of that element is non-nil.
2702 If PROPVAL is a list, check each element of PROPVAL in that way,
2703 and the first time some element is found,
2704 return 1 if the cdr of that element is non-nil.
2706 This function cannot quit. */
2709 invisible_ellipsis_p (REGISTER Lisp_Object propval, Lisp_Object list)
2711 REGISTER Lisp_Object tail, proptail;
2712 for (tail = list; CONSP (tail); tail = XCDR (tail))
2714 REGISTER Lisp_Object tem;
2716 if (CONSP (tem) && EQ (propval, XCAR (tem)))
2717 return ! NILP (XCDR (tem));
2719 if (CONSP (propval))
2720 for (proptail = propval; CONSP (proptail);
2721 proptail = XCDR (proptail))
2723 Lisp_Object propelt;
2724 propelt = XCAR (proptail);
2725 for (tail = list; CONSP (tail); tail = XCDR (tail))
2727 REGISTER Lisp_Object tem;
2729 if (CONSP (tem) && EQ (propelt, XCAR (tem)))
2730 return ! NILP (XCDR (tem));
2737 extent_fragment_update (struct window *w, struct extent_fragment *ef,
2742 buffer_or_string_stack_of_extents_force (ef->object)->extents;
2744 struct extent dummy_lhe_extent;
2745 Memind mempos = buffer_or_string_bytind_to_memind (ef->object, pos);
2747 #ifdef ERROR_CHECK_EXTENTS
2748 assert (pos >= buffer_or_string_accessible_begin_byte (ef->object)
2749 && pos <= buffer_or_string_accessible_end_byte (ef->object));
2752 Dynarr_reset (ef->extents);
2753 Dynarr_reset (ef->begin_glyphs);
2754 Dynarr_reset (ef->end_glyphs);
2756 ef->previously_invisible = ef->invisible;
2759 if (ef->invisible_ellipses)
2760 ef->invisible_ellipses_already_displayed = 1;
2763 ef->invisible_ellipses_already_displayed = 0;
2765 ef->invisible_ellipses = 0;
2767 /* Set up the begin and end positions. */
2769 ef->end = extent_find_end_of_run (ef->object, pos, 0);
2771 /* Note that extent_find_end_of_run() already moved the SOE for us. */
2772 /* soe_move (ef->object, mempos); */
2774 /* Determine the begin glyphs at POS. */
2775 for (i = 0; i < extent_list_num_els (sel); i++)
2777 EXTENT e = extent_list_at (sel, i, 0);
2778 if (extent_start (e) == mempos && !NILP (extent_begin_glyph (e)))
2780 Lisp_Object glyph = extent_begin_glyph (e);
2781 struct glyph_block gb;
2784 XSETEXTENT (gb.extent, e);
2785 Dynarr_add (ef->begin_glyphs, gb);
2789 /* Determine the end glyphs at POS. */
2790 for (i = 0; i < extent_list_num_els (sel); i++)
2792 EXTENT e = extent_list_at (sel, i, 1);
2793 if (extent_end (e) == mempos && !NILP (extent_end_glyph (e)))
2795 Lisp_Object glyph = extent_end_glyph (e);
2796 struct glyph_block gb;
2799 XSETEXTENT (gb.extent, e);
2800 Dynarr_add (ef->end_glyphs, gb);
2804 /* We tried determining all the charsets used in the run here,
2805 but that fails even if we only do the current line -- display
2806 tables or non-printable characters might cause other charsets
2809 /* Determine whether the last-highlighted-extent is present. */
2810 if (EXTENTP (Vlast_highlighted_extent))
2811 lhe = XEXTENT (Vlast_highlighted_extent);
2813 /* Now add all extents that overlap the character after POS and
2814 have a non-nil face. Also check if the character is invisible. */
2815 for (i = 0; i < extent_list_num_els (sel); i++)
2817 EXTENT e = extent_list_at (sel, i, 0);
2818 if (extent_end (e) > mempos)
2820 Lisp_Object invis_prop = extent_invisible (e);
2822 if (!NILP (invis_prop))
2824 if (!BUFFERP (ef->object))
2825 /* #### no `string-invisibility-spec' */
2829 if (!ef->invisible_ellipses_already_displayed &&
2830 EXTENT_PROP_MEANS_INVISIBLE_WITH_ELLIPSIS
2831 (XBUFFER (ef->object), invis_prop))
2834 ef->invisible_ellipses = 1;
2836 else if (EXTENT_PROP_MEANS_INVISIBLE
2837 (XBUFFER (ef->object), invis_prop))
2842 /* Remember that one of the extents in the list might be our
2843 dummy extent representing the highlighting that is
2844 attached to some other extent that is currently
2845 mouse-highlighted. When an extent is mouse-highlighted,
2846 it is as if there are two extents there, of potentially
2847 different priorities: the extent being highlighted, with
2848 whatever face and priority it has; and an ephemeral
2849 extent in the `mouse-face' face with
2850 `mouse-highlight-priority'.
2853 if (!NILP (extent_face (e)))
2854 Dynarr_add (ef->extents, e);
2858 /* zeroing isn't really necessary; we only deref `priority'
2860 xzero (dummy_lhe_extent);
2861 set_extent_priority (&dummy_lhe_extent,
2862 mouse_highlight_priority);
2863 /* Need to break up the following expression, due to an */
2864 /* error in the Digital UNIX 3.2g C compiler (Digital */
2865 /* UNIX Compiler Driver 3.11). */
2866 f = extent_mouse_face (lhe);
2867 extent_face (&dummy_lhe_extent) = f;
2868 Dynarr_add (ef->extents, &dummy_lhe_extent);
2870 /* since we are looping anyway, we might as well do this here */
2871 if ((!NILP(extent_initial_redisplay_function (e))) &&
2872 !extent_in_red_event_p(e))
2874 Lisp_Object function = extent_initial_redisplay_function (e);
2877 /* printf ("initial redisplay function called!\n "); */
2879 /* print_extent_2 (e);
2882 /* FIXME: One should probably inhibit the displaying of
2883 this extent to reduce flicker */
2884 extent_in_red_event_p(e) = 1;
2886 /* call the function */
2889 Fenqueue_eval_event(function,obj);
2894 extent_fragment_sort_by_priority (ef->extents);
2896 /* Now merge the faces together into a single face. The code to
2897 do this is in faces.c because it involves manipulating faces. */
2898 return get_extent_fragment_face_cache_index (w, ef);
2902 /************************************************************************/
2903 /* extent-object methods */
2904 /************************************************************************/
2906 /* These are the basic helper functions for handling the allocation of
2907 extent objects. They are similar to the functions for other
2908 lrecord objects. allocate_extent() is in alloc.c, not here. */
2911 mark_extent (Lisp_Object obj)
2913 struct extent *extent = XEXTENT (obj);
2915 mark_object (extent_object (extent));
2916 mark_object (extent_no_chase_normal_field (extent, face));
2917 return extent->plist;
2921 print_extent_1 (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
2923 EXTENT ext = XEXTENT (obj);
2924 EXTENT anc = extent_ancestor (ext);
2926 char buf[64], *bp = buf;
2928 /* Retrieve the ancestor and use it, for faster retrieval of properties */
2930 if (!NILP (extent_begin_glyph (anc))) *bp++ = '*';
2931 *bp++ = (extent_start_open_p (anc) ? '(': '[');
2932 if (extent_detached_p (ext))
2933 strcpy (bp, "detached");
2935 sprintf (bp, "%ld, %ld",
2936 (long) XINT (Fextent_start_position (obj)),
2937 (long) XINT (Fextent_end_position (obj)));
2939 *bp++ = (extent_end_open_p (anc) ? ')': ']');
2940 if (!NILP (extent_end_glyph (anc))) *bp++ = '*';
2943 if (!NILP (extent_read_only (anc))) *bp++ = '%';
2944 if (!NILP (extent_mouse_face (anc))) *bp++ = 'H';
2945 if (extent_unique_p (anc)) *bp++ = 'U';
2946 else if (extent_duplicable_p (anc)) *bp++ = 'D';
2947 if (!NILP (extent_invisible (anc))) *bp++ = 'I';
2949 if (!NILP (extent_read_only (anc)) || !NILP (extent_mouse_face (anc)) ||
2950 extent_unique_p (anc) ||
2951 extent_duplicable_p (anc) || !NILP (extent_invisible (anc)))
2954 write_c_string (buf, printcharfun);
2956 tail = extent_plist_slot (anc);
2958 for (; !NILP (tail); tail = Fcdr (Fcdr (tail)))
2960 Lisp_Object v = XCAR (XCDR (tail));
2961 if (NILP (v)) continue;
2962 print_internal (XCAR (tail), printcharfun, escapeflag);
2963 write_c_string (" ", printcharfun);
2966 sprintf (buf, "0x%lx", (long) ext);
2967 write_c_string (buf, printcharfun);
2971 print_extent (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
2975 const char *title = "";
2976 const char *name = "";
2977 const char *posttitle = "";
2978 Lisp_Object obj2 = Qnil;
2980 /* Destroyed extents have 't' in the object field, causing
2981 extent_object() to abort (maybe). */
2982 if (EXTENT_LIVE_P (XEXTENT (obj)))
2983 obj2 = extent_object (XEXTENT (obj));
2986 title = "no buffer";
2987 else if (BUFFERP (obj2))
2989 if (BUFFER_LIVE_P (XBUFFER (obj2)))
2992 name = (char *) XSTRING_DATA (XBUFFER (obj2)->name);
2996 title = "Killed Buffer";
3002 assert (STRINGP (obj2));
3003 title = "string \"";
3005 name = (char *) XSTRING_DATA (obj2);
3010 if (!EXTENT_LIVE_P (XEXTENT (obj)))
3011 error ("printing unreadable object #<destroyed extent>");
3013 error ("printing unreadable object #<extent 0x%lx>",
3014 (long) XEXTENT (obj));
3017 if (!EXTENT_LIVE_P (XEXTENT (obj)))
3018 write_c_string ("#<destroyed extent", printcharfun);
3021 char *buf = (char *)
3022 alloca (strlen (title) + strlen (name) + strlen (posttitle) + 1);
3023 write_c_string ("#<extent ", printcharfun);
3024 print_extent_1 (obj, printcharfun, escapeflag);
3025 write_c_string (extent_detached_p (XEXTENT (obj))
3026 ? " from " : " in ", printcharfun);
3027 sprintf (buf, "%s%s%s", title, name, posttitle);
3028 write_c_string (buf, printcharfun);
3034 error ("printing unreadable object #<extent>");
3035 write_c_string ("#<extent", printcharfun);
3037 write_c_string (">", printcharfun);
3041 properties_equal (EXTENT e1, EXTENT e2, int depth)
3043 /* When this function is called, all indirections have been followed.
3044 Thus, the indirection checks in the various macros below will not
3045 amount to anything, and could be removed. However, the time
3046 savings would probably not be significant. */
3047 if (!(EQ (extent_face (e1), extent_face (e2)) &&
3048 extent_priority (e1) == extent_priority (e2) &&
3049 internal_equal (extent_begin_glyph (e1), extent_begin_glyph (e2),
3051 internal_equal (extent_end_glyph (e1), extent_end_glyph (e2),
3055 /* compare the bit flags. */
3057 /* The has_aux field should not be relevant. */
3058 int e1_has_aux = e1->flags.has_aux;
3059 int e2_has_aux = e2->flags.has_aux;
3062 e1->flags.has_aux = e2->flags.has_aux = 0;
3063 value = memcmp (&e1->flags, &e2->flags, sizeof (e1->flags));
3064 e1->flags.has_aux = e1_has_aux;
3065 e2->flags.has_aux = e2_has_aux;
3070 /* compare the random elements of the plists. */
3071 return !plists_differ (extent_no_chase_plist (e1),
3072 extent_no_chase_plist (e2),
3077 extent_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
3079 struct extent *e1 = XEXTENT (obj1);
3080 struct extent *e2 = XEXTENT (obj2);
3082 (extent_start (e1) == extent_start (e2) &&
3083 extent_end (e1) == extent_end (e2) &&
3084 internal_equal (extent_object (e1), extent_object (e2), depth + 1) &&
3085 properties_equal (extent_ancestor (e1), extent_ancestor (e2),
3089 static unsigned long
3090 extent_hash (Lisp_Object obj, int depth)
3092 struct extent *e = XEXTENT (obj);
3093 /* No need to hash all of the elements; that would take too long.
3094 Just hash the most common ones. */
3095 return HASH3 (extent_start (e), extent_end (e),
3096 internal_hash (extent_object (e), depth + 1));
3099 static const struct lrecord_description extent_description[] = {
3100 { XD_LISP_OBJECT, offsetof (struct extent, object) },
3101 { XD_LISP_OBJECT, offsetof (struct extent, flags.face) },
3102 { XD_LISP_OBJECT, offsetof (struct extent, plist) },
3107 extent_getprop (Lisp_Object obj, Lisp_Object prop)
3109 return Fextent_property (obj, prop, Qunbound);
3113 extent_putprop (Lisp_Object obj, Lisp_Object prop, Lisp_Object value)
3115 Fset_extent_property (obj, prop, value);
3120 extent_remprop (Lisp_Object obj, Lisp_Object prop)
3122 EXTENT ext = XEXTENT (obj);
3124 /* This list is taken from Fset_extent_property, and should be kept
3126 if (EQ (prop, Qread_only)
3127 || EQ (prop, Qunique)
3128 || EQ (prop, Qduplicable)
3129 || EQ (prop, Qinvisible)
3130 || EQ (prop, Qdetachable)
3131 || EQ (prop, Qdetached)
3132 || EQ (prop, Qdestroyed)
3133 || EQ (prop, Qpriority)
3135 || EQ (prop, Qinitial_redisplay_function)
3136 || EQ (prop, Qafter_change_functions)
3137 || EQ (prop, Qbefore_change_functions)
3138 || EQ (prop, Qmouse_face)
3139 || EQ (prop, Qhighlight)
3140 || EQ (prop, Qbegin_glyph_layout)
3141 || EQ (prop, Qend_glyph_layout)
3142 || EQ (prop, Qglyph_layout)
3143 || EQ (prop, Qbegin_glyph)
3144 || EQ (prop, Qend_glyph)
3145 || EQ (prop, Qstart_open)
3146 || EQ (prop, Qend_open)
3147 || EQ (prop, Qstart_closed)
3148 || EQ (prop, Qend_closed)
3149 || EQ (prop, Qkeymap))
3151 /* #### Is this correct, anyway? */
3155 return external_remprop (extent_plist_addr (ext), prop, 0, ERROR_ME);
3159 extent_plist (Lisp_Object obj)
3161 return Fextent_properties (obj);
3164 DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS ("extent", extent,
3167 /* NOTE: If you declare a
3168 finalization method here,
3169 it will NOT be called.
3172 extent_equal, extent_hash,
3174 extent_getprop, extent_putprop,
3175 extent_remprop, extent_plist,
3179 /************************************************************************/
3180 /* basic extent accessors */
3181 /************************************************************************/
3183 /* These functions are for checking externally-passed extent objects
3184 and returning an extent's basic properties, which include the
3185 buffer the extent is associated with, the endpoints of the extent's
3186 range, the open/closed-ness of those endpoints, and whether the
3187 extent is detached. Manipulating these properties requires
3188 manipulating the ordered lists that hold extents; thus, functions
3189 to do that are in a later section. */
3191 /* Given a Lisp_Object that is supposed to be an extent, make sure it
3192 is OK and return an extent pointer. Extents can be in one of four
3196 2) detached and not associated with a buffer
3197 3) detached and associated with a buffer
3198 4) attached to a buffer
3200 If FLAGS is 0, types 2-4 are allowed. If FLAGS is DE_MUST_HAVE_BUFFER,
3201 types 3-4 are allowed. If FLAGS is DE_MUST_BE_ATTACHED, only type 4
3206 decode_extent (Lisp_Object extent_obj, unsigned int flags)
3211 CHECK_LIVE_EXTENT (extent_obj);
3212 extent = XEXTENT (extent_obj);
3213 obj = extent_object (extent);
3215 /* the following condition will fail if we're dealing with a freed extent */
3216 assert (NILP (obj) || BUFFERP (obj) || STRINGP (obj));
3218 if (flags & DE_MUST_BE_ATTACHED)
3219 flags |= DE_MUST_HAVE_BUFFER;
3221 /* if buffer is dead, then convert extent to have no buffer. */
3222 if (BUFFERP (obj) && !BUFFER_LIVE_P (XBUFFER (obj)))
3223 obj = extent_object (extent) = Qnil;
3225 assert (!NILP (obj) || extent_detached_p (extent));
3227 if ((NILP (obj) && (flags & DE_MUST_HAVE_BUFFER))
3228 || (extent_detached_p (extent) && (flags & DE_MUST_BE_ATTACHED)))
3230 signal_simple_error ("extent doesn't belong to a buffer or string",
3237 /* Note that the returned value is a buffer position, not a byte index. */
3240 extent_endpoint_external (Lisp_Object extent_obj, int endp)
3242 EXTENT extent = decode_extent (extent_obj, 0);
3244 if (extent_detached_p (extent))
3247 return make_int (extent_endpoint_bufpos (extent, endp));
3250 DEFUN ("extentp", Fextentp, 1, 1, 0, /*
3251 Return t if OBJECT is an extent.
3255 return EXTENTP (object) ? Qt : Qnil;
3258 DEFUN ("extent-live-p", Fextent_live_p, 1, 1, 0, /*
3259 Return t if OBJECT is an extent that has not been destroyed.
3263 return EXTENTP (object) && EXTENT_LIVE_P (XEXTENT (object)) ? Qt : Qnil;
3266 DEFUN ("extent-detached-p", Fextent_detached_p, 1, 1, 0, /*
3267 Return t if EXTENT is detached.
3271 return extent_detached_p (decode_extent (extent, 0)) ? Qt : Qnil;
3274 DEFUN ("extent-object", Fextent_object, 1, 1, 0, /*
3275 Return object (buffer or string) that EXTENT refers to.
3279 return extent_object (decode_extent (extent, 0));
3282 DEFUN ("extent-start-position", Fextent_start_position, 1, 1, 0, /*
3283 Return start position of EXTENT, or nil if EXTENT is detached.
3287 return extent_endpoint_external (extent, 0);
3290 DEFUN ("extent-end-position", Fextent_end_position, 1, 1, 0, /*
3291 Return end position of EXTENT, or nil if EXTENT is detached.
3295 return extent_endpoint_external (extent, 1);
3298 DEFUN ("extent-length", Fextent_length, 1, 1, 0, /*
3299 Return length of EXTENT in characters.
3303 EXTENT e = decode_extent (extent, DE_MUST_BE_ATTACHED);
3304 return make_int (extent_endpoint_bufpos (e, 1)
3305 - extent_endpoint_bufpos (e, 0));
3308 DEFUN ("next-extent", Fnext_extent, 1, 1, 0, /*
3309 Find next extent after EXTENT.
3310 If EXTENT is a buffer return the first extent in the buffer; likewise
3312 Extents in a buffer are ordered in what is called the "display"
3313 order, which sorts by increasing start positions and then by *decreasing*
3315 If you want to perform an operation on a series of extents, use
3316 `map-extents' instead of this function; it is much more efficient.
3317 The primary use of this function should be to enumerate all the
3318 extents in a buffer.
3319 Note: The display order is not necessarily the order that `map-extents'
3320 processes extents in!
3327 if (EXTENTP (extent))
3328 next = extent_next (decode_extent (extent, DE_MUST_BE_ATTACHED));
3330 next = extent_first (decode_buffer_or_string (extent));
3334 XSETEXTENT (val, next);
3338 DEFUN ("previous-extent", Fprevious_extent, 1, 1, 0, /*
3339 Find last extent before EXTENT.
3340 If EXTENT is a buffer return the last extent in the buffer; likewise
3342 This function is analogous to `next-extent'.
3349 if (EXTENTP (extent))
3350 prev = extent_previous (decode_extent (extent, DE_MUST_BE_ATTACHED));
3352 prev = extent_last (decode_buffer_or_string (extent));
3356 XSETEXTENT (val, prev);
3362 DEFUN ("next-e-extent", Fnext_e_extent, 1, 1, 0, /*
3363 Find next extent after EXTENT using the "e" order.
3364 If EXTENT is a buffer return the first extent in the buffer; likewise
3372 if (EXTENTP (extent))
3373 next = extent_e_next (decode_extent (extent, DE_MUST_BE_ATTACHED));
3375 next = extent_e_first (decode_buffer_or_string (extent));
3379 XSETEXTENT (val, next);
3383 DEFUN ("previous-e-extent", Fprevious_e_extent, 1, 1, 0, /*
3384 Find last extent before EXTENT using the "e" order.
3385 If EXTENT is a buffer return the last extent in the buffer; likewise
3387 This function is analogous to `next-e-extent'.
3394 if (EXTENTP (extent))
3395 prev = extent_e_previous (decode_extent (extent, DE_MUST_BE_ATTACHED));
3397 prev = extent_e_last (decode_buffer_or_string (extent));
3401 XSETEXTENT (val, prev);
3407 DEFUN ("next-extent-change", Fnext_extent_change, 1, 2, 0, /*
3408 Return the next position after POS where an extent begins or ends.
3409 If POS is at the end of the buffer or string, POS will be returned;
3410 otherwise a position greater than POS will always be returned.
3411 If BUFFER is nil, the current buffer is assumed.
3415 Lisp_Object obj = decode_buffer_or_string (object);
3418 bpos = get_buffer_or_string_pos_byte (obj, pos, GB_ALLOW_PAST_ACCESSIBLE);
3419 bpos = extent_find_end_of_run (obj, bpos, 1);
3420 return make_int (buffer_or_string_bytind_to_bufpos (obj, bpos));
3423 DEFUN ("previous-extent-change", Fprevious_extent_change, 1, 2, 0, /*
3424 Return the last position before POS where an extent begins or ends.
3425 If POS is at the beginning of the buffer or string, POS will be returned;
3426 otherwise a position less than POS will always be returned.
3427 If OBJECT is nil, the current buffer is assumed.
3431 Lisp_Object obj = decode_buffer_or_string (object);
3434 bpos = get_buffer_or_string_pos_byte (obj, pos, GB_ALLOW_PAST_ACCESSIBLE);
3435 bpos = extent_find_beginning_of_run (obj, bpos, 1);
3436 return make_int (buffer_or_string_bytind_to_bufpos (obj, bpos));
3440 /************************************************************************/
3441 /* parent and children stuff */
3442 /************************************************************************/
3444 DEFUN ("extent-parent", Fextent_parent, 1, 1, 0, /*
3445 Return the parent (if any) of EXTENT.
3446 If an extent has a parent, it derives all its properties from that extent
3447 and has no properties of its own. (The only "properties" that the
3448 extent keeps are the buffer/string it refers to and the start and end
3449 points.) It is possible for an extent's parent to itself have a parent.
3452 /* do I win the prize for the strangest split infinitive? */
3454 EXTENT e = decode_extent (extent, 0);
3455 return extent_parent (e);
3458 DEFUN ("extent-children", Fextent_children, 1, 1, 0, /*
3459 Return a list of the children (if any) of EXTENT.
3460 The children of an extent are all those extents whose parent is that extent.
3461 This function does not recursively trace children of children.
3462 \(To do that, use `extent-descendants'.)
3466 EXTENT e = decode_extent (extent, 0);
3467 Lisp_Object children = extent_children (e);
3469 if (!NILP (children))
3470 return Fcopy_sequence (XWEAK_LIST_LIST (children));
3476 remove_extent_from_children_list (EXTENT e, Lisp_Object child)
3478 Lisp_Object children = extent_children (e);
3480 #ifdef ERROR_CHECK_EXTENTS
3481 assert (!NILP (memq_no_quit (child, XWEAK_LIST_LIST (children))));
3483 XWEAK_LIST_LIST (children) =
3484 delq_no_quit (child, XWEAK_LIST_LIST (children));
3488 add_extent_to_children_list (EXTENT e, Lisp_Object child)
3490 Lisp_Object children = extent_children (e);
3492 if (NILP (children))
3494 children = make_weak_list (WEAK_LIST_SIMPLE);
3495 set_extent_no_chase_aux_field (e, children, children);
3498 #ifdef ERROR_CHECK_EXTENTS
3499 assert (NILP (memq_no_quit (child, XWEAK_LIST_LIST (children))));
3501 XWEAK_LIST_LIST (children) = Fcons (child, XWEAK_LIST_LIST (children));
3504 DEFUN ("set-extent-parent", Fset_extent_parent, 2, 2, 0, /*
3505 Set the parent of EXTENT to PARENT (may be nil).
3506 See `extent-parent'.
3510 EXTENT e = decode_extent (extent, 0);
3511 Lisp_Object cur_parent = extent_parent (e);
3514 XSETEXTENT (extent, e);
3516 CHECK_LIVE_EXTENT (parent);
3517 if (EQ (parent, cur_parent))
3519 for (rest = parent; !NILP (rest); rest = extent_parent (XEXTENT (rest)))
3520 if (EQ (rest, extent))
3521 signal_simple_error ("Circular parent chain would result", extent);
3524 remove_extent_from_children_list (XEXTENT (cur_parent), extent);
3525 set_extent_no_chase_aux_field (e, parent, Qnil);
3526 e->flags.has_parent = 0;
3530 add_extent_to_children_list (XEXTENT (parent), extent);
3531 set_extent_no_chase_aux_field (e, parent, parent);
3532 e->flags.has_parent = 1;
3534 /* changing the parent also changes the properties of all children. */
3536 int old_invis = (!NILP (cur_parent) &&
3537 !NILP (extent_invisible (XEXTENT (cur_parent))));
3538 int new_invis = (!NILP (parent) &&
3539 !NILP (extent_invisible (XEXTENT (parent))));
3541 extent_maybe_changed_for_redisplay (e, 1, new_invis != old_invis);
3548 /************************************************************************/
3549 /* basic extent mutators */
3550 /************************************************************************/
3552 /* Note: If you track non-duplicable extents by undo, you'll get bogus
3553 undo records for transient extents via update-extent.
3554 For example, query-replace will do this.
3558 set_extent_endpoints_1 (EXTENT extent, Memind start, Memind end)
3560 #ifdef ERROR_CHECK_EXTENTS
3561 Lisp_Object obj = extent_object (extent);
3563 assert (start <= end);
3566 assert (valid_memind_p (XBUFFER (obj), start));
3567 assert (valid_memind_p (XBUFFER (obj), end));
3571 /* Optimization: if the extent is already where we want it to be,
3573 if (!extent_detached_p (extent) && extent_start (extent) == start &&
3574 extent_end (extent) == end)
3577 if (extent_detached_p (extent))
3579 if (extent_duplicable_p (extent))
3581 Lisp_Object extent_obj;
3582 XSETEXTENT (extent_obj, extent);
3583 record_extent (extent_obj, 1);
3587 extent_detach (extent);
3589 set_extent_start (extent, start);
3590 set_extent_end (extent, end);
3591 extent_attach (extent);
3594 /* Set extent's endpoints to S and E, and put extent in buffer or string
3595 OBJECT. (If OBJECT is nil, do not change the extent's object.) */
3598 set_extent_endpoints (EXTENT extent, Bytind s, Bytind e, Lisp_Object object)
3604 object = extent_object (extent);
3605 assert (!NILP (object));
3607 else if (!EQ (object, extent_object (extent)))
3609 extent_detach (extent);
3610 extent_object (extent) = object;
3613 start = s < 0 ? extent_start (extent) :
3614 buffer_or_string_bytind_to_memind (object, s);
3615 end = e < 0 ? extent_end (extent) :
3616 buffer_or_string_bytind_to_memind (object, e);
3617 set_extent_endpoints_1 (extent, start, end);
3621 set_extent_openness (EXTENT extent, int start_open, int end_open)
3623 if (start_open != -1)
3624 extent_start_open_p (extent) = start_open;
3626 extent_end_open_p (extent) = end_open;
3627 /* changing the open/closedness of an extent does not affect
3632 make_extent_internal (Lisp_Object object, Bytind from, Bytind to)
3636 extent = make_extent_detached (object);
3637 set_extent_endpoints (extent, from, to, Qnil);
3642 copy_extent (EXTENT original, Bytind from, Bytind to, Lisp_Object object)
3646 e = make_extent_detached (object);
3648 set_extent_endpoints (e, from, to, Qnil);
3650 e->plist = Fcopy_sequence (original->plist);
3651 memcpy (&e->flags, &original->flags, sizeof (e->flags));
3652 if (e->flags.has_aux)
3654 /* also need to copy the aux struct. It won't work for
3655 this extent to share the same aux struct as the original
3657 struct extent_auxiliary *data =
3658 alloc_lcrecord_type (struct extent_auxiliary,
3659 &lrecord_extent_auxiliary);
3661 copy_lcrecord (data, XEXTENT_AUXILIARY (XCAR (original->plist)));
3662 XSETEXTENT_AUXILIARY (XCAR (e->plist), data);
3666 /* we may have just added another child to the parent extent. */
3667 Lisp_Object parent = extent_parent (e);
3671 XSETEXTENT (extent, e);
3672 add_extent_to_children_list (XEXTENT (parent), extent);
3680 destroy_extent (EXTENT extent)
3682 Lisp_Object rest, nextrest, children;
3683 Lisp_Object extent_obj;
3685 if (!extent_detached_p (extent))
3686 extent_detach (extent);
3687 /* disassociate the extent from its children and parent */
3688 children = extent_children (extent);
3689 if (!NILP (children))
3691 LIST_LOOP_DELETING (rest, nextrest, XWEAK_LIST_LIST (children))
3692 Fset_extent_parent (XCAR (rest), Qnil);
3694 XSETEXTENT (extent_obj, extent);
3695 Fset_extent_parent (extent_obj, Qnil);
3696 /* mark the extent as destroyed */
3697 extent_object (extent) = Qt;
3700 DEFUN ("make-extent", Fmake_extent, 2, 3, 0, /*
3701 Make an extent for the range [FROM, TO) in BUFFER-OR-STRING.
3702 BUFFER-OR-STRING defaults to the current buffer. Insertions at point
3703 TO will be outside of the extent; insertions at FROM will be inside the
3704 extent, causing the extent to grow. (This is the same way that markers
3705 behave.) You can change the behavior of insertions at the endpoints
3706 using `set-extent-property'. The extent is initially detached if both
3707 FROM and TO are nil, and in this case BUFFER-OR-STRING defaults to nil,
3708 meaning the extent is in no buffer and no string.
3710 (from, to, buffer_or_string))
3712 Lisp_Object extent_obj;
3715 obj = decode_buffer_or_string (buffer_or_string);
3716 if (NILP (from) && NILP (to))
3718 if (NILP (buffer_or_string))
3720 XSETEXTENT (extent_obj, make_extent_detached (obj));
3726 get_buffer_or_string_range_byte (obj, from, to, &start, &end,
3727 GB_ALLOW_PAST_ACCESSIBLE);
3728 XSETEXTENT (extent_obj, make_extent_internal (obj, start, end));
3733 DEFUN ("copy-extent", Fcopy_extent, 1, 2, 0, /*
3734 Make a copy of EXTENT. It is initially detached.
3735 Optional argument BUFFER-OR-STRING defaults to EXTENT's buffer or string.
3737 (extent, buffer_or_string))
3739 EXTENT ext = decode_extent (extent, 0);
3741 if (NILP (buffer_or_string))
3742 buffer_or_string = extent_object (ext);
3744 buffer_or_string = decode_buffer_or_string (buffer_or_string);
3746 XSETEXTENT (extent, copy_extent (ext, -1, -1, buffer_or_string));
3750 DEFUN ("delete-extent", Fdelete_extent, 1, 1, 0, /*
3751 Remove EXTENT from its buffer and destroy it.
3752 This does not modify the buffer's text, only its display properties.
3753 The extent cannot be used thereafter.
3759 /* We do not call decode_extent() here because already-destroyed
3761 CHECK_EXTENT (extent);
3762 ext = XEXTENT (extent);
3764 if (!EXTENT_LIVE_P (ext))
3766 destroy_extent (ext);
3770 DEFUN ("detach-extent", Fdetach_extent, 1, 1, 0, /*
3771 Remove EXTENT from its buffer in such a way that it can be re-inserted.
3772 An extent is also detached when all of its characters are all killed by a
3773 deletion, unless its `detachable' property has been unset.
3775 Extents which have the `duplicable' attribute are tracked by the undo
3776 mechanism. Detachment via `detach-extent' and string deletion is recorded,
3777 as is attachment via `insert-extent' and string insertion. Extent motion,
3778 face changes, and attachment via `make-extent' and `set-extent-endpoints'
3779 are not recorded. This means that extent changes which are to be undo-able
3780 must be performed by character editing, or by insertion and detachment of
3785 EXTENT ext = decode_extent (extent, 0);
3787 if (extent_detached_p (ext))
3789 if (extent_duplicable_p (ext))
3790 record_extent (extent, 0);
3791 extent_detach (ext);
3796 DEFUN ("set-extent-endpoints", Fset_extent_endpoints, 3, 4, 0, /*
3797 Set the endpoints of EXTENT to START, END.
3798 If START and END are null, call detach-extent on EXTENT.
3799 BUFFER-OR-STRING specifies the new buffer or string that the extent should
3800 be in, and defaults to EXTENT's buffer or string. (If nil, and EXTENT
3801 is in no buffer and no string, it defaults to the current buffer.)
3802 See documentation on `detach-extent' for a discussion of undo recording.
3804 (extent, start, end, buffer_or_string))
3809 ext = decode_extent (extent, 0);
3811 if (NILP (buffer_or_string))
3813 buffer_or_string = extent_object (ext);
3814 if (NILP (buffer_or_string))
3815 buffer_or_string = Fcurrent_buffer ();
3818 buffer_or_string = decode_buffer_or_string (buffer_or_string);
3820 if (NILP (start) && NILP (end))
3821 return Fdetach_extent (extent);
3823 get_buffer_or_string_range_byte (buffer_or_string, start, end, &s, &e,
3824 GB_ALLOW_PAST_ACCESSIBLE);
3826 set_extent_endpoints (ext, s, e, buffer_or_string);
3831 /************************************************************************/
3832 /* mapping over extents */
3833 /************************************************************************/
3836 decode_map_extents_flags (Lisp_Object flags)
3838 unsigned int retval = 0;
3839 unsigned int all_extents_specified = 0;
3840 unsigned int in_region_specified = 0;
3842 if (EQ (flags, Qt)) /* obsoleteness compatibility */
3843 return ME_END_CLOSED;
3846 if (SYMBOLP (flags))
3847 flags = Fcons (flags, Qnil);
3848 while (!NILP (flags))
3854 if (EQ (sym, Qall_extents_closed) || EQ (sym, Qall_extents_open) ||
3855 EQ (sym, Qall_extents_closed_open) ||
3856 EQ (sym, Qall_extents_open_closed))
3858 if (all_extents_specified)
3859 error ("Only one `all-extents-*' flag may be specified");
3860 all_extents_specified = 1;
3862 if (EQ (sym, Qstart_in_region) || EQ (sym, Qend_in_region) ||
3863 EQ (sym, Qstart_and_end_in_region) ||
3864 EQ (sym, Qstart_or_end_in_region))
3866 if (in_region_specified)
3867 error ("Only one `*-in-region' flag may be specified");
3868 in_region_specified = 1;
3871 /* I do so love that conditional operator ... */
3873 EQ (sym, Qend_closed) ? ME_END_CLOSED :
3874 EQ (sym, Qstart_open) ? ME_START_OPEN :
3875 EQ (sym, Qall_extents_closed) ? ME_ALL_EXTENTS_CLOSED :
3876 EQ (sym, Qall_extents_open) ? ME_ALL_EXTENTS_OPEN :
3877 EQ (sym, Qall_extents_closed_open) ? ME_ALL_EXTENTS_CLOSED_OPEN :
3878 EQ (sym, Qall_extents_open_closed) ? ME_ALL_EXTENTS_OPEN_CLOSED :
3879 EQ (sym, Qstart_in_region) ? ME_START_IN_REGION :
3880 EQ (sym, Qend_in_region) ? ME_END_IN_REGION :
3881 EQ (sym, Qstart_and_end_in_region) ? ME_START_AND_END_IN_REGION :
3882 EQ (sym, Qstart_or_end_in_region) ? ME_START_OR_END_IN_REGION :
3883 EQ (sym, Qnegate_in_region) ? ME_NEGATE_IN_REGION :
3884 (signal_simple_error ("Invalid `map-extents' flag", sym), 0);
3886 flags = XCDR (flags);
3891 DEFUN ("extent-in-region-p", Fextent_in_region_p, 1, 4, 0, /*
3892 Return whether EXTENT overlaps a specified region.
3893 This is equivalent to whether `map-extents' would visit EXTENT when called
3896 (extent, from, to, flags))
3899 EXTENT ext = decode_extent (extent, DE_MUST_BE_ATTACHED);
3900 Lisp_Object obj = extent_object (ext);
3902 get_buffer_or_string_range_byte (obj, from, to, &start, &end, GB_ALLOW_NIL |
3903 GB_ALLOW_PAST_ACCESSIBLE);
3905 return extent_in_region_p (ext, start, end, decode_map_extents_flags (flags)) ?
3909 struct slow_map_extents_arg
3911 Lisp_Object map_arg;
3912 Lisp_Object map_routine;
3914 Lisp_Object property;
3919 slow_map_extents_function (EXTENT extent, void *arg)
3921 /* This function can GC */
3922 struct slow_map_extents_arg *closure = (struct slow_map_extents_arg *) arg;
3923 Lisp_Object extent_obj;
3925 XSETEXTENT (extent_obj, extent);
3927 /* make sure this extent qualifies according to the PROPERTY
3930 if (!NILP (closure->property))
3932 Lisp_Object value = Fextent_property (extent_obj, closure->property,
3934 if ((NILP (closure->value) && NILP (value)) ||
3935 (!NILP (closure->value) && !EQ (value, closure->value)))
3939 closure->result = call2 (closure->map_routine, extent_obj,
3941 return !NILP (closure->result);
3944 DEFUN ("map-extents", Fmap_extents, 1, 8, 0, /*
3945 Map FUNCTION over the extents which overlap a region in OBJECT.
3946 OBJECT is normally a buffer or string but could be an extent (see below).
3947 The region is normally bounded by [FROM, TO) (i.e. the beginning of the
3948 region is closed and the end of the region is open), but this can be
3949 changed with the FLAGS argument (see below for a complete discussion).
3951 FUNCTION is called with the arguments (extent, MAPARG). The arguments
3952 OBJECT, FROM, TO, MAPARG, and FLAGS are all optional and default to
3953 the current buffer, the beginning of OBJECT, the end of OBJECT, nil,
3954 and nil, respectively. `map-extents' returns the first non-nil result
3955 produced by FUNCTION, and no more calls to FUNCTION are made after it
3958 If OBJECT is an extent, FROM and TO default to the extent's endpoints,
3959 and the mapping omits that extent and its predecessors. This feature
3960 supports restarting a loop based on `map-extents'. Note: OBJECT must
3961 be attached to a buffer or string, and the mapping is done over that
3964 An extent overlaps the region if there is any point in the extent that is
3965 also in the region. (For the purpose of overlap, zero-length extents and
3966 regions are treated as closed on both ends regardless of their endpoints'
3967 specified open/closedness.) Note that the endpoints of an extent or region
3968 are considered to be in that extent or region if and only if the
3969 corresponding end is closed. For example, the extent [5,7] overlaps the
3970 region [2,5] because 5 is in both the extent and the region. However, (5,7]
3971 does not overlap [2,5] because 5 is not in the extent, and neither [5,7] nor
3972 \(5,7] overlaps the region [2,5) because 5 is not in the region.
3974 The optional FLAGS can be a symbol or a list of one or more symbols,
3975 modifying the behavior of `map-extents'. Allowed symbols are:
3977 end-closed The region's end is closed.
3979 start-open The region's start is open.
3981 all-extents-closed Treat all extents as closed on both ends for the
3982 purpose of determining whether they overlap the
3983 region, irrespective of their actual open- or
3985 all-extents-open Treat all extents as open on both ends.
3986 all-extents-closed-open Treat all extents as start-closed, end-open.
3987 all-extents-open-closed Treat all extents as start-open, end-closed.
3989 start-in-region In addition to the above conditions for extent
3990 overlap, the extent's start position must lie within
3991 the specified region. Note that, for this
3992 condition, open start positions are treated as if
3993 0.5 was added to the endpoint's value, and open
3994 end positions are treated as if 0.5 was subtracted
3995 from the endpoint's value.
3996 end-in-region The extent's end position must lie within the
3998 start-and-end-in-region Both the extent's start and end positions must lie
4000 start-or-end-in-region Either the extent's start or end position must lie
4003 negate-in-region The condition specified by a `*-in-region' flag
4004 must NOT hold for the extent to be considered.
4007 At most one of `all-extents-closed', `all-extents-open',
4008 `all-extents-closed-open', and `all-extents-open-closed' may be specified.
4010 At most one of `start-in-region', `end-in-region',
4011 `start-and-end-in-region', and `start-or-end-in-region' may be specified.
4013 If optional arg PROPERTY is non-nil, only extents with that property set
4014 on them will be visited. If optional arg VALUE is non-nil, only extents
4015 whose value for that property is `eq' to VALUE will be visited.
4017 (function, object, from, to, maparg, flags, property, value))
4019 /* This function can GC */
4020 struct slow_map_extents_arg closure;
4021 unsigned int me_flags;
4023 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
4026 if (EXTENTP (object))
4028 after = decode_extent (object, DE_MUST_BE_ATTACHED);
4030 from = Fextent_start_position (object);
4032 to = Fextent_end_position (object);
4033 object = extent_object (after);
4036 object = decode_buffer_or_string (object);
4038 get_buffer_or_string_range_byte (object, from, to, &start, &end,
4039 GB_ALLOW_NIL | GB_ALLOW_PAST_ACCESSIBLE);
4041 me_flags = decode_map_extents_flags (flags);
4043 if (!NILP (property))
4046 value = canonicalize_extent_property (property, value);
4049 GCPRO5 (function, maparg, object, property, value);
4051 closure.map_arg = maparg;
4052 closure.map_routine = function;
4053 closure.result = Qnil;
4054 closure.property = property;
4055 closure.value = value;
4057 map_extents_bytind (start, end, slow_map_extents_function,
4058 (void *) &closure, object, after,
4059 /* You never know what the user might do ... */
4060 me_flags | ME_MIGHT_CALL_ELISP);
4063 return closure.result;
4067 /************************************************************************/
4068 /* mapping over extents -- other functions */
4069 /************************************************************************/
4071 /* ------------------------------- */
4072 /* map-extent-children */
4073 /* ------------------------------- */
4075 struct slow_map_extent_children_arg
4077 Lisp_Object map_arg;
4078 Lisp_Object map_routine;
4080 Lisp_Object property;
4088 slow_map_extent_children_function (EXTENT extent, void *arg)
4090 /* This function can GC */
4091 struct slow_map_extent_children_arg *closure =
4092 (struct slow_map_extent_children_arg *) arg;
4093 Lisp_Object extent_obj;
4094 Bytind start = extent_endpoint_bytind (extent, 0);
4095 Bytind end = extent_endpoint_bytind (extent, 1);
4096 /* Make sure the extent starts inside the region of interest,
4097 rather than just overlaps it.
4099 if (start < closure->start_min)
4101 /* Make sure the extent is not a child of a previous visited one.
4102 We know already, because of extent ordering,
4103 that start >= prev_start, and that if
4104 start == prev_start, then end <= prev_end.
4106 if (start == closure->prev_start)
4108 if (end < closure->prev_end)
4111 else /* start > prev_start */
4113 if (start < closure->prev_end)
4115 /* corner case: prev_end can be -1 if there is no prev */
4117 XSETEXTENT (extent_obj, extent);
4119 /* make sure this extent qualifies according to the PROPERTY
4122 if (!NILP (closure->property))
4124 Lisp_Object value = Fextent_property (extent_obj, closure->property,
4126 if ((NILP (closure->value) && NILP (value)) ||
4127 (!NILP (closure->value) && !EQ (value, closure->value)))
4131 closure->result = call2 (closure->map_routine, extent_obj,
4134 /* Since the callback may change the buffer, compute all stored
4135 buffer positions here.
4137 closure->start_min = -1; /* no need for this any more */
4138 closure->prev_start = extent_endpoint_bytind (extent, 0);
4139 closure->prev_end = extent_endpoint_bytind (extent, 1);
4141 return !NILP (closure->result);
4144 DEFUN ("map-extent-children", Fmap_extent_children, 1, 8, 0, /*
4145 Map FUNCTION over the extents in the region from FROM to TO.
4146 FUNCTION is called with arguments (extent, MAPARG). See `map-extents'
4147 for a full discussion of the arguments FROM, TO, and FLAGS.
4149 The arguments are the same as for `map-extents', but this function differs
4150 in that it only visits extents which start in the given region, and also
4151 in that, after visiting an extent E, it skips all other extents which start
4152 inside E but end before E's end.
4154 Thus, this function may be used to walk a tree of extents in a buffer:
4155 (defun walk-extents (buffer &optional ignore)
4156 (map-extent-children 'walk-extents buffer))
4158 (function, object, from, to, maparg, flags, property, value))
4160 /* This function can GC */
4161 struct slow_map_extent_children_arg closure;
4162 unsigned int me_flags;
4164 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
4167 if (EXTENTP (object))
4169 after = decode_extent (object, DE_MUST_BE_ATTACHED);
4171 from = Fextent_start_position (object);
4173 to = Fextent_end_position (object);
4174 object = extent_object (after);
4177 object = decode_buffer_or_string (object);
4179 get_buffer_or_string_range_byte (object, from, to, &start, &end,
4180 GB_ALLOW_NIL | GB_ALLOW_PAST_ACCESSIBLE);
4182 me_flags = decode_map_extents_flags (flags);
4184 if (!NILP (property))
4187 value = canonicalize_extent_property (property, value);
4190 GCPRO5 (function, maparg, object, property, value);
4192 closure.map_arg = maparg;
4193 closure.map_routine = function;
4194 closure.result = Qnil;
4195 closure.property = property;
4196 closure.value = value;
4197 closure.start_min = start;
4198 closure.prev_start = -1;
4199 closure.prev_end = -1;
4200 map_extents_bytind (start, end, slow_map_extent_children_function,
4201 (void *) &closure, object, after,
4202 /* You never know what the user might do ... */
4203 me_flags | ME_MIGHT_CALL_ELISP);
4206 return closure.result;
4209 /* ------------------------------- */
4211 /* ------------------------------- */
4213 /* find "smallest" matching extent containing pos -- (flag == 0) means
4214 all extents match, else (EXTENT_FLAGS (extent) & flag) must be true;
4215 for more than one matching extent with precisely the same endpoints,
4216 we choose the last extent in the extents_list.
4217 The search stops just before "before", if that is non-null.
4220 struct extent_at_arg
4236 static enum extent_at_flag
4237 decode_extent_at_flag (Lisp_Object at_flag)
4240 return EXTENT_AT_AFTER;
4242 CHECK_SYMBOL (at_flag);
4243 if (EQ (at_flag, Qafter)) return EXTENT_AT_AFTER;
4244 if (EQ (at_flag, Qbefore)) return EXTENT_AT_BEFORE;
4245 if (EQ (at_flag, Qat)) return EXTENT_AT_AT;
4247 signal_simple_error ("Invalid AT-FLAG in `extent-at'", at_flag);
4248 return EXTENT_AT_AFTER; /* unreached */
4252 extent_at_mapper (EXTENT e, void *arg)
4254 struct extent_at_arg *closure = (struct extent_at_arg *) arg;
4256 if (e == closure->before)
4259 /* If closure->prop is non-nil, then the extent is only acceptable
4260 if it has a non-nil value for that property. */
4261 if (!NILP (closure->prop))
4264 XSETEXTENT (extent, e);
4265 if (NILP (Fextent_property (extent, closure->prop, Qnil)))
4270 EXTENT current = closure->best_match;
4274 /* redundant but quick test */
4275 else if (extent_start (current) > extent_start (e))
4278 /* we return the "last" best fit, instead of the first --
4279 this is because then the glyph closest to two equivalent
4280 extents corresponds to the "extent-at" the text just past
4282 else if (!EXTENT_LESS_VALS (e, closure->best_start,
4288 closure->best_match = e;
4289 closure->best_start = extent_start (e);
4290 closure->best_end = extent_end (e);
4297 extent_at_bytind (Bytind position, Lisp_Object object, Lisp_Object property,
4298 EXTENT before, enum extent_at_flag at_flag)
4300 struct extent_at_arg closure;
4301 Lisp_Object extent_obj;
4303 /* it might be argued that invalid positions should cause
4304 errors, but the principle of least surprise dictates that
4305 nil should be returned (extent-at is often used in
4306 response to a mouse event, and in many cases previous events
4307 have changed the buffer contents).
4309 Also, the openness stuff in the text-property code currently
4310 does not check its limits and might go off the end. */
4311 if ((at_flag == EXTENT_AT_BEFORE
4312 ? position <= buffer_or_string_absolute_begin_byte (object)
4313 : position < buffer_or_string_absolute_begin_byte (object))
4314 || (at_flag == EXTENT_AT_AFTER
4315 ? position >= buffer_or_string_absolute_end_byte (object)
4316 : position > buffer_or_string_absolute_end_byte (object)))
4319 closure.best_match = 0;
4320 closure.prop = property;
4321 closure.before = before;
4323 map_extents_bytind (at_flag == EXTENT_AT_BEFORE ? position - 1 : position,
4324 at_flag == EXTENT_AT_AFTER ? position + 1 : position,
4325 extent_at_mapper, (void *) &closure, object, 0,
4326 ME_START_OPEN | ME_ALL_EXTENTS_CLOSED);
4328 if (!closure.best_match)
4331 XSETEXTENT (extent_obj, closure.best_match);
4335 DEFUN ("extent-at", Fextent_at, 1, 5, 0, /*
4336 Find "smallest" extent at POS in OBJECT having PROPERTY set.
4337 Normally, an extent is "at" POS if it overlaps the region (POS, POS+1);
4338 i.e. if it covers the character after POS. (However, see the definition
4339 of AT-FLAG.) "Smallest" means the extent that comes last in the display
4340 order; this normally means the extent whose start position is closest to
4341 POS. See `next-extent' for more information.
4342 OBJECT specifies a buffer or string and defaults to the current buffer.
4343 PROPERTY defaults to nil, meaning that any extent will do.
4344 Properties are attached to extents with `set-extent-property', which see.
4345 Returns nil if POS is invalid or there is no matching extent at POS.
4346 If the fourth argument BEFORE is not nil, it must be an extent; any returned
4347 extent will precede that extent. This feature allows `extent-at' to be
4348 used by a loop over extents.
4349 AT-FLAG controls how end cases are handled, and should be one of:
4351 nil or `after' An extent is at POS if it covers the character
4352 after POS. This is consistent with the way
4353 that text properties work.
4354 `before' An extent is at POS if it covers the character
4356 `at' An extent is at POS if it overlaps or abuts POS.
4357 This includes all zero-length extents at POS.
4359 Note that in all cases, the start-openness and end-openness of the extents
4360 considered is ignored. If you want to pay attention to those properties,
4361 you should use `map-extents', which gives you more control.
4363 (pos, object, property, before, at_flag))
4366 EXTENT before_extent;
4367 enum extent_at_flag fl;
4369 object = decode_buffer_or_string (object);
4370 position = get_buffer_or_string_pos_byte (object, pos, GB_NO_ERROR_IF_BAD);
4374 before_extent = decode_extent (before, DE_MUST_BE_ATTACHED);
4375 if (before_extent && !EQ (object, extent_object (before_extent)))
4376 signal_simple_error ("extent not in specified buffer or string", object);
4377 fl = decode_extent_at_flag (at_flag);
4379 return extent_at_bytind (position, object, property, before_extent, fl);
4382 /* ------------------------------- */
4383 /* verify_extent_modification() */
4384 /* ------------------------------- */
4386 /* verify_extent_modification() is called when a buffer or string is
4387 modified to check whether the modification is occuring inside a
4391 struct verify_extents_arg
4396 Lisp_Object iro; /* value of inhibit-read-only */
4400 verify_extent_mapper (EXTENT extent, void *arg)
4402 struct verify_extents_arg *closure = (struct verify_extents_arg *) arg;
4403 Lisp_Object prop = extent_read_only (extent);
4408 if (CONSP (closure->iro) && !NILP (Fmemq (prop, closure->iro)))
4411 #if 0 /* Nobody seems to care for this any more -sb */
4412 /* Allow deletion if the extent is completely contained in
4413 the region being deleted.
4414 This is important for supporting tokens which are internally
4415 write-protected, but which can be killed and yanked as a whole.
4416 Ignore open/closed distinctions at this point.
4419 if (closure->start != closure->end &&
4420 extent_start (extent) >= closure->start &&
4421 extent_end (extent) <= closure->end)
4426 Fsignal (Qbuffer_read_only, (list1 (closure->object)));
4428 RETURN_NOT_REACHED(0)
4431 /* Value of Vinhibit_read_only is precomputed and passed in for
4435 verify_extent_modification (Lisp_Object object, Bytind from, Bytind to,
4436 Lisp_Object inhibit_read_only_value)
4439 struct verify_extents_arg closure;
4441 /* If insertion, visit closed-endpoint extents touching the insertion
4442 point because the text would go inside those extents. If deletion,
4443 treat the range as open on both ends so that touching extents are not
4444 visited. Note that we assume that an insertion is occurring if the
4445 changed range has zero length, and a deletion otherwise. This
4446 fails if a change (i.e. non-insertion, non-deletion) is happening.
4447 As far as I know, this doesn't currently occur in XEmacs. --ben */
4448 closed = (from==to);
4449 closure.object = object;
4450 closure.start = buffer_or_string_bytind_to_memind (object, from);
4451 closure.end = buffer_or_string_bytind_to_memind (object, to);
4452 closure.iro = inhibit_read_only_value;
4454 map_extents_bytind (from, to, verify_extent_mapper, (void *) &closure,
4455 object, 0, closed ? ME_END_CLOSED : ME_START_OPEN);
4458 /* ------------------------------------ */
4459 /* process_extents_for_insertion() */
4460 /* ------------------------------------ */
4462 struct process_extents_for_insertion_arg
4469 /* A region of length LENGTH was just inserted at OPOINT. Modify all
4470 of the extents as required for the insertion, based on their
4471 start-open/end-open properties.
4475 process_extents_for_insertion_mapper (EXTENT extent, void *arg)
4477 struct process_extents_for_insertion_arg *closure =
4478 (struct process_extents_for_insertion_arg *) arg;
4479 Memind indice = buffer_or_string_bytind_to_memind (closure->object,
4482 /* When this function is called, one end of the newly-inserted text should
4483 be adjacent to some endpoint of the extent, or disjoint from it. If
4484 the insertion overlaps any existing extent, something is wrong.
4486 #ifdef ERROR_CHECK_EXTENTS
4487 if (extent_start (extent) > indice &&
4488 extent_start (extent) < indice + closure->length)
4490 if (extent_end (extent) > indice &&
4491 extent_end (extent) < indice + closure->length)
4495 /* The extent-adjustment code adjusted the extent's endpoints as if
4496 they were markers -- endpoints at the gap (i.e. the insertion
4497 point) go to the left of the insertion point, which is correct
4498 for [) extents. We need to fix the other kinds of extents.
4500 Note that both conditions below will hold for zero-length (]
4501 extents at the gap. Zero-length () extents would get adjusted
4502 such that their start is greater than their end; we treat them
4503 as [) extents. This is unfortunately an inelegant part of the
4504 extent model, but there is no way around it. */
4507 Memind new_start, new_end;
4509 new_start = extent_start (extent);
4510 new_end = extent_end (extent);
4511 if (indice == extent_start (extent) && extent_start_open_p (extent) &&
4512 /* coerce zero-length () extents to [) */
4513 new_start != new_end)
4514 new_start += closure->length;
4515 if (indice == extent_end (extent) && !extent_end_open_p (extent))
4516 new_end += closure->length;
4517 set_extent_endpoints_1 (extent, new_start, new_end);
4524 process_extents_for_insertion (Lisp_Object object, Bytind opoint,
4527 struct process_extents_for_insertion_arg closure;
4529 closure.opoint = opoint;
4530 closure.length = length;
4531 closure.object = object;
4533 map_extents_bytind (opoint, opoint + length,
4534 process_extents_for_insertion_mapper,
4535 (void *) &closure, object, 0,
4536 ME_END_CLOSED | ME_MIGHT_MODIFY_EXTENTS |
4537 ME_INCLUDE_INTERNAL);
4540 /* ------------------------------------ */
4541 /* process_extents_for_deletion() */
4542 /* ------------------------------------ */
4544 struct process_extents_for_deletion_arg
4547 int destroy_included_extents;
4550 /* This function is called when we're about to delete the range [from, to].
4551 Detach all of the extents that are completely inside the range [from, to],
4552 if they're detachable or open-open. */
4555 process_extents_for_deletion_mapper (EXTENT extent, void *arg)
4557 struct process_extents_for_deletion_arg *closure =
4558 (struct process_extents_for_deletion_arg *) arg;
4560 /* If the extent lies completely within the range that
4561 is being deleted, then nuke the extent if it's detachable
4562 (otherwise, it will become a zero-length extent). */
4564 if (closure->start <= extent_start (extent) &&
4565 extent_end (extent) <= closure->end)
4567 if (extent_detachable_p (extent))
4569 if (closure->destroy_included_extents)
4570 destroy_extent (extent);
4572 extent_detach (extent);
4579 /* DESTROY_THEM means destroy the extents instead of just deleting them.
4580 It is unused currently, but perhaps might be used (there used to
4581 be a function process_extents_for_destruction(), #if 0'd out,
4582 that did the equivalent). */
4584 process_extents_for_deletion (Lisp_Object object, Bytind from,
4585 Bytind to, int destroy_them)
4587 struct process_extents_for_deletion_arg closure;
4589 closure.start = buffer_or_string_bytind_to_memind (object, from);
4590 closure.end = buffer_or_string_bytind_to_memind (object, to);
4591 closure.destroy_included_extents = destroy_them;
4593 map_extents_bytind (from, to, process_extents_for_deletion_mapper,
4594 (void *) &closure, object, 0,
4595 ME_END_CLOSED | ME_MIGHT_MODIFY_EXTENTS);
4598 /* ------------------------------- */
4599 /* report_extent_modification() */
4600 /* ------------------------------- */
4601 struct report_extent_modification_closure {
4609 report_extent_modification_restore (Lisp_Object buffer)
4611 if (current_buffer != XBUFFER (buffer))
4612 Fset_buffer (buffer);
4617 report_extent_modification_mapper (EXTENT extent, void *arg)
4619 struct report_extent_modification_closure *closure =
4620 (struct report_extent_modification_closure *)arg;
4621 Lisp_Object exobj, startobj, endobj;
4622 Lisp_Object hook = (closure->afterp
4623 ? extent_after_change_functions (extent)
4624 : extent_before_change_functions (extent));
4628 XSETEXTENT (exobj, extent);
4629 XSETINT (startobj, closure->start);
4630 XSETINT (endobj, closure->end);
4632 /* Now that we are sure to call elisp, set up an unwind-protect so
4633 inside_change_hook gets restored in case we throw. Also record
4634 the current buffer, in case we change it. Do the recording only
4637 One confusing thing here is that our caller never actually calls
4638 unbind_to (closure.speccount, Qnil). This is because
4639 map_extents_bytind() unbinds before, and with a smaller
4640 speccount. The additional unbind_to() in
4641 report_extent_modification() would cause XEmacs to abort. */
4642 if (closure->speccount == -1)
4644 closure->speccount = specpdl_depth ();
4645 record_unwind_protect (report_extent_modification_restore,
4646 Fcurrent_buffer ());
4649 /* The functions will expect closure->buffer to be the current
4650 buffer, so change it if it isn't. */
4651 if (current_buffer != XBUFFER (closure->buffer))
4652 Fset_buffer (closure->buffer);
4654 /* #### It's a shame that we can't use any of the existing run_hook*
4655 functions here. This is so because all of them work with
4656 symbols, to be able to retrieve default values of local hooks.
4659 #### Idea: we could set up a dummy symbol, and call the hook
4660 functions on *that*. */
4662 if (!CONSP (hook) || EQ (XCAR (hook), Qlambda))
4663 call3 (hook, exobj, startobj, endobj);
4667 EXTERNAL_LIST_LOOP (tail, hook)
4668 /* #### Shouldn't this perform the same Fset_buffer() check as
4670 call3 (XCAR (tail), exobj, startobj, endobj);
4676 report_extent_modification (Lisp_Object buffer, Bufpos start, Bufpos end,
4679 struct report_extent_modification_closure closure;
4681 closure.buffer = buffer;
4682 closure.start = start;
4684 closure.afterp = afterp;
4685 closure.speccount = -1;
4687 map_extents (start, end, report_extent_modification_mapper, (void *)&closure,
4688 buffer, NULL, ME_MIGHT_CALL_ELISP);
4692 /************************************************************************/
4693 /* extent properties */
4694 /************************************************************************/
4697 set_extent_invisible (EXTENT extent, Lisp_Object value)
4699 if (!EQ (extent_invisible (extent), value))
4701 set_extent_invisible_1 (extent, value);
4702 extent_changed_for_redisplay (extent, 1, 1);
4706 /* This function does "memoization" -- similar to the interning
4707 that happens with symbols. Given a list of faces, an equivalent
4708 list is returned such that if this function is called twice with
4709 input that is `equal', the resulting outputs will be `eq'.
4711 Note that the inputs and outputs are in general *not* `equal' --
4712 faces in symbol form become actual face objects in the output.
4713 This is necessary so that temporary faces stay around. */
4716 memoize_extent_face_internal (Lisp_Object list)
4720 Lisp_Object cons, thecons;
4721 Lisp_Object oldtail, tail;
4722 struct gcpro gcpro1;
4727 return Fget_face (list);
4729 /* To do the memoization, we use a hash table mapping from
4730 external lists to internal lists. We do `equal' comparisons
4731 on the keys so the memoization works correctly.
4733 Note that we canonicalize things so that the keys in the
4734 hash table (the external lists) always contain symbols and
4735 the values (the internal lists) always contain face objects.
4737 We also maintain a "reverse" table that maps from the internal
4738 lists to the external equivalents. The idea here is twofold:
4740 1) `extent-face' wants to return a list containing face symbols
4741 rather than face objects.
4742 2) We don't want things to get quite so messed up if the user
4743 maliciously side-effects the returned lists.
4746 len = XINT (Flength (list));
4747 thelen = XINT (Flength (Vextent_face_reusable_list));
4752 /* We canonicalize the given list into another list.
4753 We try to avoid consing except when necessary, so we have
4759 cons = Vextent_face_reusable_list;
4760 while (!NILP (XCDR (cons)))
4762 XCDR (cons) = Fmake_list (make_int (len - thelen), Qnil);
4764 else if (thelen > len)
4768 /* Truncate the list temporarily so it's the right length;
4769 remember the old tail. */
4770 cons = Vextent_face_reusable_list;
4771 for (i = 0; i < len - 1; i++)
4774 oldtail = XCDR (cons);
4778 thecons = Vextent_face_reusable_list;
4779 EXTERNAL_LIST_LOOP (cons, list)
4781 Lisp_Object face = Fget_face (XCAR (cons));
4783 XCAR (thecons) = Fface_name (face);
4784 thecons = XCDR (thecons);
4787 list = Fgethash (Vextent_face_reusable_list, Vextent_face_memoize_hash_table,
4791 Lisp_Object symlist = Fcopy_sequence (Vextent_face_reusable_list);
4792 Lisp_Object facelist = Fcopy_sequence (Vextent_face_reusable_list);
4794 LIST_LOOP (cons, facelist)
4796 XCAR (cons) = Fget_face (XCAR (cons));
4798 Fputhash (symlist, facelist, Vextent_face_memoize_hash_table);
4799 Fputhash (facelist, symlist, Vextent_face_reverse_memoize_hash_table);
4803 /* Now restore the truncated tail of the reusable list, if necessary. */
4805 XCDR (tail) = oldtail;
4812 external_of_internal_memoized_face (Lisp_Object face)
4816 else if (!CONSP (face))
4817 return XFACE (face)->name;
4820 face = Fgethash (face, Vextent_face_reverse_memoize_hash_table,
4822 assert (!UNBOUNDP (face));
4828 canonicalize_extent_property (Lisp_Object prop, Lisp_Object value)
4830 if (EQ (prop, Qface) || EQ (prop, Qmouse_face))
4831 value = (external_of_internal_memoized_face
4832 (memoize_extent_face_internal (value)));
4836 /* Do we need a lisp-level function ? */
4837 DEFUN ("set-extent-initial-redisplay-function", Fset_extent_initial_redisplay_function,
4839 Note: This feature is experimental!
4841 Set initial-redisplay-function of EXTENT to the function
4844 The first time the EXTENT is (re)displayed, an eval event will be
4845 dispatched calling FUNCTION with EXTENT as its only argument.
4849 EXTENT e = decode_extent(extent, DE_MUST_BE_ATTACHED);
4851 e = extent_ancestor (e); /* Is this needed? Macro also does chasing!*/
4852 set_extent_initial_redisplay_function(e,function);
4853 extent_in_red_event_p(e) = 0; /* If the function changed we can spawn
4855 extent_changed_for_redisplay(e,1,0); /* Do we need to mark children too ?*/
4860 DEFUN ("extent-face", Fextent_face, 1, 1, 0, /*
4861 Return the name of the face in which EXTENT is displayed, or nil
4862 if the extent's face is unspecified. This might also return a list
4869 CHECK_EXTENT (extent);
4870 face = extent_face (XEXTENT (extent));
4872 return external_of_internal_memoized_face (face);
4875 DEFUN ("set-extent-face", Fset_extent_face, 2, 2, 0, /*
4876 Make the given EXTENT have the graphic attributes specified by FACE.
4877 FACE can also be a list of faces, and all faces listed will apply,
4878 with faces earlier in the list taking priority over those later in the
4883 EXTENT e = decode_extent(extent, 0);
4884 Lisp_Object orig_face = face;
4886 /* retrieve the ancestor for efficiency and proper redisplay noting. */
4887 e = extent_ancestor (e);
4889 face = memoize_extent_face_internal (face);
4891 extent_face (e) = face;
4892 extent_changed_for_redisplay (e, 1, 0);
4898 DEFUN ("extent-mouse-face", Fextent_mouse_face, 1, 1, 0, /*
4899 Return the face used to highlight EXTENT when the mouse passes over it.
4900 The return value will be a face name, a list of face names, or nil
4901 if the extent's mouse face is unspecified.
4907 CHECK_EXTENT (extent);
4908 face = extent_mouse_face (XEXTENT (extent));
4910 return external_of_internal_memoized_face (face);
4913 DEFUN ("set-extent-mouse-face", Fset_extent_mouse_face, 2, 2, 0, /*
4914 Set the face used to highlight EXTENT when the mouse passes over it.
4915 FACE can also be a list of faces, and all faces listed will apply,
4916 with faces earlier in the list taking priority over those later in the
4922 Lisp_Object orig_face = face;
4924 CHECK_EXTENT (extent);
4925 e = XEXTENT (extent);
4926 /* retrieve the ancestor for efficiency and proper redisplay noting. */
4927 e = extent_ancestor (e);
4929 face = memoize_extent_face_internal (face);
4931 set_extent_mouse_face (e, face);
4932 extent_changed_for_redisplay (e, 1, 0);
4938 set_extent_glyph (EXTENT extent, Lisp_Object glyph, int endp,
4939 glyph_layout layout)
4941 extent = extent_ancestor (extent);
4945 set_extent_begin_glyph (extent, glyph);
4946 extent_begin_glyph_layout (extent) = layout;
4950 set_extent_end_glyph (extent, glyph);
4951 extent_end_glyph_layout (extent) = layout;
4954 extent_changed_for_redisplay (extent, 1, 0);
4958 glyph_layout_to_symbol (glyph_layout layout)
4962 case GL_TEXT: return Qtext;
4963 case GL_OUTSIDE_MARGIN: return Qoutside_margin;
4964 case GL_INSIDE_MARGIN: return Qinside_margin;
4965 case GL_WHITESPACE: return Qwhitespace;
4968 return Qnil; /* unreached */
4973 symbol_to_glyph_layout (Lisp_Object layout_obj)
4975 if (NILP (layout_obj))
4978 CHECK_SYMBOL (layout_obj);
4979 if (EQ (layout_obj, Qoutside_margin)) return GL_OUTSIDE_MARGIN;
4980 if (EQ (layout_obj, Qinside_margin)) return GL_INSIDE_MARGIN;
4981 if (EQ (layout_obj, Qwhitespace)) return GL_WHITESPACE;
4982 if (EQ (layout_obj, Qtext)) return GL_TEXT;
4984 signal_simple_error ("Unknown glyph layout type", layout_obj);
4985 return GL_TEXT; /* unreached */
4989 set_extent_glyph_1 (Lisp_Object extent_obj, Lisp_Object glyph, int endp,
4990 Lisp_Object layout_obj)
4992 EXTENT extent = decode_extent (extent_obj, DE_MUST_HAVE_BUFFER);
4993 glyph_layout layout = symbol_to_glyph_layout (layout_obj);
4995 /* Make sure we've actually been given a valid glyph or it's nil
4996 (meaning we're deleting a glyph from an extent). */
4998 CHECK_BUFFER_GLYPH (glyph);
5000 set_extent_glyph (extent, glyph, endp, layout);
5004 DEFUN ("set-extent-begin-glyph", Fset_extent_begin_glyph, 2, 3, 0, /*
5005 Display a bitmap, subwindow or string at the beginning of EXTENT.
5006 BEGIN-GLYPH must be a glyph object. The layout policy defaults to `text'.
5008 (extent, begin_glyph, layout))
5010 return set_extent_glyph_1 (extent, begin_glyph, 0, layout);
5013 DEFUN ("set-extent-end-glyph", Fset_extent_end_glyph, 2, 3, 0, /*
5014 Display a bitmap, subwindow or string at the end of EXTENT.
5015 END-GLYPH must be a glyph object. The layout policy defaults to `text'.
5017 (extent, end_glyph, layout))
5019 return set_extent_glyph_1 (extent, end_glyph, 1, layout);
5022 DEFUN ("extent-begin-glyph", Fextent_begin_glyph, 1, 1, 0, /*
5023 Return the glyph object displayed at the beginning of EXTENT.
5024 If there is none, nil is returned.
5028 return extent_begin_glyph (decode_extent (extent, 0));
5031 DEFUN ("extent-end-glyph", Fextent_end_glyph, 1, 1, 0, /*
5032 Return the glyph object displayed at the end of EXTENT.
5033 If there is none, nil is returned.
5037 return extent_end_glyph (decode_extent (extent, 0));
5040 DEFUN ("set-extent-begin-glyph-layout", Fset_extent_begin_glyph_layout, 2, 2, 0, /*
5041 Set the layout policy of EXTENT's begin glyph.
5042 Access this using the `extent-begin-glyph-layout' function.
5046 EXTENT e = decode_extent (extent, 0);
5047 e = extent_ancestor (e);
5048 extent_begin_glyph_layout (e) = symbol_to_glyph_layout (layout);
5049 extent_maybe_changed_for_redisplay (e, 1, 0);
5053 DEFUN ("set-extent-end-glyph-layout", Fset_extent_end_glyph_layout, 2, 2, 0, /*
5054 Set the layout policy of EXTENT's end glyph.
5055 Access this using the `extent-end-glyph-layout' function.
5059 EXTENT e = decode_extent (extent, 0);
5060 e = extent_ancestor (e);
5061 extent_end_glyph_layout (e) = symbol_to_glyph_layout (layout);
5062 extent_maybe_changed_for_redisplay (e, 1, 0);
5066 DEFUN ("extent-begin-glyph-layout", Fextent_begin_glyph_layout, 1, 1, 0, /*
5067 Return the layout policy associated with EXTENT's begin glyph.
5068 Set this using the `set-extent-begin-glyph-layout' function.
5072 EXTENT e = decode_extent (extent, 0);
5073 return glyph_layout_to_symbol ((glyph_layout) extent_begin_glyph_layout (e));
5076 DEFUN ("extent-end-glyph-layout", Fextent_end_glyph_layout, 1, 1, 0, /*
5077 Return the layout policy associated with EXTENT's end glyph.
5078 Set this using the `set-extent-end-glyph-layout' function.
5082 EXTENT e = decode_extent (extent, 0);
5083 return glyph_layout_to_symbol ((glyph_layout) extent_end_glyph_layout (e));
5086 DEFUN ("set-extent-priority", Fset_extent_priority, 2, 2, 0, /*
5087 Set the display priority of EXTENT to PRIORITY (an integer).
5088 When the extent attributes are being merged for display, the priority
5089 is used to determine which extent takes precedence in the event of a
5090 conflict (two extents whose faces both specify font, for example: the
5091 font of the extent with the higher priority will be used).
5092 Extents are created with priority 0; priorities may be negative.
5096 EXTENT e = decode_extent (extent, 0);
5098 CHECK_INT (priority);
5099 e = extent_ancestor (e);
5100 set_extent_priority (e, XINT (priority));
5101 extent_maybe_changed_for_redisplay (e, 1, 0);
5105 DEFUN ("extent-priority", Fextent_priority, 1, 1, 0, /*
5106 Return the display priority of EXTENT; see `set-extent-priority'.
5110 EXTENT e = decode_extent (extent, 0);
5111 return make_int (extent_priority (e));
5114 DEFUN ("set-extent-property", Fset_extent_property, 3, 3, 0, /*
5115 Change a property of an extent.
5116 PROPERTY may be any symbol; the value stored may be accessed with
5117 the `extent-property' function.
5118 The following symbols have predefined meanings:
5120 detached Removes the extent from its buffer; setting this is
5121 the same as calling `detach-extent'.
5123 destroyed Removes the extent from its buffer, and makes it
5124 unusable in the future; this is the same calling
5127 priority Change redisplay priority; same as `set-extent-priority'.
5129 start-open Whether the set of characters within the extent is
5130 treated being open on the left, that is, whether
5131 the start position is an exclusive, rather than
5132 inclusive, boundary. If true, then characters
5133 inserted exactly at the beginning of the extent
5134 will remain outside of the extent; otherwise they
5135 will go into the extent, extending it.
5137 end-open Whether the set of characters within the extent is
5138 treated being open on the right, that is, whether
5139 the end position is an exclusive, rather than
5140 inclusive, boundary. If true, then characters
5141 inserted exactly at the end of the extent will
5142 remain outside of the extent; otherwise they will
5143 go into the extent, extending it.
5145 By default, extents have the `end-open' but not the
5146 `start-open' property set.
5148 read-only Text within this extent will be unmodifiable.
5150 initial-redisplay-function (EXPERIMENTAL)
5151 function to be called the first time (part of) the extent
5152 is redisplayed. It will be called with the extent as its
5154 Note: The function will not be called immediately
5155 during redisplay, an eval event will be dispatched.
5157 detachable Whether the extent gets detached (as with
5158 `detach-extent') when all the text within the
5159 extent is deleted. This is true by default. If
5160 this property is not set, the extent becomes a
5161 zero-length extent when its text is deleted. (In
5162 such a case, the `start-open' property is
5163 automatically removed if both the `start-open' and
5164 `end-open' properties are set, since zero-length
5165 extents open on both ends are not allowed.)
5167 face The face in which to display the text. Setting
5168 this is the same as calling `set-extent-face'.
5170 mouse-face If non-nil, the extent will be highlighted in this
5171 face when the mouse moves over it.
5173 pointer If non-nil, and a valid pointer glyph, this specifies
5174 the shape of the mouse pointer while over the extent.
5176 highlight Obsolete: Setting this property is equivalent to
5177 setting a `mouse-face' property of `highlight'.
5178 Reading this property returns non-nil if
5179 the extent has a non-nil `mouse-face' property.
5181 duplicable Whether this extent should be copied into strings,
5182 so that kill, yank, and undo commands will restore
5183 or copy it. `duplicable' extents are copied from
5184 an extent into a string when `buffer-substring' or
5185 a similar function creates a string. The extents
5186 in a string are copied into other strings created
5187 from the string using `concat' or `substring'.
5188 When `insert' or a similar function inserts the
5189 string into a buffer, the extents are copied back
5192 unique Meaningful only in conjunction with `duplicable'.
5193 When this is set, there may be only one instance
5194 of this extent attached at a time: if it is copied
5195 to the kill ring and then yanked, the extent is
5196 not copied. If, however, it is killed (removed
5197 from the buffer) and then yanked, it will be
5198 re-attached at the new position.
5200 invisible If the value is non-nil, text under this extent
5201 may be treated as not present for the purpose of
5202 redisplay, or may be displayed using an ellipsis
5203 or other marker; see `buffer-invisibility-spec'
5204 and `invisible-text-glyph'. In all cases,
5205 however, the text is still visible to other
5206 functions that examine a buffer's text.
5208 keymap This keymap is consulted for mouse clicks on this
5209 extent, or keypresses made while point is within the
5212 copy-function This is a hook that is run when a duplicable extent
5213 is about to be copied from a buffer to a string (or
5214 the kill ring). It is called with three arguments,
5215 the extent, and the buffer-positions within it
5216 which are being copied. If this function returns
5217 nil, then the extent will not be copied; otherwise
5220 paste-function This is a hook that is run when a duplicable extent is
5221 about to be copied from a string (or the kill ring)
5222 into a buffer. It is called with three arguments,
5223 the original extent, and the buffer positions which
5224 the copied extent will occupy. (This hook is run
5225 after the corresponding text has already been
5226 inserted into the buffer.) Note that the extent
5227 argument may be detached when this function is run.
5228 If this function returns nil, no extent will be
5229 inserted. Otherwise, there will be an extent
5230 covering the range in question.
5232 If the original extent is not attached to a buffer,
5233 then it will be re-attached at this range.
5234 Otherwise, a copy will be made, and that copy
5237 The copy-function and paste-function are meaningful
5238 only for extents with the `duplicable' flag set,
5239 and if they are not specified, behave as if `t' was
5240 the returned value. When these hooks are invoked,
5241 the current buffer is the buffer which the extent
5242 is being copied from/to, respectively.
5244 begin-glyph A glyph to be displayed at the beginning of the extent,
5247 end-glyph A glyph to be displayed at the end of the extent,
5250 begin-glyph-layout The layout policy (one of `text', `whitespace',
5251 `inside-margin', or `outside-margin') of the extent's
5254 end-glyph-layout The layout policy of the extent's end glyph.
5256 (extent, property, value))
5258 /* This function can GC if property is `keymap' */
5259 EXTENT e = decode_extent (extent, 0);
5261 if (EQ (property, Qread_only))
5262 set_extent_read_only (e, value);
5263 else if (EQ (property, Qunique))
5264 extent_unique_p (e) = !NILP (value);
5265 else if (EQ (property, Qduplicable))
5266 extent_duplicable_p (e) = !NILP (value);
5267 else if (EQ (property, Qinvisible))
5268 set_extent_invisible (e, value);
5269 else if (EQ (property, Qdetachable))
5270 extent_detachable_p (e) = !NILP (value);
5272 else if (EQ (property, Qdetached))
5275 error ("can only set `detached' to t");
5276 Fdetach_extent (extent);
5278 else if (EQ (property, Qdestroyed))
5281 error ("can only set `destroyed' to t");
5282 Fdelete_extent (extent);
5284 else if (EQ (property, Qpriority))
5285 Fset_extent_priority (extent, value);
5286 else if (EQ (property, Qface))
5287 Fset_extent_face (extent, value);
5288 else if (EQ (property, Qinitial_redisplay_function))
5289 Fset_extent_initial_redisplay_function (extent, value);
5290 else if (EQ (property, Qbefore_change_functions))
5291 set_extent_before_change_functions (e, value);
5292 else if (EQ (property, Qafter_change_functions))
5293 set_extent_after_change_functions (e, value);
5294 else if (EQ (property, Qmouse_face))
5295 Fset_extent_mouse_face (extent, value);
5297 else if (EQ (property, Qhighlight))
5298 Fset_extent_mouse_face (extent, Qhighlight);
5299 else if (EQ (property, Qbegin_glyph_layout))
5300 Fset_extent_begin_glyph_layout (extent, value);
5301 else if (EQ (property, Qend_glyph_layout))
5302 Fset_extent_end_glyph_layout (extent, value);
5303 /* For backwards compatibility. We use begin glyph because it is by
5304 far the more used of the two. */
5305 else if (EQ (property, Qglyph_layout))
5306 Fset_extent_begin_glyph_layout (extent, value);
5307 else if (EQ (property, Qbegin_glyph))
5308 Fset_extent_begin_glyph (extent, value, Qnil);
5309 else if (EQ (property, Qend_glyph))
5310 Fset_extent_end_glyph (extent, value, Qnil);
5311 else if (EQ (property, Qstart_open))
5312 set_extent_openness (e, !NILP (value), -1);
5313 else if (EQ (property, Qend_open))
5314 set_extent_openness (e, -1, !NILP (value));
5315 /* Support (but don't document...) the obvious *_closed antonyms. */
5316 else if (EQ (property, Qstart_closed))
5317 set_extent_openness (e, NILP (value), -1);
5318 else if (EQ (property, Qend_closed))
5319 set_extent_openness (e, -1, NILP (value));
5322 if (EQ (property, Qkeymap))
5323 while (!NILP (value) && NILP (Fkeymapp (value)))
5324 value = wrong_type_argument (Qkeymapp, value);
5326 external_plist_put (extent_plist_addr (e), property, value, 0, ERROR_ME);
5332 DEFUN ("set-extent-properties", Fset_extent_properties, 2, 2, 0, /*
5333 Change some properties of EXTENT.
5334 PLIST is a property list.
5335 For a list of built-in properties, see `set-extent-property'.
5339 /* This function can GC, if one of the properties is `keymap' */
5340 Lisp_Object property, value;
5341 struct gcpro gcpro1;
5344 plist = Fcopy_sequence (plist);
5345 Fcanonicalize_plist (plist, Qnil);
5347 while (!NILP (plist))
5349 property = Fcar (plist); plist = Fcdr (plist);
5350 value = Fcar (plist); plist = Fcdr (plist);
5351 Fset_extent_property (extent, property, value);
5357 DEFUN ("extent-property", Fextent_property, 2, 3, 0, /*
5358 Return EXTENT's value for property PROPERTY.
5359 See `set-extent-property' for the built-in property names.
5361 (extent, property, default_))
5363 EXTENT e = decode_extent (extent, 0);
5365 if (EQ (property, Qdetached))
5366 return extent_detached_p (e) ? Qt : Qnil;
5367 else if (EQ (property, Qdestroyed))
5368 return !EXTENT_LIVE_P (e) ? Qt : Qnil;
5369 else if (EQ (property, Qstart_open))
5370 return extent_normal_field (e, start_open) ? Qt : Qnil;
5371 else if (EQ (property, Qend_open))
5372 return extent_normal_field (e, end_open) ? Qt : Qnil;
5373 else if (EQ (property, Qunique))
5374 return extent_normal_field (e, unique) ? Qt : Qnil;
5375 else if (EQ (property, Qduplicable))
5376 return extent_normal_field (e, duplicable) ? Qt : Qnil;
5377 else if (EQ (property, Qdetachable))
5378 return extent_normal_field (e, detachable) ? Qt : Qnil;
5379 /* Support (but don't document...) the obvious *_closed antonyms. */
5380 else if (EQ (property, Qstart_closed))
5381 return extent_start_open_p (e) ? Qnil : Qt;
5382 else if (EQ (property, Qend_closed))
5383 return extent_end_open_p (e) ? Qnil : Qt;
5384 else if (EQ (property, Qpriority))
5385 return make_int (extent_priority (e));
5386 else if (EQ (property, Qread_only))
5387 return extent_read_only (e);
5388 else if (EQ (property, Qinvisible))
5389 return extent_invisible (e);
5390 else if (EQ (property, Qface))
5391 return Fextent_face (extent);
5392 else if (EQ (property, Qinitial_redisplay_function))
5393 return extent_initial_redisplay_function (e);
5394 else if (EQ (property, Qbefore_change_functions))
5395 return extent_before_change_functions (e);
5396 else if (EQ (property, Qafter_change_functions))
5397 return extent_after_change_functions (e);
5398 else if (EQ (property, Qmouse_face))
5399 return Fextent_mouse_face (extent);
5401 else if (EQ (property, Qhighlight))
5402 return !NILP (Fextent_mouse_face (extent)) ? Qt : Qnil;
5403 else if (EQ (property, Qbegin_glyph_layout))
5404 return Fextent_begin_glyph_layout (extent);
5405 else if (EQ (property, Qend_glyph_layout))
5406 return Fextent_end_glyph_layout (extent);
5407 /* For backwards compatibility. We use begin glyph because it is by
5408 far the more used of the two. */
5409 else if (EQ (property, Qglyph_layout))
5410 return Fextent_begin_glyph_layout (extent);
5411 else if (EQ (property, Qbegin_glyph))
5412 return extent_begin_glyph (e);
5413 else if (EQ (property, Qend_glyph))
5414 return extent_end_glyph (e);
5417 Lisp_Object value = external_plist_get (extent_plist_addr (e),
5418 property, 0, ERROR_ME);
5419 return UNBOUNDP (value) ? default_ : value;
5423 DEFUN ("extent-properties", Fextent_properties, 1, 1, 0, /*
5424 Return a property list of the attributes of EXTENT.
5425 Do not modify this list; use `set-extent-property' instead.
5430 Lisp_Object result, face, anc_obj;
5431 glyph_layout layout;
5433 CHECK_EXTENT (extent);
5434 e = XEXTENT (extent);
5435 if (!EXTENT_LIVE_P (e))
5436 return cons3 (Qdestroyed, Qt, Qnil);
5438 anc = extent_ancestor (e);
5439 XSETEXTENT (anc_obj, anc);
5441 /* For efficiency, use the ancestor for all properties except detached */
5443 result = extent_plist_slot (anc);
5445 if (!NILP (face = Fextent_face (anc_obj)))
5446 result = cons3 (Qface, face, result);
5448 if (!NILP (face = Fextent_mouse_face (anc_obj)))
5449 result = cons3 (Qmouse_face, face, result);
5451 if ((layout = (glyph_layout) extent_begin_glyph_layout (anc)) != GL_TEXT)
5453 Lisp_Object sym = glyph_layout_to_symbol (layout);
5454 result = cons3 (Qglyph_layout, sym, result); /* compatibility */
5455 result = cons3 (Qbegin_glyph_layout, sym, result);
5458 if ((layout = (glyph_layout) extent_end_glyph_layout (anc)) != GL_TEXT)
5459 result = cons3 (Qend_glyph_layout, glyph_layout_to_symbol (layout), result);
5461 if (!NILP (extent_end_glyph (anc)))
5462 result = cons3 (Qend_glyph, extent_end_glyph (anc), result);
5464 if (!NILP (extent_begin_glyph (anc)))
5465 result = cons3 (Qbegin_glyph, extent_begin_glyph (anc), result);
5467 if (extent_priority (anc) != 0)
5468 result = cons3 (Qpriority, make_int (extent_priority (anc)), result);
5470 if (!NILP (extent_initial_redisplay_function (anc)))
5471 result = cons3 (Qinitial_redisplay_function,
5472 extent_initial_redisplay_function (anc), result);
5474 if (!NILP (extent_before_change_functions (anc)))
5475 result = cons3 (Qbefore_change_functions,
5476 extent_before_change_functions (anc), result);
5478 if (!NILP (extent_after_change_functions (anc)))
5479 result = cons3 (Qafter_change_functions,
5480 extent_after_change_functions (anc), result);
5482 if (!NILP (extent_invisible (anc)))
5483 result = cons3 (Qinvisible, extent_invisible (anc), result);
5485 if (!NILP (extent_read_only (anc)))
5486 result = cons3 (Qread_only, extent_read_only (anc), result);
5488 if (extent_normal_field (anc, end_open))
5489 result = cons3 (Qend_open, Qt, result);
5491 if (extent_normal_field (anc, start_open))
5492 result = cons3 (Qstart_open, Qt, result);
5494 if (extent_normal_field (anc, detachable))
5495 result = cons3 (Qdetachable, Qt, result);
5497 if (extent_normal_field (anc, duplicable))
5498 result = cons3 (Qduplicable, Qt, result);
5500 if (extent_normal_field (anc, unique))
5501 result = cons3 (Qunique, Qt, result);
5503 /* detached is not an inherited property */
5504 if (extent_detached_p (e))
5505 result = cons3 (Qdetached, Qt, result);
5511 /************************************************************************/
5513 /************************************************************************/
5515 /* The display code looks into the Vlast_highlighted_extent variable to
5516 correctly display highlighted extents. This updates that variable,
5517 and marks the appropriate buffers as needing some redisplay.
5520 do_highlight (Lisp_Object extent_obj, int highlight_p)
5522 if (( highlight_p && (EQ (Vlast_highlighted_extent, extent_obj))) ||
5523 (!highlight_p && (EQ (Vlast_highlighted_extent, Qnil))))
5525 if (EXTENTP (Vlast_highlighted_extent) &&
5526 EXTENT_LIVE_P (XEXTENT (Vlast_highlighted_extent)))
5528 /* do not recurse on descendants. Only one extent is highlighted
5530 extent_changed_for_redisplay (XEXTENT (Vlast_highlighted_extent), 0, 0);
5532 Vlast_highlighted_extent = Qnil;
5533 if (!NILP (extent_obj)
5534 && BUFFERP (extent_object (XEXTENT (extent_obj)))
5537 extent_changed_for_redisplay (XEXTENT (extent_obj), 0, 0);
5538 Vlast_highlighted_extent = extent_obj;
5542 DEFUN ("force-highlight-extent", Fforce_highlight_extent, 1, 2, 0, /*
5543 Highlight or unhighlight the given extent.
5544 If the second arg is non-nil, it will be highlighted, else dehighlighted.
5545 This is the same as `highlight-extent', except that it will work even
5546 on extents without the `mouse-face' property.
5548 (extent, highlight_p))
5553 XSETEXTENT (extent, decode_extent (extent, DE_MUST_BE_ATTACHED));
5554 do_highlight (extent, !NILP (highlight_p));
5558 DEFUN ("highlight-extent", Fhighlight_extent, 1, 2, 0, /*
5559 Highlight EXTENT, if it is highlightable.
5560 \(that is, if it has the `mouse-face' property).
5561 If the second arg is non-nil, it will be highlighted, else dehighlighted.
5562 Highlighted extents are displayed as if they were merged with the face
5563 or faces specified by the `mouse-face' property.
5565 (extent, highlight_p))
5567 if (EXTENTP (extent) && NILP (extent_mouse_face (XEXTENT (extent))))
5570 return Fforce_highlight_extent (extent, highlight_p);
5574 /************************************************************************/
5575 /* strings and extents */
5576 /************************************************************************/
5578 /* copy/paste hooks */
5581 run_extent_copy_paste_internal (EXTENT e, Bufpos from, Bufpos to,
5585 /* This function can GC */
5587 Lisp_Object copy_fn;
5588 XSETEXTENT (extent, e);
5589 copy_fn = Fextent_property (extent, prop, Qnil);
5590 if (!NILP (copy_fn))
5593 struct gcpro gcpro1, gcpro2, gcpro3;
5594 GCPRO3 (extent, copy_fn, object);
5595 if (BUFFERP (object))
5596 flag = call3_in_buffer (XBUFFER (object), copy_fn, extent,
5597 make_int (from), make_int (to));
5599 flag = call3 (copy_fn, extent, make_int (from), make_int (to));
5601 if (NILP (flag) || !EXTENT_LIVE_P (XEXTENT (extent)))
5608 run_extent_copy_function (EXTENT e, Bytind from, Bytind to)
5610 Lisp_Object object = extent_object (e);
5611 /* This function can GC */
5612 return run_extent_copy_paste_internal
5613 (e, buffer_or_string_bytind_to_bufpos (object, from),
5614 buffer_or_string_bytind_to_bufpos (object, to), object,
5619 run_extent_paste_function (EXTENT e, Bytind from, Bytind to,
5622 /* This function can GC */
5623 return run_extent_copy_paste_internal
5624 (e, buffer_or_string_bytind_to_bufpos (object, from),
5625 buffer_or_string_bytind_to_bufpos (object, to), object,
5630 update_extent (EXTENT extent, Bytind from, Bytind to)
5632 set_extent_endpoints (extent, from, to, Qnil);
5635 /* Insert an extent, usually from the dup_list of a string which
5636 has just been inserted.
5637 This code does not handle the case of undo.
5640 insert_extent (EXTENT extent, Bytind new_start, Bytind new_end,
5641 Lisp_Object object, int run_hooks)
5643 /* This function can GC */
5646 if (!EQ (extent_object (extent), object))
5649 if (extent_detached_p (extent))
5652 !run_extent_paste_function (extent, new_start, new_end, object))
5653 /* The paste-function said don't re-attach this extent here. */
5656 update_extent (extent, new_start, new_end);
5660 Bytind exstart = extent_endpoint_bytind (extent, 0);
5661 Bytind exend = extent_endpoint_bytind (extent, 1);
5663 if (exend < new_start || exstart > new_end)
5667 new_start = min (exstart, new_start);
5668 new_end = max (exend, new_end);
5669 if (exstart != new_start || exend != new_end)
5670 update_extent (extent, new_start, new_end);
5674 XSETEXTENT (tmp, extent);
5679 !run_extent_paste_function (extent, new_start, new_end, object))
5680 /* The paste-function said don't attach a copy of the extent here. */
5684 XSETEXTENT (tmp, copy_extent (extent, new_start, new_end, object));
5689 DEFUN ("insert-extent", Finsert_extent, 1, 5, 0, /*
5690 Insert EXTENT from START to END in BUFFER-OR-STRING.
5691 BUFFER-OR-STRING defaults to the current buffer if omitted.
5692 This operation does not insert any characters,
5693 but otherwise acts as if there were a replicating extent whose
5694 parent is EXTENT in some string that was just inserted.
5695 Returns the newly-inserted extent.
5696 The fourth arg, NO-HOOKS, can be used to inhibit the running of the
5697 extent's `paste-function' property if it has one.
5698 See documentation on `detach-extent' for a discussion of undo recording.
5700 (extent, start, end, no_hooks, buffer_or_string))
5702 EXTENT ext = decode_extent (extent, 0);
5706 buffer_or_string = decode_buffer_or_string (buffer_or_string);
5707 get_buffer_or_string_range_byte (buffer_or_string, start, end, &s, &e,
5708 GB_ALLOW_PAST_ACCESSIBLE);
5710 copy = insert_extent (ext, s, e, buffer_or_string, NILP (no_hooks));
5713 if (extent_duplicable_p (XEXTENT (copy)))
5714 record_extent (copy, 1);
5720 /* adding buffer extents to a string */
5722 struct add_string_extents_arg
5730 add_string_extents_mapper (EXTENT extent, void *arg)
5732 /* This function can GC */
5733 struct add_string_extents_arg *closure =
5734 (struct add_string_extents_arg *) arg;
5735 Bytecount start = extent_endpoint_bytind (extent, 0) - closure->from;
5736 Bytecount end = extent_endpoint_bytind (extent, 1) - closure->from;
5738 if (extent_duplicable_p (extent))
5740 start = max (start, 0);
5741 end = min (end, closure->length);
5743 /* Run the copy-function to give an extent the option of
5744 not being copied into the string (or kill ring).
5746 if (extent_duplicable_p (extent) &&
5747 !run_extent_copy_function (extent, start + closure->from,
5748 end + closure->from))
5750 copy_extent (extent, start, end, closure->string);
5756 /* Add the extents in buffer BUF from OPOINT to OPOINT+LENGTH to
5757 the string STRING. */
5759 add_string_extents (Lisp_Object string, struct buffer *buf, Bytind opoint,
5762 /* This function can GC */
5763 struct add_string_extents_arg closure;
5764 struct gcpro gcpro1, gcpro2;
5767 closure.from = opoint;
5768 closure.length = length;
5769 closure.string = string;
5770 buffer = make_buffer (buf);
5771 GCPRO2 (buffer, string);
5772 map_extents_bytind (opoint, opoint + length, add_string_extents_mapper,
5773 (void *) &closure, buffer, 0,
5774 /* ignore extents that just abut the region */
5775 ME_END_CLOSED | ME_ALL_EXTENTS_OPEN |
5776 /* we are calling E-Lisp (the extent's copy function)
5777 so anything might happen */
5778 ME_MIGHT_CALL_ELISP);
5782 struct splice_in_string_extents_arg
5791 splice_in_string_extents_mapper (EXTENT extent, void *arg)
5793 /* This function can GC */
5794 struct splice_in_string_extents_arg *closure =
5795 (struct splice_in_string_extents_arg *) arg;
5796 /* BASE_START and BASE_END are the limits in the buffer of the string
5797 that was just inserted.
5799 NEW_START and NEW_END are the prospective buffer positions of the
5800 extent that is going into the buffer. */
5801 Bytind base_start = closure->opoint;
5802 Bytind base_end = base_start + closure->length;
5803 Bytind new_start = (base_start + extent_endpoint_bytind (extent, 0) -
5805 Bytind new_end = (base_start + extent_endpoint_bytind (extent, 1) -
5808 if (new_start < base_start)
5809 new_start = base_start;
5810 if (new_end > base_end)
5812 if (new_end <= new_start)
5815 if (!extent_duplicable_p (extent))
5819 !run_extent_paste_function (extent, new_start, new_end,
5822 copy_extent (extent, new_start, new_end, closure->buffer);
5827 /* We have just inserted a section of STRING (starting at POS, of
5828 length LENGTH) into buffer BUF at OPOINT. Do whatever is necessary
5829 to get the string's extents into the buffer. */
5832 splice_in_string_extents (Lisp_Object string, struct buffer *buf,
5833 Bytind opoint, Bytecount length, Bytecount pos)
5835 struct splice_in_string_extents_arg closure;
5836 struct gcpro gcpro1, gcpro2;
5839 buffer = make_buffer (buf);
5840 closure.opoint = opoint;
5842 closure.length = length;
5843 closure.buffer = buffer;
5844 GCPRO2 (buffer, string);
5845 map_extents_bytind (pos, pos + length,
5846 splice_in_string_extents_mapper,
5847 (void *) &closure, string, 0,
5848 /* ignore extents that just abut the region */
5849 ME_END_CLOSED | ME_ALL_EXTENTS_OPEN |
5850 /* we are calling E-Lisp (the extent's copy function)
5851 so anything might happen */
5852 ME_MIGHT_CALL_ELISP);
5856 struct copy_string_extents_arg
5861 Lisp_Object new_string;
5864 struct copy_string_extents_1_arg
5866 Lisp_Object parent_in_question;
5867 EXTENT found_extent;
5871 copy_string_extents_mapper (EXTENT extent, void *arg)
5873 struct copy_string_extents_arg *closure =
5874 (struct copy_string_extents_arg *) arg;
5875 Bytecount old_start, old_end, new_start, new_end;
5877 old_start = extent_endpoint_bytind (extent, 0);
5878 old_end = extent_endpoint_bytind (extent, 1);
5880 old_start = max (closure->old_pos, old_start);
5881 old_end = min (closure->old_pos + closure->length, old_end);
5883 if (old_start >= old_end)
5886 new_start = old_start + closure->new_pos - closure->old_pos;
5887 new_end = old_end + closure->new_pos - closure->old_pos;
5889 copy_extent (extent, new_start, new_end, closure->new_string);
5893 /* The string NEW_STRING was partially constructed from OLD_STRING.
5894 In particular, the section of length LEN starting at NEW_POS in
5895 NEW_STRING came from the section of the same length starting at
5896 OLD_POS in OLD_STRING. Copy the extents as appropriate. */
5899 copy_string_extents (Lisp_Object new_string, Lisp_Object old_string,
5900 Bytecount new_pos, Bytecount old_pos,
5903 struct copy_string_extents_arg closure;
5904 struct gcpro gcpro1, gcpro2;
5906 closure.new_pos = new_pos;
5907 closure.old_pos = old_pos;
5908 closure.new_string = new_string;
5909 closure.length = length;
5910 GCPRO2 (new_string, old_string);
5911 map_extents_bytind (old_pos, old_pos + length,
5912 copy_string_extents_mapper,
5913 (void *) &closure, old_string, 0,
5914 /* ignore extents that just abut the region */
5915 ME_END_CLOSED | ME_ALL_EXTENTS_OPEN |
5916 /* we are calling E-Lisp (the extent's copy function)
5917 so anything might happen */
5918 ME_MIGHT_CALL_ELISP);
5922 /* Checklist for sanity checking:
5923 - {kill, yank, copy} at {open, closed} {start, end} of {writable, read-only} extent
5924 - {kill, copy} & yank {once, repeatedly} duplicable extent in {same, different} buffer
5928 /************************************************************************/
5929 /* text properties */
5930 /************************************************************************/
5933 Originally this stuff was implemented in lisp (all of the functionality
5934 exists to make that possible) but speed was a problem.
5937 Lisp_Object Qtext_prop;
5938 Lisp_Object Qtext_prop_extent_paste_function;
5941 get_text_property_bytind (Bytind position, Lisp_Object prop,
5942 Lisp_Object object, enum extent_at_flag fl,
5943 int text_props_only)
5947 /* text_props_only specifies whether we only consider text-property
5948 extents (those with the 'text-prop property set) or all extents. */
5949 if (!text_props_only)
5950 extent = extent_at_bytind (position, object, prop, 0, fl);
5956 extent = extent_at_bytind (position, object, Qtext_prop, prior,
5960 if (EQ (prop, Fextent_property (extent, Qtext_prop, Qnil)))
5962 prior = XEXTENT (extent);
5967 return Fextent_property (extent, prop, Qnil);
5968 if (!NILP (Vdefault_text_properties))
5969 return Fplist_get (Vdefault_text_properties, prop, Qnil);
5974 get_text_property_1 (Lisp_Object pos, Lisp_Object prop, Lisp_Object object,
5975 Lisp_Object at_flag, int text_props_only)
5980 object = decode_buffer_or_string (object);
5981 position = get_buffer_or_string_pos_byte (object, pos, GB_NO_ERROR_IF_BAD);
5983 /* We canonicalize the start/end-open/closed properties to the
5984 non-default version -- "adding" the default property really
5985 needs to remove the non-default one. See below for more
5987 if (EQ (prop, Qstart_closed))
5993 if (EQ (prop, Qend_open))
6001 get_text_property_bytind (position, prop, object,
6002 decode_extent_at_flag (at_flag),
6005 val = NILP (val) ? Qt : Qnil;
6010 DEFUN ("get-text-property", Fget_text_property, 2, 4, 0, /*
6011 Return the value of the PROP property at the given position.
6012 Optional arg OBJECT specifies the buffer or string to look in, and
6013 defaults to the current buffer.
6014 Optional arg AT-FLAG controls what it means for a property to be "at"
6015 a position, and has the same meaning as in `extent-at'.
6016 This examines only those properties added with `put-text-property'.
6017 See also `get-char-property'.
6019 (pos, prop, object, at_flag))
6021 return get_text_property_1 (pos, prop, object, at_flag, 1);
6024 DEFUN ("get-char-property", Fget_char_property, 2, 4, 0, /*
6025 Return the value of the PROP property at the given position.
6026 Optional arg OBJECT specifies the buffer or string to look in, and
6027 defaults to the current buffer.
6028 Optional arg AT-FLAG controls what it means for a property to be "at"
6029 a position, and has the same meaning as in `extent-at'.
6030 This examines properties on all extents.
6031 See also `get-text-property'.
6033 (pos, prop, object, at_flag))
6035 return get_text_property_1 (pos, prop, object, at_flag, 0);
6038 /* About start/end-open/closed:
6040 These properties have to be handled specially because of their
6041 strange behavior. If I put the "start-open" property on a region,
6042 then *all* text-property extents in the region have to have their
6043 start be open. This is unlike all other properties, which don't
6044 affect the extents of text properties other than their own.
6048 1) We have to map start-closed to (not start-open) and end-open
6049 to (not end-closed) -- i.e. adding the default is really the
6050 same as remove the non-default property. It won't work, for
6051 example, to have both "start-open" and "start-closed" on
6053 2) Whenever we add one of these properties, we go through all
6054 text-property extents in the region and set the appropriate
6055 open/closedness on them.
6056 3) Whenever we change a text-property extent for a property,
6057 we have to make sure we set the open/closedness properly.
6059 (2) and (3) together rely on, and maintain, the invariant
6060 that the open/closedness of text-property extents is correct
6061 at the beginning and end of each operation.
6064 struct put_text_prop_arg
6066 Lisp_Object prop, value; /* The property and value we are storing */
6067 Bytind start, end; /* The region into which we are storing it */
6069 Lisp_Object the_extent; /* Our chosen extent; this is used for
6070 communication between subsequent passes. */
6071 int changed_p; /* Output: whether we have modified anything */
6075 put_text_prop_mapper (EXTENT e, void *arg)
6077 struct put_text_prop_arg *closure = (struct put_text_prop_arg *) arg;
6079 Lisp_Object object = closure->object;
6080 Lisp_Object value = closure->value;
6081 Bytind e_start, e_end;
6082 Bytind start = closure->start;
6083 Bytind end = closure->end;
6084 Lisp_Object extent, e_val;
6087 XSETEXTENT (extent, e);
6089 /* Note: in some cases when the property itself is 'start-open
6090 or 'end-closed, the checks to set the openness may do a bit
6091 of extra work; but it won't hurt because we then fix up the
6092 openness later on in put_text_prop_openness_mapper(). */
6093 if (!EQ (Fextent_property (extent, Qtext_prop, Qnil), closure->prop))
6094 /* It's not for this property; do nothing. */
6097 e_start = extent_endpoint_bytind (e, 0);
6098 e_end = extent_endpoint_bytind (e, 1);
6099 e_val = Fextent_property (extent, closure->prop, Qnil);
6100 is_eq = EQ (value, e_val);
6102 if (!NILP (value) && NILP (closure->the_extent) && is_eq)
6104 /* We want there to be an extent here at the end, and we haven't picked
6105 one yet, so use this one. Extend it as necessary. We only reuse an
6106 extent which has an EQ value for the prop in question to avoid
6107 side-effecting the kill ring (that is, we never change the property
6108 on an extent after it has been created.)
6110 if (e_start != start || e_end != end)
6112 Bytind new_start = min (e_start, start);
6113 Bytind new_end = max (e_end, end);
6114 set_extent_endpoints (e, new_start, new_end, Qnil);
6115 /* If we changed the endpoint, then we need to set its
6117 set_extent_openness (e, new_start != e_start
6118 ? !NILP (get_text_property_bytind
6119 (start, Qstart_open, object,
6120 EXTENT_AT_AFTER, 1)) : -1,
6122 ? NILP (get_text_property_bytind
6123 (end - 1, Qend_closed, object,
6124 EXTENT_AT_AFTER, 1))
6126 closure->changed_p = 1;
6128 closure->the_extent = extent;
6131 /* Even if we're adding a prop, at this point, we want all other extents of
6132 this prop to go away (as now they overlap). So the theory here is that,
6133 when we are adding a prop to a region that has multiple (disjoint)
6134 occurrences of that prop in it already, we pick one of those and extend
6135 it, and remove the others.
6138 else if (EQ (extent, closure->the_extent))
6140 /* just in case map-extents hits it again (does that happen?) */
6143 else if (e_start >= start && e_end <= end)
6145 /* Extent is contained in region; remove it. Don't destroy or modify
6146 it, because we don't want to change the attributes pointed to by the
6147 duplicates in the kill ring.
6150 closure->changed_p = 1;
6152 else if (!NILP (closure->the_extent) &&
6157 EXTENT te = XEXTENT (closure->the_extent);
6158 /* This extent overlaps, and has the same prop/value as the extent we've
6159 decided to reuse, so we can remove this existing extent as well (the
6160 whole thing, even the part outside of the region) and extend
6161 the-extent to cover it, resulting in the minimum number of extents in
6164 Bytind the_start = extent_endpoint_bytind (te, 0);
6165 Bytind the_end = extent_endpoint_bytind (te, 1);
6166 if (e_start != the_start && /* note AND not OR -- hmm, why is this
6167 the case? I think it's because the
6168 assumption that the text-property
6169 extents don't overlap makes it
6170 OK; changing it to an OR would
6171 result in changed_p sometimes getting
6172 falsely marked. Is this bad? */
6175 Bytind new_start = min (e_start, the_start);
6176 Bytind new_end = max (e_end, the_end);
6177 set_extent_endpoints (te, new_start, new_end, Qnil);
6178 /* If we changed the endpoint, then we need to set its
6179 openness. We are setting the endpoint to be the same as
6180 that of the extent we're about to remove, and we assume
6181 (the invariant mentioned above) that extent has the
6182 proper endpoint setting, so we just use it. */
6183 set_extent_openness (te, new_start != e_start ?
6184 (int) extent_start_open_p (e) : -1,
6186 (int) extent_end_open_p (e) : -1);
6187 closure->changed_p = 1;
6191 else if (e_end <= end)
6193 /* Extent begins before start but ends before end, so we can just
6194 decrease its end position.
6198 set_extent_endpoints (e, e_start, start, Qnil);
6199 set_extent_openness (e, -1, NILP (get_text_property_bytind
6200 (start - 1, Qend_closed, object,
6201 EXTENT_AT_AFTER, 1)));
6202 closure->changed_p = 1;
6205 else if (e_start >= start)
6207 /* Extent ends after end but begins after start, so we can just
6208 increase its start position.
6212 set_extent_endpoints (e, end, e_end, Qnil);
6213 set_extent_openness (e, !NILP (get_text_property_bytind
6214 (end, Qstart_open, object,
6215 EXTENT_AT_AFTER, 1)), -1);
6216 closure->changed_p = 1;
6221 /* Otherwise, `extent' straddles the region. We need to split it.
6223 set_extent_endpoints (e, e_start, start, Qnil);
6224 set_extent_openness (e, -1, NILP (get_text_property_bytind
6225 (start - 1, Qend_closed, object,
6226 EXTENT_AT_AFTER, 1)));
6227 set_extent_openness (copy_extent (e, end, e_end, extent_object (e)),
6228 !NILP (get_text_property_bytind
6229 (end, Qstart_open, object,
6230 EXTENT_AT_AFTER, 1)), -1);
6231 closure->changed_p = 1;
6234 return 0; /* to continue mapping. */
6238 put_text_prop_openness_mapper (EXTENT e, void *arg)
6240 struct put_text_prop_arg *closure = (struct put_text_prop_arg *) arg;
6241 Bytind e_start, e_end;
6242 Bytind start = closure->start;
6243 Bytind end = closure->end;
6245 XSETEXTENT (extent, e);
6246 e_start = extent_endpoint_bytind (e, 0);
6247 e_end = extent_endpoint_bytind (e, 1);
6249 if (NILP (Fextent_property (extent, Qtext_prop, Qnil)))
6251 /* It's not a text-property extent; do nothing. */
6254 /* Note end conditions and NILP/!NILP's carefully. */
6255 else if (EQ (closure->prop, Qstart_open)
6256 && e_start >= start && e_start < end)
6257 set_extent_openness (e, !NILP (closure->value), -1);
6258 else if (EQ (closure->prop, Qend_closed)
6259 && e_end > start && e_end <= end)
6260 set_extent_openness (e, -1, NILP (closure->value));
6262 return 0; /* to continue mapping. */
6266 put_text_prop (Bytind start, Bytind end, Lisp_Object object,
6267 Lisp_Object prop, Lisp_Object value,
6270 /* This function can GC */
6271 struct put_text_prop_arg closure;
6273 if (start == end) /* There are no characters in the region. */
6276 /* convert to the non-default versions, since a nil property is
6277 the same as it not being present. */
6278 if (EQ (prop, Qstart_closed))
6281 value = NILP (value) ? Qt : Qnil;
6283 else if (EQ (prop, Qend_open))
6286 value = NILP (value) ? Qt : Qnil;
6289 value = canonicalize_extent_property (prop, value);
6291 closure.prop = prop;
6292 closure.value = value;
6293 closure.start = start;
6295 closure.object = object;
6296 closure.changed_p = 0;
6297 closure.the_extent = Qnil;
6299 map_extents_bytind (start, end,
6300 put_text_prop_mapper,
6301 (void *) &closure, object, 0,
6302 /* get all extents that abut the region */
6303 ME_ALL_EXTENTS_CLOSED | ME_END_CLOSED |
6304 /* it might QUIT or error if the user has
6305 fucked with the extent plist. */
6306 /* #### dmoore - I think this should include
6307 ME_MIGHT_MOVE_SOE, since the callback function
6308 might recurse back into map_extents_bytind. */
6310 ME_MIGHT_MODIFY_EXTENTS);
6312 /* If we made it through the loop without reusing an extent
6313 (and we want there to be one) make it now.
6315 if (!NILP (value) && NILP (closure.the_extent))
6319 XSETEXTENT (extent, make_extent_internal (object, start, end));
6320 closure.changed_p = 1;
6321 Fset_extent_property (extent, Qtext_prop, prop);
6322 Fset_extent_property (extent, prop, value);
6325 extent_duplicable_p (XEXTENT (extent)) = 1;
6326 Fset_extent_property (extent, Qpaste_function,
6327 Qtext_prop_extent_paste_function);
6329 set_extent_openness (XEXTENT (extent),
6330 !NILP (get_text_property_bytind
6331 (start, Qstart_open, object,
6332 EXTENT_AT_AFTER, 1)),
6333 NILP (get_text_property_bytind
6334 (end - 1, Qend_closed, object,
6335 EXTENT_AT_AFTER, 1)));
6338 if (EQ (prop, Qstart_open) || EQ (prop, Qend_closed))
6340 map_extents_bytind (start, end,
6341 put_text_prop_openness_mapper,
6342 (void *) &closure, object, 0,
6343 /* get all extents that abut the region */
6344 ME_ALL_EXTENTS_CLOSED | ME_END_CLOSED |
6345 ME_MIGHT_MODIFY_EXTENTS);
6348 return closure.changed_p;
6351 DEFUN ("put-text-property", Fput_text_property, 4, 5, 0, /*
6352 Adds the given property/value to all characters in the specified region.
6353 The property is conceptually attached to the characters rather than the
6354 region. The properties are copied when the characters are copied/pasted.
6355 Fifth argument OBJECT is the buffer or string containing the text, and
6356 defaults to the current buffer.
6358 (start, end, prop, value, object))
6360 /* This function can GC */
6363 object = decode_buffer_or_string (object);
6364 get_buffer_or_string_range_byte (object, start, end, &s, &e, 0);
6365 put_text_prop (s, e, object, prop, value, 1);
6369 DEFUN ("put-nonduplicable-text-property", Fput_nonduplicable_text_property,
6371 Adds the given property/value to all characters in the specified region.
6372 The property is conceptually attached to the characters rather than the
6373 region, however the properties will not be copied when the characters
6375 Fifth argument OBJECT is the buffer or string containing the text, and
6376 defaults to the current buffer.
6378 (start, end, prop, value, object))
6380 /* This function can GC */
6383 object = decode_buffer_or_string (object);
6384 get_buffer_or_string_range_byte (object, start, end, &s, &e, 0);
6385 put_text_prop (s, e, object, prop, value, 0);
6389 DEFUN ("add-text-properties", Fadd_text_properties, 3, 4, 0, /*
6390 Add properties to the characters from START to END.
6391 The third argument PROPS is a property list specifying the property values
6392 to add. The optional fourth argument, OBJECT, is the buffer or string
6393 containing the text and defaults to the current buffer. Returns t if
6394 any property was changed, nil otherwise.
6396 (start, end, props, object))
6398 /* This function can GC */
6402 object = decode_buffer_or_string (object);
6403 get_buffer_or_string_range_byte (object, start, end, &s, &e, 0);
6405 for (; !NILP (props); props = Fcdr (Fcdr (props)))
6407 Lisp_Object prop = XCAR (props);
6408 Lisp_Object value = Fcar (XCDR (props));
6409 changed |= put_text_prop (s, e, object, prop, value, 1);
6411 return changed ? Qt : Qnil;
6415 DEFUN ("add-nonduplicable-text-properties", Fadd_nonduplicable_text_properties,
6417 Add nonduplicable properties to the characters from START to END.
6418 \(The properties will not be copied when the characters are copied.)
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, 0);
6439 return changed ? Qt : Qnil;
6442 DEFUN ("remove-text-properties", Fremove_text_properties, 3, 4, 0, /*
6443 Remove the given properties from all characters in the specified region.
6444 PROPS should be a plist, but the values in that plist are ignored (treated
6445 as nil). Returns t if any property was changed, nil otherwise.
6446 Fourth argument OBJECT is the buffer or string containing the text, and
6447 defaults to the current buffer.
6449 (start, end, props, object))
6451 /* This function can GC */
6455 object = decode_buffer_or_string (object);
6456 get_buffer_or_string_range_byte (object, start, end, &s, &e, 0);
6458 for (; !NILP (props); props = Fcdr (Fcdr (props)))
6460 Lisp_Object prop = XCAR (props);
6461 changed |= put_text_prop (s, e, object, prop, Qnil, 1);
6463 return changed ? Qt : Qnil;
6466 /* Whenever a text-prop extent is pasted into a buffer (via `yank' or `insert'
6467 or whatever) we attach the properties to the buffer by calling
6468 `put-text-property' instead of by simply allowing the extent to be copied or
6469 re-attached. Then we return nil, telling the extents code not to attach it
6470 again. By handing the insertion hackery in this way, we make kill/yank
6471 behave consistently with put-text-property and not fragment the extents
6472 (since text-prop extents must partition, not overlap).
6474 The lisp implementation of this was probably fast enough, but since I moved
6475 the rest of the put-text-prop code here, I moved this as well for
6478 DEFUN ("text-prop-extent-paste-function", Ftext_prop_extent_paste_function,
6480 Used as the `paste-function' property of `text-prop' extents.
6484 /* This function can GC */
6485 Lisp_Object prop, val;
6487 prop = Fextent_property (extent, Qtext_prop, Qnil);
6489 signal_simple_error ("Internal error: no text-prop", extent);
6490 val = Fextent_property (extent, prop, Qnil);
6492 /* removed by bill perry, 2/9/97
6493 ** This little bit of code would not allow you to have a text property
6494 ** with a value of Qnil. This is bad bad bad.
6497 signal_simple_error_2 ("Internal error: no text-prop",
6500 Fput_text_property (from, to, prop, val, Qnil);
6501 return Qnil; /* important! */
6504 /* This function could easily be written in Lisp but the C code wants
6505 to use it in connection with invisible extents (at least currently).
6506 If this changes, consider moving this back into Lisp. */
6508 DEFUN ("next-single-property-change", Fnext_single_property_change,
6510 Return the position of next property change for a specific property.
6511 Scans characters forward from POS till it finds a change in the PROP
6512 property, then returns the position of the change. The optional third
6513 argument OBJECT is the buffer or string to scan (defaults to the current
6515 The property values are compared with `eq'.
6516 Return nil if the property is constant all the way to the end of BUFFER.
6517 If the value is non-nil, it is a position greater than POS, never equal.
6519 If the optional fourth argument LIMIT is non-nil, don't search
6520 past position LIMIT; return LIMIT if nothing is found before LIMIT.
6521 If two or more extents with conflicting non-nil values for PROP overlap
6522 a particular character, it is undefined which value is considered to be
6523 the value of PROP. (Note that this situation will not happen if you always
6524 use the text-property primitives.)
6526 (pos, prop, object, limit))
6530 Lisp_Object extent, value;
6533 object = decode_buffer_or_string (object);
6534 bpos = get_buffer_or_string_pos_char (object, pos, 0);
6537 blim = buffer_or_string_accessible_end_char (object);
6542 blim = get_buffer_or_string_pos_char (object, limit, 0);
6546 extent = Fextent_at (make_int (bpos), object, prop, Qnil, Qnil);
6548 value = Fextent_property (extent, prop, Qnil);
6554 bpos = XINT (Fnext_extent_change (make_int (bpos), object));
6556 break; /* property is the same all the way to the end */
6557 extent = Fextent_at (make_int (bpos), object, prop, Qnil, Qnil);
6558 if ((NILP (extent) && !NILP (value)) ||
6559 (!NILP (extent) && !EQ (value,
6560 Fextent_property (extent, prop, Qnil))))
6561 return make_int (bpos);
6564 /* I think it's more sensible for this function to return nil always
6565 in this situation and it used to do it this way, but it's been changed
6566 for FSF compatibility. */
6570 return make_int (blim);
6573 /* See comment on previous function about why this is written in C. */
6575 DEFUN ("previous-single-property-change", Fprevious_single_property_change,
6577 Return the position of next property change for a specific property.
6578 Scans characters backward from POS till it finds a change in the PROP
6579 property, then returns the position of the change. The optional third
6580 argument OBJECT is the buffer or string to scan (defaults to the current
6582 The property values are compared with `eq'.
6583 Return nil if the property is constant all the way to the start of BUFFER.
6584 If the value is non-nil, it is a position less than POS, never equal.
6586 If the optional fourth argument LIMIT is non-nil, don't search back
6587 past position LIMIT; return LIMIT if nothing is found until LIMIT.
6588 If two or more extents with conflicting non-nil values for PROP overlap
6589 a particular character, it is undefined which value is considered to be
6590 the value of PROP. (Note that this situation will not happen if you always
6591 use the text-property primitives.)
6593 (pos, prop, object, limit))
6597 Lisp_Object extent, value;
6600 object = decode_buffer_or_string (object);
6601 bpos = get_buffer_or_string_pos_char (object, pos, 0);
6604 blim = buffer_or_string_accessible_begin_char (object);
6609 blim = get_buffer_or_string_pos_char (object, limit, 0);
6613 /* extent-at refers to the character AFTER bpos, but we want the
6614 character before bpos. Thus the - 1. extent-at simply
6615 returns nil on bogus positions, so not to worry. */
6616 extent = Fextent_at (make_int (bpos - 1), object, prop, Qnil, Qnil);
6618 value = Fextent_property (extent, prop, Qnil);
6624 bpos = XINT (Fprevious_extent_change (make_int (bpos), object));
6626 break; /* property is the same all the way to the beginning */
6627 extent = Fextent_at (make_int (bpos - 1), object, prop, Qnil, Qnil);
6628 if ((NILP (extent) && !NILP (value)) ||
6629 (!NILP (extent) && !EQ (value,
6630 Fextent_property (extent, prop, Qnil))))
6631 return make_int (bpos);
6634 /* I think it's more sensible for this function to return nil always
6635 in this situation and it used to do it this way, but it's been changed
6636 for FSF compatibility. */
6640 return make_int (blim);
6643 #ifdef MEMORY_USAGE_STATS
6646 compute_buffer_extent_usage (struct buffer *b, struct overhead_stats *ovstats)
6648 /* #### not yet written */
6652 #endif /* MEMORY_USAGE_STATS */
6655 /************************************************************************/
6656 /* initialization */
6657 /************************************************************************/
6660 syms_of_extents (void)
6662 INIT_LRECORD_IMPLEMENTATION (extent);
6663 INIT_LRECORD_IMPLEMENTATION (extent_info);
6664 INIT_LRECORD_IMPLEMENTATION (extent_auxiliary);
6666 defsymbol (&Qextentp, "extentp");
6667 defsymbol (&Qextent_live_p, "extent-live-p");
6669 defsymbol (&Qall_extents_closed, "all-extents-closed");
6670 defsymbol (&Qall_extents_open, "all-extents-open");
6671 defsymbol (&Qall_extents_closed_open, "all-extents-closed-open");
6672 defsymbol (&Qall_extents_open_closed, "all-extents-open-closed");
6673 defsymbol (&Qstart_in_region, "start-in-region");
6674 defsymbol (&Qend_in_region, "end-in-region");
6675 defsymbol (&Qstart_and_end_in_region, "start-and-end-in-region");
6676 defsymbol (&Qstart_or_end_in_region, "start-or-end-in-region");
6677 defsymbol (&Qnegate_in_region, "negate-in-region");
6679 defsymbol (&Qdetached, "detached");
6680 defsymbol (&Qdestroyed, "destroyed");
6681 defsymbol (&Qbegin_glyph, "begin-glyph");
6682 defsymbol (&Qend_glyph, "end-glyph");
6683 defsymbol (&Qstart_open, "start-open");
6684 defsymbol (&Qend_open, "end-open");
6685 defsymbol (&Qstart_closed, "start-closed");
6686 defsymbol (&Qend_closed, "end-closed");
6687 defsymbol (&Qread_only, "read-only");
6688 /* defsymbol (&Qhighlight, "highlight"); in faces.c */
6689 defsymbol (&Qunique, "unique");
6690 defsymbol (&Qduplicable, "duplicable");
6691 defsymbol (&Qdetachable, "detachable");
6692 defsymbol (&Qpriority, "priority");
6693 defsymbol (&Qmouse_face, "mouse-face");
6694 defsymbol (&Qinitial_redisplay_function,"initial-redisplay-function");
6697 defsymbol (&Qglyph_layout, "glyph-layout"); /* backwards compatibility */
6698 defsymbol (&Qbegin_glyph_layout, "begin-glyph-layout");
6699 defsymbol (&Qend_glyph_layout, "end-glyph-layout");
6700 defsymbol (&Qoutside_margin, "outside-margin");
6701 defsymbol (&Qinside_margin, "inside-margin");
6702 defsymbol (&Qwhitespace, "whitespace");
6703 /* Qtext defined in general.c */
6705 defsymbol (&Qpaste_function, "paste-function");
6706 defsymbol (&Qcopy_function, "copy-function");
6708 defsymbol (&Qtext_prop, "text-prop");
6709 defsymbol (&Qtext_prop_extent_paste_function,
6710 "text-prop-extent-paste-function");
6713 DEFSUBR (Fextent_live_p);
6714 DEFSUBR (Fextent_detached_p);
6715 DEFSUBR (Fextent_start_position);
6716 DEFSUBR (Fextent_end_position);
6717 DEFSUBR (Fextent_object);
6718 DEFSUBR (Fextent_length);
6720 DEFSUBR (Fmake_extent);
6721 DEFSUBR (Fcopy_extent);
6722 DEFSUBR (Fdelete_extent);
6723 DEFSUBR (Fdetach_extent);
6724 DEFSUBR (Fset_extent_endpoints);
6725 DEFSUBR (Fnext_extent);
6726 DEFSUBR (Fprevious_extent);
6728 DEFSUBR (Fnext_e_extent);
6729 DEFSUBR (Fprevious_e_extent);
6731 DEFSUBR (Fnext_extent_change);
6732 DEFSUBR (Fprevious_extent_change);
6734 DEFSUBR (Fextent_parent);
6735 DEFSUBR (Fextent_children);
6736 DEFSUBR (Fset_extent_parent);
6738 DEFSUBR (Fextent_in_region_p);
6739 DEFSUBR (Fmap_extents);
6740 DEFSUBR (Fmap_extent_children);
6741 DEFSUBR (Fextent_at);
6743 DEFSUBR (Fset_extent_initial_redisplay_function);
6744 DEFSUBR (Fextent_face);
6745 DEFSUBR (Fset_extent_face);
6746 DEFSUBR (Fextent_mouse_face);
6747 DEFSUBR (Fset_extent_mouse_face);
6748 DEFSUBR (Fset_extent_begin_glyph);
6749 DEFSUBR (Fset_extent_end_glyph);
6750 DEFSUBR (Fextent_begin_glyph);
6751 DEFSUBR (Fextent_end_glyph);
6752 DEFSUBR (Fset_extent_begin_glyph_layout);
6753 DEFSUBR (Fset_extent_end_glyph_layout);
6754 DEFSUBR (Fextent_begin_glyph_layout);
6755 DEFSUBR (Fextent_end_glyph_layout);
6756 DEFSUBR (Fset_extent_priority);
6757 DEFSUBR (Fextent_priority);
6758 DEFSUBR (Fset_extent_property);
6759 DEFSUBR (Fset_extent_properties);
6760 DEFSUBR (Fextent_property);
6761 DEFSUBR (Fextent_properties);
6763 DEFSUBR (Fhighlight_extent);
6764 DEFSUBR (Fforce_highlight_extent);
6766 DEFSUBR (Finsert_extent);
6768 DEFSUBR (Fget_text_property);
6769 DEFSUBR (Fget_char_property);
6770 DEFSUBR (Fput_text_property);
6771 DEFSUBR (Fput_nonduplicable_text_property);
6772 DEFSUBR (Fadd_text_properties);
6773 DEFSUBR (Fadd_nonduplicable_text_properties);
6774 DEFSUBR (Fremove_text_properties);
6775 DEFSUBR (Ftext_prop_extent_paste_function);
6776 DEFSUBR (Fnext_single_property_change);
6777 DEFSUBR (Fprevious_single_property_change);
6781 reinit_vars_of_extents (void)
6783 extent_auxiliary_defaults.begin_glyph = Qnil;
6784 extent_auxiliary_defaults.end_glyph = Qnil;
6785 extent_auxiliary_defaults.parent = Qnil;
6786 extent_auxiliary_defaults.children = Qnil;
6787 extent_auxiliary_defaults.priority = 0;
6788 extent_auxiliary_defaults.invisible = Qnil;
6789 extent_auxiliary_defaults.read_only = Qnil;
6790 extent_auxiliary_defaults.mouse_face = Qnil;
6791 extent_auxiliary_defaults.initial_redisplay_function = Qnil;
6792 extent_auxiliary_defaults.before_change_functions = Qnil;
6793 extent_auxiliary_defaults.after_change_functions = Qnil;
6797 vars_of_extents (void)
6799 reinit_vars_of_extents ();
6801 DEFVAR_INT ("mouse-highlight-priority", &mouse_highlight_priority /*
6802 The priority to use for the mouse-highlighting pseudo-extent
6803 that is used to highlight extents with the `mouse-face' attribute set.
6804 See `set-extent-priority'.
6806 /* Set mouse-highlight-priority (which ends up being used both for the
6807 mouse-highlighting pseudo-extent and the primary selection extent)
6808 to a very high value because very few extents should override it.
6809 1000 gives lots of room below it for different-prioritized extents.
6810 10 doesn't. ediff, for example, likes to use priorities around 100.
6812 mouse_highlight_priority = /* 10 */ 1000;
6814 DEFVAR_LISP ("default-text-properties", &Vdefault_text_properties /*
6815 Property list giving default values for text properties.
6816 Whenever a character does not specify a value for a property, the value
6817 stored in this list is used instead. This only applies when the
6818 functions `get-text-property' or `get-char-property' are called.
6820 Vdefault_text_properties = Qnil;
6822 staticpro (&Vlast_highlighted_extent);
6823 Vlast_highlighted_extent = Qnil;
6825 Vextent_face_reusable_list = Fcons (Qnil, Qnil);
6826 staticpro (&Vextent_face_reusable_list);
6830 complex_vars_of_extents (void)
6832 staticpro (&Vextent_face_memoize_hash_table);
6833 /* The memoize hash table maps from lists of symbols to lists of
6834 faces. It needs to be `equal' to implement the memoization.
6835 The reverse table maps in the other direction and just needs
6836 to do `eq' comparison because the lists of faces are already
6838 Vextent_face_memoize_hash_table =
6839 make_lisp_hash_table (100, HASH_TABLE_VALUE_WEAK, HASH_TABLE_EQUAL);
6840 staticpro (&Vextent_face_reverse_memoize_hash_table);
6841 Vextent_face_reverse_memoize_hash_table =
6842 make_lisp_hash_table (100, HASH_TABLE_KEY_WEAK, HASH_TABLE_EQ);