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"
232 /* ------------------------------- */
234 /* ------------------------------- */
236 /* Note that this object is not extent-specific and should perhaps be
237 moved into another file. */
239 /* Holds a marker that moves as elements in the array are inserted and
240 deleted, similar to standard markers. */
242 typedef struct gap_array_marker
245 struct gap_array_marker *next;
248 /* Holds a "gap array", which is an array of elements with a gap located
249 in it. Insertions and deletions with a high degree of locality
250 are very fast, essentially in constant time. Array positions as
251 used and returned in the gap array functions are independent of
254 typedef struct gap_array
261 Gap_Array_Marker *markers;
264 static Gap_Array_Marker *gap_array_marker_freelist;
266 /* Convert a "memory position" (i.e. taking the gap into account) into
267 the address of the element at (i.e. after) that position. "Memory
268 positions" are only used internally and are of type Memind.
269 "Array positions" are used externally and are of type int. */
270 #define GAP_ARRAY_MEMEL_ADDR(ga, memel) ((ga)->array + (ga)->elsize*(memel))
272 /* Number of elements currently in a gap array */
273 #define GAP_ARRAY_NUM_ELS(ga) ((ga)->numels)
275 #define GAP_ARRAY_ARRAY_TO_MEMORY_POS(ga, pos) \
276 ((pos) <= (ga)->gap ? (pos) : (pos) + (ga)->gapsize)
278 #define GAP_ARRAY_MEMORY_TO_ARRAY_POS(ga, pos) \
279 ((pos) <= (ga)->gap ? (pos) : (pos) - (ga)->gapsize)
281 /* Convert an array position into the address of the element at
282 (i.e. after) that position. */
283 #define GAP_ARRAY_EL_ADDR(ga, pos) ((pos) < (ga)->gap ? \
284 GAP_ARRAY_MEMEL_ADDR(ga, pos) : \
285 GAP_ARRAY_MEMEL_ADDR(ga, (pos) + (ga)->gapsize))
287 /* ------------------------------- */
289 /* ------------------------------- */
291 typedef struct extent_list_marker
295 struct extent_list_marker *next;
296 } Extent_List_Marker;
298 typedef struct extent_list
302 Extent_List_Marker *markers;
305 static Extent_List_Marker *extent_list_marker_freelist;
307 #define EXTENT_LESS_VALS(e,st,nd) ((extent_start (e) < (st)) || \
308 ((extent_start (e) == (st)) && \
309 (extent_end (e) > (nd))))
311 #define EXTENT_EQUAL_VALS(e,st,nd) ((extent_start (e) == (st)) && \
312 (extent_end (e) == (nd)))
314 #define EXTENT_LESS_EQUAL_VALS(e,st,nd) ((extent_start (e) < (st)) || \
315 ((extent_start (e) == (st)) && \
316 (extent_end (e) >= (nd))))
318 /* Is extent E1 less than extent E2 in the display order? */
319 #define EXTENT_LESS(e1,e2) \
320 EXTENT_LESS_VALS (e1, extent_start (e2), extent_end (e2))
322 /* Is extent E1 equal to extent E2? */
323 #define EXTENT_EQUAL(e1,e2) \
324 EXTENT_EQUAL_VALS (e1, extent_start (e2), extent_end (e2))
326 /* Is extent E1 less than or equal to extent E2 in the display order? */
327 #define EXTENT_LESS_EQUAL(e1,e2) \
328 EXTENT_LESS_EQUAL_VALS (e1, extent_start (e2), extent_end (e2))
330 #define EXTENT_E_LESS_VALS(e,st,nd) ((extent_end (e) < (nd)) || \
331 ((extent_end (e) == (nd)) && \
332 (extent_start (e) > (st))))
334 #define EXTENT_E_LESS_EQUAL_VALS(e,st,nd) ((extent_end (e) < (nd)) || \
335 ((extent_end (e) == (nd)) && \
336 (extent_start (e) >= (st))))
338 /* Is extent E1 less than extent E2 in the e-order? */
339 #define EXTENT_E_LESS(e1,e2) \
340 EXTENT_E_LESS_VALS(e1, extent_start (e2), extent_end (e2))
342 /* Is extent E1 less than or equal to extent E2 in the e-order? */
343 #define EXTENT_E_LESS_EQUAL(e1,e2) \
344 EXTENT_E_LESS_EQUAL_VALS (e1, extent_start (e2), extent_end (e2))
346 #define EXTENT_GAP_ARRAY_AT(ga, pos) (* (EXTENT *) GAP_ARRAY_EL_ADDR(ga, pos))
348 /* ------------------------------- */
349 /* auxiliary extent structure */
350 /* ------------------------------- */
352 struct extent_auxiliary extent_auxiliary_defaults;
354 /* ------------------------------- */
355 /* buffer-extent primitives */
356 /* ------------------------------- */
358 typedef struct stack_of_extents
360 Extent_List *extents;
361 Memind pos; /* Position of stack of extents. EXTENTS is the list of
362 all extents that overlap this position. This position
363 can be -1 if the stack of extents is invalid (this
364 happens when a buffer is first created or a string's
365 stack of extents is created [a string's stack of extents
366 is nuked when a GC occurs, to conserve memory]). */
369 /* ------------------------------- */
371 /* ------------------------------- */
373 typedef int Endpoint_Index;
375 #define memind_to_startind(x, start_open) \
376 ((Endpoint_Index) (((x) << 1) + !!(start_open)))
377 #define memind_to_endind(x, end_open) \
378 ((Endpoint_Index) (((x) << 1) - !!(end_open)))
380 /* Combination macros */
381 #define bytind_to_startind(buf, x, start_open) \
382 memind_to_startind (bytind_to_memind (buf, x), start_open)
383 #define bytind_to_endind(buf, x, end_open) \
384 memind_to_endind (bytind_to_memind (buf, x), end_open)
386 /* ------------------------------- */
387 /* buffer-or-string primitives */
388 /* ------------------------------- */
390 /* Similar for Bytinds and start/end indices. */
392 #define buffer_or_string_bytind_to_startind(obj, ind, start_open) \
393 memind_to_startind (buffer_or_string_bytind_to_memind (obj, ind), \
396 #define buffer_or_string_bytind_to_endind(obj, ind, end_open) \
397 memind_to_endind (buffer_or_string_bytind_to_memind (obj, ind), \
400 /* ------------------------------- */
401 /* Lisp-level functions */
402 /* ------------------------------- */
404 /* flags for decode_extent() */
405 #define DE_MUST_HAVE_BUFFER 1
406 #define DE_MUST_BE_ATTACHED 2
408 Lisp_Object Vlast_highlighted_extent;
409 int mouse_highlight_priority;
411 Lisp_Object Qextentp;
412 Lisp_Object Qextent_live_p;
414 Lisp_Object Qall_extents_closed;
415 Lisp_Object Qall_extents_open;
416 Lisp_Object Qall_extents_closed_open;
417 Lisp_Object Qall_extents_open_closed;
418 Lisp_Object Qstart_in_region;
419 Lisp_Object Qend_in_region;
420 Lisp_Object Qstart_and_end_in_region;
421 Lisp_Object Qstart_or_end_in_region;
422 Lisp_Object Qnegate_in_region;
424 Lisp_Object Qdetached;
425 Lisp_Object Qdestroyed;
426 Lisp_Object Qbegin_glyph;
427 Lisp_Object Qend_glyph;
428 Lisp_Object Qstart_open;
429 Lisp_Object Qend_open;
430 Lisp_Object Qstart_closed;
431 Lisp_Object Qend_closed;
432 Lisp_Object Qread_only;
433 /* Qhighlight defined in general.c */
435 Lisp_Object Qduplicable;
436 Lisp_Object Qdetachable;
437 Lisp_Object Qpriority;
438 Lisp_Object Qmouse_face;
439 Lisp_Object Qinitial_redisplay_function;
441 Lisp_Object Qglyph_layout; /* This exists only for backwards compatibility. */
442 Lisp_Object Qbegin_glyph_layout, Qend_glyph_layout;
443 Lisp_Object Qoutside_margin;
444 Lisp_Object Qinside_margin;
445 Lisp_Object Qwhitespace;
446 /* Qtext defined in general.c */
448 Lisp_Object Qcopy_function;
449 Lisp_Object Qpaste_function;
451 /* The idea here is that if we're given a list of faces, we
452 need to "memoize" this so that two lists of faces that are `equal'
453 turn into the same object. When `set-extent-face' is called, we
454 "memoize" into a list of actual faces; when `extent-face' is called,
455 we do a reverse lookup to get the list of symbols. */
457 static Lisp_Object canonicalize_extent_property (Lisp_Object prop,
459 Lisp_Object Vextent_face_memoize_hash_table;
460 Lisp_Object Vextent_face_reverse_memoize_hash_table;
461 Lisp_Object Vextent_face_reusable_list;
462 /* FSFmacs bogosity */
463 Lisp_Object Vdefault_text_properties;
465 EXFUN (Fextent_properties, 1);
466 EXFUN (Fset_extent_property, 3);
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 (extent_detached_p (extent))
1595 else if (STRINGP (object))
1597 /* #### Changes to string extents can affect redisplay if they are
1598 in the modeline or in the gutters.
1600 If the extent is in some generated-modeline-string: when we
1601 change an extent in generated-modeline-string, this changes its
1602 parent, which is in `modeline-format', so we should force the
1603 modeline to be updated. But how to determine whether a string
1604 is a `generated-modeline-string'? Looping through all buffers
1605 is not very efficient. Should we add all
1606 `generated-modeline-string' strings to a hash table? Maybe
1607 efficiency is not the greatest concern here and there's no big
1608 loss in looping over the buffers.
1610 If the extent is in a gutter we mark the gutter as
1611 changed. This means (a) we can update extents in the gutters
1612 when we need it. (b) we don't have to update the gutters when
1613 only extents attached to buffers have changed. */
1615 MARK_EXTENTS_CHANGED;
1616 gutter_extent_signal_changed_region_maybe (object,
1617 extent_endpoint_bufpos (extent, 0),
1618 extent_endpoint_bufpos (extent, 1));
1620 else if (BUFFERP (object))
1623 b = XBUFFER (object);
1624 BUF_FACECHANGE (b)++;
1625 MARK_EXTENTS_CHANGED;
1626 if (invisibility_change)
1628 buffer_extent_signal_changed_region (b,
1629 extent_endpoint_bufpos (extent, 0),
1630 extent_endpoint_bufpos (extent, 1));
1634 /* A change to an extent occurred that might affect redisplay.
1635 This is called when properties such as the endpoints, the layout,
1636 or the priority changes. Redisplay will be affected only if
1637 the extent has any displayable attributes. */
1640 extent_maybe_changed_for_redisplay (EXTENT extent, int descendants_too,
1641 int invisibility_change)
1643 /* Retrieve the ancestor for efficiency */
1644 EXTENT anc = extent_ancestor (extent);
1645 if (!NILP (extent_face (anc)) ||
1646 !NILP (extent_begin_glyph (anc)) ||
1647 !NILP (extent_end_glyph (anc)) ||
1648 !NILP (extent_mouse_face (anc)) ||
1649 !NILP (extent_invisible (anc)) ||
1650 !NILP (extent_initial_redisplay_function (anc)) ||
1651 invisibility_change)
1652 extent_changed_for_redisplay (extent, descendants_too,
1653 invisibility_change);
1657 make_extent_detached (Lisp_Object object)
1659 EXTENT extent = allocate_extent ();
1661 assert (NILP (object) || STRINGP (object) ||
1662 (BUFFERP (object) && BUFFER_LIVE_P (XBUFFER (object))));
1663 extent_object (extent) = object;
1664 /* Now make sure the extent info exists. */
1666 buffer_or_string_extent_info_force (object);
1670 /* A "real" extent is any extent other than the internal (not-user-visible)
1671 extents used by `map-extents'. */
1674 real_extent_at_forward (Extent_List *el, int pos, int endp)
1676 for (; pos < extent_list_num_els (el); pos++)
1678 EXTENT e = extent_list_at (el, pos, endp);
1679 if (!extent_internal_p (e))
1686 real_extent_at_backward (Extent_List *el, int pos, int endp)
1688 for (; pos >= 0; pos--)
1690 EXTENT e = extent_list_at (el, pos, endp);
1691 if (!extent_internal_p (e))
1698 extent_first (Lisp_Object obj)
1700 Extent_List *el = buffer_or_string_extent_list (obj);
1704 return real_extent_at_forward (el, 0, 0);
1709 extent_e_first (Lisp_Object obj)
1711 Extent_List *el = buffer_or_string_extent_list (obj);
1715 return real_extent_at_forward (el, 0, 1);
1720 extent_next (EXTENT e)
1722 Extent_List *el = extent_extent_list (e);
1724 int pos = extent_list_locate (el, e, 0, &foundp);
1726 return real_extent_at_forward (el, pos+1, 0);
1731 extent_e_next (EXTENT e)
1733 Extent_List *el = extent_extent_list (e);
1735 int pos = extent_list_locate (el, e, 1, &foundp);
1737 return real_extent_at_forward (el, pos+1, 1);
1742 extent_last (Lisp_Object obj)
1744 Extent_List *el = buffer_or_string_extent_list (obj);
1748 return real_extent_at_backward (el, extent_list_num_els (el) - 1, 0);
1753 extent_e_last (Lisp_Object obj)
1755 Extent_List *el = buffer_or_string_extent_list (obj);
1759 return real_extent_at_backward (el, extent_list_num_els (el) - 1, 1);
1764 extent_previous (EXTENT e)
1766 Extent_List *el = extent_extent_list (e);
1768 int pos = extent_list_locate (el, e, 0, &foundp);
1770 return real_extent_at_backward (el, pos-1, 0);
1775 extent_e_previous (EXTENT e)
1777 Extent_List *el = extent_extent_list (e);
1779 int pos = extent_list_locate (el, e, 1, &foundp);
1781 return real_extent_at_backward (el, pos-1, 1);
1786 extent_attach (EXTENT extent)
1788 Extent_List *el = extent_extent_list (extent);
1790 extent_list_insert (el, extent);
1791 soe_insert (extent_object (extent), extent);
1792 /* only this extent changed */
1793 extent_maybe_changed_for_redisplay (extent, 0,
1794 !NILP (extent_invisible (extent)));
1798 extent_detach (EXTENT extent)
1802 if (extent_detached_p (extent))
1804 el = extent_extent_list (extent);
1806 /* call this before messing with the extent. */
1807 extent_maybe_changed_for_redisplay (extent, 0,
1808 !NILP (extent_invisible (extent)));
1809 extent_list_delete (el, extent);
1810 soe_delete (extent_object (extent), extent);
1811 set_extent_start (extent, -1);
1812 set_extent_end (extent, -1);
1815 /* ------------------------------- */
1816 /* map-extents et al. */
1817 /* ------------------------------- */
1819 /* Returns true iff map_extents() would visit the given extent.
1820 See the comments at map_extents() for info on the overlap rule.
1821 Assumes that all validation on the extent and buffer positions has
1822 already been performed (see Fextent_in_region_p ()).
1825 extent_in_region_p (EXTENT extent, Bytind from, Bytind to,
1828 Lisp_Object obj = extent_object (extent);
1829 Endpoint_Index start, end, exs, exe;
1830 int start_open, end_open;
1831 unsigned int all_extents_flags = flags & ME_ALL_EXTENTS_MASK;
1832 unsigned int in_region_flags = flags & ME_IN_REGION_MASK;
1835 /* A zero-length region is treated as closed-closed. */
1838 flags |= ME_END_CLOSED;
1839 flags &= ~ME_START_OPEN;
1842 /* So is a zero-length extent. */
1843 if (extent_start (extent) == extent_end (extent))
1844 start_open = 0, end_open = 0;
1845 /* `all_extents_flags' will almost always be zero. */
1846 else if (all_extents_flags == 0)
1848 start_open = extent_start_open_p (extent);
1849 end_open = extent_end_open_p (extent);
1852 switch (all_extents_flags)
1854 case ME_ALL_EXTENTS_CLOSED: start_open = 0, end_open = 0; break;
1855 case ME_ALL_EXTENTS_OPEN: start_open = 1, end_open = 1; break;
1856 case ME_ALL_EXTENTS_CLOSED_OPEN: start_open = 0, end_open = 1; break;
1857 case ME_ALL_EXTENTS_OPEN_CLOSED: start_open = 1, end_open = 0; break;
1858 default: abort(); break;
1861 start = buffer_or_string_bytind_to_startind (obj, from,
1862 flags & ME_START_OPEN);
1863 end = buffer_or_string_bytind_to_endind (obj, to, ! (flags & ME_END_CLOSED));
1864 exs = memind_to_startind (extent_start (extent), start_open);
1865 exe = memind_to_endind (extent_end (extent), end_open);
1867 /* It's easy to determine whether an extent lies *outside* the
1868 region -- just determine whether it's completely before
1869 or completely after the region. Reject all such extents, so
1870 we're now left with only the extents that overlap the region.
1873 if (exs > end || exe < start)
1876 /* See if any further restrictions are called for. */
1877 /* in_region_flags will almost always be zero. */
1878 if (in_region_flags == 0)
1881 switch (in_region_flags)
1883 case ME_START_IN_REGION:
1884 retval = start <= exs && exs <= end; break;
1885 case ME_END_IN_REGION:
1886 retval = start <= exe && exe <= end; break;
1887 case ME_START_AND_END_IN_REGION:
1888 retval = start <= exs && exe <= end; break;
1889 case ME_START_OR_END_IN_REGION:
1890 retval = (start <= exs && exs <= end) || (start <= exe && exe <= end);
1895 return flags & ME_NEGATE_IN_REGION ? !retval : retval;
1898 struct map_extents_struct
1901 Extent_List_Marker *mkr;
1906 map_extents_unwind (Lisp_Object obj)
1908 struct map_extents_struct *closure =
1909 (struct map_extents_struct *) get_opaque_ptr (obj);
1910 free_opaque_ptr (obj);
1912 extent_detach (closure->range);
1914 extent_list_delete_marker (closure->el, closure->mkr);
1918 /* This is the guts of `map-extents' and the other functions that
1919 map over extents. In theory the operation of this function is
1920 simple: just figure out what extents we're mapping over, and
1921 call the function on each one of them in the range. Unfortunately
1922 there are a wide variety of things that the mapping function
1923 might do, and we have to be very tricky to avoid getting messed
1924 up. Furthermore, this function needs to be very fast (it is
1925 called multiple times every time text is inserted or deleted
1926 from a buffer), and so we can't always afford the overhead of
1927 dealing with all the possible things that the mapping function
1928 might do; thus, there are many flags that can be specified
1929 indicating what the mapping function might or might not do.
1931 The result of all this is that this is the most complicated
1932 function in this file. Change it at your own risk!
1934 A potential simplification to the logic below is to determine
1935 all the extents that the mapping function should be called on
1936 before any calls are actually made and save them in an array.
1937 That introduces its own complications, however (the array
1938 needs to be marked for garbage-collection, and a static array
1939 cannot be used because map_extents() needs to be reentrant).
1940 Furthermore, the results might be a little less sensible than
1945 map_extents_bytind (Bytind from, Bytind to, map_extents_fun fn, void *arg,
1946 Lisp_Object obj, EXTENT after, unsigned int flags)
1948 Memind st, en; /* range we're mapping over */
1949 EXTENT range = 0; /* extent for this, if ME_MIGHT_MODIFY_TEXT */
1950 Extent_List *el = 0; /* extent list we're iterating over */
1951 Extent_List_Marker *posm = 0; /* marker for extent list,
1952 if ME_MIGHT_MODIFY_EXTENTS */
1953 /* count and struct for unwind-protect, if ME_MIGHT_THROW */
1955 struct map_extents_struct closure;
1957 #ifdef ERROR_CHECK_EXTENTS
1958 assert (from <= to);
1959 assert (from >= buffer_or_string_absolute_begin_byte (obj) &&
1960 from <= buffer_or_string_absolute_end_byte (obj) &&
1961 to >= buffer_or_string_absolute_begin_byte (obj) &&
1962 to <= buffer_or_string_absolute_end_byte (obj));
1967 assert (EQ (obj, extent_object (after)));
1968 assert (!extent_detached_p (after));
1971 el = buffer_or_string_extent_list (obj);
1972 if (!el || !extent_list_num_els(el))
1976 st = buffer_or_string_bytind_to_memind (obj, from);
1977 en = buffer_or_string_bytind_to_memind (obj, to);
1979 if (flags & ME_MIGHT_MODIFY_TEXT)
1981 /* The mapping function might change the text in the buffer,
1982 so make an internal extent to hold the range we're mapping
1984 range = make_extent_detached (obj);
1985 set_extent_start (range, st);
1986 set_extent_end (range, en);
1987 range->flags.start_open = flags & ME_START_OPEN;
1988 range->flags.end_open = !(flags & ME_END_CLOSED);
1989 range->flags.internal = 1;
1990 range->flags.detachable = 0;
1991 extent_attach (range);
1994 if (flags & ME_MIGHT_THROW)
1996 /* The mapping function might throw past us so we need to use an
1997 unwind_protect() to eliminate the internal extent and range
1999 count = specpdl_depth ();
2000 closure.range = range;
2002 record_unwind_protect (map_extents_unwind,
2003 make_opaque_ptr (&closure));
2006 /* ---------- Figure out where we start and what direction
2007 we move in. This is the trickiest part of this
2008 function. ---------- */
2010 /* If ME_START_IN_REGION, ME_END_IN_REGION or ME_START_AND_END_IN_REGION
2011 was specified and ME_NEGATE_IN_REGION was not specified, our job
2012 is simple because of the presence of the display order and e-order.
2013 (Note that theoretically do something similar for
2014 ME_START_OR_END_IN_REGION, but that would require more trickiness
2015 than it's worth to avoid hitting the same extent twice.)
2017 In the general case, all the extents that overlap a range can be
2018 divided into two classes: those whose start position lies within
2019 the range (including the range's end but not including the
2020 range's start), and those that overlap the start position,
2021 i.e. those in the SOE for the start position. Or equivalently,
2022 the extents can be divided into those whose end position lies
2023 within the range and those in the SOE for the end position. Note
2024 that for this purpose we treat both the range and all extents in
2025 the buffer as closed on both ends. If this is not what the ME_
2026 flags specified, then we've mapped over a few too many extents,
2027 but no big deal because extent_in_region_p() will filter them
2028 out. Ideally, we could move the SOE to the closer of the range's
2029 two ends and work forwards or backwards from there. However, in
2030 order to make the semantics of the AFTER argument work out, we
2031 have to always go in the same direction; so we choose to always
2032 move the SOE to the start position.
2034 When it comes time to do the SOE stage, we first call soe_move()
2035 so that the SOE gets set up. Note that the SOE might get
2036 changed while we are mapping over its contents. If we can
2037 guarantee that the SOE won't get moved to a new position, we
2038 simply need to put a marker in the SOE and we will track deletions
2039 and insertions of extents in the SOE. If the SOE might get moved,
2040 however (this would happen as a result of a recursive invocation
2041 of map-extents or a call to a redisplay-type function), then
2042 trying to track its changes is hopeless, so we just keep a
2043 marker to the first (or last) extent in the SOE and use that as
2046 Finally, if DONT_USE_SOE is defined, we don't use the SOE at all
2047 and instead just map from the beginning of the buffer. This is
2048 used for testing purposes and allows the SOE to be calculated
2049 using map_extents() instead of the other way around. */
2052 int range_flag; /* ME_*_IN_REGION subset of flags */
2053 int do_soe_stage = 0; /* Are we mapping over the SOE? */
2054 /* Does the range stage map over start or end positions? */
2056 /* If type == 0, we include the start position in the range stage mapping.
2057 If type == 1, we exclude the start position in the range stage mapping.
2058 If type == 2, we begin at range_start_pos, an extent-list position.
2060 int range_start_type = 0;
2061 int range_start_pos = 0;
2064 range_flag = flags & ME_IN_REGION_MASK;
2065 if ((range_flag == ME_START_IN_REGION ||
2066 range_flag == ME_START_AND_END_IN_REGION) &&
2067 !(flags & ME_NEGATE_IN_REGION))
2069 /* map over start position in [range-start, range-end]. No SOE
2073 else if (range_flag == ME_END_IN_REGION && !(flags & ME_NEGATE_IN_REGION))
2075 /* map over end position in [range-start, range-end]. No SOE
2081 /* Need to include the SOE extents. */
2083 /* Just brute-force it: start from the beginning. */
2085 range_start_type = 2;
2086 range_start_pos = 0;
2088 Stack_Of_Extents *soe = buffer_or_string_stack_of_extents_force (obj);
2091 /* Move the SOE to the closer end of the range. This dictates
2092 whether we map over start positions or end positions. */
2095 numsoe = extent_list_num_els (soe->extents);
2098 if (flags & ME_MIGHT_MOVE_SOE)
2101 /* Can't map over SOE, so just extend range to cover the
2103 EXTENT e = extent_list_at (soe->extents, 0, 0);
2105 extent_list_locate (buffer_or_string_extent_list (obj), e, 0,
2108 range_start_type = 2;
2112 /* We can map over the SOE. */
2114 range_start_type = 1;
2119 /* No extents in the SOE to map over, so we act just as if
2120 ME_START_IN_REGION or ME_END_IN_REGION was specified.
2121 RANGE_ENDP already specified so no need to do anything else. */
2126 /* ---------- Now loop over the extents. ---------- */
2128 /* We combine the code for the two stages because much of it
2130 for (stage = 0; stage < 2; stage++)
2132 int pos = 0; /* Position in extent list */
2134 /* First set up start conditions */
2136 { /* The SOE stage */
2139 el = buffer_or_string_stack_of_extents_force (obj)->extents;
2140 /* We will always be looping over start extents here. */
2141 assert (!range_endp);
2145 { /* The range stage */
2146 el = buffer_or_string_extent_list (obj);
2147 switch (range_start_type)
2150 pos = extent_list_locate_from_pos (el, st, range_endp);
2153 pos = extent_list_locate_from_pos (el, st + 1, range_endp);
2156 pos = range_start_pos;
2161 if (flags & ME_MIGHT_MODIFY_EXTENTS)
2163 /* Create a marker to track changes to the extent list */
2165 /* Delete the marker used in the SOE stage. */
2166 extent_list_delete_marker
2167 (buffer_or_string_stack_of_extents_force (obj)->extents, posm);
2168 posm = extent_list_make_marker (el, pos, range_endp);
2169 /* tell the unwind function about the marker. */
2180 /* ----- update position in extent list
2181 and fetch next extent ----- */
2184 /* fetch POS again to track extent insertions or deletions */
2185 pos = extent_list_marker_pos (el, posm);
2186 if (pos >= extent_list_num_els (el))
2188 e = extent_list_at (el, pos, range_endp);
2191 /* now point the marker to the next one we're going to process.
2192 This ensures graceful behavior if this extent is deleted. */
2193 extent_list_move_marker (el, posm, pos);
2195 /* ----- deal with internal extents ----- */
2197 if (extent_internal_p (e))
2199 if (!(flags & ME_INCLUDE_INTERNAL))
2201 else if (e == range)
2203 /* We're processing internal extents and we've
2204 come across our own special range extent.
2205 (This happens only in adjust_extents*() and
2206 process_extents*(), which handle text
2207 insertion and deletion.) We need to omit
2208 processing of this extent; otherwise
2209 we will probably end up prematurely
2210 terminating this loop. */
2215 /* ----- deal with AFTER condition ----- */
2219 /* if e > after, then we can stop skipping extents. */
2220 if (EXTENT_LESS (after, e))
2222 else /* otherwise, skip this extent. */
2226 /* ----- stop if we're completely outside the range ----- */
2228 /* fetch ST and EN again to track text insertions or deletions */
2231 st = extent_start (range);
2232 en = extent_end (range);
2234 if (extent_endpoint (e, range_endp) > en)
2236 /* Can't be mapping over SOE because all extents in
2237 there should overlap ST */
2238 assert (stage == 1);
2242 /* ----- Now actually call the function ----- */
2244 obj2 = extent_object (e);
2245 if (extent_in_region_p (e,
2246 buffer_or_string_memind_to_bytind (obj2,
2248 buffer_or_string_memind_to_bytind (obj2,
2254 /* Function wants us to stop mapping. */
2255 stage = 1; /* so outer for loop will terminate */
2261 /* ---------- Finished looping. ---------- */
2264 if (flags & ME_MIGHT_THROW)
2265 /* This deletes the range extent and frees the marker. */
2266 unbind_to (count, Qnil);
2269 /* Delete them ourselves */
2271 extent_detach (range);
2273 extent_list_delete_marker (el, posm);
2278 map_extents (Bufpos from, Bufpos to, map_extents_fun fn,
2279 void *arg, Lisp_Object obj, EXTENT after, unsigned int flags)
2281 map_extents_bytind (buffer_or_string_bufpos_to_bytind (obj, from),
2282 buffer_or_string_bufpos_to_bytind (obj, to), fn, arg,
2286 /* ------------------------------- */
2287 /* adjust_extents() */
2288 /* ------------------------------- */
2290 /* Add AMOUNT to all extent endpoints in the range (FROM, TO]. This
2291 happens whenever the gap is moved or (under Mule) a character in a
2292 string is substituted for a different-length one. The reason for
2293 this is that extent endpoints behave just like markers (all memory
2294 indices do) and this adjustment correct for markers -- see
2295 adjust_markers(). Note that it is important that we visit all
2296 extent endpoints in the range, irrespective of whether the
2297 endpoints are open or closed.
2299 We could use map_extents() for this (and in fact the function
2300 was originally written that way), but the gap is in an incoherent
2301 state when this function is called and this function plays
2302 around with extent endpoints without detaching and reattaching
2303 the extents (this is provably correct and saves lots of time),
2304 so for safety we make it just look at the extent lists directly. */
2307 adjust_extents (Lisp_Object obj, Memind from, Memind to, int amount)
2313 Stack_Of_Extents *soe;
2315 #ifdef ERROR_CHECK_EXTENTS
2316 sledgehammer_extent_check (obj);
2318 el = buffer_or_string_extent_list (obj);
2320 if (!el || !extent_list_num_els(el))
2323 /* IMPORTANT! Compute the starting positions of the extents to
2324 modify BEFORE doing any modification! Otherwise the starting
2325 position for the second time through the loop might get
2326 incorrectly calculated (I got bit by this bug real bad). */
2327 startpos[0] = extent_list_locate_from_pos (el, from+1, 0);
2328 startpos[1] = extent_list_locate_from_pos (el, from+1, 1);
2329 for (endp = 0; endp < 2; endp++)
2331 for (pos = startpos[endp]; pos < extent_list_num_els (el);
2334 EXTENT e = extent_list_at (el, pos, endp);
2335 if (extent_endpoint (e, endp) > to)
2337 set_extent_endpoint (e,
2338 do_marker_adjustment (extent_endpoint (e, endp),
2344 /* The index for the buffer's SOE is a memory index and thus
2345 needs to be adjusted like a marker. */
2346 soe = buffer_or_string_stack_of_extents (obj);
2347 if (soe && soe->pos >= 0)
2348 soe->pos = do_marker_adjustment (soe->pos, from, to, amount);
2351 /* ------------------------------- */
2352 /* adjust_extents_for_deletion() */
2353 /* ------------------------------- */
2355 struct adjust_extents_for_deletion_arg
2357 EXTENT_dynarr *list;
2361 adjust_extents_for_deletion_mapper (EXTENT extent, void *arg)
2363 struct adjust_extents_for_deletion_arg *closure =
2364 (struct adjust_extents_for_deletion_arg *) arg;
2366 Dynarr_add (closure->list, extent);
2367 return 0; /* continue mapping */
2370 /* For all extent endpoints in the range (FROM, TO], move them to the beginning
2371 of the new gap. Note that it is important that we visit all extent
2372 endpoints in the range, irrespective of whether the endpoints are open or
2375 This function deals with weird stuff such as the fact that extents
2378 There is no string correspondent for this because you can't
2379 delete characters from a string.
2383 adjust_extents_for_deletion (Lisp_Object object, Bytind from,
2384 Bytind to, int gapsize, int numdel,
2387 struct adjust_extents_for_deletion_arg closure;
2389 Memind adjust_to = (Memind) (to + gapsize);
2390 Bytecount amount = - numdel - movegapsize;
2391 Memind oldsoe = 0, newsoe = 0;
2392 Stack_Of_Extents *soe = buffer_or_string_stack_of_extents (object);
2394 #ifdef ERROR_CHECK_EXTENTS
2395 sledgehammer_extent_check (object);
2397 closure.list = Dynarr_new (EXTENT);
2399 /* We're going to be playing weird games below with extents and the SOE
2400 and such, so compute the list now of all the extents that we're going
2401 to muck with. If we do the mapping and adjusting together, things can
2402 get all screwed up. */
2404 map_extents_bytind (from, to, adjust_extents_for_deletion_mapper,
2405 (void *) &closure, object, 0,
2406 /* extent endpoints move like markers regardless
2407 of their open/closeness. */
2408 ME_ALL_EXTENTS_CLOSED | ME_END_CLOSED |
2409 ME_START_OR_END_IN_REGION | ME_INCLUDE_INTERNAL);
2412 Old and new values for the SOE's position. (It gets adjusted
2413 like a marker, just like extent endpoints.)
2420 newsoe = do_marker_adjustment (soe->pos,
2421 adjust_to, adjust_to,
2427 for (i = 0; i < Dynarr_length (closure.list); i++)
2429 EXTENT extent = Dynarr_at (closure.list, i);
2430 Memind new_start = extent_start (extent);
2431 Memind new_end = extent_end (extent);
2433 /* do_marker_adjustment() will not adjust values that should not be
2434 adjusted. We're passing the same funky arguments to
2435 do_marker_adjustment() as buffer_delete_range() does. */
2437 do_marker_adjustment (new_start,
2438 adjust_to, adjust_to,
2441 do_marker_adjustment (new_end,
2442 adjust_to, adjust_to,
2445 /* We need to be very careful here so that the SOE doesn't get
2446 corrupted. We are shrinking extents out of the deleted region
2447 and simultaneously moving the SOE's pos out of the deleted
2448 region, so the SOE should contain the same extents at the end
2449 as at the beginning. However, extents may get reordered
2450 by this process, so we have to operate by pulling the extents
2451 out of the buffer and SOE, changing their bounds, and then
2452 reinserting them. In order for the SOE not to get screwed up,
2453 we have to make sure that the SOE's pos points to its old
2454 location whenever we pull an extent out, and points to its
2455 new location whenever we put the extent back in.
2458 if (new_start != extent_start (extent) ||
2459 new_end != extent_end (extent))
2461 extent_detach (extent);
2462 set_extent_start (extent, new_start);
2463 set_extent_end (extent, new_end);
2466 extent_attach (extent);
2475 #ifdef ERROR_CHECK_EXTENTS
2476 sledgehammer_extent_check (object);
2478 Dynarr_free (closure.list);
2481 /* ------------------------------- */
2482 /* extent fragments */
2483 /* ------------------------------- */
2485 /* Imagine that the buffer is divided up into contiguous,
2486 nonoverlapping "runs" of text such that no extent
2487 starts or ends within a run (extents that abut the
2490 An extent fragment is a structure that holds data about
2491 the run that contains a particular buffer position (if
2492 the buffer position is at the junction of two runs, the
2493 run after the position is used) -- the beginning and
2494 end of the run, a list of all of the extents in that
2495 run, the "merged face" that results from merging all of
2496 the faces corresponding to those extents, the begin and
2497 end glyphs at the beginning of the run, etc. This is
2498 the information that redisplay needs in order to
2501 Extent fragments have to be very quick to update to
2502 a new buffer position when moving linearly through
2503 the buffer. They rely on the stack-of-extents code,
2504 which does the heavy-duty algorithmic work of determining
2505 which extents overly a particular position. */
2507 /* This function returns the position of the beginning of
2508 the first run that begins after POS, or returns POS if
2509 there are no such runs. */
2512 extent_find_end_of_run (Lisp_Object obj, Bytind pos, int outside_accessible)
2515 Extent_List *bel = buffer_or_string_extent_list (obj);
2518 Memind mempos = buffer_or_string_bytind_to_memind (obj, pos);
2519 Bytind limit = outside_accessible ?
2520 buffer_or_string_absolute_end_byte (obj) :
2521 buffer_or_string_accessible_end_byte (obj);
2523 if (!bel || !extent_list_num_els(bel))
2526 sel = buffer_or_string_stack_of_extents_force (obj)->extents;
2527 soe_move (obj, mempos);
2529 /* Find the first start position after POS. */
2530 elind1 = extent_list_locate_from_pos (bel, mempos+1, 0);
2531 if (elind1 < extent_list_num_els (bel))
2532 pos1 = buffer_or_string_memind_to_bytind
2533 (obj, extent_start (extent_list_at (bel, elind1, 0)));
2537 /* Find the first end position after POS. The extent corresponding
2538 to this position is either in the SOE or is greater than or
2539 equal to POS1, so we just have to look in the SOE. */
2540 elind2 = extent_list_locate_from_pos (sel, mempos+1, 1);
2541 if (elind2 < extent_list_num_els (sel))
2542 pos2 = buffer_or_string_memind_to_bytind
2543 (obj, extent_end (extent_list_at (sel, elind2, 1)));
2547 return min (min (pos1, pos2), limit);
2551 extent_find_beginning_of_run (Lisp_Object obj, Bytind pos,
2552 int outside_accessible)
2555 Extent_List *bel = buffer_or_string_extent_list (obj);
2558 Memind mempos = buffer_or_string_bytind_to_memind (obj, pos);
2559 Bytind limit = outside_accessible ?
2560 buffer_or_string_absolute_begin_byte (obj) :
2561 buffer_or_string_accessible_begin_byte (obj);
2563 if (!bel || !extent_list_num_els(bel))
2566 sel = buffer_or_string_stack_of_extents_force (obj)->extents;
2567 soe_move (obj, mempos);
2569 /* Find the first end position before POS. */
2570 elind1 = extent_list_locate_from_pos (bel, mempos, 1);
2572 pos1 = buffer_or_string_memind_to_bytind
2573 (obj, extent_end (extent_list_at (bel, elind1 - 1, 1)));
2577 /* Find the first start position before POS. The extent corresponding
2578 to this position is either in the SOE or is less than or
2579 equal to POS1, so we just have to look in the SOE. */
2580 elind2 = extent_list_locate_from_pos (sel, mempos, 0);
2582 pos2 = buffer_or_string_memind_to_bytind
2583 (obj, extent_start (extent_list_at (sel, elind2 - 1, 0)));
2587 return max (max (pos1, pos2), limit);
2590 struct extent_fragment *
2591 extent_fragment_new (Lisp_Object buffer_or_string, struct frame *frm)
2593 struct extent_fragment *ef = xnew_and_zero (struct extent_fragment);
2595 ef->object = buffer_or_string;
2597 ef->extents = Dynarr_new (EXTENT);
2598 ef->begin_glyphs = Dynarr_new (glyph_block);
2599 ef->end_glyphs = Dynarr_new (glyph_block);
2605 extent_fragment_delete (struct extent_fragment *ef)
2607 Dynarr_free (ef->extents);
2608 Dynarr_free (ef->begin_glyphs);
2609 Dynarr_free (ef->end_glyphs);
2614 extent_priority_sort_function (const void *humpty, const void *dumpty)
2616 const EXTENT foo = * (const EXTENT *) humpty;
2617 const EXTENT bar = * (const EXTENT *) dumpty;
2618 if (extent_priority (foo) < extent_priority (bar))
2620 return extent_priority (foo) > extent_priority (bar);
2624 extent_fragment_sort_by_priority (EXTENT_dynarr *extarr)
2628 /* Sort our copy of the stack by extent_priority. We use a bubble
2629 sort here because it's going to be faster than qsort() for small
2630 numbers of extents (less than 10 or so), and 99.999% of the time
2631 there won't ever be more extents than this in the stack. */
2632 if (Dynarr_length (extarr) < 10)
2634 for (i = 1; i < Dynarr_length (extarr); i++)
2638 (extent_priority (Dynarr_at (extarr, j)) >
2639 extent_priority (Dynarr_at (extarr, j+1))))
2641 EXTENT tmp = Dynarr_at (extarr, j);
2642 Dynarr_at (extarr, j) = Dynarr_at (extarr, j+1);
2643 Dynarr_at (extarr, j+1) = tmp;
2649 /* But some loser programs mess up and may create a large number
2650 of extents overlapping the same spot. This will result in
2651 catastrophic behavior if we use the bubble sort above. */
2652 qsort (Dynarr_atp (extarr, 0), Dynarr_length (extarr),
2653 sizeof (EXTENT), extent_priority_sort_function);
2656 /* If PROP is the `invisible' property of an extent,
2657 this is 1 if the extent should be treated as invisible. */
2659 #define EXTENT_PROP_MEANS_INVISIBLE(buf, prop) \
2660 (EQ (buf->invisibility_spec, Qt) \
2662 : invisible_p (prop, buf->invisibility_spec))
2664 /* If PROP is the `invisible' property of a extent,
2665 this is 1 if the extent should be treated as invisible
2666 and should have an ellipsis. */
2668 #define EXTENT_PROP_MEANS_INVISIBLE_WITH_ELLIPSIS(buf, prop) \
2669 (EQ (buf->invisibility_spec, Qt) \
2671 : invisible_ellipsis_p (prop, buf->invisibility_spec))
2673 /* This is like a combination of memq and assq.
2674 Return 1 if PROPVAL appears as an element of LIST
2675 or as the car of an element of LIST.
2676 If PROPVAL is a list, compare each element against LIST
2677 in that way, and return 1 if any element of PROPVAL is found in LIST.
2679 This function cannot quit. */
2682 invisible_p (REGISTER Lisp_Object propval, Lisp_Object list)
2684 REGISTER Lisp_Object tail, proptail;
2685 for (tail = list; CONSP (tail); tail = XCDR (tail))
2687 REGISTER Lisp_Object tem;
2689 if (EQ (propval, tem))
2691 if (CONSP (tem) && EQ (propval, XCAR (tem)))
2694 if (CONSP (propval))
2695 for (proptail = propval; CONSP (proptail);
2696 proptail = XCDR (proptail))
2698 Lisp_Object propelt;
2699 propelt = XCAR (proptail);
2700 for (tail = list; CONSP (tail); tail = XCDR (tail))
2702 REGISTER Lisp_Object tem;
2704 if (EQ (propelt, tem))
2706 if (CONSP (tem) && EQ (propelt, XCAR (tem)))
2713 /* Return 1 if PROPVAL appears as the car of an element of LIST
2714 and the cdr of that element is non-nil.
2715 If PROPVAL is a list, check each element of PROPVAL in that way,
2716 and the first time some element is found,
2717 return 1 if the cdr of that element is non-nil.
2719 This function cannot quit. */
2722 invisible_ellipsis_p (REGISTER Lisp_Object propval, Lisp_Object list)
2724 REGISTER Lisp_Object tail, proptail;
2725 for (tail = list; CONSP (tail); tail = XCDR (tail))
2727 REGISTER Lisp_Object tem;
2729 if (CONSP (tem) && EQ (propval, XCAR (tem)))
2730 return ! NILP (XCDR (tem));
2732 if (CONSP (propval))
2733 for (proptail = propval; CONSP (proptail);
2734 proptail = XCDR (proptail))
2736 Lisp_Object propelt;
2737 propelt = XCAR (proptail);
2738 for (tail = list; CONSP (tail); tail = XCDR (tail))
2740 REGISTER Lisp_Object tem;
2742 if (CONSP (tem) && EQ (propelt, XCAR (tem)))
2743 return ! NILP (XCDR (tem));
2750 extent_fragment_update (struct window *w, struct extent_fragment *ef,
2755 buffer_or_string_stack_of_extents_force (ef->object)->extents;
2757 struct extent dummy_lhe_extent;
2758 Memind mempos = buffer_or_string_bytind_to_memind (ef->object, pos);
2760 #ifdef ERROR_CHECK_EXTENTS
2761 assert (pos >= buffer_or_string_accessible_begin_byte (ef->object)
2762 && pos <= buffer_or_string_accessible_end_byte (ef->object));
2765 Dynarr_reset (ef->extents);
2766 Dynarr_reset (ef->begin_glyphs);
2767 Dynarr_reset (ef->end_glyphs);
2769 ef->previously_invisible = ef->invisible;
2772 if (ef->invisible_ellipses)
2773 ef->invisible_ellipses_already_displayed = 1;
2776 ef->invisible_ellipses_already_displayed = 0;
2778 ef->invisible_ellipses = 0;
2780 /* Set up the begin and end positions. */
2782 ef->end = extent_find_end_of_run (ef->object, pos, 0);
2784 /* Note that extent_find_end_of_run() already moved the SOE for us. */
2785 /* soe_move (ef->object, mempos); */
2787 /* Determine the begin glyphs at POS. */
2788 for (i = 0; i < extent_list_num_els (sel); i++)
2790 EXTENT e = extent_list_at (sel, i, 0);
2791 if (extent_start (e) == mempos && !NILP (extent_begin_glyph (e)))
2793 Lisp_Object glyph = extent_begin_glyph (e);
2794 struct glyph_block gb;
2797 XSETEXTENT (gb.extent, e);
2798 Dynarr_add (ef->begin_glyphs, gb);
2802 /* Determine the end glyphs at POS. */
2803 for (i = 0; i < extent_list_num_els (sel); i++)
2805 EXTENT e = extent_list_at (sel, i, 1);
2806 if (extent_end (e) == mempos && !NILP (extent_end_glyph (e)))
2808 Lisp_Object glyph = extent_end_glyph (e);
2809 struct glyph_block gb;
2812 XSETEXTENT (gb.extent, e);
2813 Dynarr_add (ef->end_glyphs, gb);
2817 /* We tried determining all the charsets used in the run here,
2818 but that fails even if we only do the current line -- display
2819 tables or non-printable characters might cause other charsets
2822 /* Determine whether the last-highlighted-extent is present. */
2823 if (EXTENTP (Vlast_highlighted_extent))
2824 lhe = XEXTENT (Vlast_highlighted_extent);
2826 /* Now add all extents that overlap the character after POS and
2827 have a non-nil face. Also check if the character is invisible. */
2828 for (i = 0; i < extent_list_num_els (sel); i++)
2830 EXTENT e = extent_list_at (sel, i, 0);
2831 if (extent_end (e) > mempos)
2833 Lisp_Object invis_prop = extent_invisible (e);
2835 if (!NILP (invis_prop))
2837 if (!BUFFERP (ef->object))
2838 /* #### no `string-invisibility-spec' */
2842 if (!ef->invisible_ellipses_already_displayed &&
2843 EXTENT_PROP_MEANS_INVISIBLE_WITH_ELLIPSIS
2844 (XBUFFER (ef->object), invis_prop))
2847 ef->invisible_ellipses = 1;
2849 else if (EXTENT_PROP_MEANS_INVISIBLE
2850 (XBUFFER (ef->object), invis_prop))
2855 /* Remember that one of the extents in the list might be our
2856 dummy extent representing the highlighting that is
2857 attached to some other extent that is currently
2858 mouse-highlighted. When an extent is mouse-highlighted,
2859 it is as if there are two extents there, of potentially
2860 different priorities: the extent being highlighted, with
2861 whatever face and priority it has; and an ephemeral
2862 extent in the `mouse-face' face with
2863 `mouse-highlight-priority'.
2866 if (!NILP (extent_face (e)))
2867 Dynarr_add (ef->extents, e);
2871 /* zeroing isn't really necessary; we only deref `priority'
2873 xzero (dummy_lhe_extent);
2874 set_extent_priority (&dummy_lhe_extent,
2875 mouse_highlight_priority);
2876 /* Need to break up the following expression, due to an */
2877 /* error in the Digital UNIX 3.2g C compiler (Digital */
2878 /* UNIX Compiler Driver 3.11). */
2879 f = extent_mouse_face (lhe);
2880 extent_face (&dummy_lhe_extent) = f;
2881 Dynarr_add (ef->extents, &dummy_lhe_extent);
2883 /* since we are looping anyway, we might as well do this here */
2884 if ((!NILP(extent_initial_redisplay_function (e))) &&
2885 !extent_in_red_event_p(e))
2887 Lisp_Object function = extent_initial_redisplay_function (e);
2890 /* printf ("initial redisplay function called!\n "); */
2892 /* print_extent_2 (e);
2895 /* FIXME: One should probably inhibit the displaying of
2896 this extent to reduce flicker */
2897 extent_in_red_event_p(e) = 1;
2899 /* call the function */
2902 Fenqueue_eval_event(function,obj);
2907 extent_fragment_sort_by_priority (ef->extents);
2909 /* Now merge the faces together into a single face. The code to
2910 do this is in faces.c because it involves manipulating faces. */
2911 return get_extent_fragment_face_cache_index (w, ef);
2915 /************************************************************************/
2916 /* extent-object methods */
2917 /************************************************************************/
2919 /* These are the basic helper functions for handling the allocation of
2920 extent objects. They are similar to the functions for other
2921 lrecord objects. allocate_extent() is in alloc.c, not here. */
2924 mark_extent (Lisp_Object obj)
2926 struct extent *extent = XEXTENT (obj);
2928 mark_object (extent_object (extent));
2929 mark_object (extent_no_chase_normal_field (extent, face));
2930 return extent->plist;
2934 print_extent_1 (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
2936 EXTENT ext = XEXTENT (obj);
2937 EXTENT anc = extent_ancestor (ext);
2939 char buf[64], *bp = buf;
2941 /* Retrieve the ancestor and use it, for faster retrieval of properties */
2943 if (!NILP (extent_begin_glyph (anc))) *bp++ = '*';
2944 *bp++ = (extent_start_open_p (anc) ? '(': '[');
2945 if (extent_detached_p (ext))
2946 strcpy (bp, "detached");
2948 sprintf (bp, "%ld, %ld",
2949 (long) XINT (Fextent_start_position (obj)),
2950 (long) XINT (Fextent_end_position (obj)));
2952 *bp++ = (extent_end_open_p (anc) ? ')': ']');
2953 if (!NILP (extent_end_glyph (anc))) *bp++ = '*';
2956 if (!NILP (extent_read_only (anc))) *bp++ = '%';
2957 if (!NILP (extent_mouse_face (anc))) *bp++ = 'H';
2958 if (extent_unique_p (anc)) *bp++ = 'U';
2959 else if (extent_duplicable_p (anc)) *bp++ = 'D';
2960 if (!NILP (extent_invisible (anc))) *bp++ = 'I';
2962 if (!NILP (extent_read_only (anc)) || !NILP (extent_mouse_face (anc)) ||
2963 extent_unique_p (anc) ||
2964 extent_duplicable_p (anc) || !NILP (extent_invisible (anc)))
2967 write_c_string (buf, printcharfun);
2969 tail = extent_plist_slot (anc);
2971 for (; !NILP (tail); tail = Fcdr (Fcdr (tail)))
2973 Lisp_Object v = XCAR (XCDR (tail));
2974 if (NILP (v)) continue;
2975 print_internal (XCAR (tail), printcharfun, escapeflag);
2976 write_c_string (" ", printcharfun);
2979 sprintf (buf, "0x%lx", (long) ext);
2980 write_c_string (buf, printcharfun);
2984 print_extent (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
2988 const char *title = "";
2989 const char *name = "";
2990 const char *posttitle = "";
2991 Lisp_Object obj2 = Qnil;
2993 /* Destroyed extents have 't' in the object field, causing
2994 extent_object() to abort (maybe). */
2995 if (EXTENT_LIVE_P (XEXTENT (obj)))
2996 obj2 = extent_object (XEXTENT (obj));
2999 title = "no buffer";
3000 else if (BUFFERP (obj2))
3002 if (BUFFER_LIVE_P (XBUFFER (obj2)))
3005 name = (char *) XSTRING_DATA (XBUFFER (obj2)->name);
3009 title = "Killed Buffer";
3015 assert (STRINGP (obj2));
3016 title = "string \"";
3018 name = (char *) XSTRING_DATA (obj2);
3023 if (!EXTENT_LIVE_P (XEXTENT (obj)))
3024 error ("printing unreadable object #<destroyed extent>");
3026 error ("printing unreadable object #<extent 0x%lx>",
3027 (long) XEXTENT (obj));
3030 if (!EXTENT_LIVE_P (XEXTENT (obj)))
3031 write_c_string ("#<destroyed extent", printcharfun);
3034 char *buf = (char *)
3035 alloca (strlen (title) + strlen (name) + strlen (posttitle) + 1);
3036 write_c_string ("#<extent ", printcharfun);
3037 print_extent_1 (obj, printcharfun, escapeflag);
3038 write_c_string (extent_detached_p (XEXTENT (obj))
3039 ? " from " : " in ", printcharfun);
3040 sprintf (buf, "%s%s%s", title, name, posttitle);
3041 write_c_string (buf, printcharfun);
3047 error ("printing unreadable object #<extent>");
3048 write_c_string ("#<extent", printcharfun);
3050 write_c_string (">", printcharfun);
3054 properties_equal (EXTENT e1, EXTENT e2, int depth)
3056 /* When this function is called, all indirections have been followed.
3057 Thus, the indirection checks in the various macros below will not
3058 amount to anything, and could be removed. However, the time
3059 savings would probably not be significant. */
3060 if (!(EQ (extent_face (e1), extent_face (e2)) &&
3061 extent_priority (e1) == extent_priority (e2) &&
3062 internal_equal (extent_begin_glyph (e1), extent_begin_glyph (e2),
3064 internal_equal (extent_end_glyph (e1), extent_end_glyph (e2),
3068 /* compare the bit flags. */
3070 /* The has_aux field should not be relevant. */
3071 int e1_has_aux = e1->flags.has_aux;
3072 int e2_has_aux = e2->flags.has_aux;
3075 e1->flags.has_aux = e2->flags.has_aux = 0;
3076 value = memcmp (&e1->flags, &e2->flags, sizeof (e1->flags));
3077 e1->flags.has_aux = e1_has_aux;
3078 e2->flags.has_aux = e2_has_aux;
3083 /* compare the random elements of the plists. */
3084 return !plists_differ (extent_no_chase_plist (e1),
3085 extent_no_chase_plist (e2),
3090 extent_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
3092 struct extent *e1 = XEXTENT (obj1);
3093 struct extent *e2 = XEXTENT (obj2);
3095 (extent_start (e1) == extent_start (e2) &&
3096 extent_end (e1) == extent_end (e2) &&
3097 internal_equal (extent_object (e1), extent_object (e2), depth + 1) &&
3098 properties_equal (extent_ancestor (e1), extent_ancestor (e2),
3102 static unsigned long
3103 extent_hash (Lisp_Object obj, int depth)
3105 struct extent *e = XEXTENT (obj);
3106 /* No need to hash all of the elements; that would take too long.
3107 Just hash the most common ones. */
3108 return HASH3 (extent_start (e), extent_end (e),
3109 internal_hash (extent_object (e), depth + 1));
3112 static const struct lrecord_description extent_description[] = {
3113 { XD_LISP_OBJECT, offsetof (struct extent, object) },
3114 { XD_LISP_OBJECT, offsetof (struct extent, flags.face) },
3115 { XD_LISP_OBJECT, offsetof (struct extent, plist) },
3120 extent_getprop (Lisp_Object obj, Lisp_Object prop)
3122 return Fextent_property (obj, prop, Qunbound);
3126 extent_putprop (Lisp_Object obj, Lisp_Object prop, Lisp_Object value)
3128 Fset_extent_property (obj, prop, value);
3133 extent_remprop (Lisp_Object obj, Lisp_Object prop)
3135 EXTENT ext = XEXTENT (obj);
3137 /* This list is taken from Fset_extent_property, and should be kept
3139 if (EQ (prop, Qread_only)
3140 || EQ (prop, Qunique)
3141 || EQ (prop, Qduplicable)
3142 || EQ (prop, Qinvisible)
3143 || EQ (prop, Qdetachable)
3144 || EQ (prop, Qdetached)
3145 || EQ (prop, Qdestroyed)
3146 || EQ (prop, Qpriority)
3148 || EQ (prop, Qinitial_redisplay_function)
3149 || EQ (prop, Qafter_change_functions)
3150 || EQ (prop, Qbefore_change_functions)
3151 || EQ (prop, Qmouse_face)
3152 || EQ (prop, Qhighlight)
3153 || EQ (prop, Qbegin_glyph_layout)
3154 || EQ (prop, Qend_glyph_layout)
3155 || EQ (prop, Qglyph_layout)
3156 || EQ (prop, Qbegin_glyph)
3157 || EQ (prop, Qend_glyph)
3158 || EQ (prop, Qstart_open)
3159 || EQ (prop, Qend_open)
3160 || EQ (prop, Qstart_closed)
3161 || EQ (prop, Qend_closed)
3162 || EQ (prop, Qkeymap))
3164 /* #### Is this correct, anyway? */
3168 return external_remprop (extent_plist_addr (ext), prop, 0, ERROR_ME);
3172 extent_plist (Lisp_Object obj)
3174 return Fextent_properties (obj);
3177 DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS ("extent", extent,
3180 /* NOTE: If you declare a
3181 finalization method here,
3182 it will NOT be called.
3185 extent_equal, extent_hash,
3187 extent_getprop, extent_putprop,
3188 extent_remprop, extent_plist,
3192 /************************************************************************/
3193 /* basic extent accessors */
3194 /************************************************************************/
3196 /* These functions are for checking externally-passed extent objects
3197 and returning an extent's basic properties, which include the
3198 buffer the extent is associated with, the endpoints of the extent's
3199 range, the open/closed-ness of those endpoints, and whether the
3200 extent is detached. Manipulating these properties requires
3201 manipulating the ordered lists that hold extents; thus, functions
3202 to do that are in a later section. */
3204 /* Given a Lisp_Object that is supposed to be an extent, make sure it
3205 is OK and return an extent pointer. Extents can be in one of four
3209 2) detached and not associated with a buffer
3210 3) detached and associated with a buffer
3211 4) attached to a buffer
3213 If FLAGS is 0, types 2-4 are allowed. If FLAGS is DE_MUST_HAVE_BUFFER,
3214 types 3-4 are allowed. If FLAGS is DE_MUST_BE_ATTACHED, only type 4
3219 decode_extent (Lisp_Object extent_obj, unsigned int flags)
3224 CHECK_LIVE_EXTENT (extent_obj);
3225 extent = XEXTENT (extent_obj);
3226 obj = extent_object (extent);
3228 /* the following condition will fail if we're dealing with a freed extent */
3229 assert (NILP (obj) || BUFFERP (obj) || STRINGP (obj));
3231 if (flags & DE_MUST_BE_ATTACHED)
3232 flags |= DE_MUST_HAVE_BUFFER;
3234 /* if buffer is dead, then convert extent to have no buffer. */
3235 if (BUFFERP (obj) && !BUFFER_LIVE_P (XBUFFER (obj)))
3236 obj = extent_object (extent) = Qnil;
3238 assert (!NILP (obj) || extent_detached_p (extent));
3240 if ((NILP (obj) && (flags & DE_MUST_HAVE_BUFFER))
3241 || (extent_detached_p (extent) && (flags & DE_MUST_BE_ATTACHED)))
3243 signal_simple_error ("extent doesn't belong to a buffer or string",
3250 /* Note that the returned value is a buffer position, not a byte index. */
3253 extent_endpoint_external (Lisp_Object extent_obj, int endp)
3255 EXTENT extent = decode_extent (extent_obj, 0);
3257 if (extent_detached_p (extent))
3260 return make_int (extent_endpoint_bufpos (extent, endp));
3263 DEFUN ("extentp", Fextentp, 1, 1, 0, /*
3264 Return t if OBJECT is an extent.
3268 return EXTENTP (object) ? Qt : Qnil;
3271 DEFUN ("extent-live-p", Fextent_live_p, 1, 1, 0, /*
3272 Return t if OBJECT is an extent that has not been destroyed.
3276 return EXTENTP (object) && EXTENT_LIVE_P (XEXTENT (object)) ? Qt : Qnil;
3279 DEFUN ("extent-detached-p", Fextent_detached_p, 1, 1, 0, /*
3280 Return t if EXTENT is detached.
3284 return extent_detached_p (decode_extent (extent, 0)) ? Qt : Qnil;
3287 DEFUN ("extent-object", Fextent_object, 1, 1, 0, /*
3288 Return object (buffer or string) that EXTENT refers to.
3292 return extent_object (decode_extent (extent, 0));
3295 DEFUN ("extent-start-position", Fextent_start_position, 1, 1, 0, /*
3296 Return start position of EXTENT, or nil if EXTENT is detached.
3300 return extent_endpoint_external (extent, 0);
3303 DEFUN ("extent-end-position", Fextent_end_position, 1, 1, 0, /*
3304 Return end position of EXTENT, or nil if EXTENT is detached.
3308 return extent_endpoint_external (extent, 1);
3311 DEFUN ("extent-length", Fextent_length, 1, 1, 0, /*
3312 Return length of EXTENT in characters.
3316 EXTENT e = decode_extent (extent, DE_MUST_BE_ATTACHED);
3317 return make_int (extent_endpoint_bufpos (e, 1)
3318 - extent_endpoint_bufpos (e, 0));
3321 DEFUN ("next-extent", Fnext_extent, 1, 1, 0, /*
3322 Find next extent after EXTENT.
3323 If EXTENT is a buffer return the first extent in the buffer; likewise
3325 Extents in a buffer are ordered in what is called the "display"
3326 order, which sorts by increasing start positions and then by *decreasing*
3328 If you want to perform an operation on a series of extents, use
3329 `map-extents' instead of this function; it is much more efficient.
3330 The primary use of this function should be to enumerate all the
3331 extents in a buffer.
3332 Note: The display order is not necessarily the order that `map-extents'
3333 processes extents in!
3340 if (EXTENTP (extent))
3341 next = extent_next (decode_extent (extent, DE_MUST_BE_ATTACHED));
3343 next = extent_first (decode_buffer_or_string (extent));
3347 XSETEXTENT (val, next);
3351 DEFUN ("previous-extent", Fprevious_extent, 1, 1, 0, /*
3352 Find last extent before EXTENT.
3353 If EXTENT is a buffer return the last extent in the buffer; likewise
3355 This function is analogous to `next-extent'.
3362 if (EXTENTP (extent))
3363 prev = extent_previous (decode_extent (extent, DE_MUST_BE_ATTACHED));
3365 prev = extent_last (decode_buffer_or_string (extent));
3369 XSETEXTENT (val, prev);
3375 DEFUN ("next-e-extent", Fnext_e_extent, 1, 1, 0, /*
3376 Find next extent after EXTENT using the "e" order.
3377 If EXTENT is a buffer return the first extent in the buffer; likewise
3385 if (EXTENTP (extent))
3386 next = extent_e_next (decode_extent (extent, DE_MUST_BE_ATTACHED));
3388 next = extent_e_first (decode_buffer_or_string (extent));
3392 XSETEXTENT (val, next);
3396 DEFUN ("previous-e-extent", Fprevious_e_extent, 1, 1, 0, /*
3397 Find last extent before EXTENT using the "e" order.
3398 If EXTENT is a buffer return the last extent in the buffer; likewise
3400 This function is analogous to `next-e-extent'.
3407 if (EXTENTP (extent))
3408 prev = extent_e_previous (decode_extent (extent, DE_MUST_BE_ATTACHED));
3410 prev = extent_e_last (decode_buffer_or_string (extent));
3414 XSETEXTENT (val, prev);
3420 DEFUN ("next-extent-change", Fnext_extent_change, 1, 2, 0, /*
3421 Return the next position after POS where an extent begins or ends.
3422 If POS is at the end of the buffer or string, POS will be returned;
3423 otherwise a position greater than POS will always be returned.
3424 If BUFFER is nil, the current buffer is assumed.
3428 Lisp_Object obj = decode_buffer_or_string (object);
3431 bpos = get_buffer_or_string_pos_byte (obj, pos, GB_ALLOW_PAST_ACCESSIBLE);
3432 bpos = extent_find_end_of_run (obj, bpos, 1);
3433 return make_int (buffer_or_string_bytind_to_bufpos (obj, bpos));
3436 DEFUN ("previous-extent-change", Fprevious_extent_change, 1, 2, 0, /*
3437 Return the last position before POS where an extent begins or ends.
3438 If POS is at the beginning of the buffer or string, POS will be returned;
3439 otherwise a position less than POS will always be returned.
3440 If OBJECT is nil, the current buffer is assumed.
3444 Lisp_Object obj = decode_buffer_or_string (object);
3447 bpos = get_buffer_or_string_pos_byte (obj, pos, GB_ALLOW_PAST_ACCESSIBLE);
3448 bpos = extent_find_beginning_of_run (obj, bpos, 1);
3449 return make_int (buffer_or_string_bytind_to_bufpos (obj, bpos));
3453 /************************************************************************/
3454 /* parent and children stuff */
3455 /************************************************************************/
3457 DEFUN ("extent-parent", Fextent_parent, 1, 1, 0, /*
3458 Return the parent (if any) of EXTENT.
3459 If an extent has a parent, it derives all its properties from that extent
3460 and has no properties of its own. (The only "properties" that the
3461 extent keeps are the buffer/string it refers to and the start and end
3462 points.) It is possible for an extent's parent to itself have a parent.
3465 /* do I win the prize for the strangest split infinitive? */
3467 EXTENT e = decode_extent (extent, 0);
3468 return extent_parent (e);
3471 DEFUN ("extent-children", Fextent_children, 1, 1, 0, /*
3472 Return a list of the children (if any) of EXTENT.
3473 The children of an extent are all those extents whose parent is that extent.
3474 This function does not recursively trace children of children.
3475 \(To do that, use `extent-descendants'.)
3479 EXTENT e = decode_extent (extent, 0);
3480 Lisp_Object children = extent_children (e);
3482 if (!NILP (children))
3483 return Fcopy_sequence (XWEAK_LIST_LIST (children));
3489 remove_extent_from_children_list (EXTENT e, Lisp_Object child)
3491 Lisp_Object children = extent_children (e);
3493 #ifdef ERROR_CHECK_EXTENTS
3494 assert (!NILP (memq_no_quit (child, XWEAK_LIST_LIST (children))));
3496 XWEAK_LIST_LIST (children) =
3497 delq_no_quit (child, XWEAK_LIST_LIST (children));
3501 add_extent_to_children_list (EXTENT e, Lisp_Object child)
3503 Lisp_Object children = extent_children (e);
3505 if (NILP (children))
3507 children = make_weak_list (WEAK_LIST_SIMPLE);
3508 set_extent_no_chase_aux_field (e, children, children);
3511 #ifdef ERROR_CHECK_EXTENTS
3512 assert (NILP (memq_no_quit (child, XWEAK_LIST_LIST (children))));
3514 XWEAK_LIST_LIST (children) = Fcons (child, XWEAK_LIST_LIST (children));
3517 DEFUN ("set-extent-parent", Fset_extent_parent, 2, 2, 0, /*
3518 Set the parent of EXTENT to PARENT (may be nil).
3519 See `extent-parent'.
3523 EXTENT e = decode_extent (extent, 0);
3524 Lisp_Object cur_parent = extent_parent (e);
3527 XSETEXTENT (extent, e);
3529 CHECK_LIVE_EXTENT (parent);
3530 if (EQ (parent, cur_parent))
3532 for (rest = parent; !NILP (rest); rest = extent_parent (XEXTENT (rest)))
3533 if (EQ (rest, extent))
3534 signal_simple_error ("Circular parent chain would result", extent);
3537 remove_extent_from_children_list (XEXTENT (cur_parent), extent);
3538 set_extent_no_chase_aux_field (e, parent, Qnil);
3539 e->flags.has_parent = 0;
3543 add_extent_to_children_list (XEXTENT (parent), extent);
3544 set_extent_no_chase_aux_field (e, parent, parent);
3545 e->flags.has_parent = 1;
3547 /* changing the parent also changes the properties of all children. */
3549 int old_invis = (!NILP (cur_parent) &&
3550 !NILP (extent_invisible (XEXTENT (cur_parent))));
3551 int new_invis = (!NILP (parent) &&
3552 !NILP (extent_invisible (XEXTENT (parent))));
3554 extent_maybe_changed_for_redisplay (e, 1, new_invis != old_invis);
3561 /************************************************************************/
3562 /* basic extent mutators */
3563 /************************************************************************/
3565 /* Note: If you track non-duplicable extents by undo, you'll get bogus
3566 undo records for transient extents via update-extent.
3567 For example, query-replace will do this.
3571 set_extent_endpoints_1 (EXTENT extent, Memind start, Memind end)
3573 #ifdef ERROR_CHECK_EXTENTS
3574 Lisp_Object obj = extent_object (extent);
3576 assert (start <= end);
3579 assert (valid_memind_p (XBUFFER (obj), start));
3580 assert (valid_memind_p (XBUFFER (obj), end));
3584 /* Optimization: if the extent is already where we want it to be,
3586 if (!extent_detached_p (extent) && extent_start (extent) == start &&
3587 extent_end (extent) == end)
3590 if (extent_detached_p (extent))
3592 if (extent_duplicable_p (extent))
3594 Lisp_Object extent_obj;
3595 XSETEXTENT (extent_obj, extent);
3596 record_extent (extent_obj, 1);
3600 extent_detach (extent);
3602 set_extent_start (extent, start);
3603 set_extent_end (extent, end);
3604 extent_attach (extent);
3607 /* Set extent's endpoints to S and E, and put extent in buffer or string
3608 OBJECT. (If OBJECT is nil, do not change the extent's object.) */
3611 set_extent_endpoints (EXTENT extent, Bytind s, Bytind e, Lisp_Object object)
3617 object = extent_object (extent);
3618 assert (!NILP (object));
3620 else if (!EQ (object, extent_object (extent)))
3622 extent_detach (extent);
3623 extent_object (extent) = object;
3626 start = s < 0 ? extent_start (extent) :
3627 buffer_or_string_bytind_to_memind (object, s);
3628 end = e < 0 ? extent_end (extent) :
3629 buffer_or_string_bytind_to_memind (object, e);
3630 set_extent_endpoints_1 (extent, start, end);
3634 set_extent_openness (EXTENT extent, int start_open, int end_open)
3636 if (start_open != -1)
3637 extent_start_open_p (extent) = start_open;
3639 extent_end_open_p (extent) = end_open;
3640 /* changing the open/closedness of an extent does not affect
3645 make_extent_internal (Lisp_Object object, Bytind from, Bytind to)
3649 extent = make_extent_detached (object);
3650 set_extent_endpoints (extent, from, to, Qnil);
3655 copy_extent (EXTENT original, Bytind from, Bytind to, Lisp_Object object)
3659 e = make_extent_detached (object);
3661 set_extent_endpoints (e, from, to, Qnil);
3663 e->plist = Fcopy_sequence (original->plist);
3664 memcpy (&e->flags, &original->flags, sizeof (e->flags));
3665 if (e->flags.has_aux)
3667 /* also need to copy the aux struct. It won't work for
3668 this extent to share the same aux struct as the original
3670 struct extent_auxiliary *data =
3671 alloc_lcrecord_type (struct extent_auxiliary,
3672 &lrecord_extent_auxiliary);
3674 copy_lcrecord (data, XEXTENT_AUXILIARY (XCAR (original->plist)));
3675 XSETEXTENT_AUXILIARY (XCAR (e->plist), data);
3679 /* we may have just added another child to the parent extent. */
3680 Lisp_Object parent = extent_parent (e);
3684 XSETEXTENT (extent, e);
3685 add_extent_to_children_list (XEXTENT (parent), extent);
3693 destroy_extent (EXTENT extent)
3695 Lisp_Object rest, nextrest, children;
3696 Lisp_Object extent_obj;
3698 if (!extent_detached_p (extent))
3699 extent_detach (extent);
3700 /* disassociate the extent from its children and parent */
3701 children = extent_children (extent);
3702 if (!NILP (children))
3704 LIST_LOOP_DELETING (rest, nextrest, XWEAK_LIST_LIST (children))
3705 Fset_extent_parent (XCAR (rest), Qnil);
3707 XSETEXTENT (extent_obj, extent);
3708 Fset_extent_parent (extent_obj, Qnil);
3709 /* mark the extent as destroyed */
3710 extent_object (extent) = Qt;
3713 DEFUN ("make-extent", Fmake_extent, 2, 3, 0, /*
3714 Make an extent for the range [FROM, TO) in BUFFER-OR-STRING.
3715 BUFFER-OR-STRING defaults to the current buffer. Insertions at point
3716 TO will be outside of the extent; insertions at FROM will be inside the
3717 extent, causing the extent to grow. (This is the same way that markers
3718 behave.) You can change the behavior of insertions at the endpoints
3719 using `set-extent-property'. The extent is initially detached if both
3720 FROM and TO are nil, and in this case BUFFER-OR-STRING defaults to nil,
3721 meaning the extent is in no buffer and no string.
3723 (from, to, buffer_or_string))
3725 Lisp_Object extent_obj;
3728 obj = decode_buffer_or_string (buffer_or_string);
3729 if (NILP (from) && NILP (to))
3731 if (NILP (buffer_or_string))
3733 XSETEXTENT (extent_obj, make_extent_detached (obj));
3739 get_buffer_or_string_range_byte (obj, from, to, &start, &end,
3740 GB_ALLOW_PAST_ACCESSIBLE);
3741 XSETEXTENT (extent_obj, make_extent_internal (obj, start, end));
3746 DEFUN ("copy-extent", Fcopy_extent, 1, 2, 0, /*
3747 Make a copy of EXTENT. It is initially detached.
3748 Optional argument BUFFER-OR-STRING defaults to EXTENT's buffer or string.
3750 (extent, buffer_or_string))
3752 EXTENT ext = decode_extent (extent, 0);
3754 if (NILP (buffer_or_string))
3755 buffer_or_string = extent_object (ext);
3757 buffer_or_string = decode_buffer_or_string (buffer_or_string);
3759 XSETEXTENT (extent, copy_extent (ext, -1, -1, buffer_or_string));
3763 DEFUN ("delete-extent", Fdelete_extent, 1, 1, 0, /*
3764 Remove EXTENT from its buffer and destroy it.
3765 This does not modify the buffer's text, only its display properties.
3766 The extent cannot be used thereafter.
3772 /* We do not call decode_extent() here because already-destroyed
3774 CHECK_EXTENT (extent);
3775 ext = XEXTENT (extent);
3777 if (!EXTENT_LIVE_P (ext))
3779 destroy_extent (ext);
3783 DEFUN ("detach-extent", Fdetach_extent, 1, 1, 0, /*
3784 Remove EXTENT from its buffer in such a way that it can be re-inserted.
3785 An extent is also detached when all of its characters are all killed by a
3786 deletion, unless its `detachable' property has been unset.
3788 Extents which have the `duplicable' attribute are tracked by the undo
3789 mechanism. Detachment via `detach-extent' and string deletion is recorded,
3790 as is attachment via `insert-extent' and string insertion. Extent motion,
3791 face changes, and attachment via `make-extent' and `set-extent-endpoints'
3792 are not recorded. This means that extent changes which are to be undo-able
3793 must be performed by character editing, or by insertion and detachment of
3798 EXTENT ext = decode_extent (extent, 0);
3800 if (extent_detached_p (ext))
3802 if (extent_duplicable_p (ext))
3803 record_extent (extent, 0);
3804 extent_detach (ext);
3809 DEFUN ("set-extent-endpoints", Fset_extent_endpoints, 3, 4, 0, /*
3810 Set the endpoints of EXTENT to START, END.
3811 If START and END are null, call detach-extent on EXTENT.
3812 BUFFER-OR-STRING specifies the new buffer or string that the extent should
3813 be in, and defaults to EXTENT's buffer or string. (If nil, and EXTENT
3814 is in no buffer and no string, it defaults to the current buffer.)
3815 See documentation on `detach-extent' for a discussion of undo recording.
3817 (extent, start, end, buffer_or_string))
3822 ext = decode_extent (extent, 0);
3824 if (NILP (buffer_or_string))
3826 buffer_or_string = extent_object (ext);
3827 if (NILP (buffer_or_string))
3828 buffer_or_string = Fcurrent_buffer ();
3831 buffer_or_string = decode_buffer_or_string (buffer_or_string);
3833 if (NILP (start) && NILP (end))
3834 return Fdetach_extent (extent);
3836 get_buffer_or_string_range_byte (buffer_or_string, start, end, &s, &e,
3837 GB_ALLOW_PAST_ACCESSIBLE);
3839 set_extent_endpoints (ext, s, e, buffer_or_string);
3844 /************************************************************************/
3845 /* mapping over extents */
3846 /************************************************************************/
3849 decode_map_extents_flags (Lisp_Object flags)
3851 unsigned int retval = 0;
3852 unsigned int all_extents_specified = 0;
3853 unsigned int in_region_specified = 0;
3855 if (EQ (flags, Qt)) /* obsoleteness compatibility */
3856 return ME_END_CLOSED;
3859 if (SYMBOLP (flags))
3860 flags = Fcons (flags, Qnil);
3861 while (!NILP (flags))
3867 if (EQ (sym, Qall_extents_closed) || EQ (sym, Qall_extents_open) ||
3868 EQ (sym, Qall_extents_closed_open) ||
3869 EQ (sym, Qall_extents_open_closed))
3871 if (all_extents_specified)
3872 error ("Only one `all-extents-*' flag may be specified");
3873 all_extents_specified = 1;
3875 if (EQ (sym, Qstart_in_region) || EQ (sym, Qend_in_region) ||
3876 EQ (sym, Qstart_and_end_in_region) ||
3877 EQ (sym, Qstart_or_end_in_region))
3879 if (in_region_specified)
3880 error ("Only one `*-in-region' flag may be specified");
3881 in_region_specified = 1;
3884 /* I do so love that conditional operator ... */
3886 EQ (sym, Qend_closed) ? ME_END_CLOSED :
3887 EQ (sym, Qstart_open) ? ME_START_OPEN :
3888 EQ (sym, Qall_extents_closed) ? ME_ALL_EXTENTS_CLOSED :
3889 EQ (sym, Qall_extents_open) ? ME_ALL_EXTENTS_OPEN :
3890 EQ (sym, Qall_extents_closed_open) ? ME_ALL_EXTENTS_CLOSED_OPEN :
3891 EQ (sym, Qall_extents_open_closed) ? ME_ALL_EXTENTS_OPEN_CLOSED :
3892 EQ (sym, Qstart_in_region) ? ME_START_IN_REGION :
3893 EQ (sym, Qend_in_region) ? ME_END_IN_REGION :
3894 EQ (sym, Qstart_and_end_in_region) ? ME_START_AND_END_IN_REGION :
3895 EQ (sym, Qstart_or_end_in_region) ? ME_START_OR_END_IN_REGION :
3896 EQ (sym, Qnegate_in_region) ? ME_NEGATE_IN_REGION :
3897 (signal_simple_error ("Invalid `map-extents' flag", sym), 0);
3899 flags = XCDR (flags);
3904 DEFUN ("extent-in-region-p", Fextent_in_region_p, 1, 4, 0, /*
3905 Return whether EXTENT overlaps a specified region.
3906 This is equivalent to whether `map-extents' would visit EXTENT when called
3909 (extent, from, to, flags))
3912 EXTENT ext = decode_extent (extent, DE_MUST_BE_ATTACHED);
3913 Lisp_Object obj = extent_object (ext);
3915 get_buffer_or_string_range_byte (obj, from, to, &start, &end, GB_ALLOW_NIL |
3916 GB_ALLOW_PAST_ACCESSIBLE);
3918 return extent_in_region_p (ext, start, end, decode_map_extents_flags (flags)) ?
3922 struct slow_map_extents_arg
3924 Lisp_Object map_arg;
3925 Lisp_Object map_routine;
3927 Lisp_Object property;
3932 slow_map_extents_function (EXTENT extent, void *arg)
3934 /* This function can GC */
3935 struct slow_map_extents_arg *closure = (struct slow_map_extents_arg *) arg;
3936 Lisp_Object extent_obj;
3938 XSETEXTENT (extent_obj, extent);
3940 /* make sure this extent qualifies according to the PROPERTY
3943 if (!NILP (closure->property))
3945 Lisp_Object value = Fextent_property (extent_obj, closure->property,
3947 if ((NILP (closure->value) && NILP (value)) ||
3948 (!NILP (closure->value) && !EQ (value, closure->value)))
3952 closure->result = call2 (closure->map_routine, extent_obj,
3954 return !NILP (closure->result);
3957 DEFUN ("map-extents", Fmap_extents, 1, 8, 0, /*
3958 Map FUNCTION over the extents which overlap a region in OBJECT.
3959 OBJECT is normally a buffer or string but could be an extent (see below).
3960 The region is normally bounded by [FROM, TO) (i.e. the beginning of the
3961 region is closed and the end of the region is open), but this can be
3962 changed with the FLAGS argument (see below for a complete discussion).
3964 FUNCTION is called with the arguments (extent, MAPARG). The arguments
3965 OBJECT, FROM, TO, MAPARG, and FLAGS are all optional and default to
3966 the current buffer, the beginning of OBJECT, the end of OBJECT, nil,
3967 and nil, respectively. `map-extents' returns the first non-nil result
3968 produced by FUNCTION, and no more calls to FUNCTION are made after it
3971 If OBJECT is an extent, FROM and TO default to the extent's endpoints,
3972 and the mapping omits that extent and its predecessors. This feature
3973 supports restarting a loop based on `map-extents'. Note: OBJECT must
3974 be attached to a buffer or string, and the mapping is done over that
3977 An extent overlaps the region if there is any point in the extent that is
3978 also in the region. (For the purpose of overlap, zero-length extents and
3979 regions are treated as closed on both ends regardless of their endpoints'
3980 specified open/closedness.) Note that the endpoints of an extent or region
3981 are considered to be in that extent or region if and only if the
3982 corresponding end is closed. For example, the extent [5,7] overlaps the
3983 region [2,5] because 5 is in both the extent and the region. However, (5,7]
3984 does not overlap [2,5] because 5 is not in the extent, and neither [5,7] nor
3985 \(5,7] overlaps the region [2,5) because 5 is not in the region.
3987 The optional FLAGS can be a symbol or a list of one or more symbols,
3988 modifying the behavior of `map-extents'. Allowed symbols are:
3990 end-closed The region's end is closed.
3992 start-open The region's start is open.
3994 all-extents-closed Treat all extents as closed on both ends for the
3995 purpose of determining whether they overlap the
3996 region, irrespective of their actual open- or
3998 all-extents-open Treat all extents as open on both ends.
3999 all-extents-closed-open Treat all extents as start-closed, end-open.
4000 all-extents-open-closed Treat all extents as start-open, end-closed.
4002 start-in-region In addition to the above conditions for extent
4003 overlap, the extent's start position must lie within
4004 the specified region. Note that, for this
4005 condition, open start positions are treated as if
4006 0.5 was added to the endpoint's value, and open
4007 end positions are treated as if 0.5 was subtracted
4008 from the endpoint's value.
4009 end-in-region The extent's end position must lie within the
4011 start-and-end-in-region Both the extent's start and end positions must lie
4013 start-or-end-in-region Either the extent's start or end position must lie
4016 negate-in-region The condition specified by a `*-in-region' flag
4017 must NOT hold for the extent to be considered.
4020 At most one of `all-extents-closed', `all-extents-open',
4021 `all-extents-closed-open', and `all-extents-open-closed' may be specified.
4023 At most one of `start-in-region', `end-in-region',
4024 `start-and-end-in-region', and `start-or-end-in-region' may be specified.
4026 If optional arg PROPERTY is non-nil, only extents with that property set
4027 on them will be visited. If optional arg VALUE is non-nil, only extents
4028 whose value for that property is `eq' to VALUE will be visited.
4030 (function, object, from, to, maparg, flags, property, value))
4032 /* This function can GC */
4033 struct slow_map_extents_arg closure;
4034 unsigned int me_flags;
4036 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
4039 if (EXTENTP (object))
4041 after = decode_extent (object, DE_MUST_BE_ATTACHED);
4043 from = Fextent_start_position (object);
4045 to = Fextent_end_position (object);
4046 object = extent_object (after);
4049 object = decode_buffer_or_string (object);
4051 get_buffer_or_string_range_byte (object, from, to, &start, &end,
4052 GB_ALLOW_NIL | GB_ALLOW_PAST_ACCESSIBLE);
4054 me_flags = decode_map_extents_flags (flags);
4056 if (!NILP (property))
4059 value = canonicalize_extent_property (property, value);
4062 GCPRO5 (function, maparg, object, property, value);
4064 closure.map_arg = maparg;
4065 closure.map_routine = function;
4066 closure.result = Qnil;
4067 closure.property = property;
4068 closure.value = value;
4070 map_extents_bytind (start, end, slow_map_extents_function,
4071 (void *) &closure, object, after,
4072 /* You never know what the user might do ... */
4073 me_flags | ME_MIGHT_CALL_ELISP);
4076 return closure.result;
4080 /************************************************************************/
4081 /* mapping over extents -- other functions */
4082 /************************************************************************/
4084 /* ------------------------------- */
4085 /* map-extent-children */
4086 /* ------------------------------- */
4088 struct slow_map_extent_children_arg
4090 Lisp_Object map_arg;
4091 Lisp_Object map_routine;
4093 Lisp_Object property;
4101 slow_map_extent_children_function (EXTENT extent, void *arg)
4103 /* This function can GC */
4104 struct slow_map_extent_children_arg *closure =
4105 (struct slow_map_extent_children_arg *) arg;
4106 Lisp_Object extent_obj;
4107 Bytind start = extent_endpoint_bytind (extent, 0);
4108 Bytind end = extent_endpoint_bytind (extent, 1);
4109 /* Make sure the extent starts inside the region of interest,
4110 rather than just overlaps it.
4112 if (start < closure->start_min)
4114 /* Make sure the extent is not a child of a previous visited one.
4115 We know already, because of extent ordering,
4116 that start >= prev_start, and that if
4117 start == prev_start, then end <= prev_end.
4119 if (start == closure->prev_start)
4121 if (end < closure->prev_end)
4124 else /* start > prev_start */
4126 if (start < closure->prev_end)
4128 /* corner case: prev_end can be -1 if there is no prev */
4130 XSETEXTENT (extent_obj, extent);
4132 /* make sure this extent qualifies according to the PROPERTY
4135 if (!NILP (closure->property))
4137 Lisp_Object value = Fextent_property (extent_obj, closure->property,
4139 if ((NILP (closure->value) && NILP (value)) ||
4140 (!NILP (closure->value) && !EQ (value, closure->value)))
4144 closure->result = call2 (closure->map_routine, extent_obj,
4147 /* Since the callback may change the buffer, compute all stored
4148 buffer positions here.
4150 closure->start_min = -1; /* no need for this any more */
4151 closure->prev_start = extent_endpoint_bytind (extent, 0);
4152 closure->prev_end = extent_endpoint_bytind (extent, 1);
4154 return !NILP (closure->result);
4157 DEFUN ("map-extent-children", Fmap_extent_children, 1, 8, 0, /*
4158 Map FUNCTION over the extents in the region from FROM to TO.
4159 FUNCTION is called with arguments (extent, MAPARG). See `map-extents'
4160 for a full discussion of the arguments FROM, TO, and FLAGS.
4162 The arguments are the same as for `map-extents', but this function differs
4163 in that it only visits extents which start in the given region, and also
4164 in that, after visiting an extent E, it skips all other extents which start
4165 inside E but end before E's end.
4167 Thus, this function may be used to walk a tree of extents in a buffer:
4168 (defun walk-extents (buffer &optional ignore)
4169 (map-extent-children 'walk-extents buffer))
4171 (function, object, from, to, maparg, flags, property, value))
4173 /* This function can GC */
4174 struct slow_map_extent_children_arg closure;
4175 unsigned int me_flags;
4177 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
4180 if (EXTENTP (object))
4182 after = decode_extent (object, DE_MUST_BE_ATTACHED);
4184 from = Fextent_start_position (object);
4186 to = Fextent_end_position (object);
4187 object = extent_object (after);
4190 object = decode_buffer_or_string (object);
4192 get_buffer_or_string_range_byte (object, from, to, &start, &end,
4193 GB_ALLOW_NIL | GB_ALLOW_PAST_ACCESSIBLE);
4195 me_flags = decode_map_extents_flags (flags);
4197 if (!NILP (property))
4200 value = canonicalize_extent_property (property, value);
4203 GCPRO5 (function, maparg, object, property, value);
4205 closure.map_arg = maparg;
4206 closure.map_routine = function;
4207 closure.result = Qnil;
4208 closure.property = property;
4209 closure.value = value;
4210 closure.start_min = start;
4211 closure.prev_start = -1;
4212 closure.prev_end = -1;
4213 map_extents_bytind (start, end, slow_map_extent_children_function,
4214 (void *) &closure, object, after,
4215 /* You never know what the user might do ... */
4216 me_flags | ME_MIGHT_CALL_ELISP);
4219 return closure.result;
4222 /* ------------------------------- */
4224 /* ------------------------------- */
4226 /* find "smallest" matching extent containing pos -- (flag == 0) means
4227 all extents match, else (EXTENT_FLAGS (extent) & flag) must be true;
4228 for more than one matching extent with precisely the same endpoints,
4229 we choose the last extent in the extents_list.
4230 The search stops just before "before", if that is non-null.
4233 struct extent_at_arg
4249 static enum extent_at_flag
4250 decode_extent_at_flag (Lisp_Object at_flag)
4253 return EXTENT_AT_AFTER;
4255 CHECK_SYMBOL (at_flag);
4256 if (EQ (at_flag, Qafter)) return EXTENT_AT_AFTER;
4257 if (EQ (at_flag, Qbefore)) return EXTENT_AT_BEFORE;
4258 if (EQ (at_flag, Qat)) return EXTENT_AT_AT;
4260 signal_simple_error ("Invalid AT-FLAG in `extent-at'", at_flag);
4261 return EXTENT_AT_AFTER; /* unreached */
4265 extent_at_mapper (EXTENT e, void *arg)
4267 struct extent_at_arg *closure = (struct extent_at_arg *) arg;
4269 if (e == closure->before)
4272 /* If closure->prop is non-nil, then the extent is only acceptable
4273 if it has a non-nil value for that property. */
4274 if (!NILP (closure->prop))
4277 XSETEXTENT (extent, e);
4278 if (NILP (Fextent_property (extent, closure->prop, Qnil)))
4283 EXTENT current = closure->best_match;
4287 /* redundant but quick test */
4288 else if (extent_start (current) > extent_start (e))
4291 /* we return the "last" best fit, instead of the first --
4292 this is because then the glyph closest to two equivalent
4293 extents corresponds to the "extent-at" the text just past
4295 else if (!EXTENT_LESS_VALS (e, closure->best_start,
4301 closure->best_match = e;
4302 closure->best_start = extent_start (e);
4303 closure->best_end = extent_end (e);
4310 extent_at_bytind (Bytind position, Lisp_Object object, Lisp_Object property,
4311 EXTENT before, enum extent_at_flag at_flag)
4313 struct extent_at_arg closure;
4314 Lisp_Object extent_obj;
4316 /* it might be argued that invalid positions should cause
4317 errors, but the principle of least surprise dictates that
4318 nil should be returned (extent-at is often used in
4319 response to a mouse event, and in many cases previous events
4320 have changed the buffer contents).
4322 Also, the openness stuff in the text-property code currently
4323 does not check its limits and might go off the end. */
4324 if ((at_flag == EXTENT_AT_BEFORE
4325 ? position <= buffer_or_string_absolute_begin_byte (object)
4326 : position < buffer_or_string_absolute_begin_byte (object))
4327 || (at_flag == EXTENT_AT_AFTER
4328 ? position >= buffer_or_string_absolute_end_byte (object)
4329 : position > buffer_or_string_absolute_end_byte (object)))
4332 closure.best_match = 0;
4333 closure.prop = property;
4334 closure.before = before;
4336 map_extents_bytind (at_flag == EXTENT_AT_BEFORE ? position - 1 : position,
4337 at_flag == EXTENT_AT_AFTER ? position + 1 : position,
4338 extent_at_mapper, (void *) &closure, object, 0,
4339 ME_START_OPEN | ME_ALL_EXTENTS_CLOSED);
4341 if (!closure.best_match)
4344 XSETEXTENT (extent_obj, closure.best_match);
4348 DEFUN ("extent-at", Fextent_at, 1, 5, 0, /*
4349 Find "smallest" extent at POS in OBJECT having PROPERTY set.
4350 Normally, an extent is "at" POS if it overlaps the region (POS, POS+1);
4351 i.e. if it covers the character after POS. (However, see the definition
4352 of AT-FLAG.) "Smallest" means the extent that comes last in the display
4353 order; this normally means the extent whose start position is closest to
4354 POS. See `next-extent' for more information.
4355 OBJECT specifies a buffer or string and defaults to the current buffer.
4356 PROPERTY defaults to nil, meaning that any extent will do.
4357 Properties are attached to extents with `set-extent-property', which see.
4358 Returns nil if POS is invalid or there is no matching extent at POS.
4359 If the fourth argument BEFORE is not nil, it must be an extent; any returned
4360 extent will precede that extent. This feature allows `extent-at' to be
4361 used by a loop over extents.
4362 AT-FLAG controls how end cases are handled, and should be one of:
4364 nil or `after' An extent is at POS if it covers the character
4365 after POS. This is consistent with the way
4366 that text properties work.
4367 `before' An extent is at POS if it covers the character
4369 `at' An extent is at POS if it overlaps or abuts POS.
4370 This includes all zero-length extents at POS.
4372 Note that in all cases, the start-openness and end-openness of the extents
4373 considered is ignored. If you want to pay attention to those properties,
4374 you should use `map-extents', which gives you more control.
4376 (pos, object, property, before, at_flag))
4379 EXTENT before_extent;
4380 enum extent_at_flag fl;
4382 object = decode_buffer_or_string (object);
4383 position = get_buffer_or_string_pos_byte (object, pos, GB_NO_ERROR_IF_BAD);
4387 before_extent = decode_extent (before, DE_MUST_BE_ATTACHED);
4388 if (before_extent && !EQ (object, extent_object (before_extent)))
4389 signal_simple_error ("extent not in specified buffer or string", object);
4390 fl = decode_extent_at_flag (at_flag);
4392 return extent_at_bytind (position, object, property, before_extent, fl);
4395 /* ------------------------------- */
4396 /* verify_extent_modification() */
4397 /* ------------------------------- */
4399 /* verify_extent_modification() is called when a buffer or string is
4400 modified to check whether the modification is occuring inside a
4404 struct verify_extents_arg
4409 Lisp_Object iro; /* value of inhibit-read-only */
4413 verify_extent_mapper (EXTENT extent, void *arg)
4415 struct verify_extents_arg *closure = (struct verify_extents_arg *) arg;
4416 Lisp_Object prop = extent_read_only (extent);
4421 if (CONSP (closure->iro) && !NILP (Fmemq (prop, closure->iro)))
4424 #if 0 /* Nobody seems to care for this any more -sb */
4425 /* Allow deletion if the extent is completely contained in
4426 the region being deleted.
4427 This is important for supporting tokens which are internally
4428 write-protected, but which can be killed and yanked as a whole.
4429 Ignore open/closed distinctions at this point.
4432 if (closure->start != closure->end &&
4433 extent_start (extent) >= closure->start &&
4434 extent_end (extent) <= closure->end)
4439 Fsignal (Qbuffer_read_only, (list1 (closure->object)));
4441 RETURN_NOT_REACHED(0)
4444 /* Value of Vinhibit_read_only is precomputed and passed in for
4448 verify_extent_modification (Lisp_Object object, Bytind from, Bytind to,
4449 Lisp_Object inhibit_read_only_value)
4452 struct verify_extents_arg closure;
4454 /* If insertion, visit closed-endpoint extents touching the insertion
4455 point because the text would go inside those extents. If deletion,
4456 treat the range as open on both ends so that touching extents are not
4457 visited. Note that we assume that an insertion is occurring if the
4458 changed range has zero length, and a deletion otherwise. This
4459 fails if a change (i.e. non-insertion, non-deletion) is happening.
4460 As far as I know, this doesn't currently occur in XEmacs. --ben */
4461 closed = (from==to);
4462 closure.object = object;
4463 closure.start = buffer_or_string_bytind_to_memind (object, from);
4464 closure.end = buffer_or_string_bytind_to_memind (object, to);
4465 closure.iro = inhibit_read_only_value;
4467 map_extents_bytind (from, to, verify_extent_mapper, (void *) &closure,
4468 object, 0, closed ? ME_END_CLOSED : ME_START_OPEN);
4471 /* ------------------------------------ */
4472 /* process_extents_for_insertion() */
4473 /* ------------------------------------ */
4475 struct process_extents_for_insertion_arg
4482 /* A region of length LENGTH was just inserted at OPOINT. Modify all
4483 of the extents as required for the insertion, based on their
4484 start-open/end-open properties.
4488 process_extents_for_insertion_mapper (EXTENT extent, void *arg)
4490 struct process_extents_for_insertion_arg *closure =
4491 (struct process_extents_for_insertion_arg *) arg;
4492 Memind indice = buffer_or_string_bytind_to_memind (closure->object,
4495 /* When this function is called, one end of the newly-inserted text should
4496 be adjacent to some endpoint of the extent, or disjoint from it. If
4497 the insertion overlaps any existing extent, something is wrong.
4499 #ifdef ERROR_CHECK_EXTENTS
4500 if (extent_start (extent) > indice &&
4501 extent_start (extent) < indice + closure->length)
4503 if (extent_end (extent) > indice &&
4504 extent_end (extent) < indice + closure->length)
4508 /* The extent-adjustment code adjusted the extent's endpoints as if
4509 they were markers -- endpoints at the gap (i.e. the insertion
4510 point) go to the left of the insertion point, which is correct
4511 for [) extents. We need to fix the other kinds of extents.
4513 Note that both conditions below will hold for zero-length (]
4514 extents at the gap. Zero-length () extents would get adjusted
4515 such that their start is greater than their end; we treat them
4516 as [) extents. This is unfortunately an inelegant part of the
4517 extent model, but there is no way around it. */
4520 Memind new_start, new_end;
4522 new_start = extent_start (extent);
4523 new_end = extent_end (extent);
4524 if (indice == extent_start (extent) && extent_start_open_p (extent) &&
4525 /* coerce zero-length () extents to [) */
4526 new_start != new_end)
4527 new_start += closure->length;
4528 if (indice == extent_end (extent) && !extent_end_open_p (extent))
4529 new_end += closure->length;
4530 set_extent_endpoints_1 (extent, new_start, new_end);
4537 process_extents_for_insertion (Lisp_Object object, Bytind opoint,
4540 struct process_extents_for_insertion_arg closure;
4542 closure.opoint = opoint;
4543 closure.length = length;
4544 closure.object = object;
4546 map_extents_bytind (opoint, opoint + length,
4547 process_extents_for_insertion_mapper,
4548 (void *) &closure, object, 0,
4549 ME_END_CLOSED | ME_MIGHT_MODIFY_EXTENTS |
4550 ME_INCLUDE_INTERNAL);
4553 /* ------------------------------------ */
4554 /* process_extents_for_deletion() */
4555 /* ------------------------------------ */
4557 struct process_extents_for_deletion_arg
4560 int destroy_included_extents;
4563 /* This function is called when we're about to delete the range [from, to].
4564 Detach all of the extents that are completely inside the range [from, to],
4565 if they're detachable or open-open. */
4568 process_extents_for_deletion_mapper (EXTENT extent, void *arg)
4570 struct process_extents_for_deletion_arg *closure =
4571 (struct process_extents_for_deletion_arg *) arg;
4573 /* If the extent lies completely within the range that
4574 is being deleted, then nuke the extent if it's detachable
4575 (otherwise, it will become a zero-length extent). */
4577 if (closure->start <= extent_start (extent) &&
4578 extent_end (extent) <= closure->end)
4580 if (extent_detachable_p (extent))
4582 if (closure->destroy_included_extents)
4583 destroy_extent (extent);
4585 extent_detach (extent);
4592 /* DESTROY_THEM means destroy the extents instead of just deleting them.
4593 It is unused currently, but perhaps might be used (there used to
4594 be a function process_extents_for_destruction(), #if 0'd out,
4595 that did the equivalent). */
4597 process_extents_for_deletion (Lisp_Object object, Bytind from,
4598 Bytind to, int destroy_them)
4600 struct process_extents_for_deletion_arg closure;
4602 closure.start = buffer_or_string_bytind_to_memind (object, from);
4603 closure.end = buffer_or_string_bytind_to_memind (object, to);
4604 closure.destroy_included_extents = destroy_them;
4606 map_extents_bytind (from, to, process_extents_for_deletion_mapper,
4607 (void *) &closure, object, 0,
4608 ME_END_CLOSED | ME_MIGHT_MODIFY_EXTENTS);
4611 /* ------------------------------- */
4612 /* report_extent_modification() */
4613 /* ------------------------------- */
4614 struct report_extent_modification_closure {
4622 report_extent_modification_restore (Lisp_Object buffer)
4624 if (current_buffer != XBUFFER (buffer))
4625 Fset_buffer (buffer);
4630 report_extent_modification_mapper (EXTENT extent, void *arg)
4632 struct report_extent_modification_closure *closure =
4633 (struct report_extent_modification_closure *)arg;
4634 Lisp_Object exobj, startobj, endobj;
4635 Lisp_Object hook = (closure->afterp
4636 ? extent_after_change_functions (extent)
4637 : extent_before_change_functions (extent));
4641 XSETEXTENT (exobj, extent);
4642 XSETINT (startobj, closure->start);
4643 XSETINT (endobj, closure->end);
4645 /* Now that we are sure to call elisp, set up an unwind-protect so
4646 inside_change_hook gets restored in case we throw. Also record
4647 the current buffer, in case we change it. Do the recording only
4650 One confusing thing here is that our caller never actually calls
4651 unbind_to (closure.speccount, Qnil). This is because
4652 map_extents_bytind() unbinds before, and with a smaller
4653 speccount. The additional unbind_to() in
4654 report_extent_modification() would cause XEmacs to abort. */
4655 if (closure->speccount == -1)
4657 closure->speccount = specpdl_depth ();
4658 record_unwind_protect (report_extent_modification_restore,
4659 Fcurrent_buffer ());
4662 /* The functions will expect closure->buffer to be the current
4663 buffer, so change it if it isn't. */
4664 if (current_buffer != XBUFFER (closure->buffer))
4665 Fset_buffer (closure->buffer);
4667 /* #### It's a shame that we can't use any of the existing run_hook*
4668 functions here. This is so because all of them work with
4669 symbols, to be able to retrieve default values of local hooks.
4672 #### Idea: we could set up a dummy symbol, and call the hook
4673 functions on *that*. */
4675 if (!CONSP (hook) || EQ (XCAR (hook), Qlambda))
4676 call3 (hook, exobj, startobj, endobj);
4680 EXTERNAL_LIST_LOOP (tail, hook)
4681 /* #### Shouldn't this perform the same Fset_buffer() check as
4683 call3 (XCAR (tail), exobj, startobj, endobj);
4689 report_extent_modification (Lisp_Object buffer, Bufpos start, Bufpos end,
4692 struct report_extent_modification_closure closure;
4694 closure.buffer = buffer;
4695 closure.start = start;
4697 closure.afterp = afterp;
4698 closure.speccount = -1;
4700 map_extents (start, end, report_extent_modification_mapper, (void *)&closure,
4701 buffer, NULL, ME_MIGHT_CALL_ELISP);
4705 /************************************************************************/
4706 /* extent properties */
4707 /************************************************************************/
4710 set_extent_invisible (EXTENT extent, Lisp_Object value)
4712 if (!EQ (extent_invisible (extent), value))
4714 set_extent_invisible_1 (extent, value);
4715 extent_changed_for_redisplay (extent, 1, 1);
4719 /* This function does "memoization" -- similar to the interning
4720 that happens with symbols. Given a list of faces, an equivalent
4721 list is returned such that if this function is called twice with
4722 input that is `equal', the resulting outputs will be `eq'.
4724 Note that the inputs and outputs are in general *not* `equal' --
4725 faces in symbol form become actual face objects in the output.
4726 This is necessary so that temporary faces stay around. */
4729 memoize_extent_face_internal (Lisp_Object list)
4733 Lisp_Object cons, thecons;
4734 Lisp_Object oldtail, tail;
4735 struct gcpro gcpro1;
4740 return Fget_face (list);
4742 /* To do the memoization, we use a hash table mapping from
4743 external lists to internal lists. We do `equal' comparisons
4744 on the keys so the memoization works correctly.
4746 Note that we canonicalize things so that the keys in the
4747 hash table (the external lists) always contain symbols and
4748 the values (the internal lists) always contain face objects.
4750 We also maintain a "reverse" table that maps from the internal
4751 lists to the external equivalents. The idea here is twofold:
4753 1) `extent-face' wants to return a list containing face symbols
4754 rather than face objects.
4755 2) We don't want things to get quite so messed up if the user
4756 maliciously side-effects the returned lists.
4759 len = XINT (Flength (list));
4760 thelen = XINT (Flength (Vextent_face_reusable_list));
4765 /* We canonicalize the given list into another list.
4766 We try to avoid consing except when necessary, so we have
4772 cons = Vextent_face_reusable_list;
4773 while (!NILP (XCDR (cons)))
4775 XCDR (cons) = Fmake_list (make_int (len - thelen), Qnil);
4777 else if (thelen > len)
4781 /* Truncate the list temporarily so it's the right length;
4782 remember the old tail. */
4783 cons = Vextent_face_reusable_list;
4784 for (i = 0; i < len - 1; i++)
4787 oldtail = XCDR (cons);
4791 thecons = Vextent_face_reusable_list;
4792 EXTERNAL_LIST_LOOP (cons, list)
4794 Lisp_Object face = Fget_face (XCAR (cons));
4796 XCAR (thecons) = Fface_name (face);
4797 thecons = XCDR (thecons);
4800 list = Fgethash (Vextent_face_reusable_list, Vextent_face_memoize_hash_table,
4804 Lisp_Object symlist = Fcopy_sequence (Vextent_face_reusable_list);
4805 Lisp_Object facelist = Fcopy_sequence (Vextent_face_reusable_list);
4807 LIST_LOOP (cons, facelist)
4809 XCAR (cons) = Fget_face (XCAR (cons));
4811 Fputhash (symlist, facelist, Vextent_face_memoize_hash_table);
4812 Fputhash (facelist, symlist, Vextent_face_reverse_memoize_hash_table);
4816 /* Now restore the truncated tail of the reusable list, if necessary. */
4818 XCDR (tail) = oldtail;
4825 external_of_internal_memoized_face (Lisp_Object face)
4829 else if (!CONSP (face))
4830 return XFACE (face)->name;
4833 face = Fgethash (face, Vextent_face_reverse_memoize_hash_table,
4835 assert (!UNBOUNDP (face));
4841 canonicalize_extent_property (Lisp_Object prop, Lisp_Object value)
4843 if (EQ (prop, Qface) || EQ (prop, Qmouse_face))
4844 value = (external_of_internal_memoized_face
4845 (memoize_extent_face_internal (value)));
4849 /* Do we need a lisp-level function ? */
4850 DEFUN ("set-extent-initial-redisplay-function", Fset_extent_initial_redisplay_function,
4852 Note: This feature is experimental!
4854 Set initial-redisplay-function of EXTENT to the function
4857 The first time the EXTENT is (re)displayed, an eval event will be
4858 dispatched calling FUNCTION with EXTENT as its only argument.
4862 EXTENT e = decode_extent(extent, DE_MUST_BE_ATTACHED);
4864 e = extent_ancestor (e); /* Is this needed? Macro also does chasing!*/
4865 set_extent_initial_redisplay_function(e,function);
4866 extent_in_red_event_p(e) = 0; /* If the function changed we can spawn
4868 extent_changed_for_redisplay(e,1,0); /* Do we need to mark children too ?*/
4873 DEFUN ("extent-face", Fextent_face, 1, 1, 0, /*
4874 Return the name of the face in which EXTENT is displayed, or nil
4875 if the extent's face is unspecified. This might also return a list
4882 CHECK_EXTENT (extent);
4883 face = extent_face (XEXTENT (extent));
4885 return external_of_internal_memoized_face (face);
4888 DEFUN ("set-extent-face", Fset_extent_face, 2, 2, 0, /*
4889 Make the given EXTENT have the graphic attributes specified by FACE.
4890 FACE can also be a list of faces, and all faces listed will apply,
4891 with faces earlier in the list taking priority over those later in the
4896 EXTENT e = decode_extent(extent, 0);
4897 Lisp_Object orig_face = face;
4899 /* retrieve the ancestor for efficiency and proper redisplay noting. */
4900 e = extent_ancestor (e);
4902 face = memoize_extent_face_internal (face);
4904 extent_face (e) = face;
4905 extent_changed_for_redisplay (e, 1, 0);
4911 DEFUN ("extent-mouse-face", Fextent_mouse_face, 1, 1, 0, /*
4912 Return the face used to highlight EXTENT when the mouse passes over it.
4913 The return value will be a face name, a list of face names, or nil
4914 if the extent's mouse face is unspecified.
4920 CHECK_EXTENT (extent);
4921 face = extent_mouse_face (XEXTENT (extent));
4923 return external_of_internal_memoized_face (face);
4926 DEFUN ("set-extent-mouse-face", Fset_extent_mouse_face, 2, 2, 0, /*
4927 Set the face used to highlight EXTENT when the mouse passes over it.
4928 FACE can also be a list of faces, and all faces listed will apply,
4929 with faces earlier in the list taking priority over those later in the
4935 Lisp_Object orig_face = face;
4937 CHECK_EXTENT (extent);
4938 e = XEXTENT (extent);
4939 /* retrieve the ancestor for efficiency and proper redisplay noting. */
4940 e = extent_ancestor (e);
4942 face = memoize_extent_face_internal (face);
4944 set_extent_mouse_face (e, face);
4945 extent_changed_for_redisplay (e, 1, 0);
4951 set_extent_glyph (EXTENT extent, Lisp_Object glyph, int endp,
4952 glyph_layout layout)
4954 extent = extent_ancestor (extent);
4958 set_extent_begin_glyph (extent, glyph);
4959 extent_begin_glyph_layout (extent) = layout;
4963 set_extent_end_glyph (extent, glyph);
4964 extent_end_glyph_layout (extent) = layout;
4967 extent_changed_for_redisplay (extent, 1, 0);
4971 glyph_layout_to_symbol (glyph_layout layout)
4975 case GL_TEXT: return Qtext;
4976 case GL_OUTSIDE_MARGIN: return Qoutside_margin;
4977 case GL_INSIDE_MARGIN: return Qinside_margin;
4978 case GL_WHITESPACE: return Qwhitespace;
4981 return Qnil; /* unreached */
4986 symbol_to_glyph_layout (Lisp_Object layout_obj)
4988 if (NILP (layout_obj))
4991 CHECK_SYMBOL (layout_obj);
4992 if (EQ (layout_obj, Qoutside_margin)) return GL_OUTSIDE_MARGIN;
4993 if (EQ (layout_obj, Qinside_margin)) return GL_INSIDE_MARGIN;
4994 if (EQ (layout_obj, Qwhitespace)) return GL_WHITESPACE;
4995 if (EQ (layout_obj, Qtext)) return GL_TEXT;
4997 signal_simple_error ("Unknown glyph layout type", layout_obj);
4998 return GL_TEXT; /* unreached */
5002 set_extent_glyph_1 (Lisp_Object extent_obj, Lisp_Object glyph, int endp,
5003 Lisp_Object layout_obj)
5005 EXTENT extent = decode_extent (extent_obj, 0);
5006 glyph_layout layout = symbol_to_glyph_layout (layout_obj);
5008 /* Make sure we've actually been given a valid glyph or it's nil
5009 (meaning we're deleting a glyph from an extent). */
5011 CHECK_BUFFER_GLYPH (glyph);
5013 set_extent_glyph (extent, glyph, endp, layout);
5017 DEFUN ("set-extent-begin-glyph", Fset_extent_begin_glyph, 2, 3, 0, /*
5018 Display a bitmap, subwindow or string at the beginning of EXTENT.
5019 BEGIN-GLYPH must be a glyph object. The layout policy defaults to `text'.
5021 (extent, begin_glyph, layout))
5023 return set_extent_glyph_1 (extent, begin_glyph, 0, layout);
5026 DEFUN ("set-extent-end-glyph", Fset_extent_end_glyph, 2, 3, 0, /*
5027 Display a bitmap, subwindow or string at the end of EXTENT.
5028 END-GLYPH must be a glyph object. The layout policy defaults to `text'.
5030 (extent, end_glyph, layout))
5032 return set_extent_glyph_1 (extent, end_glyph, 1, layout);
5035 DEFUN ("extent-begin-glyph", Fextent_begin_glyph, 1, 1, 0, /*
5036 Return the glyph object displayed at the beginning of EXTENT.
5037 If there is none, nil is returned.
5041 return extent_begin_glyph (decode_extent (extent, 0));
5044 DEFUN ("extent-end-glyph", Fextent_end_glyph, 1, 1, 0, /*
5045 Return the glyph object displayed at the end of EXTENT.
5046 If there is none, nil is returned.
5050 return extent_end_glyph (decode_extent (extent, 0));
5053 DEFUN ("set-extent-begin-glyph-layout", Fset_extent_begin_glyph_layout, 2, 2, 0, /*
5054 Set the layout policy of EXTENT's begin glyph.
5055 Access this using the `extent-begin-glyph-layout' function.
5059 EXTENT e = decode_extent (extent, 0);
5060 e = extent_ancestor (e);
5061 extent_begin_glyph_layout (e) = symbol_to_glyph_layout (layout);
5062 extent_maybe_changed_for_redisplay (e, 1, 0);
5066 DEFUN ("set-extent-end-glyph-layout", Fset_extent_end_glyph_layout, 2, 2, 0, /*
5067 Set the layout policy of EXTENT's end glyph.
5068 Access this using the `extent-end-glyph-layout' function.
5072 EXTENT e = decode_extent (extent, 0);
5073 e = extent_ancestor (e);
5074 extent_end_glyph_layout (e) = symbol_to_glyph_layout (layout);
5075 extent_maybe_changed_for_redisplay (e, 1, 0);
5079 DEFUN ("extent-begin-glyph-layout", Fextent_begin_glyph_layout, 1, 1, 0, /*
5080 Return the layout policy associated with EXTENT's begin glyph.
5081 Set this using the `set-extent-begin-glyph-layout' function.
5085 EXTENT e = decode_extent (extent, 0);
5086 return glyph_layout_to_symbol ((glyph_layout) extent_begin_glyph_layout (e));
5089 DEFUN ("extent-end-glyph-layout", Fextent_end_glyph_layout, 1, 1, 0, /*
5090 Return the layout policy associated with EXTENT's end glyph.
5091 Set this using the `set-extent-end-glyph-layout' function.
5095 EXTENT e = decode_extent (extent, 0);
5096 return glyph_layout_to_symbol ((glyph_layout) extent_end_glyph_layout (e));
5099 DEFUN ("set-extent-priority", Fset_extent_priority, 2, 2, 0, /*
5100 Set the display priority of EXTENT to PRIORITY (an integer).
5101 When the extent attributes are being merged for display, the priority
5102 is used to determine which extent takes precedence in the event of a
5103 conflict (two extents whose faces both specify font, for example: the
5104 font of the extent with the higher priority will be used).
5105 Extents are created with priority 0; priorities may be negative.
5109 EXTENT e = decode_extent (extent, 0);
5111 CHECK_INT (priority);
5112 e = extent_ancestor (e);
5113 set_extent_priority (e, XINT (priority));
5114 extent_maybe_changed_for_redisplay (e, 1, 0);
5118 DEFUN ("extent-priority", Fextent_priority, 1, 1, 0, /*
5119 Return the display priority of EXTENT; see `set-extent-priority'.
5123 EXTENT e = decode_extent (extent, 0);
5124 return make_int (extent_priority (e));
5127 DEFUN ("set-extent-property", Fset_extent_property, 3, 3, 0, /*
5128 Change a property of an extent.
5129 PROPERTY may be any symbol; the value stored may be accessed with
5130 the `extent-property' function.
5131 The following symbols have predefined meanings:
5133 detached Removes the extent from its buffer; setting this is
5134 the same as calling `detach-extent'.
5136 destroyed Removes the extent from its buffer, and makes it
5137 unusable in the future; this is the same calling
5140 priority Change redisplay priority; same as `set-extent-priority'.
5142 start-open Whether the set of characters within the extent is
5143 treated being open on the left, that is, whether
5144 the start position is an exclusive, rather than
5145 inclusive, boundary. If true, then characters
5146 inserted exactly at the beginning of the extent
5147 will remain outside of the extent; otherwise they
5148 will go into the extent, extending it.
5150 end-open Whether the set of characters within the extent is
5151 treated being open on the right, that is, whether
5152 the end position is an exclusive, rather than
5153 inclusive, boundary. If true, then characters
5154 inserted exactly at the end of the extent will
5155 remain outside of the extent; otherwise they will
5156 go into the extent, extending it.
5158 By default, extents have the `end-open' but not the
5159 `start-open' property set.
5161 read-only Text within this extent will be unmodifiable.
5163 initial-redisplay-function (EXPERIMENTAL)
5164 function to be called the first time (part of) the extent
5165 is redisplayed. It will be called with the extent as its
5167 Note: The function will not be called immediately
5168 during redisplay, an eval event will be dispatched.
5170 detachable Whether the extent gets detached (as with
5171 `detach-extent') when all the text within the
5172 extent is deleted. This is true by default. If
5173 this property is not set, the extent becomes a
5174 zero-length extent when its text is deleted. (In
5175 such a case, the `start-open' property is
5176 automatically removed if both the `start-open' and
5177 `end-open' properties are set, since zero-length
5178 extents open on both ends are not allowed.)
5180 face The face in which to display the text. Setting
5181 this is the same as calling `set-extent-face'.
5183 mouse-face If non-nil, the extent will be highlighted in this
5184 face when the mouse moves over it.
5186 pointer If non-nil, and a valid pointer glyph, this specifies
5187 the shape of the mouse pointer while over the extent.
5189 highlight Obsolete: Setting this property is equivalent to
5190 setting a `mouse-face' property of `highlight'.
5191 Reading this property returns non-nil if
5192 the extent has a non-nil `mouse-face' property.
5194 duplicable Whether this extent should be copied into strings,
5195 so that kill, yank, and undo commands will restore
5196 or copy it. `duplicable' extents are copied from
5197 an extent into a string when `buffer-substring' or
5198 a similar function creates a string. The extents
5199 in a string are copied into other strings created
5200 from the string using `concat' or `substring'.
5201 When `insert' or a similar function inserts the
5202 string into a buffer, the extents are copied back
5205 unique Meaningful only in conjunction with `duplicable'.
5206 When this is set, there may be only one instance
5207 of this extent attached at a time: if it is copied
5208 to the kill ring and then yanked, the extent is
5209 not copied. If, however, it is killed (removed
5210 from the buffer) and then yanked, it will be
5211 re-attached at the new position.
5213 invisible If the value is non-nil, text under this extent
5214 may be treated as not present for the purpose of
5215 redisplay, or may be displayed using an ellipsis
5216 or other marker; see `buffer-invisibility-spec'
5217 and `invisible-text-glyph'. In all cases,
5218 however, the text is still visible to other
5219 functions that examine a buffer's text.
5221 keymap This keymap is consulted for mouse clicks on this
5222 extent, or keypresses made while point is within the
5225 copy-function This is a hook that is run when a duplicable extent
5226 is about to be copied from a buffer to a string (or
5227 the kill ring). It is called with three arguments,
5228 the extent, and the buffer-positions within it
5229 which are being copied. If this function returns
5230 nil, then the extent will not be copied; otherwise
5233 paste-function This is a hook that is run when a duplicable extent is
5234 about to be copied from a string (or the kill ring)
5235 into a buffer. It is called with three arguments,
5236 the original extent, and the buffer positions which
5237 the copied extent will occupy. (This hook is run
5238 after the corresponding text has already been
5239 inserted into the buffer.) Note that the extent
5240 argument may be detached when this function is run.
5241 If this function returns nil, no extent will be
5242 inserted. Otherwise, there will be an extent
5243 covering the range in question.
5245 If the original extent is not attached to a buffer,
5246 then it will be re-attached at this range.
5247 Otherwise, a copy will be made, and that copy
5250 The copy-function and paste-function are meaningful
5251 only for extents with the `duplicable' flag set,
5252 and if they are not specified, behave as if `t' was
5253 the returned value. When these hooks are invoked,
5254 the current buffer is the buffer which the extent
5255 is being copied from/to, respectively.
5257 begin-glyph A glyph to be displayed at the beginning of the extent,
5260 end-glyph A glyph to be displayed at the end of the extent,
5263 begin-glyph-layout The layout policy (one of `text', `whitespace',
5264 `inside-margin', or `outside-margin') of the extent's
5267 end-glyph-layout The layout policy of the extent's end glyph.
5269 (extent, property, value))
5271 /* This function can GC if property is `keymap' */
5272 EXTENT e = decode_extent (extent, 0);
5274 if (EQ (property, Qread_only))
5275 set_extent_read_only (e, value);
5276 else if (EQ (property, Qunique))
5277 extent_unique_p (e) = !NILP (value);
5278 else if (EQ (property, Qduplicable))
5279 extent_duplicable_p (e) = !NILP (value);
5280 else if (EQ (property, Qinvisible))
5281 set_extent_invisible (e, value);
5282 else if (EQ (property, Qdetachable))
5283 extent_detachable_p (e) = !NILP (value);
5285 else if (EQ (property, Qdetached))
5288 error ("can only set `detached' to t");
5289 Fdetach_extent (extent);
5291 else if (EQ (property, Qdestroyed))
5294 error ("can only set `destroyed' to t");
5295 Fdelete_extent (extent);
5297 else if (EQ (property, Qpriority))
5298 Fset_extent_priority (extent, value);
5299 else if (EQ (property, Qface))
5300 Fset_extent_face (extent, value);
5301 else if (EQ (property, Qinitial_redisplay_function))
5302 Fset_extent_initial_redisplay_function (extent, value);
5303 else if (EQ (property, Qbefore_change_functions))
5304 set_extent_before_change_functions (e, value);
5305 else if (EQ (property, Qafter_change_functions))
5306 set_extent_after_change_functions (e, value);
5307 else if (EQ (property, Qmouse_face))
5308 Fset_extent_mouse_face (extent, value);
5310 else if (EQ (property, Qhighlight))
5311 Fset_extent_mouse_face (extent, Qhighlight);
5312 else if (EQ (property, Qbegin_glyph_layout))
5313 Fset_extent_begin_glyph_layout (extent, value);
5314 else if (EQ (property, Qend_glyph_layout))
5315 Fset_extent_end_glyph_layout (extent, value);
5316 /* For backwards compatibility. We use begin glyph because it is by
5317 far the more used of the two. */
5318 else if (EQ (property, Qglyph_layout))
5319 Fset_extent_begin_glyph_layout (extent, value);
5320 else if (EQ (property, Qbegin_glyph))
5321 Fset_extent_begin_glyph (extent, value, Qnil);
5322 else if (EQ (property, Qend_glyph))
5323 Fset_extent_end_glyph (extent, value, Qnil);
5324 else if (EQ (property, Qstart_open))
5325 set_extent_openness (e, !NILP (value), -1);
5326 else if (EQ (property, Qend_open))
5327 set_extent_openness (e, -1, !NILP (value));
5328 /* Support (but don't document...) the obvious *_closed antonyms. */
5329 else if (EQ (property, Qstart_closed))
5330 set_extent_openness (e, NILP (value), -1);
5331 else if (EQ (property, Qend_closed))
5332 set_extent_openness (e, -1, NILP (value));
5335 if (EQ (property, Qkeymap))
5336 while (!NILP (value) && NILP (Fkeymapp (value)))
5337 value = wrong_type_argument (Qkeymapp, value);
5339 external_plist_put (extent_plist_addr (e), property, value, 0, ERROR_ME);
5345 DEFUN ("set-extent-properties", Fset_extent_properties, 2, 2, 0, /*
5346 Change some properties of EXTENT.
5347 PLIST is a property list.
5348 For a list of built-in properties, see `set-extent-property'.
5352 /* This function can GC, if one of the properties is `keymap' */
5353 Lisp_Object property, value;
5354 struct gcpro gcpro1;
5357 plist = Fcopy_sequence (plist);
5358 Fcanonicalize_plist (plist, Qnil);
5360 while (!NILP (plist))
5362 property = Fcar (plist); plist = Fcdr (plist);
5363 value = Fcar (plist); plist = Fcdr (plist);
5364 Fset_extent_property (extent, property, value);
5370 DEFUN ("extent-property", Fextent_property, 2, 3, 0, /*
5371 Return EXTENT's value for property PROPERTY.
5372 See `set-extent-property' for the built-in property names.
5374 (extent, property, default_))
5376 EXTENT e = decode_extent (extent, 0);
5378 if (EQ (property, Qdetached))
5379 return extent_detached_p (e) ? Qt : Qnil;
5380 else if (EQ (property, Qdestroyed))
5381 return !EXTENT_LIVE_P (e) ? Qt : Qnil;
5382 else if (EQ (property, Qstart_open))
5383 return extent_normal_field (e, start_open) ? Qt : Qnil;
5384 else if (EQ (property, Qend_open))
5385 return extent_normal_field (e, end_open) ? Qt : Qnil;
5386 else if (EQ (property, Qunique))
5387 return extent_normal_field (e, unique) ? Qt : Qnil;
5388 else if (EQ (property, Qduplicable))
5389 return extent_normal_field (e, duplicable) ? Qt : Qnil;
5390 else if (EQ (property, Qdetachable))
5391 return extent_normal_field (e, detachable) ? Qt : Qnil;
5392 /* Support (but don't document...) the obvious *_closed antonyms. */
5393 else if (EQ (property, Qstart_closed))
5394 return extent_start_open_p (e) ? Qnil : Qt;
5395 else if (EQ (property, Qend_closed))
5396 return extent_end_open_p (e) ? Qnil : Qt;
5397 else if (EQ (property, Qpriority))
5398 return make_int (extent_priority (e));
5399 else if (EQ (property, Qread_only))
5400 return extent_read_only (e);
5401 else if (EQ (property, Qinvisible))
5402 return extent_invisible (e);
5403 else if (EQ (property, Qface))
5404 return Fextent_face (extent);
5405 else if (EQ (property, Qinitial_redisplay_function))
5406 return extent_initial_redisplay_function (e);
5407 else if (EQ (property, Qbefore_change_functions))
5408 return extent_before_change_functions (e);
5409 else if (EQ (property, Qafter_change_functions))
5410 return extent_after_change_functions (e);
5411 else if (EQ (property, Qmouse_face))
5412 return Fextent_mouse_face (extent);
5414 else if (EQ (property, Qhighlight))
5415 return !NILP (Fextent_mouse_face (extent)) ? Qt : Qnil;
5416 else if (EQ (property, Qbegin_glyph_layout))
5417 return Fextent_begin_glyph_layout (extent);
5418 else if (EQ (property, Qend_glyph_layout))
5419 return Fextent_end_glyph_layout (extent);
5420 /* For backwards compatibility. We use begin glyph because it is by
5421 far the more used of the two. */
5422 else if (EQ (property, Qglyph_layout))
5423 return Fextent_begin_glyph_layout (extent);
5424 else if (EQ (property, Qbegin_glyph))
5425 return extent_begin_glyph (e);
5426 else if (EQ (property, Qend_glyph))
5427 return extent_end_glyph (e);
5430 Lisp_Object value = external_plist_get (extent_plist_addr (e),
5431 property, 0, ERROR_ME);
5432 return UNBOUNDP (value) ? default_ : value;
5436 DEFUN ("extent-properties", Fextent_properties, 1, 1, 0, /*
5437 Return a property list of the attributes of EXTENT.
5438 Do not modify this list; use `set-extent-property' instead.
5443 Lisp_Object result, face, anc_obj;
5444 glyph_layout layout;
5446 CHECK_EXTENT (extent);
5447 e = XEXTENT (extent);
5448 if (!EXTENT_LIVE_P (e))
5449 return cons3 (Qdestroyed, Qt, Qnil);
5451 anc = extent_ancestor (e);
5452 XSETEXTENT (anc_obj, anc);
5454 /* For efficiency, use the ancestor for all properties except detached */
5456 result = extent_plist_slot (anc);
5458 if (!NILP (face = Fextent_face (anc_obj)))
5459 result = cons3 (Qface, face, result);
5461 if (!NILP (face = Fextent_mouse_face (anc_obj)))
5462 result = cons3 (Qmouse_face, face, result);
5464 if ((layout = (glyph_layout) extent_begin_glyph_layout (anc)) != GL_TEXT)
5466 Lisp_Object sym = glyph_layout_to_symbol (layout);
5467 result = cons3 (Qglyph_layout, sym, result); /* compatibility */
5468 result = cons3 (Qbegin_glyph_layout, sym, result);
5471 if ((layout = (glyph_layout) extent_end_glyph_layout (anc)) != GL_TEXT)
5472 result = cons3 (Qend_glyph_layout, glyph_layout_to_symbol (layout), result);
5474 if (!NILP (extent_end_glyph (anc)))
5475 result = cons3 (Qend_glyph, extent_end_glyph (anc), result);
5477 if (!NILP (extent_begin_glyph (anc)))
5478 result = cons3 (Qbegin_glyph, extent_begin_glyph (anc), result);
5480 if (extent_priority (anc) != 0)
5481 result = cons3 (Qpriority, make_int (extent_priority (anc)), result);
5483 if (!NILP (extent_initial_redisplay_function (anc)))
5484 result = cons3 (Qinitial_redisplay_function,
5485 extent_initial_redisplay_function (anc), result);
5487 if (!NILP (extent_before_change_functions (anc)))
5488 result = cons3 (Qbefore_change_functions,
5489 extent_before_change_functions (anc), result);
5491 if (!NILP (extent_after_change_functions (anc)))
5492 result = cons3 (Qafter_change_functions,
5493 extent_after_change_functions (anc), result);
5495 if (!NILP (extent_invisible (anc)))
5496 result = cons3 (Qinvisible, extent_invisible (anc), result);
5498 if (!NILP (extent_read_only (anc)))
5499 result = cons3 (Qread_only, extent_read_only (anc), result);
5501 if (extent_normal_field (anc, end_open))
5502 result = cons3 (Qend_open, Qt, result);
5504 if (extent_normal_field (anc, start_open))
5505 result = cons3 (Qstart_open, Qt, result);
5507 if (extent_normal_field (anc, detachable))
5508 result = cons3 (Qdetachable, Qt, result);
5510 if (extent_normal_field (anc, duplicable))
5511 result = cons3 (Qduplicable, Qt, result);
5513 if (extent_normal_field (anc, unique))
5514 result = cons3 (Qunique, Qt, result);
5516 /* detached is not an inherited property */
5517 if (extent_detached_p (e))
5518 result = cons3 (Qdetached, Qt, result);
5524 /************************************************************************/
5526 /************************************************************************/
5528 /* The display code looks into the Vlast_highlighted_extent variable to
5529 correctly display highlighted extents. This updates that variable,
5530 and marks the appropriate buffers as needing some redisplay.
5533 do_highlight (Lisp_Object extent_obj, int highlight_p)
5535 if (( highlight_p && (EQ (Vlast_highlighted_extent, extent_obj))) ||
5536 (!highlight_p && (EQ (Vlast_highlighted_extent, Qnil))))
5538 if (EXTENTP (Vlast_highlighted_extent) &&
5539 EXTENT_LIVE_P (XEXTENT (Vlast_highlighted_extent)))
5541 /* do not recurse on descendants. Only one extent is highlighted
5543 extent_changed_for_redisplay (XEXTENT (Vlast_highlighted_extent), 0, 0);
5545 Vlast_highlighted_extent = Qnil;
5546 if (!NILP (extent_obj)
5547 && BUFFERP (extent_object (XEXTENT (extent_obj)))
5550 extent_changed_for_redisplay (XEXTENT (extent_obj), 0, 0);
5551 Vlast_highlighted_extent = extent_obj;
5555 DEFUN ("force-highlight-extent", Fforce_highlight_extent, 1, 2, 0, /*
5556 Highlight or unhighlight the given extent.
5557 If the second arg is non-nil, it will be highlighted, else dehighlighted.
5558 This is the same as `highlight-extent', except that it will work even
5559 on extents without the `mouse-face' property.
5561 (extent, highlight_p))
5566 XSETEXTENT (extent, decode_extent (extent, DE_MUST_BE_ATTACHED));
5567 do_highlight (extent, !NILP (highlight_p));
5571 DEFUN ("highlight-extent", Fhighlight_extent, 1, 2, 0, /*
5572 Highlight EXTENT, if it is highlightable.
5573 \(that is, if it has the `mouse-face' property).
5574 If the second arg is non-nil, it will be highlighted, else dehighlighted.
5575 Highlighted extents are displayed as if they were merged with the face
5576 or faces specified by the `mouse-face' property.
5578 (extent, highlight_p))
5580 if (EXTENTP (extent) && NILP (extent_mouse_face (XEXTENT (extent))))
5583 return Fforce_highlight_extent (extent, highlight_p);
5587 /************************************************************************/
5588 /* strings and extents */
5589 /************************************************************************/
5591 /* copy/paste hooks */
5594 run_extent_copy_paste_internal (EXTENT e, Bufpos from, Bufpos to,
5598 /* This function can GC */
5600 Lisp_Object copy_fn;
5601 XSETEXTENT (extent, e);
5602 copy_fn = Fextent_property (extent, prop, Qnil);
5603 if (!NILP (copy_fn))
5606 struct gcpro gcpro1, gcpro2, gcpro3;
5607 GCPRO3 (extent, copy_fn, object);
5608 if (BUFFERP (object))
5609 flag = call3_in_buffer (XBUFFER (object), copy_fn, extent,
5610 make_int (from), make_int (to));
5612 flag = call3 (copy_fn, extent, make_int (from), make_int (to));
5614 if (NILP (flag) || !EXTENT_LIVE_P (XEXTENT (extent)))
5621 run_extent_copy_function (EXTENT e, Bytind from, Bytind to)
5623 Lisp_Object object = extent_object (e);
5624 /* This function can GC */
5625 return run_extent_copy_paste_internal
5626 (e, buffer_or_string_bytind_to_bufpos (object, from),
5627 buffer_or_string_bytind_to_bufpos (object, to), object,
5632 run_extent_paste_function (EXTENT e, Bytind from, Bytind to,
5635 /* This function can GC */
5636 return run_extent_copy_paste_internal
5637 (e, buffer_or_string_bytind_to_bufpos (object, from),
5638 buffer_or_string_bytind_to_bufpos (object, to), object,
5643 update_extent (EXTENT extent, Bytind from, Bytind to)
5645 set_extent_endpoints (extent, from, to, Qnil);
5648 /* Insert an extent, usually from the dup_list of a string which
5649 has just been inserted.
5650 This code does not handle the case of undo.
5653 insert_extent (EXTENT extent, Bytind new_start, Bytind new_end,
5654 Lisp_Object object, int run_hooks)
5656 /* This function can GC */
5659 if (!EQ (extent_object (extent), object))
5662 if (extent_detached_p (extent))
5665 !run_extent_paste_function (extent, new_start, new_end, object))
5666 /* The paste-function said don't re-attach this extent here. */
5669 update_extent (extent, new_start, new_end);
5673 Bytind exstart = extent_endpoint_bytind (extent, 0);
5674 Bytind exend = extent_endpoint_bytind (extent, 1);
5676 if (exend < new_start || exstart > new_end)
5680 new_start = min (exstart, new_start);
5681 new_end = max (exend, new_end);
5682 if (exstart != new_start || exend != new_end)
5683 update_extent (extent, new_start, new_end);
5687 XSETEXTENT (tmp, extent);
5692 !run_extent_paste_function (extent, new_start, new_end, object))
5693 /* The paste-function said don't attach a copy of the extent here. */
5697 XSETEXTENT (tmp, copy_extent (extent, new_start, new_end, object));
5702 DEFUN ("insert-extent", Finsert_extent, 1, 5, 0, /*
5703 Insert EXTENT from START to END in BUFFER-OR-STRING.
5704 BUFFER-OR-STRING defaults to the current buffer if omitted.
5705 This operation does not insert any characters,
5706 but otherwise acts as if there were a replicating extent whose
5707 parent is EXTENT in some string that was just inserted.
5708 Returns the newly-inserted extent.
5709 The fourth arg, NO-HOOKS, can be used to inhibit the running of the
5710 extent's `paste-function' property if it has one.
5711 See documentation on `detach-extent' for a discussion of undo recording.
5713 (extent, start, end, no_hooks, buffer_or_string))
5715 EXTENT ext = decode_extent (extent, 0);
5719 buffer_or_string = decode_buffer_or_string (buffer_or_string);
5720 get_buffer_or_string_range_byte (buffer_or_string, start, end, &s, &e,
5721 GB_ALLOW_PAST_ACCESSIBLE);
5723 copy = insert_extent (ext, s, e, buffer_or_string, NILP (no_hooks));
5726 if (extent_duplicable_p (XEXTENT (copy)))
5727 record_extent (copy, 1);
5733 /* adding buffer extents to a string */
5735 struct add_string_extents_arg
5743 add_string_extents_mapper (EXTENT extent, void *arg)
5745 /* This function can GC */
5746 struct add_string_extents_arg *closure =
5747 (struct add_string_extents_arg *) arg;
5748 Bytecount start = extent_endpoint_bytind (extent, 0) - closure->from;
5749 Bytecount end = extent_endpoint_bytind (extent, 1) - closure->from;
5751 if (extent_duplicable_p (extent))
5753 start = max (start, 0);
5754 end = min (end, closure->length);
5756 /* Run the copy-function to give an extent the option of
5757 not being copied into the string (or kill ring).
5759 if (extent_duplicable_p (extent) &&
5760 !run_extent_copy_function (extent, start + closure->from,
5761 end + closure->from))
5763 copy_extent (extent, start, end, closure->string);
5769 /* Add the extents in buffer BUF from OPOINT to OPOINT+LENGTH to
5770 the string STRING. */
5772 add_string_extents (Lisp_Object string, struct buffer *buf, Bytind opoint,
5775 /* This function can GC */
5776 struct add_string_extents_arg closure;
5777 struct gcpro gcpro1, gcpro2;
5780 closure.from = opoint;
5781 closure.length = length;
5782 closure.string = string;
5783 buffer = make_buffer (buf);
5784 GCPRO2 (buffer, string);
5785 map_extents_bytind (opoint, opoint + length, add_string_extents_mapper,
5786 (void *) &closure, buffer, 0,
5787 /* ignore extents that just abut the region */
5788 ME_END_CLOSED | ME_ALL_EXTENTS_OPEN |
5789 /* we are calling E-Lisp (the extent's copy function)
5790 so anything might happen */
5791 ME_MIGHT_CALL_ELISP);
5795 struct splice_in_string_extents_arg
5804 splice_in_string_extents_mapper (EXTENT extent, void *arg)
5806 /* This function can GC */
5807 struct splice_in_string_extents_arg *closure =
5808 (struct splice_in_string_extents_arg *) arg;
5809 /* BASE_START and BASE_END are the limits in the buffer of the string
5810 that was just inserted.
5812 NEW_START and NEW_END are the prospective buffer positions of the
5813 extent that is going into the buffer. */
5814 Bytind base_start = closure->opoint;
5815 Bytind base_end = base_start + closure->length;
5816 Bytind new_start = (base_start + extent_endpoint_bytind (extent, 0) -
5818 Bytind new_end = (base_start + extent_endpoint_bytind (extent, 1) -
5821 if (new_start < base_start)
5822 new_start = base_start;
5823 if (new_end > base_end)
5825 if (new_end <= new_start)
5828 if (!extent_duplicable_p (extent))
5832 !run_extent_paste_function (extent, new_start, new_end,
5835 copy_extent (extent, new_start, new_end, closure->buffer);
5840 /* We have just inserted a section of STRING (starting at POS, of
5841 length LENGTH) into buffer BUF at OPOINT. Do whatever is necessary
5842 to get the string's extents into the buffer. */
5845 splice_in_string_extents (Lisp_Object string, struct buffer *buf,
5846 Bytind opoint, Bytecount length, Bytecount pos)
5848 struct splice_in_string_extents_arg closure;
5849 struct gcpro gcpro1, gcpro2;
5852 buffer = make_buffer (buf);
5853 closure.opoint = opoint;
5855 closure.length = length;
5856 closure.buffer = buffer;
5857 GCPRO2 (buffer, string);
5858 map_extents_bytind (pos, pos + length,
5859 splice_in_string_extents_mapper,
5860 (void *) &closure, string, 0,
5861 /* ignore extents that just abut the region */
5862 ME_END_CLOSED | ME_ALL_EXTENTS_OPEN |
5863 /* we are calling E-Lisp (the extent's copy function)
5864 so anything might happen */
5865 ME_MIGHT_CALL_ELISP);
5869 struct copy_string_extents_arg
5874 Lisp_Object new_string;
5877 struct copy_string_extents_1_arg
5879 Lisp_Object parent_in_question;
5880 EXTENT found_extent;
5884 copy_string_extents_mapper (EXTENT extent, void *arg)
5886 struct copy_string_extents_arg *closure =
5887 (struct copy_string_extents_arg *) arg;
5888 Bytecount old_start, old_end, new_start, new_end;
5890 old_start = extent_endpoint_bytind (extent, 0);
5891 old_end = extent_endpoint_bytind (extent, 1);
5893 old_start = max (closure->old_pos, old_start);
5894 old_end = min (closure->old_pos + closure->length, old_end);
5896 if (old_start >= old_end)
5899 new_start = old_start + closure->new_pos - closure->old_pos;
5900 new_end = old_end + closure->new_pos - closure->old_pos;
5902 copy_extent (extent, new_start, new_end, closure->new_string);
5906 /* The string NEW_STRING was partially constructed from OLD_STRING.
5907 In particular, the section of length LEN starting at NEW_POS in
5908 NEW_STRING came from the section of the same length starting at
5909 OLD_POS in OLD_STRING. Copy the extents as appropriate. */
5912 copy_string_extents (Lisp_Object new_string, Lisp_Object old_string,
5913 Bytecount new_pos, Bytecount old_pos,
5916 struct copy_string_extents_arg closure;
5917 struct gcpro gcpro1, gcpro2;
5919 closure.new_pos = new_pos;
5920 closure.old_pos = old_pos;
5921 closure.new_string = new_string;
5922 closure.length = length;
5923 GCPRO2 (new_string, old_string);
5924 map_extents_bytind (old_pos, old_pos + length,
5925 copy_string_extents_mapper,
5926 (void *) &closure, old_string, 0,
5927 /* ignore extents that just abut the region */
5928 ME_END_CLOSED | ME_ALL_EXTENTS_OPEN |
5929 /* we are calling E-Lisp (the extent's copy function)
5930 so anything might happen */
5931 ME_MIGHT_CALL_ELISP);
5935 /* Checklist for sanity checking:
5936 - {kill, yank, copy} at {open, closed} {start, end} of {writable, read-only} extent
5937 - {kill, copy} & yank {once, repeatedly} duplicable extent in {same, different} buffer
5941 /************************************************************************/
5942 /* text properties */
5943 /************************************************************************/
5946 Originally this stuff was implemented in lisp (all of the functionality
5947 exists to make that possible) but speed was a problem.
5950 Lisp_Object Qtext_prop;
5951 Lisp_Object Qtext_prop_extent_paste_function;
5954 get_text_property_bytind (Bytind position, Lisp_Object prop,
5955 Lisp_Object object, enum extent_at_flag fl,
5956 int text_props_only)
5960 /* text_props_only specifies whether we only consider text-property
5961 extents (those with the 'text-prop property set) or all extents. */
5962 if (!text_props_only)
5963 extent = extent_at_bytind (position, object, prop, 0, fl);
5969 extent = extent_at_bytind (position, object, Qtext_prop, prior,
5973 if (EQ (prop, Fextent_property (extent, Qtext_prop, Qnil)))
5975 prior = XEXTENT (extent);
5980 return Fextent_property (extent, prop, Qnil);
5981 if (!NILP (Vdefault_text_properties))
5982 return Fplist_get (Vdefault_text_properties, prop, Qnil);
5987 get_text_property_1 (Lisp_Object pos, Lisp_Object prop, Lisp_Object object,
5988 Lisp_Object at_flag, int text_props_only)
5993 object = decode_buffer_or_string (object);
5994 position = get_buffer_or_string_pos_byte (object, pos, GB_NO_ERROR_IF_BAD);
5996 /* We canonicalize the start/end-open/closed properties to the
5997 non-default version -- "adding" the default property really
5998 needs to remove the non-default one. See below for more
6000 if (EQ (prop, Qstart_closed))
6006 if (EQ (prop, Qend_open))
6014 get_text_property_bytind (position, prop, object,
6015 decode_extent_at_flag (at_flag),
6018 val = NILP (val) ? Qt : Qnil;
6023 DEFUN ("get-text-property", Fget_text_property, 2, 4, 0, /*
6024 Return the value of the PROP property at the given position.
6025 Optional arg OBJECT specifies the buffer or string to look in, and
6026 defaults to the current buffer.
6027 Optional arg AT-FLAG controls what it means for a property to be "at"
6028 a position, and has the same meaning as in `extent-at'.
6029 This examines only those properties added with `put-text-property'.
6030 See also `get-char-property'.
6032 (pos, prop, object, at_flag))
6034 return get_text_property_1 (pos, prop, object, at_flag, 1);
6037 DEFUN ("get-char-property", Fget_char_property, 2, 4, 0, /*
6038 Return the value of the PROP property at the given position.
6039 Optional arg OBJECT specifies the buffer or string to look in, and
6040 defaults to the current buffer.
6041 Optional arg AT-FLAG controls what it means for a property to be "at"
6042 a position, and has the same meaning as in `extent-at'.
6043 This examines properties on all extents.
6044 See also `get-text-property'.
6046 (pos, prop, object, at_flag))
6048 return get_text_property_1 (pos, prop, object, at_flag, 0);
6051 /* About start/end-open/closed:
6053 These properties have to be handled specially because of their
6054 strange behavior. If I put the "start-open" property on a region,
6055 then *all* text-property extents in the region have to have their
6056 start be open. This is unlike all other properties, which don't
6057 affect the extents of text properties other than their own.
6061 1) We have to map start-closed to (not start-open) and end-open
6062 to (not end-closed) -- i.e. adding the default is really the
6063 same as remove the non-default property. It won't work, for
6064 example, to have both "start-open" and "start-closed" on
6066 2) Whenever we add one of these properties, we go through all
6067 text-property extents in the region and set the appropriate
6068 open/closedness on them.
6069 3) Whenever we change a text-property extent for a property,
6070 we have to make sure we set the open/closedness properly.
6072 (2) and (3) together rely on, and maintain, the invariant
6073 that the open/closedness of text-property extents is correct
6074 at the beginning and end of each operation.
6077 struct put_text_prop_arg
6079 Lisp_Object prop, value; /* The property and value we are storing */
6080 Bytind start, end; /* The region into which we are storing it */
6082 Lisp_Object the_extent; /* Our chosen extent; this is used for
6083 communication between subsequent passes. */
6084 int changed_p; /* Output: whether we have modified anything */
6088 put_text_prop_mapper (EXTENT e, void *arg)
6090 struct put_text_prop_arg *closure = (struct put_text_prop_arg *) arg;
6092 Lisp_Object object = closure->object;
6093 Lisp_Object value = closure->value;
6094 Bytind e_start, e_end;
6095 Bytind start = closure->start;
6096 Bytind end = closure->end;
6097 Lisp_Object extent, e_val;
6100 XSETEXTENT (extent, e);
6102 /* Note: in some cases when the property itself is 'start-open
6103 or 'end-closed, the checks to set the openness may do a bit
6104 of extra work; but it won't hurt because we then fix up the
6105 openness later on in put_text_prop_openness_mapper(). */
6106 if (!EQ (Fextent_property (extent, Qtext_prop, Qnil), closure->prop))
6107 /* It's not for this property; do nothing. */
6110 e_start = extent_endpoint_bytind (e, 0);
6111 e_end = extent_endpoint_bytind (e, 1);
6112 e_val = Fextent_property (extent, closure->prop, Qnil);
6113 is_eq = EQ (value, e_val);
6115 if (!NILP (value) && NILP (closure->the_extent) && is_eq)
6117 /* We want there to be an extent here at the end, and we haven't picked
6118 one yet, so use this one. Extend it as necessary. We only reuse an
6119 extent which has an EQ value for the prop in question to avoid
6120 side-effecting the kill ring (that is, we never change the property
6121 on an extent after it has been created.)
6123 if (e_start != start || e_end != end)
6125 Bytind new_start = min (e_start, start);
6126 Bytind new_end = max (e_end, end);
6127 set_extent_endpoints (e, new_start, new_end, Qnil);
6128 /* If we changed the endpoint, then we need to set its
6130 set_extent_openness (e, new_start != e_start
6131 ? !NILP (get_text_property_bytind
6132 (start, Qstart_open, object,
6133 EXTENT_AT_AFTER, 1)) : -1,
6135 ? NILP (get_text_property_bytind
6136 (end - 1, Qend_closed, object,
6137 EXTENT_AT_AFTER, 1))
6139 closure->changed_p = 1;
6141 closure->the_extent = extent;
6144 /* Even if we're adding a prop, at this point, we want all other extents of
6145 this prop to go away (as now they overlap). So the theory here is that,
6146 when we are adding a prop to a region that has multiple (disjoint)
6147 occurrences of that prop in it already, we pick one of those and extend
6148 it, and remove the others.
6151 else if (EQ (extent, closure->the_extent))
6153 /* just in case map-extents hits it again (does that happen?) */
6156 else if (e_start >= start && e_end <= end)
6158 /* Extent is contained in region; remove it. Don't destroy or modify
6159 it, because we don't want to change the attributes pointed to by the
6160 duplicates in the kill ring.
6163 closure->changed_p = 1;
6165 else if (!NILP (closure->the_extent) &&
6170 EXTENT te = XEXTENT (closure->the_extent);
6171 /* This extent overlaps, and has the same prop/value as the extent we've
6172 decided to reuse, so we can remove this existing extent as well (the
6173 whole thing, even the part outside of the region) and extend
6174 the-extent to cover it, resulting in the minimum number of extents in
6177 Bytind the_start = extent_endpoint_bytind (te, 0);
6178 Bytind the_end = extent_endpoint_bytind (te, 1);
6179 if (e_start != the_start && /* note AND not OR -- hmm, why is this
6180 the case? I think it's because the
6181 assumption that the text-property
6182 extents don't overlap makes it
6183 OK; changing it to an OR would
6184 result in changed_p sometimes getting
6185 falsely marked. Is this bad? */
6188 Bytind new_start = min (e_start, the_start);
6189 Bytind new_end = max (e_end, the_end);
6190 set_extent_endpoints (te, new_start, new_end, Qnil);
6191 /* If we changed the endpoint, then we need to set its
6192 openness. We are setting the endpoint to be the same as
6193 that of the extent we're about to remove, and we assume
6194 (the invariant mentioned above) that extent has the
6195 proper endpoint setting, so we just use it. */
6196 set_extent_openness (te, new_start != e_start ?
6197 (int) extent_start_open_p (e) : -1,
6199 (int) extent_end_open_p (e) : -1);
6200 closure->changed_p = 1;
6204 else if (e_end <= end)
6206 /* Extent begins before start but ends before end, so we can just
6207 decrease its end position.
6211 set_extent_endpoints (e, e_start, start, Qnil);
6212 set_extent_openness (e, -1, NILP (get_text_property_bytind
6213 (start - 1, Qend_closed, object,
6214 EXTENT_AT_AFTER, 1)));
6215 closure->changed_p = 1;
6218 else if (e_start >= start)
6220 /* Extent ends after end but begins after start, so we can just
6221 increase its start position.
6225 set_extent_endpoints (e, end, e_end, Qnil);
6226 set_extent_openness (e, !NILP (get_text_property_bytind
6227 (end, Qstart_open, object,
6228 EXTENT_AT_AFTER, 1)), -1);
6229 closure->changed_p = 1;
6234 /* Otherwise, `extent' straddles the region. We need to split it.
6236 set_extent_endpoints (e, e_start, start, Qnil);
6237 set_extent_openness (e, -1, NILP (get_text_property_bytind
6238 (start - 1, Qend_closed, object,
6239 EXTENT_AT_AFTER, 1)));
6240 set_extent_openness (copy_extent (e, end, e_end, extent_object (e)),
6241 !NILP (get_text_property_bytind
6242 (end, Qstart_open, object,
6243 EXTENT_AT_AFTER, 1)), -1);
6244 closure->changed_p = 1;
6247 return 0; /* to continue mapping. */
6251 put_text_prop_openness_mapper (EXTENT e, void *arg)
6253 struct put_text_prop_arg *closure = (struct put_text_prop_arg *) arg;
6254 Bytind e_start, e_end;
6255 Bytind start = closure->start;
6256 Bytind end = closure->end;
6258 XSETEXTENT (extent, e);
6259 e_start = extent_endpoint_bytind (e, 0);
6260 e_end = extent_endpoint_bytind (e, 1);
6262 if (NILP (Fextent_property (extent, Qtext_prop, Qnil)))
6264 /* It's not a text-property extent; do nothing. */
6267 /* Note end conditions and NILP/!NILP's carefully. */
6268 else if (EQ (closure->prop, Qstart_open)
6269 && e_start >= start && e_start < end)
6270 set_extent_openness (e, !NILP (closure->value), -1);
6271 else if (EQ (closure->prop, Qend_closed)
6272 && e_end > start && e_end <= end)
6273 set_extent_openness (e, -1, NILP (closure->value));
6275 return 0; /* to continue mapping. */
6279 put_text_prop (Bytind start, Bytind end, Lisp_Object object,
6280 Lisp_Object prop, Lisp_Object value,
6283 /* This function can GC */
6284 struct put_text_prop_arg closure;
6286 if (start == end) /* There are no characters in the region. */
6289 /* convert to the non-default versions, since a nil property is
6290 the same as it not being present. */
6291 if (EQ (prop, Qstart_closed))
6294 value = NILP (value) ? Qt : Qnil;
6296 else if (EQ (prop, Qend_open))
6299 value = NILP (value) ? Qt : Qnil;
6302 value = canonicalize_extent_property (prop, value);
6304 closure.prop = prop;
6305 closure.value = value;
6306 closure.start = start;
6308 closure.object = object;
6309 closure.changed_p = 0;
6310 closure.the_extent = Qnil;
6312 map_extents_bytind (start, end,
6313 put_text_prop_mapper,
6314 (void *) &closure, object, 0,
6315 /* get all extents that abut the region */
6316 ME_ALL_EXTENTS_CLOSED | ME_END_CLOSED |
6317 /* it might QUIT or error if the user has
6318 fucked with the extent plist. */
6319 /* #### dmoore - I think this should include
6320 ME_MIGHT_MOVE_SOE, since the callback function
6321 might recurse back into map_extents_bytind. */
6323 ME_MIGHT_MODIFY_EXTENTS);
6325 /* If we made it through the loop without reusing an extent
6326 (and we want there to be one) make it now.
6328 if (!NILP (value) && NILP (closure.the_extent))
6332 XSETEXTENT (extent, make_extent_internal (object, start, end));
6333 closure.changed_p = 1;
6334 Fset_extent_property (extent, Qtext_prop, prop);
6335 Fset_extent_property (extent, prop, value);
6338 extent_duplicable_p (XEXTENT (extent)) = 1;
6339 Fset_extent_property (extent, Qpaste_function,
6340 Qtext_prop_extent_paste_function);
6342 set_extent_openness (XEXTENT (extent),
6343 !NILP (get_text_property_bytind
6344 (start, Qstart_open, object,
6345 EXTENT_AT_AFTER, 1)),
6346 NILP (get_text_property_bytind
6347 (end - 1, Qend_closed, object,
6348 EXTENT_AT_AFTER, 1)));
6351 if (EQ (prop, Qstart_open) || EQ (prop, Qend_closed))
6353 map_extents_bytind (start, end,
6354 put_text_prop_openness_mapper,
6355 (void *) &closure, object, 0,
6356 /* get all extents that abut the region */
6357 ME_ALL_EXTENTS_CLOSED | ME_END_CLOSED |
6358 ME_MIGHT_MODIFY_EXTENTS);
6361 return closure.changed_p;
6364 DEFUN ("put-text-property", Fput_text_property, 4, 5, 0, /*
6365 Adds the given property/value to all characters in the specified region.
6366 The property is conceptually attached to the characters rather than the
6367 region. The properties are copied when the characters are copied/pasted.
6368 Fifth argument OBJECT is the buffer or string containing the text, and
6369 defaults to the current buffer.
6371 (start, end, prop, value, object))
6373 /* This function can GC */
6376 object = decode_buffer_or_string (object);
6377 get_buffer_or_string_range_byte (object, start, end, &s, &e, 0);
6378 put_text_prop (s, e, object, prop, value, 1);
6382 DEFUN ("put-nonduplicable-text-property", Fput_nonduplicable_text_property,
6384 Adds the given property/value to all characters in the specified region.
6385 The property is conceptually attached to the characters rather than the
6386 region, however the properties will not be copied when the characters
6388 Fifth argument OBJECT is the buffer or string containing the text, and
6389 defaults to the current buffer.
6391 (start, end, prop, value, object))
6393 /* This function can GC */
6396 object = decode_buffer_or_string (object);
6397 get_buffer_or_string_range_byte (object, start, end, &s, &e, 0);
6398 put_text_prop (s, e, object, prop, value, 0);
6402 DEFUN ("add-text-properties", Fadd_text_properties, 3, 4, 0, /*
6403 Add properties to the characters from START to END.
6404 The third argument PROPS is a property list specifying the property values
6405 to add. The optional fourth argument, OBJECT, is the buffer or string
6406 containing the text and defaults to the current buffer. Returns t if
6407 any property was changed, nil otherwise.
6409 (start, end, props, object))
6411 /* This function can GC */
6415 object = decode_buffer_or_string (object);
6416 get_buffer_or_string_range_byte (object, start, end, &s, &e, 0);
6418 for (; !NILP (props); props = Fcdr (Fcdr (props)))
6420 Lisp_Object prop = XCAR (props);
6421 Lisp_Object value = Fcar (XCDR (props));
6422 changed |= put_text_prop (s, e, object, prop, value, 1);
6424 return changed ? Qt : Qnil;
6428 DEFUN ("add-nonduplicable-text-properties", Fadd_nonduplicable_text_properties,
6430 Add nonduplicable properties to the characters from START to END.
6431 \(The properties will not be copied when the characters are copied.)
6432 The third argument PROPS is a property list specifying the property values
6433 to add. The optional fourth argument, OBJECT, is the buffer or string
6434 containing the text and defaults to the current buffer. Returns t if
6435 any property was changed, nil otherwise.
6437 (start, end, props, object))
6439 /* This function can GC */
6443 object = decode_buffer_or_string (object);
6444 get_buffer_or_string_range_byte (object, start, end, &s, &e, 0);
6446 for (; !NILP (props); props = Fcdr (Fcdr (props)))
6448 Lisp_Object prop = XCAR (props);
6449 Lisp_Object value = Fcar (XCDR (props));
6450 changed |= put_text_prop (s, e, object, prop, value, 0);
6452 return changed ? Qt : Qnil;
6455 DEFUN ("remove-text-properties", Fremove_text_properties, 3, 4, 0, /*
6456 Remove the given properties from all characters in the specified region.
6457 PROPS should be a plist, but the values in that plist are ignored (treated
6458 as nil). Returns t if any property was changed, nil otherwise.
6459 Fourth argument OBJECT is the buffer or string containing the text, and
6460 defaults to the current buffer.
6462 (start, end, props, object))
6464 /* This function can GC */
6468 object = decode_buffer_or_string (object);
6469 get_buffer_or_string_range_byte (object, start, end, &s, &e, 0);
6471 for (; !NILP (props); props = Fcdr (Fcdr (props)))
6473 Lisp_Object prop = XCAR (props);
6474 changed |= put_text_prop (s, e, object, prop, Qnil, 1);
6476 return changed ? Qt : Qnil;
6479 /* Whenever a text-prop extent is pasted into a buffer (via `yank' or `insert'
6480 or whatever) we attach the properties to the buffer by calling
6481 `put-text-property' instead of by simply allowing the extent to be copied or
6482 re-attached. Then we return nil, telling the extents code not to attach it
6483 again. By handing the insertion hackery in this way, we make kill/yank
6484 behave consistently with put-text-property and not fragment the extents
6485 (since text-prop extents must partition, not overlap).
6487 The lisp implementation of this was probably fast enough, but since I moved
6488 the rest of the put-text-prop code here, I moved this as well for
6491 DEFUN ("text-prop-extent-paste-function", Ftext_prop_extent_paste_function,
6493 Used as the `paste-function' property of `text-prop' extents.
6497 /* This function can GC */
6498 Lisp_Object prop, val;
6500 prop = Fextent_property (extent, Qtext_prop, Qnil);
6502 signal_simple_error ("Internal error: no text-prop", extent);
6503 val = Fextent_property (extent, prop, Qnil);
6505 /* removed by bill perry, 2/9/97
6506 ** This little bit of code would not allow you to have a text property
6507 ** with a value of Qnil. This is bad bad bad.
6510 signal_simple_error_2 ("Internal error: no text-prop",
6513 Fput_text_property (from, to, prop, val, Qnil);
6514 return Qnil; /* important! */
6517 /* This function could easily be written in Lisp but the C code wants
6518 to use it in connection with invisible extents (at least currently).
6519 If this changes, consider moving this back into Lisp. */
6521 DEFUN ("next-single-property-change", Fnext_single_property_change,
6523 Return the position of next property change for a specific property.
6524 Scans characters forward from POS till it finds a change in the PROP
6525 property, then returns the position of the change. The optional third
6526 argument OBJECT is the buffer or string to scan (defaults to the current
6528 The property values are compared with `eq'.
6529 Return nil if the property is constant all the way to the end of BUFFER.
6530 If the value is non-nil, it is a position greater than POS, never equal.
6532 If the optional fourth argument LIMIT is non-nil, don't search
6533 past position LIMIT; return LIMIT if nothing is found before LIMIT.
6534 If two or more extents with conflicting non-nil values for PROP overlap
6535 a particular character, it is undefined which value is considered to be
6536 the value of PROP. (Note that this situation will not happen if you always
6537 use the text-property primitives.)
6539 (pos, prop, object, limit))
6543 Lisp_Object extent, value;
6546 object = decode_buffer_or_string (object);
6547 bpos = get_buffer_or_string_pos_char (object, pos, 0);
6550 blim = buffer_or_string_accessible_end_char (object);
6555 blim = get_buffer_or_string_pos_char (object, limit, 0);
6559 extent = Fextent_at (make_int (bpos), object, prop, Qnil, Qnil);
6561 value = Fextent_property (extent, prop, Qnil);
6567 bpos = XINT (Fnext_extent_change (make_int (bpos), object));
6569 break; /* property is the same all the way to the end */
6570 extent = Fextent_at (make_int (bpos), object, prop, Qnil, Qnil);
6571 if ((NILP (extent) && !NILP (value)) ||
6572 (!NILP (extent) && !EQ (value,
6573 Fextent_property (extent, prop, Qnil))))
6574 return make_int (bpos);
6577 /* I think it's more sensible for this function to return nil always
6578 in this situation and it used to do it this way, but it's been changed
6579 for FSF compatibility. */
6583 return make_int (blim);
6586 /* See comment on previous function about why this is written in C. */
6588 DEFUN ("previous-single-property-change", Fprevious_single_property_change,
6590 Return the position of next property change for a specific property.
6591 Scans characters backward from POS till it finds a change in the PROP
6592 property, then returns the position of the change. The optional third
6593 argument OBJECT is the buffer or string to scan (defaults to the current
6595 The property values are compared with `eq'.
6596 Return nil if the property is constant all the way to the start of BUFFER.
6597 If the value is non-nil, it is a position less than POS, never equal.
6599 If the optional fourth argument LIMIT is non-nil, don't search back
6600 past position LIMIT; return LIMIT if nothing is found until LIMIT.
6601 If two or more extents with conflicting non-nil values for PROP overlap
6602 a particular character, it is undefined which value is considered to be
6603 the value of PROP. (Note that this situation will not happen if you always
6604 use the text-property primitives.)
6606 (pos, prop, object, limit))
6610 Lisp_Object extent, value;
6613 object = decode_buffer_or_string (object);
6614 bpos = get_buffer_or_string_pos_char (object, pos, 0);
6617 blim = buffer_or_string_accessible_begin_char (object);
6622 blim = get_buffer_or_string_pos_char (object, limit, 0);
6626 /* extent-at refers to the character AFTER bpos, but we want the
6627 character before bpos. Thus the - 1. extent-at simply
6628 returns nil on bogus positions, so not to worry. */
6629 extent = Fextent_at (make_int (bpos - 1), object, prop, Qnil, Qnil);
6631 value = Fextent_property (extent, prop, Qnil);
6637 bpos = XINT (Fprevious_extent_change (make_int (bpos), object));
6639 break; /* property is the same all the way to the beginning */
6640 extent = Fextent_at (make_int (bpos - 1), object, prop, Qnil, Qnil);
6641 if ((NILP (extent) && !NILP (value)) ||
6642 (!NILP (extent) && !EQ (value,
6643 Fextent_property (extent, prop, Qnil))))
6644 return make_int (bpos);
6647 /* I think it's more sensible for this function to return nil always
6648 in this situation and it used to do it this way, but it's been changed
6649 for FSF compatibility. */
6653 return make_int (blim);
6656 #ifdef MEMORY_USAGE_STATS
6659 compute_buffer_extent_usage (struct buffer *b, struct overhead_stats *ovstats)
6661 /* #### not yet written */
6665 #endif /* MEMORY_USAGE_STATS */
6668 /************************************************************************/
6669 /* initialization */
6670 /************************************************************************/
6673 syms_of_extents (void)
6675 INIT_LRECORD_IMPLEMENTATION (extent);
6676 INIT_LRECORD_IMPLEMENTATION (extent_info);
6677 INIT_LRECORD_IMPLEMENTATION (extent_auxiliary);
6679 defsymbol (&Qextentp, "extentp");
6680 defsymbol (&Qextent_live_p, "extent-live-p");
6682 defsymbol (&Qall_extents_closed, "all-extents-closed");
6683 defsymbol (&Qall_extents_open, "all-extents-open");
6684 defsymbol (&Qall_extents_closed_open, "all-extents-closed-open");
6685 defsymbol (&Qall_extents_open_closed, "all-extents-open-closed");
6686 defsymbol (&Qstart_in_region, "start-in-region");
6687 defsymbol (&Qend_in_region, "end-in-region");
6688 defsymbol (&Qstart_and_end_in_region, "start-and-end-in-region");
6689 defsymbol (&Qstart_or_end_in_region, "start-or-end-in-region");
6690 defsymbol (&Qnegate_in_region, "negate-in-region");
6692 defsymbol (&Qdetached, "detached");
6693 defsymbol (&Qdestroyed, "destroyed");
6694 defsymbol (&Qbegin_glyph, "begin-glyph");
6695 defsymbol (&Qend_glyph, "end-glyph");
6696 defsymbol (&Qstart_open, "start-open");
6697 defsymbol (&Qend_open, "end-open");
6698 defsymbol (&Qstart_closed, "start-closed");
6699 defsymbol (&Qend_closed, "end-closed");
6700 defsymbol (&Qread_only, "read-only");
6701 /* defsymbol (&Qhighlight, "highlight"); in faces.c */
6702 defsymbol (&Qunique, "unique");
6703 defsymbol (&Qduplicable, "duplicable");
6704 defsymbol (&Qdetachable, "detachable");
6705 defsymbol (&Qpriority, "priority");
6706 defsymbol (&Qmouse_face, "mouse-face");
6707 defsymbol (&Qinitial_redisplay_function,"initial-redisplay-function");
6710 defsymbol (&Qglyph_layout, "glyph-layout"); /* backwards compatibility */
6711 defsymbol (&Qbegin_glyph_layout, "begin-glyph-layout");
6712 defsymbol (&Qend_glyph_layout, "end-glyph-layout");
6713 defsymbol (&Qoutside_margin, "outside-margin");
6714 defsymbol (&Qinside_margin, "inside-margin");
6715 defsymbol (&Qwhitespace, "whitespace");
6716 /* Qtext defined in general.c */
6718 defsymbol (&Qpaste_function, "paste-function");
6719 defsymbol (&Qcopy_function, "copy-function");
6721 defsymbol (&Qtext_prop, "text-prop");
6722 defsymbol (&Qtext_prop_extent_paste_function,
6723 "text-prop-extent-paste-function");
6726 DEFSUBR (Fextent_live_p);
6727 DEFSUBR (Fextent_detached_p);
6728 DEFSUBR (Fextent_start_position);
6729 DEFSUBR (Fextent_end_position);
6730 DEFSUBR (Fextent_object);
6731 DEFSUBR (Fextent_length);
6733 DEFSUBR (Fmake_extent);
6734 DEFSUBR (Fcopy_extent);
6735 DEFSUBR (Fdelete_extent);
6736 DEFSUBR (Fdetach_extent);
6737 DEFSUBR (Fset_extent_endpoints);
6738 DEFSUBR (Fnext_extent);
6739 DEFSUBR (Fprevious_extent);
6741 DEFSUBR (Fnext_e_extent);
6742 DEFSUBR (Fprevious_e_extent);
6744 DEFSUBR (Fnext_extent_change);
6745 DEFSUBR (Fprevious_extent_change);
6747 DEFSUBR (Fextent_parent);
6748 DEFSUBR (Fextent_children);
6749 DEFSUBR (Fset_extent_parent);
6751 DEFSUBR (Fextent_in_region_p);
6752 DEFSUBR (Fmap_extents);
6753 DEFSUBR (Fmap_extent_children);
6754 DEFSUBR (Fextent_at);
6756 DEFSUBR (Fset_extent_initial_redisplay_function);
6757 DEFSUBR (Fextent_face);
6758 DEFSUBR (Fset_extent_face);
6759 DEFSUBR (Fextent_mouse_face);
6760 DEFSUBR (Fset_extent_mouse_face);
6761 DEFSUBR (Fset_extent_begin_glyph);
6762 DEFSUBR (Fset_extent_end_glyph);
6763 DEFSUBR (Fextent_begin_glyph);
6764 DEFSUBR (Fextent_end_glyph);
6765 DEFSUBR (Fset_extent_begin_glyph_layout);
6766 DEFSUBR (Fset_extent_end_glyph_layout);
6767 DEFSUBR (Fextent_begin_glyph_layout);
6768 DEFSUBR (Fextent_end_glyph_layout);
6769 DEFSUBR (Fset_extent_priority);
6770 DEFSUBR (Fextent_priority);
6771 DEFSUBR (Fset_extent_property);
6772 DEFSUBR (Fset_extent_properties);
6773 DEFSUBR (Fextent_property);
6774 DEFSUBR (Fextent_properties);
6776 DEFSUBR (Fhighlight_extent);
6777 DEFSUBR (Fforce_highlight_extent);
6779 DEFSUBR (Finsert_extent);
6781 DEFSUBR (Fget_text_property);
6782 DEFSUBR (Fget_char_property);
6783 DEFSUBR (Fput_text_property);
6784 DEFSUBR (Fput_nonduplicable_text_property);
6785 DEFSUBR (Fadd_text_properties);
6786 DEFSUBR (Fadd_nonduplicable_text_properties);
6787 DEFSUBR (Fremove_text_properties);
6788 DEFSUBR (Ftext_prop_extent_paste_function);
6789 DEFSUBR (Fnext_single_property_change);
6790 DEFSUBR (Fprevious_single_property_change);
6794 reinit_vars_of_extents (void)
6796 extent_auxiliary_defaults.begin_glyph = Qnil;
6797 extent_auxiliary_defaults.end_glyph = Qnil;
6798 extent_auxiliary_defaults.parent = Qnil;
6799 extent_auxiliary_defaults.children = Qnil;
6800 extent_auxiliary_defaults.priority = 0;
6801 extent_auxiliary_defaults.invisible = Qnil;
6802 extent_auxiliary_defaults.read_only = Qnil;
6803 extent_auxiliary_defaults.mouse_face = Qnil;
6804 extent_auxiliary_defaults.initial_redisplay_function = Qnil;
6805 extent_auxiliary_defaults.before_change_functions = Qnil;
6806 extent_auxiliary_defaults.after_change_functions = Qnil;
6810 vars_of_extents (void)
6812 reinit_vars_of_extents ();
6814 DEFVAR_INT ("mouse-highlight-priority", &mouse_highlight_priority /*
6815 The priority to use for the mouse-highlighting pseudo-extent
6816 that is used to highlight extents with the `mouse-face' attribute set.
6817 See `set-extent-priority'.
6819 /* Set mouse-highlight-priority (which ends up being used both for the
6820 mouse-highlighting pseudo-extent and the primary selection extent)
6821 to a very high value because very few extents should override it.
6822 1000 gives lots of room below it for different-prioritized extents.
6823 10 doesn't. ediff, for example, likes to use priorities around 100.
6825 mouse_highlight_priority = /* 10 */ 1000;
6827 DEFVAR_LISP ("default-text-properties", &Vdefault_text_properties /*
6828 Property list giving default values for text properties.
6829 Whenever a character does not specify a value for a property, the value
6830 stored in this list is used instead. This only applies when the
6831 functions `get-text-property' or `get-char-property' are called.
6833 Vdefault_text_properties = Qnil;
6835 staticpro (&Vlast_highlighted_extent);
6836 Vlast_highlighted_extent = Qnil;
6838 Vextent_face_reusable_list = Fcons (Qnil, Qnil);
6839 staticpro (&Vextent_face_reusable_list);
6843 complex_vars_of_extents (void)
6845 staticpro (&Vextent_face_memoize_hash_table);
6846 /* The memoize hash table maps from lists of symbols to lists of
6847 faces. It needs to be `equal' to implement the memoization.
6848 The reverse table maps in the other direction and just needs
6849 to do `eq' comparison because the lists of faces are already
6851 Vextent_face_memoize_hash_table =
6852 make_lisp_hash_table (100, HASH_TABLE_VALUE_WEAK, HASH_TABLE_EQUAL);
6853 staticpro (&Vextent_face_reverse_memoize_hash_table);
6854 Vextent_face_reverse_memoize_hash_table =
6855 make_lisp_hash_table (100, HASH_TABLE_KEY_WEAK, HASH_TABLE_EQ);