1 /* Copyright (c) 1994, 1995 Free Software Foundation, Inc.
2 Copyright (c) 1995 Sun Microsystems, Inc.
3 Copyright (c) 1995, 1996, 2000 Ben Wing.
5 This file is part of SXEmacs
7 SXEmacs is free software: you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation, either version 3 of the License, or
10 (at your option) any later version.
12 SXEmacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with this program. If not, see <http://www.gnu.org/licenses/>. */
21 /* Synched up with: Not in FSF. */
23 /* This file has been Mule-ized. */
25 /* Written by Ben Wing <ben@xemacs.org>.
27 [Originally written by some people at Lucid.
29 Start/end-open stuff added by John Rose (john.rose@eng.sun.com).
30 Rewritten from scratch by Ben Wing, December 1994.] */
34 Extents are regions over a buffer, with a start and an end position
35 denoting the region of the buffer included in the extent. In
36 addition, either end can be closed or open, meaning that the endpoint
37 is or is not logically included in the extent. Insertion of a character
38 at a closed endpoint causes the character to go inside the extent;
39 insertion at an open endpoint causes the character to go outside.
41 Extent endpoints are stored using memory indices (see insdel.c),
42 to minimize the amount of adjusting that needs to be done when
43 characters are inserted or deleted.
45 (Formerly, extent endpoints at the gap could be either before or
46 after the gap, depending on the open/closedness of the endpoint.
47 The intent of this was to make it so that insertions would
48 automatically go inside or out of extents as necessary with no
49 further work needing to be done. It didn't work out that way,
50 however, and just ended up complexifying and buggifying all the
53 Extents are compared using memory indices. There are two orderings
54 for extents and both orders are kept current at all times. The normal
55 or "display" order is as follows:
57 Extent A is "less than" extent B, that is, earlier in the display order,
58 if: A-start < B-start,
59 or if: A-start = B-start, and A-end > B-end
61 So if two extents begin at the same position, the larger of them is the
62 earlier one in the display order (EXTENT_LESS is true).
64 For the e-order, the same thing holds: Extent A is "less than" extent B
65 in e-order, that is, later in the buffer,
67 or if: A-end = B-end, and A-start > B-start
69 So if two extents end at the same position, the smaller of them is the
70 earlier one in the e-order (EXTENT_E_LESS is true).
72 The display order and the e-order are complementary orders: any
73 theorem about the display order also applies to the e-order if you
74 swap all occurrences of "display order" and "e-order", "less than"
75 and "greater than", and "extent start" and "extent end".
77 Extents can be zero-length, and will end up that way if their endpoints
78 are explicitly set that way or if their detachable property is nil
79 and all the text in the extent is deleted. (The exception is open-open
80 zero-length extents, which are barred from existing because there is
81 no sensible way to define their properties. Deletion of the text in
82 an open-open extent causes it to be converted into a closed-open
83 extent.) Zero-length extents are primarily used to represent
84 annotations, and behave as follows:
86 1) Insertion at the position of a zero-length extent expands the extent
87 if both endpoints are closed; goes after the extent if it is closed-open;
88 and goes before the extent if it is open-closed.
90 2) Deletion of a character on a side of a zero-length extent whose
91 corresponding endpoint is closed causes the extent to be detached if
92 it is detachable; if the extent is not detachable or the corresponding
93 endpoint is open, the extent remains in the buffer, moving as necessary.
95 Note that closed-open, non-detachable zero-length extents behave exactly
96 like markers and that open-closed, non-detachable zero-length extents
97 behave like the "point-type" marker in Mule.
99 #### The following information is wrong in places.
101 More about the different orders:
102 --------------------------------
104 The extents in a buffer are ordered by "display order" because that
105 is that order that the redisplay mechanism needs to process them in.
106 The e-order is an auxiliary ordering used to facilitate operations
107 over extents. The operations that can be performed on the ordered
108 list of extents in a buffer are
110 1) Locate where an extent would go if inserted into the list.
111 2) Insert an extent into the list.
112 3) Remove an extent from the list.
113 4) Map over all the extents that overlap a range.
115 (4) requires being able to determine the first and last extents
116 that overlap a range.
118 NOTE: "overlap" is used as follows:
120 -- two ranges overlap if they have at least one point in common.
121 Whether the endpoints are open or closed makes a difference here.
122 -- a point overlaps a range if the point is contained within the
123 range; this is equivalent to treating a point P as the range
125 -- In the case of an *extent* overlapping a point or range, the
126 extent is normally treated as having closed endpoints. This
127 applies consistently in the discussion of stacks of extents
128 and such below. Note that this definition of overlap is not
129 necessarily consistent with the extents that `map-extents'
130 maps over, since `map-extents' sometimes pays attention to
131 whether the endpoints of an extents are open or closed.
132 But for our purposes, it greatly simplifies things to treat
133 all extents as having closed endpoints.
135 First, define >, <, <=, etc. as applied to extents to mean
136 comparison according to the display order. Comparison between an
137 extent E and an index I means comparison between E and the range
139 Also define e>, e<, e<=, etc. to mean comparison according to the
141 For any range R, define R(0) to be the starting index of the range
142 and R(1) to be the ending index of the range.
143 For any extent E, define E(next) to be the extent directly following
144 E, and E(prev) to be the extent directly preceding E. Assume
145 E(next) and E(prev) can be determined from E in constant time.
146 (This is because we store the extent list as a doubly linked
148 Similarly, define E(e-next) and E(e-prev) to be the extents
149 directly following and preceding E in the e-order.
154 Let F be the first extent overlapping R.
155 Let L be the last extent overlapping R.
157 Theorem 1: R(1) lies between L and L(next), i.e. L <= R(1) < L(next).
159 This follows easily from the definition of display order. The
160 basic reason that this theorem applies is that the display order
161 sorts by increasing starting index.
163 Therefore, we can determine L just by looking at where we would
164 insert R(1) into the list, and if we know F and are moving forward
165 over extents, we can easily determine when we've hit L by comparing
166 the extent we're at to R(1).
168 Theorem 2: F(e-prev) e< [1, R(0)] e<= F.
170 This is the analog of Theorem 1, and applies because the e-order
171 sorts by increasing ending index.
173 Therefore, F can be found in the same amount of time as operation (1),
174 i.e. the time that it takes to locate where an extent would go if
175 inserted into the e-order list.
177 If the lists were stored as balanced binary trees, then operation (1)
178 would take logarithmic time, which is usually quite fast. However,
179 currently they're stored as simple doubly-linked lists, and instead
180 we do some caching to try to speed things up.
182 Define a "stack of extents" (or "SOE") as the set of extents
183 (ordered in the display order) that overlap an index I, together with
184 the SOE's "previous" extent, which is an extent that precedes I in
185 the e-order. (Hopefully there will not be very many extents between
186 I and the previous extent.)
190 Let I be an index, let S be the stack of extents on I, let F be
191 the first extent in S, and let P be S's previous extent.
193 Theorem 3: The first extent in S is the first extent that overlaps
196 Proof: Any extent that overlaps [I, J] but does not include I must
197 have a start index > I, and thus be greater than any extent in S.
199 Therefore, finding the first extent that overlaps a range R is the
200 same as finding the first extent that overlaps R(0).
202 Theorem 4: Let I2 be an index such that I2 > I, and let F2 be the
203 first extent that overlaps I2. Then, either F2 is in S or F2 is
204 greater than any extent in S.
206 Proof: If F2 does not include I then its start index is greater
207 than I and thus it is greater than any extent in S, including F.
208 Otherwise, F2 includes I and thus is in S, and thus F2 >= F.
217 #include "ui/device.h"
220 #include "ui/faces.h"
221 #include "ui/frame.h"
222 #include "ui/glyphs.h"
223 #include "ui/insdel.h"
224 #include "ui/keymap.h"
227 #include "ui/redisplay.h"
228 #include "ui/gutter.h"
230 /* ------------------------------- */
232 /* ------------------------------- */
234 /* Note that this object is not extent-specific and should perhaps be
235 moved into another file. */
237 typedef struct gap_array_marker_s *gap_array_marker_t;
238 typedef struct gap_array_s *gap_array_t;
240 /* Holds a marker that moves as elements in the array are inserted and
241 deleted, similar to standard markers. */
243 struct gap_array_marker_s {
245 gap_array_marker_t 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
260 gap_array_marker_t markers;
263 #if !defined HAVE_BDWGC || !defined EF_USE_BDWGC
264 static gap_array_marker_t gap_array_marker_freelist;
267 /* Convert a "memory position" (i.e. taking the gap into account) into
268 the address of the element at (i.e. after) that position. "Memory
269 positions" are only used internally and are of type Memind.
270 "Array positions" are used externally and are of type int. */
271 #define GAP_ARRAY_MEMEL_ADDR(ga, memel) ((ga)->array + (ga)->elsize*(memel))
273 /* Number of elements currently in a gap array */
274 #define GAP_ARRAY_NUM_ELS(ga) ((ga)->numels)
276 #define GAP_ARRAY_ARRAY_TO_MEMORY_POS(ga, pos) \
277 ((pos) <= (ga)->gap ? (pos) : (pos) + (ga)->gapsize)
279 #define GAP_ARRAY_MEMORY_TO_ARRAY_POS(ga, pos) \
280 ((pos) <= (ga)->gap ? (pos) : (pos) - (ga)->gapsize)
282 /* Convert an array position into the address of the element at
283 (i.e. after) that position. */
284 #define GAP_ARRAY_EL_ADDR(ga, pos) \
286 ? GAP_ARRAY_MEMEL_ADDR(ga, pos) \
287 : GAP_ARRAY_MEMEL_ADDR(ga, (pos) + (ga)->gapsize))
289 /* ------------------------------- */
291 /* ------------------------------- */
293 typedef struct extent_list_marker_s *extent_list_marker_t;
294 typedef struct extent_list_s *extent_list_t;
296 struct extent_list_marker_s {
297 gap_array_marker_t m;
299 extent_list_marker_t next;
302 struct extent_list_s {
305 extent_list_marker_t markers;
308 #if !defined HAVE_BDWGC || !defined EF_USE_BDWGC
309 static extent_list_marker_t extent_list_marker_freelist;
312 #define EXTENT_LESS_VALS(e,st,nd) \
313 ((extent_start (e) < (st)) || \
314 ((extent_start (e) == (st)) && \
315 (extent_end (e) > (nd))))
317 #define EXTENT_EQUAL_VALS(e,st,nd) \
318 ((extent_start (e) == (st)) && \
319 (extent_end (e) == (nd)))
321 #define EXTENT_LESS_EQUAL_VALS(e,st,nd) \
322 ((extent_start (e) < (st)) || \
323 ((extent_start (e) == (st)) && \
324 (extent_end (e) >= (nd))))
326 /* Is extent E1 less than extent E2 in the display order? */
327 #define EXTENT_LESS(e1,e2) \
328 EXTENT_LESS_VALS (e1, extent_start (e2), extent_end (e2))
330 /* Is extent E1 equal to extent E2? */
331 #define EXTENT_EQUAL(e1,e2) \
332 EXTENT_EQUAL_VALS (e1, extent_start (e2), extent_end (e2))
334 /* Is extent E1 less than or equal to extent E2 in the display order? */
335 #define EXTENT_LESS_EQUAL(e1,e2) \
336 EXTENT_LESS_EQUAL_VALS (e1, extent_start (e2), extent_end (e2))
338 #define EXTENT_E_LESS_VALS(e,st,nd) \
339 ((extent_end (e) < (nd)) || \
340 ((extent_end (e) == (nd)) && \
341 (extent_start (e) > (st))))
343 #define EXTENT_E_LESS_EQUAL_VALS(e,st,nd) \
344 ((extent_end (e) < (nd)) || \
345 ((extent_end (e) == (nd)) && \
346 (extent_start (e) >= (st))))
348 /* Is extent E1 less than extent E2 in the e-order? */
349 #define EXTENT_E_LESS(e1,e2) \
350 EXTENT_E_LESS_VALS(e1, extent_start (e2), extent_end (e2))
352 /* Is extent E1 less than or equal to extent E2 in the e-order? */
353 #define EXTENT_E_LESS_EQUAL(e1,e2) \
354 EXTENT_E_LESS_EQUAL_VALS (e1, extent_start (e2), extent_end (e2))
356 #define EXTENT_GAP_ARRAY_AT(ga, pos) (*(EXTENT*)GAP_ARRAY_EL_ADDR(ga, pos))
358 /* ------------------------------- */
359 /* auxiliary extent structure */
360 /* ------------------------------- */
362 struct extent_auxiliary extent_auxiliary_defaults;
364 /* ------------------------------- */
365 /* buffer-extent primitives */
366 /* ------------------------------- */
367 typedef struct extent_stack_s *extent_stack_t;
369 struct extent_stack_s {
370 extent_list_t extents;
371 /* Position of stack of extents. EXTENTS is the list of
372 all extents that overlap this position. This position
373 can be -1 if the stack of extents is invalid (this
374 happens when a buffer is first created or a string's
375 stack of extents is created [a string's stack of extents
376 is nuked when a GC occurs, to conserve memory]). */
380 /* ------------------------------- */
382 /* ------------------------------- */
384 typedef int Endpoint_Index;
386 #define memind_to_startind(x, start_open) \
387 ((Endpoint_Index) (((x) << 1) + !!(start_open)))
388 #define memind_to_endind(x, end_open) \
389 ((Endpoint_Index) (((x) << 1) - !!(end_open)))
391 /* Combination macros */
392 #define bytind_to_startind(buf, x, start_open) \
393 memind_to_startind (bytind_to_memind (buf, x), start_open)
394 #define bytind_to_endind(buf, x, end_open) \
395 memind_to_endind (bytind_to_memind (buf, x), end_open)
397 /* ------------------------------- */
398 /* buffer-or-string primitives */
399 /* ------------------------------- */
401 /* Similar for Bytinds and start/end indices. */
403 #define buffer_or_string_bytind_to_startind(obj, ind, start_open) \
404 memind_to_startind(buffer_or_string_bytind_to_memind (obj, ind), \
407 #define buffer_or_string_bytind_to_endind(obj, ind, end_open) \
408 memind_to_endind(buffer_or_string_bytind_to_memind (obj, ind), \
411 /* ------------------------------- */
412 /* Lisp-level functions */
413 /* ------------------------------- */
415 /* flags for decode_extent() */
416 #define DE_MUST_HAVE_BUFFER 1
417 #define DE_MUST_BE_ATTACHED 2
419 Lisp_Object Vlast_highlighted_extent;
420 Fixnum mouse_highlight_priority;
422 Lisp_Object Qextentp;
423 Lisp_Object Qextent_live_p;
425 Lisp_Object Qall_extents_closed;
426 Lisp_Object Qall_extents_open;
427 Lisp_Object Qall_extents_closed_open;
428 Lisp_Object Qall_extents_open_closed;
429 Lisp_Object Qstart_in_region;
430 Lisp_Object Qend_in_region;
431 Lisp_Object Qstart_and_end_in_region;
432 Lisp_Object Qstart_or_end_in_region;
433 Lisp_Object Qnegate_in_region;
435 Lisp_Object Qdetached;
436 Lisp_Object Qdestroyed;
437 Lisp_Object Qbegin_glyph;
438 Lisp_Object Qend_glyph;
439 Lisp_Object Qstart_open;
440 Lisp_Object Qend_open;
441 Lisp_Object Qstart_closed;
442 Lisp_Object Qend_closed;
443 Lisp_Object Qread_only;
444 /* Qhighlight defined in general.c */
446 Lisp_Object Qduplicable;
447 Lisp_Object Qdetachable;
448 Lisp_Object Qpriority;
449 Lisp_Object Qmouse_face;
450 Lisp_Object Qinitial_redisplay_function;
452 /* This exists only for backwards compatibility. */
453 Lisp_Object Qglyph_layout;
454 Lisp_Object Qbegin_glyph_layout, Qend_glyph_layout;
455 Lisp_Object Qoutside_margin;
456 Lisp_Object Qinside_margin;
457 Lisp_Object Qwhitespace;
458 /* Qtext defined in general.c */
460 Lisp_Object Qcopy_function;
461 Lisp_Object Qpaste_function;
463 /* The idea here is that if we're given a list of faces, we
464 need to "memoize" this so that two lists of faces that are `equal'
465 turn into the same object. When `set-extent-face' is called, we
466 "memoize" into a list of actual faces; when `extent-face' is called,
467 we do a reverse lookup to get the list of symbols. */
469 static Lisp_Object canonicalize_extent_property(Lisp_Object prop,
471 Lisp_Object Vextent_face_memoize_hash_table;
472 Lisp_Object Vextent_face_reverse_memoize_hash_table;
473 Lisp_Object Vextent_face_reusable_list;
474 /* FSFmacs bogosity */
475 Lisp_Object Vdefault_text_properties;
477 EXFUN(Fextent_properties, 1);
478 EXFUN(Fset_extent_property, 3);
480 /* if true, we don't want to set any redisplay flags on modeline extent
482 int in_modeline_generation;
484 /************************************************************************/
485 /* Generalized gap array */
486 /************************************************************************/
488 /* This generalizes the "array with a gap" model used to store buffer
489 characters. This is based on the stuff in insdel.c and should
490 probably be merged with it. This is not extent-specific and should
491 perhaps be moved into a separate file. */
493 /* ------------------------------- */
494 /* internal functions */
495 /* ------------------------------- */
497 /* Adjust the gap array markers in the range (FROM, TO]. Parallel to
498 adjust_markers() in insdel.c. */
501 gap_array_adjust_markers(gap_array_t ga, Memind from, Memind to, int amount)
503 gap_array_marker_t m;
505 for (m = ga->markers; m; m = m->next) {
506 m->pos = do_marker_adjustment(m->pos, from, to, amount);
511 /* Move the gap to array position POS. Parallel to move_gap() in
512 insdel.c but somewhat simplified. */
515 gap_array_move_gap(gap_array_t ga, int pos)
518 int gapsize = ga->gapsize;
522 memmove(GAP_ARRAY_MEMEL_ADDR(ga, pos + gapsize),
523 GAP_ARRAY_MEMEL_ADDR(ga, pos),
524 (gap - pos) * ga->elsize);
525 gap_array_adjust_markers(ga, (Memind) pos, (Memind) gap,
527 } else if (pos > gap) {
528 memmove(GAP_ARRAY_MEMEL_ADDR(ga, gap),
529 GAP_ARRAY_MEMEL_ADDR(ga, gap + gapsize),
530 (pos - gap) * ga->elsize);
531 gap_array_adjust_markers(ga, (Memind) (gap + gapsize),
532 (Memind) (pos + gapsize), -gapsize);
538 /* Make the gap INCREMENT characters longer. Parallel to make_gap() in
542 gap_array_make_gap(gap_array_t ga, int increment)
544 char *ptr = ga->array;
548 /* If we have to get more space, get enough to last a while. We use
549 a geometric progression that saves on realloc space. */
550 increment += 100 + ga->numels / 8;
552 ptr = (char*)xrealloc(ptr,
553 (ga->numels + ga->gapsize +
554 increment) * ga->elsize);
560 real_gap_loc = ga->gap;
561 old_gap_size = ga->gapsize;
563 /* Call the newly allocated space a gap at the end of the whole
565 ga->gap = ga->numels + ga->gapsize;
566 ga->gapsize = increment;
568 /* Move the new gap down to be consecutive with the end of the old one.
569 This adjusts the markers properly too. */
570 gap_array_move_gap(ga, real_gap_loc + old_gap_size);
572 /* Now combine the two into one large gap. */
573 ga->gapsize += old_gap_size;
574 ga->gap = real_gap_loc;
578 /* ------------------------------- */
579 /* external functions */
580 /* ------------------------------- */
582 /* Insert NUMELS elements (pointed to by ELPTR) into the specified
586 gap_array_insert_els(gap_array_t ga, int pos, void *elptr, int numels)
588 assert(pos >= 0 && pos <= ga->numels);
589 if (ga->gapsize < numels) {
590 gap_array_make_gap(ga, numels - ga->gapsize);
592 if (pos != ga->gap) {
593 gap_array_move_gap(ga, pos);
595 memcpy(GAP_ARRAY_MEMEL_ADDR(ga, ga->gap), (char *)elptr,
596 numels * ga->elsize);
597 ga->gapsize -= numels;
599 ga->numels += numels;
600 /* This is the equivalent of insert-before-markers.
602 #### Should only happen if marker is "moves forward at insert" type.
605 gap_array_adjust_markers(ga, pos - 1, pos, numels);
609 /* Delete NUMELS elements from the specified gap array, starting at FROM. */
612 gap_array_delete_els(gap_array_t ga, int from, int numdel)
614 int to = from + numdel;
615 int gapsize = ga->gapsize;
619 assert(to <= ga->numels);
621 /* Make sure the gap is somewhere in or next to what we are deleting. */
623 gap_array_move_gap(ga, to);
625 if (from > ga->gap) {
626 gap_array_move_gap(ga, from);
628 /* Relocate all markers pointing into the new, larger gap
629 to point at the end of the text before the gap. */
630 gap_array_adjust_markers(ga, to + gapsize, to + gapsize,
633 ga->gapsize += numdel;
634 ga->numels -= numdel;
639 static gap_array_marker_t
640 gap_array_make_marker(gap_array_t ga, int pos)
642 gap_array_marker_t m;
644 assert(pos >= 0 && pos <= ga->numels);
645 #if defined HAVE_BDWGC && defined EF_USE_BDWGC
646 m = xnew(struct gap_array_marker_s);
648 if (gap_array_marker_freelist) {
649 m = gap_array_marker_freelist;
650 gap_array_marker_freelist = gap_array_marker_freelist->next;
652 m = xnew(struct gap_array_marker_s);
656 m->pos = GAP_ARRAY_ARRAY_TO_MEMORY_POS(ga, pos);
657 m->next = ga->markers;
663 gap_array_delete_marker(gap_array_t ga, gap_array_marker_t m)
665 volatile gap_array_marker_t p, prev;
667 for (prev = 0, p = ga->markers; p && p != m; prev = p, p = p->next);
668 if (UNLIKELY(p == NULL)) {
673 prev->next = p->next;
675 ga->markers = p->next;
677 #if defined HAVE_BDWGC && defined EF_USE_BDWGC
680 m->next = gap_array_marker_freelist;
682 gap_array_marker_freelist = m;
688 gap_array_delete_all_markers(gap_array_t ga)
690 for (volatile gap_array_marker_t p = ga->markers, next; p; p = next) {
692 #if defined HAVE_BDWGC && defined EF_USE_BDWGC
695 p->next = gap_array_marker_freelist;
697 gap_array_marker_freelist = p;
705 gap_array_move_marker(gap_array_t ga, gap_array_marker_t m, int pos)
707 assert(pos >= 0 && pos <= ga->numels);
708 m->pos = GAP_ARRAY_ARRAY_TO_MEMORY_POS(ga, pos);
711 #define gap_array_marker_pos(ga, m) \
712 GAP_ARRAY_MEMORY_TO_ARRAY_POS (ga, (m)->pos)
715 make_gap_array(int elsize)
717 gap_array_t ga = xnew_and_zero(struct gap_array_s);
723 free_gap_array(gap_array_t ga)
728 gap_array_delete_all_markers(ga);
733 /************************************************************************/
734 /* Extent list primitives */
735 /************************************************************************/
737 /* A list of extents is maintained as a double gap array: one gap array
738 is ordered by start index (the "display order") and the other is
739 ordered by end index (the "e-order"). Note that positions in an
740 extent list should logically be conceived of as referring *to*
741 a particular extent (as is the norm in programs) rather than
742 sitting between two extents. Note also that callers of these
743 functions should not be aware of the fact that the extent list is
744 implemented as an array, except for the fact that positions are
745 integers (this should be generalized to handle integers and linked
749 /* Number of elements in an extent list */
750 #define extent_list_num_els(el) GAP_ARRAY_NUM_ELS(el->start)
752 /* Return the position at which EXTENT is located in the specified extent
753 list (in the display order if ENDP is 0, in the e-order otherwise).
754 If the extent is not found, the position where the extent would
755 be inserted is returned. If ENDP is 0, the insertion would go after
756 all other equal extents. If ENDP is not 0, the insertion would go
757 before all other equal extents. If FOUNDP is not 0, then whether
758 the extent was found will get written into it. */
761 extent_list_locate(extent_list_t el, EXTENT extent, int endp, bool *foundp)
763 gap_array_t ga = endp ? el->end : el->start;
764 int left = 0, right = GAP_ARRAY_NUM_ELS(ga);
765 int oldfoundpos, foundpos;
768 while (left != right) {
769 /* RIGHT might not point to a valid extent (i.e. it's at the end
770 of the list), so NEWPOS must round down. */
771 unsigned int newpos = (left + right) >> 1;
772 EXTENT e = EXTENT_GAP_ARRAY_AT(ga, (int)newpos);
774 if (endp ? EXTENT_E_LESS(e, extent) : EXTENT_LESS(e, extent)) {
781 /* Now we're at the beginning of all equal extents. */
783 oldfoundpos = foundpos = left;
784 while (foundpos < GAP_ARRAY_NUM_ELS(ga)) {
785 EXTENT e = EXTENT_GAP_ARRAY_AT(ga, foundpos);
790 if (!EXTENT_EQUAL(e, extent)) {
798 if (found || !endp) {
805 /* Return the position of the first extent that begins at or after POS
806 (or ends at or after POS, if ENDP is not 0).
808 An out-of-range value for POS is allowed, and guarantees that the
809 position at the beginning or end of the extent list is returned. */
812 extent_list_locate_from_pos(extent_list_t el, Memind pos, int endp)
814 struct extent fake_extent;
817 Note that if we search for [POS, POS], then we get the following:
819 -- if ENDP is 0, then all extents whose start position is <= POS
820 lie before the returned position, and all extents whose start
821 position is > POS lie at or after the returned position.
823 -- if ENDP is not 0, then all extents whose end position is < POS
824 lie before the returned position, and all extents whose end
825 position is >= POS lie at or after the returned position.
828 set_extent_start(&fake_extent, endp ? pos : pos - 1);
829 set_extent_end(&fake_extent, endp ? pos : pos - 1);
830 return extent_list_locate(el, &fake_extent, endp, 0);
833 /* Return the extent at POS. */
836 extent_list_at(extent_list_t el, Memind pos, int endp)
838 gap_array_t ga = endp ? el->end : el->start;
840 assert(pos >= 0 && pos < GAP_ARRAY_NUM_ELS(ga));
841 return EXTENT_GAP_ARRAY_AT(ga, pos);
844 /* Insert an extent into an extent list. */
847 extent_list_insert(extent_list_t el, EXTENT extent)
852 pos = extent_list_locate(el, extent, 0, &foundp);
854 gap_array_insert_els(el->start, pos, &extent, 1);
855 pos = extent_list_locate(el, extent, 1, &foundp);
857 gap_array_insert_els(el->end, pos, &extent, 1);
861 /* Delete an extent from an extent list. */
864 extent_list_delete(extent_list_t el, EXTENT extent)
869 pos = extent_list_locate(el, extent, 0, &foundp);
871 gap_array_delete_els(el->start, pos, 1);
872 pos = extent_list_locate(el, extent, 1, &foundp);
874 gap_array_delete_els(el->end, pos, 1);
879 extent_list_delete_all(extent_list_t el)
881 gap_array_delete_els(el->start, 0, GAP_ARRAY_NUM_ELS(el->start));
882 gap_array_delete_els(el->end, 0, GAP_ARRAY_NUM_ELS(el->end));
886 static extent_list_marker_t
887 extent_list_make_marker(extent_list_t el, int pos, int endp)
889 extent_list_marker_t m;
891 #if defined HAVE_BDWGC && defined EF_USE_BDWGC
892 m = xnew(struct extent_list_marker_s);
894 if (extent_list_marker_freelist) {
895 m = extent_list_marker_freelist;
896 extent_list_marker_freelist = extent_list_marker_freelist->next;
898 m = xnew(struct extent_list_marker_s);
902 m->m = gap_array_make_marker(endp ? el->end : el->start, pos);
904 m->next = el->markers;
909 #define extent_list_move_marker(el, mkr, pos) \
910 gap_array_move_marker((mkr)->endp \
912 : (el)->start, (mkr)->m, pos)
915 extent_list_delete_marker(extent_list_t el, extent_list_marker_t m)
917 extent_list_marker_t p, prev;
919 for (prev = 0, p = el->markers; p && p != m; prev = p, p = p->next);
926 prev->next = p->next;
928 el->markers = p->next;
930 #if defined HAVE_BDWGC && defined EF_USE_BDWGC
933 m->next = extent_list_marker_freelist;
934 extent_list_marker_freelist = m;
936 gap_array_delete_marker(m->endp ? el->end : el->start, m->m);
940 #define extent_list_marker_pos(el, mkr) \
941 gap_array_marker_pos ((mkr)->endp \
943 : (el)->start, (mkr)->m)
946 allocate_extent_list(void)
948 extent_list_t el = xnew(struct extent_list_s);
949 el->start = make_gap_array(sizeof(EXTENT));
950 el->end = make_gap_array(sizeof(EXTENT));
956 free_extent_list(extent_list_t el)
958 free_gap_array(el->start);
959 free_gap_array(el->end);
964 /************************************************************************/
965 /* Auxiliary extent structure */
966 /************************************************************************/
968 static Lisp_Object mark_extent_auxiliary(Lisp_Object obj)
970 struct extent_auxiliary *data = XEXTENT_AUXILIARY(obj);
971 mark_object(data->begin_glyph);
972 mark_object(data->end_glyph);
973 mark_object(data->invisible);
974 mark_object(data->children);
975 mark_object(data->read_only);
976 mark_object(data->mouse_face);
977 mark_object(data->initial_redisplay_function);
978 mark_object(data->before_change_functions);
979 mark_object(data->after_change_functions);
983 DEFINE_LRECORD_IMPLEMENTATION("extent-auxiliary", extent_auxiliary,
984 mark_extent_auxiliary, internal_object_printer,
985 0, 0, 0, 0, struct extent_auxiliary);
987 void allocate_extent_auxiliary(EXTENT ext)
989 Lisp_Object extent_aux;
990 struct extent_auxiliary *data =
991 alloc_lcrecord_type(struct extent_auxiliary,
992 &lrecord_extent_auxiliary);
994 copy_lcrecord(data, &extent_auxiliary_defaults);
995 XSETEXTENT_AUXILIARY(extent_aux, data);
996 ext->plist = Fcons(extent_aux, ext->plist);
997 ext->flags.has_aux = 1;
1001 /************************************************************************/
1002 /* Extent info structure */
1003 /************************************************************************/
1005 /* An extent-info structure consists of a list of the buffer or string's
1006 extents and a "stack of extents" that lists all of the extents over
1007 a particular position. The stack-of-extents info is used for
1008 optimization purposes -- it basically caches some info that might
1009 be expensive to compute. Certain otherwise hard computations are easy
1010 given the stack of extents over a particular position, and if the
1011 stack of extents over a nearby position is known (because it was
1012 calculated at some prior point in time), it's easy to move the stack
1013 of extents to the proper position.
1015 Given that the stack of extents is an optimization, and given that
1016 it requires memory, a string's stack of extents is wiped out each
1017 time a garbage collection occurs. Therefore, any time you retrieve
1018 the stack of extents, it might not be there. If you need it to
1019 be there, use the _force version.
1021 Similarly, a string may or may not have an extent_info structure.
1022 (Generally it won't if there haven't been any extents added to the
1023 string.) So use the _force version if you need the extent_info
1024 structure to be there. */
1026 static extent_stack_t allocate_soe(void);
1027 static void free_soe(extent_stack_t);
1028 static void soe_invalidate(Lisp_Object obj);
1030 #if !defined HAVE_BDWGC || !defined EF_USE_BDWGC
1032 mark_extent_info(Lisp_Object obj)
1034 struct extent_info *data = (struct extent_info *)XEXTENT_INFO(obj);
1036 extent_list_t list = data->extents;
1038 /* Vbuffer_defaults and Vbuffer_local_symbols are buffer-like
1039 objects that are created specially and never have their extent
1040 list initialized (or rather, it is set to zero in
1041 nuke_all_buffer_slots()). However, these objects get
1042 garbage-collected so we have to deal.
1044 (Also the list can be zero when we're dealing with a destroyed
1048 for (i = 0; i < extent_list_num_els(list); i++) {
1049 struct extent *extent = extent_list_at(list, i, 0);
1052 XSETEXTENT(exobj, extent);
1061 finalize_extent_info(void *header, int for_disksave)
1063 struct extent_info *data = (struct extent_info *)header;
1069 free_soe(data->soe);
1072 if (data->extents) {
1073 free_extent_list(data->extents);
1078 /* just define dummies */
1080 mark_extent_info(Lisp_Object SXE_UNUSED(obj))
1086 finalize_extent_info(void *SXE_UNUSED(header), int SXE_UNUSED(for_disksave))
1092 DEFINE_LRECORD_IMPLEMENTATION("extent-info", extent_info,
1093 mark_extent_info, internal_object_printer,
1094 finalize_extent_info, 0, 0, 0,
1095 struct extent_info);
1098 allocate_extent_info(void)
1100 Lisp_Object extent_info;
1101 struct extent_info *data =
1102 alloc_lcrecord_type(struct extent_info, &lrecord_extent_info);
1104 XSETEXTENT_INFO(extent_info, data);
1105 data->extents = allocate_extent_list();
1111 flush_cached_extent_info(Lisp_Object extent_info)
1113 struct extent_info *data = XEXTENT_INFO(extent_info);
1116 free_soe(data->soe);
1121 /************************************************************************/
1122 /* Buffer/string extent primitives */
1123 /************************************************************************/
1125 /* The functions in this section are the ONLY ones that should know
1126 about the internal implementation of the extent lists. Other functions
1127 should only know that there are two orderings on extents, the "display"
1128 order (sorted by start position, basically) and the e-order (sorted
1129 by end position, basically), and that certain operations are provided
1130 to manipulate the list. */
1132 /* ------------------------------- */
1133 /* basic primitives */
1134 /* ------------------------------- */
1137 decode_buffer_or_string(Lisp_Object object)
1139 if (LIKELY(NILP(object))) {
1140 XSETBUFFER(object, current_buffer);
1141 } else if (BUFFERP(object)) {
1142 CHECK_LIVE_BUFFER(object);
1143 } else if (STRINGP(object)) {
1146 dead_wrong_type_argument(Qbuffer_or_string_p, object);
1151 EXTENT extent_ancestor_1(EXTENT e)
1153 while (e->flags.has_parent) {
1154 /* There should be no circularities except in case of a logic
1155 error somewhere in the extent code */
1156 e = XEXTENT(XEXTENT_AUXILIARY(XCAR(e->plist))->parent);
1161 /* Given an extent object (string or buffer or nil), return its extent info.
1162 This may be 0 for a string. */
1164 static struct extent_info*
1165 buffer_or_string_extent_info(Lisp_Object object)
1167 if (STRINGP(object)) {
1168 Lisp_Object plist = XSTRING(object)->plist;
1169 if (!CONSP(plist) || !EXTENT_INFOP(XCAR(plist))) {
1172 return XEXTENT_INFO(XCAR(plist));
1173 } else if (NILP(object)) {
1176 return XEXTENT_INFO(XBUFFER(object)->extent_info);
1180 /* Given a string or buffer, return its extent list. This may be
1183 static extent_list_t
1184 buffer_or_string_extent_list(Lisp_Object object)
1186 struct extent_info *info = buffer_or_string_extent_info(object);
1191 return info->extents;
1194 /* Given a string or buffer, return its extent info. If it's not there,
1197 static struct extent_info*
1198 buffer_or_string_extent_info_force(Lisp_Object object)
1200 struct extent_info *info = buffer_or_string_extent_info(object);
1203 Lisp_Object extent_info;
1205 /* should never happen for buffers --
1206 the only buffers without an extent
1207 info are those after finalization,
1208 destroyed buffers, or special
1209 Lisp-inaccessible buffer objects. */
1210 assert(STRINGP(object));
1212 extent_info = allocate_extent_info();
1213 XSTRING(object)->plist =
1214 Fcons(extent_info, XSTRING(object)->plist);
1215 return XEXTENT_INFO(extent_info);
1220 /* Detach all the extents in OBJECT. Called from redisplay. */
1223 detach_all_extents(Lisp_Object object)
1225 struct extent_info *data = buffer_or_string_extent_info(object);
1228 if (data->extents) {
1230 i < extent_list_num_els(data->extents);
1232 EXTENT e = extent_list_at(data->extents, i, 0);
1233 /* No need to do detach_extent(). Just nuke the
1234 damn things, which results in the equivalent
1236 set_extent_start(e, -1);
1237 set_extent_end(e, -1);
1239 /* But we need to clear all the lists containing extents
1240 or havoc will result. */
1241 extent_list_delete_all(data->extents);
1243 soe_invalidate(object);
1249 init_buffer_extents(struct buffer *b)
1251 b->extent_info = allocate_extent_info();
1256 uninit_buffer_extents(struct buffer *b)
1258 struct extent_info *data = XEXTENT_INFO(b->extent_info);
1260 /* Don't destroy the extents here -- there may still be children
1261 extents pointing to the extents. */
1262 detach_all_extents(make_buffer(b));
1263 finalize_extent_info(data, 0);
1267 /* Retrieve the extent list that an extent is a member of; the
1268 return value will never be 0 except in destroyed buffers (in which
1269 case the only extents that can refer to this buffer are detached
1272 #define extent_extent_list(e) buffer_or_string_extent_list (extent_object (e))
1274 /* ------------------------------- */
1275 /* stack of extents */
1276 /* ------------------------------- */
1278 #ifdef ERROR_CHECK_EXTENTS
1281 sledgehammer_extent_check(Lisp_Object object)
1283 extent_list_t el = buffer_or_string_extent_list(object);
1284 struct buffer *buf = 0;
1289 if (BUFFERP(object)) {
1290 buf = XBUFFER(object);
1292 for (int endp = 0; endp < 2; endp++) {
1293 for (int i = 1; i < extent_list_num_els(el); i++) {
1294 EXTENT e1 = extent_list_at(el, i - 1, endp);
1295 EXTENT e2 = extent_list_at(el, i, endp);
1297 assert(extent_start(e1) <= buf->text->gpt ||
1299 buf->text->gpt + buf->text->gap_size);
1300 assert(extent_end(e1) <= buf->text->gpt
1302 buf->text->gpt + buf->text->gap_size);
1304 assert(extent_start(e1) <= extent_end(e1));
1306 ? (EXTENT_E_LESS_EQUAL(e1, e2))
1307 : (EXTENT_LESS_EQUAL(e1, e2)));
1312 #endif /* ERROR_CHECK_EXTENTS */
1314 static extent_stack_t
1315 buffer_or_string_stack_of_extents(Lisp_Object object)
1317 struct extent_info *info = buffer_or_string_extent_info(object);
1324 static extent_stack_t
1325 buffer_or_string_stack_of_extents_force(Lisp_Object object)
1327 struct extent_info *info = buffer_or_string_extent_info_force(object);
1329 info->soe = allocate_soe();
1334 /* #define SOE_DEBUG */
1338 static void print_extent_1(char *buf, Lisp_Object extent);
1341 print_extent_2(EXTENT e)
1346 XSETEXTENT(extent, e);
1347 print_extent_1(buf, extent);
1352 soe_dump(Lisp_Object obj)
1355 extent_stack_t soe = buffer_or_string_stack_of_extents(obj);
1364 printf("SOE pos is %d (memind %d)\n",
1365 soe->pos < 0 ? soe->pos :
1366 buffer_or_string_memind_to_bytind(obj, soe->pos), soe->pos);
1367 for (endp = 0; endp < 2; endp++) {
1368 printf(endp ? "SOE end:" : "SOE start:");
1369 for (i = 0; i < extent_list_num_els(sel); i++) {
1370 EXTENT e = extent_list_at(sel, i, endp);
1379 #endif /* SOE_DEBUG */
1381 /* Insert EXTENT into OBJ's stack of extents, if necessary. */
1384 soe_insert(Lisp_Object obj, EXTENT extent)
1386 extent_stack_t soe = buffer_or_string_stack_of_extents(obj);
1389 printf("Inserting into SOE: ");
1390 print_extent_2(extent);
1393 if (!soe || soe->pos < extent_start(extent) ||
1394 soe->pos > extent_end(extent)) {
1396 printf("(not needed)\n\n");
1400 extent_list_insert(soe->extents, extent);
1402 puts("SOE afterwards is:");
1408 /* Delete EXTENT from OBJ's stack of extents, if necessary. */
1411 soe_delete(Lisp_Object obj, EXTENT extent)
1413 extent_stack_t soe = buffer_or_string_stack_of_extents(obj);
1416 printf("Deleting from SOE: ");
1417 print_extent_2(extent);
1420 if (!soe || soe->pos < extent_start(extent) ||
1421 soe->pos > extent_end(extent)) {
1423 puts("(not needed)\n");
1427 extent_list_delete(soe->extents, extent);
1429 puts("SOE afterwards is:");
1435 /* Move OBJ's stack of extents to lie over the specified position. */
1438 soe_move(Lisp_Object obj, Memind pos)
1440 extent_stack_t soe = buffer_or_string_stack_of_extents_force(obj);
1441 extent_list_t sel = soe->extents;
1442 int numsoe = extent_list_num_els(sel);
1443 extent_list_t bel = buffer_or_string_extent_list(obj);
1447 #ifdef ERROR_CHECK_EXTENTS
1452 printf("Moving SOE from %d (memind %d) to %d (memind %d)\n",
1453 soe->pos < 0 ? soe->pos :
1454 buffer_or_string_memind_to_bytind(obj, soe->pos), soe->pos,
1455 buffer_or_string_memind_to_bytind(obj, pos), pos);
1457 if (soe->pos < pos) {
1460 } else if (soe->pos > pos) {
1465 puts("(not needed)\n");
1470 /* For DIRECTION = 1: Any extent that overlaps POS is either in the
1471 SOE (if the extent starts at or before SOE->POS) or is greater
1472 (in the display order) than any extent in the SOE (if it starts
1475 For DIRECTION = -1: Any extent that overlaps POS is either in the
1476 SOE (if the extent ends at or after SOE->POS) or is less (in the
1477 e-order) than any extent in the SOE (if it ends before SOE->POS).
1479 We proceed in two stages:
1481 1) delete all extents in the SOE that don't overlap POS.
1482 2) insert all extents into the SOE that start (or end, when
1483 DIRECTION = -1) in (SOE->POS, POS] and that overlap
1484 POS. (Don't include SOE->POS in the range because those
1485 extents would already be in the SOE.)
1491 /* Delete all extents in the SOE that don't overlap POS.
1492 This is all extents that end before (or start after,
1493 if DIRECTION = -1) POS.
1496 /* Deleting extents from the SOE is tricky because it changes
1497 the positions of extents. If we are deleting in the forward
1498 direction we have to call extent_list_at() on the same position
1499 over and over again because positions after the deleted element
1500 get shifted back by 1. To make life simplest, we delete forward
1501 irrespective of DIRECTION.
1506 if (direction > 0) {
1508 end = extent_list_locate_from_pos(sel, pos, 1);
1510 start = extent_list_locate_from_pos(sel, pos + 1, 0);
1514 for (i = start; i < end; i++) {
1516 sel, extent_list_at(sel, start, !endp));
1525 if (direction < 0) {
1527 extent_list_locate_from_pos(
1528 bel, soe->pos, endp) - 1;
1531 extent_list_locate_from_pos(
1532 bel, soe->pos + 1, endp);
1535 for (; start_pos >= 0 && start_pos < extent_list_num_els(bel);
1536 start_pos += direction) {
1537 EXTENT e = extent_list_at(bel, start_pos, endp);
1539 ? (extent_start(e) > pos)
1540 : (extent_end(e) < pos)) {
1541 /* All further extents lie on the far side of
1542 POS and thus can't overlap. */
1546 ? (extent_end(e) >= pos)
1547 : (extent_start(e) <= pos)) {
1548 extent_list_insert(sel, e);
1555 puts("SOE afterwards is:");
1562 soe_invalidate(Lisp_Object obj)
1564 extent_stack_t soe = buffer_or_string_stack_of_extents(obj);
1567 extent_list_delete_all(soe->extents);
1573 static extent_stack_t
1576 extent_stack_t soe = xnew_and_zero(struct extent_stack_s);
1577 soe->extents = allocate_extent_list();
1583 free_soe(extent_stack_t soe)
1585 free_extent_list(soe->extents);
1590 /* ------------------------------- */
1591 /* other primitives */
1592 /* ------------------------------- */
1594 /* Return the start (endp == 0) or end (endp == 1) of an extent as
1595 a byte index. If you want the value as a memory index, use
1596 extent_endpoint(). If you want the value as a buffer position,
1597 use extent_endpoint_bufpos(). */
1599 static Bytind extent_endpoint_bytind(EXTENT extent, int endp)
1601 assert(EXTENT_LIVE_P(extent));
1602 assert(!extent_detached_p(extent));
1604 Memind i = endp ? extent_end(extent) : extent_start(extent);
1605 Lisp_Object obj = extent_object(extent);
1606 return buffer_or_string_memind_to_bytind(obj, i);
1610 static Bufpos extent_endpoint_bufpos(EXTENT extent, int endp)
1612 assert(EXTENT_LIVE_P(extent));
1613 assert(!extent_detached_p(extent));
1615 Memind i = endp ? extent_end(extent) : extent_start(extent);
1616 Lisp_Object obj = extent_object(extent);
1617 return buffer_or_string_memind_to_bufpos(obj, i);
1621 /* A change to an extent occurred that will change the display, so
1622 notify redisplay. Maybe also recurse over all the extent's
1626 extent_changed_for_redisplay(EXTENT extent, int descendants_too,
1627 int invisibility_change)
1632 /* we could easily encounter a detached extent while traversing the
1633 children, but we should never be able to encounter a dead extent. */
1634 assert(EXTENT_LIVE_P(extent));
1636 if (descendants_too) {
1637 Lisp_Object children = extent_children(extent);
1639 if (!NILP(children)) {
1640 /* first mark all of the extent's children. We will
1641 lose big-time if there are any circularities here, so
1642 we sure as hell better ensure that there aren't. */
1643 LIST_LOOP(rest, XWEAK_LIST_LIST(children)) {
1644 extent_changed_for_redisplay(
1645 XEXTENT(XCAR(rest)), 1,
1646 invisibility_change);
1651 /* now mark the extent itself. */
1653 object = extent_object(extent);
1655 if (extent_detached_p(extent)) {
1658 } else if (STRINGP(object)) {
1659 /* #### Changes to string extents can affect redisplay if they
1660 are in the modeline or in the gutters.
1662 If the extent is in some generated-modeline-string: when we
1663 change an extent in generated-modeline-string, this changes
1664 its parent, which is in `modeline-format', so we should force
1665 the modeline to be updated. But how to determine whether a
1666 string is a `generated-modeline-string'? Looping through all
1667 buffers is not very efficient. Should we add all
1668 `generated-modeline-string' strings to a hash table? Maybe
1669 efficiency is not the greatest concern here and there's no
1670 big loss in looping over the buffers.
1672 If the extent is in a gutter we mark the gutter as
1673 changed. This means (a) we can update extents in the gutters
1674 when we need it. (b) we don't have to update the gutters when
1675 only extents attached to buffers have changed. */
1677 if (!in_modeline_generation) {
1678 MARK_EXTENTS_CHANGED;
1680 gutter_extent_signal_changed_region_maybe(
1682 extent_endpoint_bufpos(extent, 0),
1683 extent_endpoint_bufpos(extent, 1));
1685 } else if (BUFFERP(object)) {
1687 b = XBUFFER(object);
1688 BUF_FACECHANGE(b)++;
1689 MARK_EXTENTS_CHANGED;
1690 if (invisibility_change) {
1693 buffer_extent_signal_changed_region(
1695 extent_endpoint_bufpos(extent, 0),
1696 extent_endpoint_bufpos(extent, 1));
1700 /* A change to an extent occurred that might affect redisplay.
1701 This is called when properties such as the endpoints, the layout,
1702 or the priority changes. Redisplay will be affected only if
1703 the extent has any displayable attributes. */
1706 extent_maybe_changed_for_redisplay(EXTENT extent, int descendants_too,
1707 int invisibility_change)
1709 /* Retrieve the ancestor for efficiency */
1710 EXTENT anc = extent_ancestor(extent);
1711 if (!NILP(extent_face(anc)) ||
1712 !NILP(extent_begin_glyph(anc)) ||
1713 !NILP(extent_end_glyph(anc)) ||
1714 !NILP(extent_mouse_face(anc)) ||
1715 !NILP(extent_invisible(anc)) ||
1716 !NILP(extent_initial_redisplay_function(anc)) ||
1717 invisibility_change)
1718 extent_changed_for_redisplay(extent, descendants_too,
1719 invisibility_change);
1723 make_extent_detached(Lisp_Object object)
1725 EXTENT extent = allocate_extent();
1727 assert(NILP(object) || STRINGP(object) ||
1728 (BUFFERP(object) && BUFFER_LIVE_P(XBUFFER(object))));
1729 extent_object(extent) = object;
1730 /* Now make sure the extent info exists. */
1731 if (!NILP(object)) {
1732 buffer_or_string_extent_info_force(object);
1737 /* A "real" extent is any extent other than the internal (not-user-visible)
1738 extents used by `map-extents'. */
1741 real_extent_at_forward(extent_list_t el, int pos, int endp)
1743 for (; pos < extent_list_num_els(el); pos++) {
1744 EXTENT e = extent_list_at(el, pos, endp);
1745 if (!extent_internal_p(e)) {
1753 real_extent_at_backward(extent_list_t el, int pos, int endp)
1755 for (; pos >= 0; pos--) {
1756 EXTENT e = extent_list_at(el, pos, endp);
1757 if (!extent_internal_p(e)) {
1765 extent_first(Lisp_Object obj)
1767 extent_list_t el = buffer_or_string_extent_list(obj);
1772 return real_extent_at_forward(el, 0, 0);
1775 #ifdef DEBUG_SXEMACS
1777 extent_e_first(Lisp_Object obj)
1779 extent_list_t el = buffer_or_string_extent_list(obj);
1784 return real_extent_at_forward(el, 0, 1);
1786 #endif /* DEBUG_SXEMACS */
1789 extent_next(EXTENT e)
1791 extent_list_t el = extent_extent_list(e);
1793 int pos = extent_list_locate(el, e, 0, &foundp);
1795 return real_extent_at_forward(el, pos + 1, 0);
1798 #ifdef DEBUG_SXEMACS
1800 extent_e_next(EXTENT e)
1802 extent_list_t el = extent_extent_list(e);
1804 int pos = extent_list_locate(el, e, 1, &foundp);
1806 return real_extent_at_forward(el, pos + 1, 1);
1808 #endif /* DEBUG_SXEMACS */
1811 extent_last(Lisp_Object obj)
1813 extent_list_t el = buffer_or_string_extent_list(obj);
1818 return real_extent_at_backward(el, extent_list_num_els(el) - 1, 0);
1821 #ifdef DEBUG_SXEMACS
1823 extent_e_last(Lisp_Object obj)
1825 extent_list_t el = buffer_or_string_extent_list(obj);
1830 return real_extent_at_backward(el, extent_list_num_els(el) - 1, 1);
1832 #endif /* DEBUG_SXEMACS */
1835 extent_previous(EXTENT e)
1837 extent_list_t el = extent_extent_list(e);
1839 int pos = extent_list_locate(el, e, 0, &foundp);
1841 return real_extent_at_backward(el, pos - 1, 0);
1844 #ifdef DEBUG_SXEMACS
1846 extent_e_previous(EXTENT e)
1848 extent_list_t el = extent_extent_list(e);
1850 int pos = extent_list_locate(el, e, 1, &foundp);
1852 return real_extent_at_backward(el, pos - 1, 1);
1854 #endif /* DEBUG_SXEMACS */
1857 extent_attach(EXTENT extent)
1859 extent_list_t el = extent_extent_list(extent);
1861 extent_list_insert(el, extent);
1862 soe_insert(extent_object(extent), extent);
1863 /* only this extent changed */
1864 extent_maybe_changed_for_redisplay(
1865 extent, 0, !NILP(extent_invisible(extent)));
1870 extent_detach(EXTENT extent)
1874 if (extent_detached_p(extent)) {
1877 el = extent_extent_list(extent);
1879 /* call this before messing with the extent. */
1880 extent_maybe_changed_for_redisplay(
1881 extent, 0, !NILP(extent_invisible(extent)));
1882 extent_list_delete(el, extent);
1883 soe_delete(extent_object(extent), extent);
1884 set_extent_start(extent, -1);
1885 set_extent_end(extent, -1);
1889 /* ------------------------------- */
1890 /* map-extents et al. */
1891 /* ------------------------------- */
1893 /* Returns true iff map_extents() would visit the given extent.
1894 See the comments at map_extents() for info on the overlap rule.
1895 Assumes that all validation on the extent and buffer positions has
1896 already been performed (see Fextent_in_region_p ()).
1899 extent_in_region_p(EXTENT extent, Bytind from, Bytind to, unsigned int flags)
1901 Lisp_Object obj = extent_object(extent);
1902 Endpoint_Index start, end, exs, exe;
1903 int start_open, end_open;
1904 unsigned int all_extents_flags = flags & ME_ALL_EXTENTS_MASK;
1905 unsigned int in_region_flags = flags & ME_IN_REGION_MASK;
1908 /* A zero-length region is treated as closed-closed. */
1910 flags |= ME_END_CLOSED;
1911 flags &= ~ME_START_OPEN;
1914 /* So is a zero-length extent. */
1915 if (extent_start(extent) == extent_end(extent)) {
1916 start_open = 0, end_open = 0;
1917 } else if (LIKELY(all_extents_flags == 0)) {
1918 /* `all_extents_flags' will almost always be zero. */
1919 start_open = extent_start_open_p(extent);
1920 end_open = extent_end_open_p(extent);
1922 switch (all_extents_flags) {
1923 case ME_ALL_EXTENTS_CLOSED:
1924 start_open = 0, end_open = 0;
1926 case ME_ALL_EXTENTS_OPEN:
1927 start_open = 1, end_open = 1;
1929 case ME_ALL_EXTENTS_CLOSED_OPEN:
1930 start_open = 0, end_open = 1;
1932 case ME_ALL_EXTENTS_OPEN_CLOSED:
1933 start_open = 1, end_open = 0;
1940 start = buffer_or_string_bytind_to_startind(obj, from,
1941 flags & ME_START_OPEN);
1942 end = buffer_or_string_bytind_to_endind(obj, to,
1943 !(flags & ME_END_CLOSED));
1944 exs = memind_to_startind(extent_start(extent), start_open);
1945 exe = memind_to_endind(extent_end(extent), end_open);
1947 /* It's easy to determine whether an extent lies *outside* the
1948 region -- just determine whether it's completely before
1949 or completely after the region. Reject all such extents, so
1950 we're now left with only the extents that overlap the region.
1953 if (exs > end || exe < start) {
1956 /* See if any further restrictions are called for. */
1957 /* in_region_flags will almost always be zero. */
1958 if (in_region_flags == 0) {
1961 switch (in_region_flags) {
1962 case ME_START_IN_REGION:
1963 retval = start <= exs && exs <= end;
1965 case ME_END_IN_REGION:
1966 retval = start <= exe && exe <= end;
1968 case ME_START_AND_END_IN_REGION:
1969 retval = start <= exs && exe <= end;
1971 case ME_START_OR_END_IN_REGION:
1972 retval = (start <= exs && exs <= end) ||
1973 (start <= exe && exe <= end);
1980 return flags & ME_NEGATE_IN_REGION ? !retval : retval;
1983 struct map_extents_struct {
1985 extent_list_marker_t mkr;
1990 map_extents_unwind(Lisp_Object obj)
1992 struct map_extents_struct *closure =
1993 (struct map_extents_struct *)get_opaque_ptr(obj);
1994 free_opaque_ptr(obj);
1995 if (closure->range) {
1996 extent_detach(closure->range);
1999 extent_list_delete_marker(closure->el, closure->mkr);
2004 /* This is the guts of `map-extents' and the other functions that
2005 map over extents. In theory the operation of this function is
2006 simple: just figure out what extents we're mapping over, and
2007 call the function on each one of them in the range. Unfortunately
2008 there are a wide variety of things that the mapping function
2009 might do, and we have to be very tricky to avoid getting messed
2010 up. Furthermore, this function needs to be very fast (it is
2011 called multiple times every time text is inserted or deleted
2012 from a buffer), and so we can't always afford the overhead of
2013 dealing with all the possible things that the mapping function
2014 might do; thus, there are many flags that can be specified
2015 indicating what the mapping function might or might not do.
2017 The result of all this is that this is the most complicated
2018 function in this file. Change it at your own risk!
2020 A potential simplification to the logic below is to determine
2021 all the extents that the mapping function should be called on
2022 before any calls are actually made and save them in an array.
2023 That introduces its own complications, however (the array
2024 needs to be marked for garbage-collection, and a static array
2025 cannot be used because map_extents() needs to be reentrant).
2026 Furthermore, the results might be a little less sensible than
2030 map_extents_bytind(Bytind from, Bytind to, map_extents_fun fn, void *arg,
2031 Lisp_Object obj, EXTENT after, unsigned int flags)
2033 Memind st, en; /* range we're mapping over */
2034 EXTENT range = 0; /* extent for this, if ME_MIGHT_MODIFY_TEXT */
2035 extent_list_t el = 0; /* extent list we're iterating over */
2036 extent_list_marker_t posm = 0; /* marker for extent list,
2037 if ME_MIGHT_MODIFY_EXTENTS */
2038 /* count and struct for unwind-protect, if ME_MIGHT_THROW */
2040 struct map_extents_struct closure;
2042 #ifdef ERROR_CHECK_EXTENTS
2044 assert(from >= buffer_or_string_absolute_begin_byte(obj) &&
2045 from <= buffer_or_string_absolute_end_byte(obj) &&
2046 to >= buffer_or_string_absolute_begin_byte(obj) &&
2047 to <= buffer_or_string_absolute_end_byte(obj));
2051 assert(EQ(obj, extent_object(after)));
2052 assert(!extent_detached_p(after));
2055 el = buffer_or_string_extent_list(obj);
2056 if (!el || !extent_list_num_els(el))
2060 st = buffer_or_string_bytind_to_memind(obj, from);
2061 en = buffer_or_string_bytind_to_memind(obj, to);
2063 if (flags & ME_MIGHT_MODIFY_TEXT) {
2064 /* The mapping function might change the text in the buffer,
2065 so make an internal extent to hold the range we're mapping
2067 range = make_extent_detached(obj);
2068 set_extent_start(range, st);
2069 set_extent_end(range, en);
2070 range->flags.start_open = flags & ME_START_OPEN;
2071 range->flags.end_open = !(flags & ME_END_CLOSED);
2072 range->flags.internal = 1;
2073 range->flags.detachable = 0;
2074 extent_attach(range);
2077 if (flags & ME_MIGHT_THROW) {
2078 /* The mapping function might throw past us so we need to use an
2079 unwind_protect() to eliminate the internal extent and range
2081 count = specpdl_depth();
2082 closure.range = range;
2084 record_unwind_protect(map_extents_unwind,
2085 make_opaque_ptr(&closure));
2088 /* ---------- Figure out where we start and what direction
2089 we move in. This is the trickiest part of this
2090 function. ---------- */
2092 /* If ME_START_IN_REGION, ME_END_IN_REGION or ME_START_AND_END_IN_REGION
2093 was specified and ME_NEGATE_IN_REGION was not specified, our job
2094 is simple because of the presence of the display order and e-order.
2095 (Note that theoretically do something similar for
2096 ME_START_OR_END_IN_REGION, but that would require more trickiness
2097 than it's worth to avoid hitting the same extent twice.)
2099 In the general case, all the extents that overlap a range can be
2100 divided into two classes: those whose start position lies within
2101 the range (including the range's end but not including the
2102 range's start), and those that overlap the start position,
2103 i.e. those in the SOE for the start position. Or equivalently,
2104 the extents can be divided into those whose end position lies
2105 within the range and those in the SOE for the end position. Note
2106 that for this purpose we treat both the range and all extents in
2107 the buffer as closed on both ends. If this is not what the ME_
2108 flags specified, then we've mapped over a few too many extents,
2109 but no big deal because extent_in_region_p() will filter them
2110 out. Ideally, we could move the SOE to the closer of the range's
2111 two ends and work forwards or backwards from there. However, in
2112 order to make the semantics of the AFTER argument work out, we
2113 have to always go in the same direction; so we choose to always
2114 move the SOE to the start position.
2116 When it comes time to do the SOE stage, we first call soe_move()
2117 so that the SOE gets set up. Note that the SOE might get
2118 changed while we are mapping over its contents. If we can
2119 guarantee that the SOE won't get moved to a new position, we
2120 simply need to put a marker in the SOE and we will track deletions
2121 and insertions of extents in the SOE. If the SOE might get moved,
2122 however (this would happen as a result of a recursive invocation
2123 of map-extents or a call to a redisplay-type function), then
2124 trying to track its changes is hopeless, so we just keep a
2125 marker to the first (or last) extent in the SOE and use that as
2128 Finally, if DONT_USE_SOE is defined, we don't use the SOE at all
2129 and instead just map from the beginning of the buffer. This is
2130 used for testing purposes and allows the SOE to be calculated
2131 using map_extents() instead of the other way around. */
2134 int range_flag; /* ME_*_IN_REGION subset of flags */
2135 int do_soe_stage = 0; /* Are we mapping over the SOE? */
2136 /* Does the range stage map over start or end positions? */
2138 /* If type == 0, we include the start position in the range
2140 If type == 1, we exclude the start position in the range
2142 If type == 2, we begin at range_start_pos, an extent-list
2145 int range_start_type = 0;
2146 int range_start_pos = 0;
2149 range_flag = flags & ME_IN_REGION_MASK;
2150 if ((range_flag == ME_START_IN_REGION ||
2151 range_flag == ME_START_AND_END_IN_REGION) &&
2152 !(flags & ME_NEGATE_IN_REGION)) {
2153 /* map over start position in [range-start, range-end].
2156 } else if (range_flag == ME_END_IN_REGION
2157 && !(flags & ME_NEGATE_IN_REGION)) {
2158 /* map over end position in [range-start, range-end].
2162 /* Need to include the SOE extents. */
2164 /* Just brute-force it: start from the beginning. */
2166 range_start_type = 2;
2167 range_start_pos = 0;
2169 extent_stack_t soe =
2170 buffer_or_string_stack_of_extents_force(obj);
2173 /* Move the SOE to the closer end of the range. This
2174 dictates whether we map over start positions or end
2178 numsoe = extent_list_num_els(soe->extents);
2180 if (flags & ME_MIGHT_MOVE_SOE) {
2182 /* Can't map over SOE, so just extend
2183 range to cover the SOE. */
2184 EXTENT e = extent_list_at(
2185 soe->extents, 0, 0);
2186 range_start_pos = extent_list_locate
2187 (buffer_or_string_extent_list
2188 (obj), e, 0, &foundp);
2190 range_start_type = 2;
2192 /* We can map over the SOE. */
2194 range_start_type = 1;
2197 /* No extents in the SOE to map over, so we act
2198 just as if ME_START_IN_REGION or
2199 ME_END_IN_REGION was specified. RANGE_ENDP
2200 already specified so no need to do anything
2206 /* ---------- Now loop over the extents. ---------- */
2208 /* We combine the code for the two stages because much of it
2210 for (stage = 0; stage < 2; stage++) {
2211 int pos = 0; /* Position in extent list */
2213 /* First set up start conditions */
2214 if (stage == 0) { /* The SOE stage */
2217 el = buffer_or_string_stack_of_extents_force
2219 /* We will always be looping over start extents
2221 assert(!range_endp);
2223 } else { /* The range stage */
2224 el = buffer_or_string_extent_list(obj);
2225 switch (range_start_type) {
2227 pos = extent_list_locate_from_pos
2228 (el, st, range_endp);
2231 pos = extent_list_locate_from_pos
2232 (el, st + 1, range_endp);
2235 pos = range_start_pos;
2242 if (flags & ME_MIGHT_MODIFY_EXTENTS) {
2243 /* Create a marker to track changes to the
2246 /* Delete the marker used in the SOE
2248 extent_list_delete_marker
2249 (buffer_or_string_stack_of_extents_force
2250 (obj)->extents, posm);
2251 posm = extent_list_make_marker(
2252 el, pos, range_endp);
2253 /* tell the unwind function about the marker. */
2263 /* ----- update position in extent list
2264 and fetch next extent ----- */
2267 /* fetch POS again to track extent
2268 insertions or deletions */
2269 pos = extent_list_marker_pos(el, posm);
2271 if (pos >= extent_list_num_els(el)) {
2274 e = extent_list_at(el, pos, range_endp);
2277 /* now point the marker to the next one
2278 we're going to process. This ensures
2279 graceful behavior if this extent is
2281 extent_list_move_marker(el, posm, pos);
2283 /* ----- deal with internal extents ----- */
2285 if (extent_internal_p(e)) {
2286 if (!(flags & ME_INCLUDE_INTERNAL)) {
2288 } else if (e == range) {
2289 /* We're processing internal
2290 extents and we've come across
2291 our own special range extent.
2292 (This happens only in
2293 adjust_extents*() and
2294 process_extents*(), which
2295 handle text insertion and
2296 deletion.) We need to omit
2297 processing of this extent;
2298 otherwise we will probably
2300 terminating this loop. */
2305 /* ----- deal with AFTER condition ----- */
2308 /* if e > after, then we can stop
2309 skipping extents. */
2310 if (EXTENT_LESS(after, e)) {
2313 /* otherwise, skip this
2319 /* ----- stop if we're completely outside the
2322 /* fetch ST and EN again to track text
2323 insertions or deletions */
2325 st = extent_start(range);
2326 en = extent_end(range);
2328 if (extent_endpoint(e, range_endp) > en) {
2329 /* Can't be mapping over SOE because all
2330 extents in there should overlap ST */
2335 /* ----- Now actually call the function ----- */
2337 obj2 = extent_object(e);
2338 if (extent_in_region_p(
2340 buffer_or_string_memind_to_bytind
2342 buffer_or_string_memind_to_bytind
2343 (obj2, en), flags)) {
2344 if ((*fn) (e, arg)) {
2345 /* Function wants us to stop
2348 /* so outer for loop will
2355 /* ---------- Finished looping. ---------- */
2358 if (flags & ME_MIGHT_THROW) {
2359 /* This deletes the range extent and frees the marker. */
2360 unbind_to(count, Qnil);
2362 /* Delete them ourselves */
2364 extent_detach(range);
2367 extent_list_delete_marker(el, posm);
2373 map_extents(Bufpos from, Bufpos to, map_extents_fun fn,
2374 void *arg, Lisp_Object obj, EXTENT after, unsigned int flags)
2376 map_extents_bytind(buffer_or_string_bufpos_to_bytind(obj, from),
2377 buffer_or_string_bufpos_to_bytind(obj, to), fn, arg,
2381 /* ------------------------------- */
2382 /* adjust_extents() */
2383 /* ------------------------------- */
2385 /* Add AMOUNT to all extent endpoints in the range (FROM, TO]. This
2386 happens whenever the gap is moved or (under Mule) a character in a
2387 string is substituted for a different-length one. The reason for
2388 this is that extent endpoints behave just like markers (all memory
2389 indices do) and this adjustment correct for markers -- see
2390 adjust_markers(). Note that it is important that we visit all
2391 extent endpoints in the range, irrespective of whether the
2392 endpoints are open or closed.
2394 We could use map_extents() for this (and in fact the function
2395 was originally written that way), but the gap is in an incoherent
2396 state when this function is called and this function plays
2397 around with extent endpoints without detaching and reattaching
2398 the extents (this is provably correct and saves lots of time),
2399 so for safety we make it just look at the extent lists directly. */
2402 adjust_extents(Lisp_Object obj, Memind from, Memind to, int amount)
2410 #ifdef ERROR_CHECK_EXTENTS
2411 sledgehammer_extent_check(obj);
2413 el = buffer_or_string_extent_list(obj);
2415 if (!el || !extent_list_num_els(el)) {
2418 /* IMPORTANT! Compute the starting positions of the extents to
2419 modify BEFORE doing any modification! Otherwise the starting
2420 position for the second time through the loop might get
2421 incorrectly calculated (I got bit by this bug real bad). */
2422 startpos[0] = extent_list_locate_from_pos(el, from + 1, 0);
2423 startpos[1] = extent_list_locate_from_pos(el, from + 1, 1);
2424 for (endp = 0; endp < 2; endp++) {
2425 for (pos = startpos[endp]; pos < extent_list_num_els(el);
2427 EXTENT e = extent_list_at(el, pos, endp);
2428 if (extent_endpoint(e, endp) > to) {
2431 set_extent_endpoint(
2433 do_marker_adjustment(
2434 extent_endpoint(e, endp),
2440 /* The index for the buffer's SOE is a memory index and thus
2441 needs to be adjusted like a marker. */
2442 soe = buffer_or_string_stack_of_extents(obj);
2443 if (soe && soe->pos >= 0) {
2444 soe->pos = do_marker_adjustment(soe->pos, from, to, amount);
2449 /* ------------------------------- */
2450 /* adjust_extents_for_deletion() */
2451 /* ------------------------------- */
2453 struct adjust_extents_for_deletion_arg {
2454 EXTENT_dynarr *list;
2457 static int adjust_extents_for_deletion_mapper(EXTENT extent, void *arg)
2459 struct adjust_extents_for_deletion_arg *closure =
2460 (struct adjust_extents_for_deletion_arg *)arg;
2462 Dynarr_add(closure->list, extent);
2463 /* continue mapping */
2467 /* For all extent endpoints in the range (FROM, TO], move them to the beginning
2468 of the new gap. Note that it is important that we visit all extent
2469 endpoints in the range, irrespective of whether the endpoints are open or
2472 This function deals with weird stuff such as the fact that extents
2475 There is no string correspondent for this because you can't
2476 delete characters from a string.
2480 adjust_extents_for_deletion(Lisp_Object object, Bytind from,
2481 Bytind to, int gapsize, int numdel, int movegapsize)
2483 struct adjust_extents_for_deletion_arg closure;
2485 Memind adjust_to = (Memind) (to + gapsize);
2486 Bytecount amount = -numdel - movegapsize;
2487 Memind oldsoe = 0, newsoe = 0;
2488 extent_stack_t soe = buffer_or_string_stack_of_extents(object);
2490 #ifdef ERROR_CHECK_EXTENTS
2491 sledgehammer_extent_check(object);
2493 closure.list = Dynarr_new(EXTENT);
2495 /* We're going to be playing weird games below with extents and the SOE
2496 and such, so compute the list now of all the extents that we're going
2497 to muck with. If we do the mapping and adjusting together, things
2498 can get all screwed up. */
2500 map_extents_bytind(from, to, adjust_extents_for_deletion_mapper,
2501 (void *)&closure, object, 0,
2502 /* extent endpoints move like markers regardless
2503 of their open/closeness. */
2504 ME_ALL_EXTENTS_CLOSED | ME_END_CLOSED |
2505 ME_START_OR_END_IN_REGION | ME_INCLUDE_INTERNAL);
2508 Old and new values for the SOE's position. (It gets adjusted
2509 like a marker, just like extent endpoints.)
2514 if (soe->pos >= 0) {
2515 newsoe = do_marker_adjustment(
2516 soe->pos, adjust_to, adjust_to, amount);
2522 for (i = 0; i < Dynarr_length(closure.list); i++) {
2523 EXTENT extent = Dynarr_at(closure.list, i);
2524 Memind new_start = extent_start(extent);
2525 Memind new_end = extent_end(extent);
2527 /* do_marker_adjustment() will not adjust values that should not
2528 be adjusted. We're passing the same funky arguments to
2529 do_marker_adjustment() as buffer_delete_range() does. */
2530 new_start = do_marker_adjustment(
2531 new_start, adjust_to, adjust_to, amount);
2532 new_end = do_marker_adjustment(
2533 new_end, adjust_to, adjust_to, amount);
2535 /* We need to be very careful here so that the SOE doesn't get
2536 corrupted. We are shrinking extents out of the deleted
2537 region and simultaneously moving the SOE's pos out of the
2538 deleted region, so the SOE should contain the same extents at
2539 the end as at the beginning. However, extents may get
2540 reordered by this process, so we have to operate by pulling
2541 the extents out of the buffer and SOE, changing their bounds,
2542 and then reinserting them. In order for the SOE not to get
2543 screwed up, we have to make sure that the SOE's pos points to
2544 its old location whenever we pull an extent out, and points
2545 to its new location whenever we put the extent back in.
2548 if (new_start != extent_start(extent) ||
2549 new_end != extent_end(extent)) {
2550 extent_detach(extent);
2551 set_extent_start(extent, new_start);
2552 set_extent_end(extent, new_end);
2556 extent_attach(extent);
2567 #ifdef ERROR_CHECK_EXTENTS
2568 sledgehammer_extent_check(object);
2570 Dynarr_free(closure.list);
2574 /* ------------------------------- */
2575 /* extent fragments */
2576 /* ------------------------------- */
2578 /* Imagine that the buffer is divided up into contiguous,
2579 nonoverlapping "runs" of text such that no extent
2580 starts or ends within a run (extents that abut the
2583 An extent fragment is a structure that holds data about
2584 the run that contains a particular buffer position (if
2585 the buffer position is at the junction of two runs, the
2586 run after the position is used) -- the beginning and
2587 end of the run, a list of all of the extents in that
2588 run, the "merged face" that results from merging all of
2589 the faces corresponding to those extents, the begin and
2590 end glyphs at the beginning of the run, etc. This is
2591 the information that redisplay needs in order to
2594 Extent fragments have to be very quick to update to
2595 a new buffer position when moving linearly through
2596 the buffer. They rely on the stack-of-extents code,
2597 which does the heavy-duty algorithmic work of determining
2598 which extents overly a particular position. */
2600 /* This function returns the position of the beginning of
2601 the first run that begins after POS, or returns POS if
2602 there are no such runs. */
2605 extent_find_end_of_run(Lisp_Object obj, Bytind pos, int outside_accessible)
2608 extent_list_t bel = buffer_or_string_extent_list(obj);
2611 Memind mempos = buffer_or_string_bytind_to_memind(obj, pos);
2612 Bytind limit = outside_accessible ?
2613 buffer_or_string_absolute_end_byte(obj) :
2614 buffer_or_string_accessible_end_byte(obj);
2616 if (!bel || !extent_list_num_els(bel)) {
2619 sel = buffer_or_string_stack_of_extents_force(obj)->extents;
2620 soe_move(obj, mempos);
2622 /* Find the first start position after POS. */
2623 elind1 = extent_list_locate_from_pos(bel, mempos + 1, 0);
2624 if (elind1 < extent_list_num_els(bel)) {
2625 pos1 = buffer_or_string_memind_to_bytind(
2626 obj, extent_start(extent_list_at(bel, elind1, 0)));
2631 /* Find the first end position after POS. The extent corresponding
2632 to this position is either in the SOE or is greater than or
2633 equal to POS1, so we just have to look in the SOE. */
2634 elind2 = extent_list_locate_from_pos(sel, mempos + 1, 1);
2635 if (elind2 < extent_list_num_els(sel)) {
2636 pos2 = buffer_or_string_memind_to_bytind(
2637 obj, extent_end(extent_list_at(sel, elind2, 1)));
2641 return min(min(pos1, pos2), limit);
2645 extent_find_beginning_of_run(Lisp_Object obj, Bytind pos,
2646 int outside_accessible)
2649 extent_list_t bel = buffer_or_string_extent_list(obj);
2652 Memind mempos = buffer_or_string_bytind_to_memind(obj, pos);
2653 Bytind limit = outside_accessible
2654 ? buffer_or_string_absolute_begin_byte(obj)
2655 : buffer_or_string_accessible_begin_byte(obj);
2657 if (!bel || !extent_list_num_els(bel)) {
2660 sel = buffer_or_string_stack_of_extents_force(obj)->extents;
2661 soe_move(obj, mempos);
2663 /* Find the first end position before POS. */
2664 elind1 = extent_list_locate_from_pos(bel, mempos, 1);
2666 pos1 = buffer_or_string_memind_to_bytind(
2667 obj, extent_end(extent_list_at(bel, elind1 - 1, 1)));
2671 /* Find the first start position before POS. The extent corresponding
2672 to this position is either in the SOE or is less than or
2673 equal to POS1, so we just have to look in the SOE. */
2674 elind2 = extent_list_locate_from_pos(sel, mempos, 0);
2676 pos2 = buffer_or_string_memind_to_bytind(
2677 obj, extent_start(extent_list_at(sel, elind2 - 1, 0)));
2681 return max(max(pos1, pos2), limit);
2684 struct extent_fragment*
2685 extent_fragment_new(Lisp_Object buffer_or_string, struct frame *frm)
2687 struct extent_fragment *ef = xnew_and_zero(struct extent_fragment);
2689 ef->object = buffer_or_string;
2691 ef->extents = Dynarr_new(EXTENT);
2692 ef->glyphs = Dynarr_new(glyph_block);
2697 void extent_fragment_delete(struct extent_fragment *ef)
2699 Dynarr_free(ef->extents);
2700 Dynarr_free(ef->glyphs);
2705 extent_priority_sort_function(const void *humpty, const void *dumpty)
2707 const EXTENT foo = *(const EXTENT *)humpty;
2708 const EXTENT bar = *(const EXTENT *)dumpty;
2709 if (extent_priority(foo) < extent_priority(bar)) {
2712 return extent_priority(foo) > extent_priority(bar);
2716 extent_fragment_sort_by_priority(EXTENT_dynarr * extarr)
2720 /* Sort our copy of the stack by extent_priority. We use a bubble
2721 sort here because it's going to be faster than qsort() for small
2722 numbers of extents (less than 10 or so), and 99.999% of the time
2723 there won't ever be more extents than this in the stack. */
2724 if (Dynarr_length(extarr) < 10) {
2725 for (i = 1; i < Dynarr_length(extarr); i++) {
2728 (extent_priority(Dynarr_at(extarr, j)) >
2729 extent_priority(Dynarr_at(extarr, j + 1)))) {
2730 EXTENT tmp = Dynarr_at(extarr, j);
2731 Dynarr_at(extarr, j) = Dynarr_at(extarr, j + 1);
2732 Dynarr_at(extarr, j + 1) = tmp;
2737 /* But some loser programs mess up and may create a large number
2738 of extents overlapping the same spot. This will result in
2739 catastrophic behavior if we use the bubble sort above. */
2740 qsort(Dynarr_atp(extarr, 0), Dynarr_length(extarr),
2741 sizeof(EXTENT), extent_priority_sort_function);
2745 /* If PROP is the `invisible' property of an extent,
2746 this is 1 if the extent should be treated as invisible. */
2748 #define EXTENT_PROP_MEANS_INVISIBLE(buf, prop) \
2749 (EQ (buf->invisibility_spec, Qt) \
2751 : invisible_p (prop, buf->invisibility_spec))
2753 /* If PROP is the `invisible' property of a extent,
2754 this is 1 if the extent should be treated as invisible
2755 and should have an ellipsis. */
2757 #define EXTENT_PROP_MEANS_INVISIBLE_WITH_ELLIPSIS(buf, prop) \
2758 (EQ (buf->invisibility_spec, Qt) \
2760 : invisible_ellipsis_p (prop, buf->invisibility_spec))
2762 /* This is like a combination of memq and assq.
2763 Return 1 if PROPVAL appears as an element of LIST
2764 or as the car of an element of LIST.
2765 If PROPVAL is a list, compare each element against LIST
2766 in that way, and return 1 if any element of PROPVAL is found in LIST.
2768 This function cannot quit. */
2771 invisible_p(REGISTER Lisp_Object propval, Lisp_Object list)
2773 REGISTER Lisp_Object tail, proptail;
2774 for (tail = list; CONSP(tail); tail = XCDR(tail)) {
2775 REGISTER Lisp_Object tem;
2777 if (EQ(propval, tem))
2779 if (CONSP(tem) && EQ(propval, XCAR(tem)))
2782 if (CONSP(propval)) {
2783 for (proptail = propval; CONSP(proptail);
2784 proptail = XCDR(proptail)) {
2785 Lisp_Object propelt;
2786 propelt = XCAR(proptail);
2787 for (tail = list; CONSP(tail); tail = XCDR(tail)) {
2788 REGISTER Lisp_Object tem;
2790 if (EQ(propelt, tem)) {
2793 if (CONSP(tem) && EQ(propelt, XCAR(tem))) {
2802 /* Return 1 if PROPVAL appears as the car of an element of LIST
2803 and the cdr of that element is non-nil.
2804 If PROPVAL is a list, check each element of PROPVAL in that way,
2805 and the first time some element is found,
2806 return 1 if the cdr of that element is non-nil.
2808 This function cannot quit. */
2811 invisible_ellipsis_p(REGISTER Lisp_Object propval, Lisp_Object list)
2813 REGISTER Lisp_Object tail, proptail;
2815 for (tail = list; CONSP(tail); tail = XCDR(tail)) {
2816 REGISTER Lisp_Object tem;
2818 if (CONSP(tem) && EQ(propval, XCAR(tem))) {
2819 return !NILP(XCDR(tem));
2822 if (CONSP(propval)) {
2823 for (proptail = propval; CONSP(proptail);
2824 proptail = XCDR(proptail)) {
2825 Lisp_Object propelt;
2826 propelt = XCAR(proptail);
2827 for (tail = list; CONSP(tail); tail = XCDR(tail)) {
2828 REGISTER Lisp_Object tem;
2830 if (CONSP(tem) && EQ(propelt, XCAR(tem))) {
2831 return !NILP(XCDR(tem));
2840 extent_fragment_update(struct window * w, struct extent_fragment * ef,
2841 Bytind pos, Lisp_Object last_glyph)
2844 int seen_glyph = NILP(last_glyph) ? 1 : 0;
2846 buffer_or_string_stack_of_extents_force(ef->object)->extents;
2848 struct extent dummy_lhe_extent;
2849 Memind mempos = buffer_or_string_bytind_to_memind(ef->object, pos);
2850 glyph_block_dynarr *glyphs; /* List of glyphs to post process */
2851 int invis_before = 0; /* Exiting an invisible extent. */
2852 int invis_after = 0; /* Entering an invisible extent. */
2853 int insert_empty = 0; /* Position to insert empty extent glyphs */
2854 int queuing_begin = 0; /* Queuing begin glyphs. */
2856 #ifdef ERROR_CHECK_EXTENTS
2857 assert(pos >= buffer_or_string_accessible_begin_byte(ef->object)
2858 && pos <= buffer_or_string_accessible_end_byte(ef->object));
2861 Dynarr_reset(ef->extents);
2862 Dynarr_reset(ef->glyphs);
2864 ef->previously_invisible = ef->invisible;
2865 if (ef->invisible) {
2866 if (ef->invisible_ellipses)
2867 ef->invisible_ellipses_already_displayed = 1;
2869 ef->invisible_ellipses_already_displayed = 0;
2872 ef->invisible_ellipses = 0;
2874 /* Set up the begin and end positions. */
2876 ef->end = extent_find_end_of_run(ef->object, pos, 0);
2878 /* Note that extent_find_end_of_run() already moved the SOE for us. */
2879 /* soe_move (ef->object, mempos); */
2881 /* We tried determining all the charsets used in the run here,
2882 but that fails even if we only do the current line -- display
2883 tables or non-printable characters might cause other charsets
2886 /* Determine whether the last-highlighted-extent is present. */
2887 if (EXTENTP(Vlast_highlighted_extent))
2888 lhe = XEXTENT(Vlast_highlighted_extent);
2890 /* Now add all extents that overlap the character after POS and
2891 have a non-nil face. Also check if the character is
2892 invisible. We also queue begin and end glyphs of extents
2893 that being/end at just before POS. These are ordered as
2894 follows. 1) end glyphs of non-empty extents in reverse
2895 display order. 2) begin glyphs of empty extents. 3) end
2896 glyphs of empty extents. 4) begin glyphs of non-empty
2897 extents in display order. Empty extents are shown nested,
2898 but the invisibility property of an empty extent is
2899 ignored and not used to determine whether an 'interior'
2900 empty extent's glyphs should be shown or not. */
2901 glyphs = Dynarr_new(glyph_block);
2902 for (i = 0; i < extent_list_num_els(sel); i++) {
2903 EXTENT e = extent_list_at(sel, i, 0);
2904 int zero_width = extent_start(e) == extent_end(e);
2905 Lisp_Object invis_prop = extent_invisible(e);
2908 if (extent_start(e) == mempos) {
2909 /* The extent starts here. If we are queuing
2910 end glyphs, we should display all the end
2911 glyphs we've pushed. */
2913 if (!queuing_begin) {
2914 /* Append any already seen end glyphs */
2915 for (j = Dynarr_length(glyphs); j--;) {
2916 struct glyph_block *gbp
2917 = Dynarr_atp(glyphs, j);
2920 Dynarr_add(ef->glyphs, *gbp);
2921 else if (EQ(gbp->glyph, last_glyph))
2925 /* Pop the end glyphs just displayed. */
2926 Dynarr_set_size(glyphs, 0);
2927 /* We are now queuing begin glyphs. */
2929 /* And will insert empty extent glyphs
2931 insert_empty = Dynarr_length (ef->glyphs);
2934 glyph = extent_begin_glyph(e);
2937 struct glyph_block gb;
2939 memset(&gb,0,sizeof(gb));
2942 gb.active = 0; /* BEGIN_GLYPH */
2944 XSETEXTENT(gb.extent, e);
2948 == Dynarr_length (ef->glyphs))
2949 Dynarr_add (ef->glyphs, gb);
2954 } else if (!invis_after)
2955 Dynarr_add (glyphs, gb);
2959 if (extent_end(e) == mempos) {
2960 /* The extend ends here. Push the end glyph. */
2961 glyph = extent_end_glyph(e);
2963 if (!NILP (glyph)) {
2964 struct glyph_block gb;
2966 gb.width = gb.findex = 0; /* just init */
2968 gb.active = 1; /* END_GLYPH */
2969 XSETEXTENT(gb.extent, e);
2972 Dynarr_add (ef->glyphs, gb);
2973 else if (!invis_before)
2974 Dynarr_add(glyphs, gb);
2976 /* If this extent is not empty, any inner
2977 extents ending here will not be visible. */
2978 if (extent_start (e) < mempos && !NILP (invis_prop))
2982 if (extent_end(e) > mempos) {
2983 /* This extent covers POS. */
2984 if (!NILP(invis_prop)) {
2986 /* If this extend spans POS, all
2987 glyphs are invisible. */
2988 if (extent_start (e) < mempos)
2989 Dynarr_set_size (glyphs, 0);
2991 if (!BUFFERP(ef->object))
2992 /* #### no `string-invisibility-spec' */
2996 invisible_ellipses_already_displayed
2998 EXTENT_PROP_MEANS_INVISIBLE_WITH_ELLIPSIS
2999 (XBUFFER(ef->object), invis_prop)) {
3001 ef->invisible_ellipses = 1;
3002 } else if (EXTENT_PROP_MEANS_INVISIBLE
3003 (XBUFFER(ef->object),
3009 /* Remember that one of the extents in the list might be
3010 our dummy extent representing the highlighting that
3011 is attached to some other extent that is currently
3012 mouse-highlighted. When an extent is
3013 mouse-highlighted, it is as if there are two extents
3014 there, of potentially different priorities: the
3015 extent being highlighted, with whatever face and
3016 priority it has; and an ephemeral extent in the
3017 `mouse-face' face with `mouse-highlight-priority'.
3020 if (!NILP(extent_face(e)))
3021 Dynarr_add(ef->extents, e);
3024 /* zeroing isn't really necessary; we only deref
3025 `priority' and `face' */
3026 xzero(dummy_lhe_extent);
3027 set_extent_priority(&dummy_lhe_extent,
3028 mouse_highlight_priority);
3029 /* Need to break up the following expression,
3031 /* error in the Digital UNIX 3.2g C compiler
3033 /* UNIX Compiler Driver 3.11). */
3034 f = extent_mouse_face(lhe);
3035 extent_face(&dummy_lhe_extent) = f;
3036 Dynarr_add(ef->extents, &dummy_lhe_extent);
3038 /* since we are looping anyway, we might as well do this
3040 if ((!NILP(extent_initial_redisplay_function(e))) &&
3041 !extent_in_red_event_p(e)) {
3042 Lisp_Object function =
3043 extent_initial_redisplay_function(e);
3046 /* print_extent_2 (e);
3049 /* FIXME: One should probably inhibit the
3050 displaying of this extent to reduce
3052 extent_in_red_event_p(e) = 1;
3054 /* call the function */
3056 if (!NILP(function)) {
3057 Fenqueue_eval_event(function, obj);
3063 if (!queuing_begin) {
3064 /* Append end glyphs in reverse order */
3065 for (j = Dynarr_length(glyphs); j--;) {
3066 struct glyph_block *gbp = Dynarr_atp(glyphs, j);
3069 Dynarr_add(ef->glyphs, *gbp);
3070 else if (EQ(gbp->glyph, last_glyph))
3075 /* Scan the zero length glyphs and see where we
3076 start a glyph that has not been displayed yet. */
3077 for (j = insert_empty;
3078 j != Dynarr_length (ef->glyphs); j++) {
3079 struct glyph_block *gbp
3080 = Dynarr_atp(ef->glyphs, j);
3082 if (EQ(gbp->glyph, last_glyph)) {
3088 Dynarr_delete_many (ef->glyphs, insert_empty,
3092 /* Now copy the begin glyphs. */
3093 for (j = 0; j != Dynarr_length (glyphs); j++) {
3094 struct glyph_block *gbp = Dynarr_atp(glyphs, j);
3097 Dynarr_add(ef->glyphs, *gbp);
3098 else if (EQ(gbp->glyph, last_glyph))
3103 Dynarr_free(glyphs);
3105 extent_fragment_sort_by_priority(ef->extents);
3107 /* Now merge the faces together into a single face. The code to
3108 do this is in faces.c because it involves manipulating faces. */
3109 return get_extent_fragment_face_cache_index(w, ef);
3112 /************************************************************************/
3113 /* extent-object methods */
3114 /************************************************************************/
3116 /* These are the basic helper functions for handling the allocation of
3117 extent objects. They are similar to the functions for other
3118 lrecord objects. allocate_extent() is in alloc.c, not here. */
3120 static Lisp_Object mark_extent(Lisp_Object obj)
3122 struct extent *extent = XEXTENT(obj);
3124 mark_object(extent_object(extent));
3125 mark_object(extent_no_chase_normal_field(extent, face));
3126 return extent->plist;
3130 print_extent_1(Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
3132 EXTENT ext = XEXTENT(obj);
3133 EXTENT anc = extent_ancestor(ext);
3135 char buf[100], *bp = buf;
3138 /* Retrieve the ancestor and use it, for faster retrieval of properties */
3140 if (!NILP(extent_begin_glyph(anc)))
3142 *bp++ = (extent_start_open_p(anc) ? '(' : '[');
3143 if (extent_detached_p(ext))
3144 strncpy(bp, "detached", sizeof(buf)-1);
3146 sz=snprintf(bp, sizeof(buf)-2, "%ld, %ld",
3147 XINT(Fextent_start_position(obj)),
3148 XINT(Fextent_end_position(obj)));
3149 assert(sz>=0 && (size_t)sz<(sizeof(buf)-2));
3152 *bp++ = (extent_end_open_p(anc) ? ')' : ']');
3153 if (!NILP(extent_end_glyph(anc)))
3157 if (!NILP(extent_read_only(anc)))
3159 if (!NILP(extent_mouse_face(anc)))
3161 if (extent_unique_p(anc))
3163 else if (extent_duplicable_p(anc))
3165 if (!NILP(extent_invisible(anc)))
3168 if (!NILP(extent_read_only(anc)) || !NILP(extent_mouse_face(anc)) ||
3169 extent_unique_p(anc) ||
3170 extent_duplicable_p(anc) || !NILP(extent_invisible(anc)))
3173 write_c_string(buf, printcharfun);
3175 tail = extent_plist_slot(anc);
3177 for (; !NILP(tail); tail = Fcdr(Fcdr(tail))) {
3178 Lisp_Object v = XCAR(XCDR(tail));
3181 print_internal(XCAR(tail), printcharfun, escapeflag);
3182 write_c_string(" ", printcharfun);
3185 write_fmt_str(printcharfun, "0x%lx", (long)ext);
3189 print_extent(Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
3192 const char *title = "";
3193 const char *name = "";
3194 const char *posttitle = "";
3195 Lisp_Object obj2 = Qnil;
3197 /* Destroyed extents have 't' in the object field, causing
3198 extent_object() to abort (maybe). */
3199 if (EXTENT_LIVE_P(XEXTENT(obj)))
3200 obj2 = extent_object(XEXTENT(obj));
3203 title = "no buffer";
3204 else if (BUFFERP(obj2)) {
3205 if (BUFFER_LIVE_P(XBUFFER(obj2))) {
3208 (char *)XSTRING_DATA(XBUFFER(obj2)->name);
3210 title = "Killed Buffer";
3214 assert(STRINGP(obj2));
3215 title = "string \"";
3217 name = (char *)XSTRING_DATA(obj2);
3220 if (print_readably) {
3221 if (!EXTENT_LIVE_P(XEXTENT(obj))) {
3222 error("printing unreadable object "
3223 "#<destroyed extent>");
3225 error("printing unreadable object "
3226 "#<extent %p>", XEXTENT(obj));
3230 if (!EXTENT_LIVE_P(XEXTENT(obj))) {
3231 write_c_string("#<destroyed extent", printcharfun);
3233 write_c_string("#<extent ", printcharfun);
3234 print_extent_1(obj, printcharfun, escapeflag);
3235 write_c_string(extent_detached_p(XEXTENT(obj))
3236 ? " from " : " in ", printcharfun);
3237 write_fmt_string(printcharfun, "%s%s%s", title, name, posttitle);
3241 error("printing unreadable object #<extent>");
3242 write_c_string("#<extent", printcharfun);
3244 write_c_string(">", printcharfun);
3247 static int properties_equal(EXTENT e1, EXTENT e2, int depth)
3249 /* When this function is called, all indirections have been followed.
3250 Thus, the indirection checks in the various macros below will not
3251 amount to anything, and could be removed. However, the time
3252 savings would probably not be significant. */
3253 if (!(EQ(extent_face(e1), extent_face(e2)) &&
3254 extent_priority(e1) == extent_priority(e2) &&
3255 internal_equal(extent_begin_glyph(e1), extent_begin_glyph(e2),
3257 internal_equal(extent_end_glyph(e1), extent_end_glyph(e2),
3261 /* compare the bit flags. */
3263 /* The has_aux field should not be relevant. */
3264 int e1_has_aux = e1->flags.has_aux;
3265 int e2_has_aux = e2->flags.has_aux;
3268 e1->flags.has_aux = e2->flags.has_aux = 0;
3269 value = memcmp(&e1->flags, &e2->flags, sizeof(e1->flags));
3270 e1->flags.has_aux = e1_has_aux;
3271 e2->flags.has_aux = e2_has_aux;
3276 /* compare the random elements of the plists. */
3277 return !plists_differ(extent_no_chase_plist(e1),
3278 extent_no_chase_plist(e2), 0, 0, depth + 1);
3281 static int extent_equal(Lisp_Object obj1, Lisp_Object obj2, int depth)
3283 struct extent *e1 = XEXTENT(obj1);
3284 struct extent *e2 = XEXTENT(obj2);
3286 (extent_start(e1) == extent_start(e2) &&
3287 extent_end(e1) == extent_end(e2) &&
3288 internal_equal(extent_object(e1), extent_object(e2), depth + 1) &&
3289 properties_equal(extent_ancestor(e1), extent_ancestor(e2), depth));
3292 static unsigned long extent_hash(Lisp_Object obj, int depth)
3294 struct extent *e = XEXTENT(obj);
3295 /* No need to hash all of the elements; that would take too long.
3296 Just hash the most common ones. */
3297 return HASH3(extent_start(e), extent_end(e),
3298 internal_hash(extent_object(e), depth + 1));
3301 static const struct lrecord_description extent_description[] = {
3302 {XD_LISP_OBJECT, offsetof(struct extent, object)},
3303 {XD_LISP_OBJECT, offsetof(struct extent, flags.face)},
3304 {XD_LISP_OBJECT, offsetof(struct extent, plist)},
3308 static Lisp_Object extent_getprop(Lisp_Object obj, Lisp_Object prop)
3310 return Fextent_property(obj, prop, Qunbound);
3313 static int extent_putprop(Lisp_Object obj, Lisp_Object prop, Lisp_Object value)
3315 Fset_extent_property(obj, prop, value);
3319 static int extent_remprop(Lisp_Object obj, Lisp_Object prop)
3321 EXTENT ext = XEXTENT(obj);
3323 /* This list is taken from Fset_extent_property, and should be kept
3325 if (EQ(prop, Qread_only)
3326 || EQ(prop, Qunique)
3327 || EQ(prop, Qduplicable)
3328 || EQ(prop, Qinvisible)
3329 || EQ(prop, Qdetachable)
3330 || EQ(prop, Qdetached)
3331 || EQ(prop, Qdestroyed)
3332 || EQ(prop, Qpriority)
3334 || EQ(prop, Qinitial_redisplay_function)
3335 || EQ(prop, Qafter_change_functions)
3336 || EQ(prop, Qbefore_change_functions)
3337 || EQ(prop, Qmouse_face)
3338 || EQ(prop, Qhighlight)
3339 || EQ(prop, Qbegin_glyph_layout)
3340 || EQ(prop, Qend_glyph_layout)
3341 || EQ(prop, Qglyph_layout)
3342 || EQ(prop, Qbegin_glyph)
3343 || EQ(prop, Qend_glyph)
3344 || EQ(prop, Qstart_open)
3345 || EQ(prop, Qend_open)
3346 || EQ(prop, Qstart_closed)
3347 || EQ(prop, Qend_closed)
3348 || EQ(prop, Qkeymap)) {
3349 /* #### Is this correct, anyway? */
3353 return external_remprop(extent_plist_addr(ext), prop, 0, ERROR_ME);
3356 static Lisp_Object extent_plist(Lisp_Object obj)
3358 return Fextent_properties(obj);
3361 DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS("extent", extent,
3362 mark_extent, print_extent,
3363 /* NOTE: If you declare a
3364 finalization method here,
3365 it will NOT be called.
3368 extent_equal, extent_hash,
3370 extent_getprop, extent_putprop,
3371 extent_remprop, extent_plist,
3374 /************************************************************************/
3375 /* basic extent accessors */
3376 /************************************************************************/
3378 /* These functions are for checking externally-passed extent objects
3379 and returning an extent's basic properties, which include the
3380 buffer the extent is associated with, the endpoints of the extent's
3381 range, the open/closed-ness of those endpoints, and whether the
3382 extent is detached. Manipulating these properties requires
3383 manipulating the ordered lists that hold extents; thus, functions
3384 to do that are in a later section. */
3386 /* Given a Lisp_Object that is supposed to be an extent, make sure it
3387 is OK and return an extent pointer. Extents can be in one of four
3391 2) detached and not associated with a buffer
3392 3) detached and associated with a buffer
3393 4) attached to a buffer
3395 If FLAGS is 0, types 2-4 are allowed. If FLAGS is DE_MUST_HAVE_BUFFER,
3396 types 3-4 are allowed. If FLAGS is DE_MUST_BE_ATTACHED, only type 4
3400 static EXTENT decode_extent(Lisp_Object extent_obj, unsigned int flags)
3405 CHECK_LIVE_EXTENT(extent_obj);
3406 extent = XEXTENT(extent_obj);
3407 obj = extent_object(extent);
3409 /* the following condition will fail if we're dealing with a freed extent */
3410 assert(NILP(obj) || BUFFERP(obj) || STRINGP(obj));
3412 if (flags & DE_MUST_BE_ATTACHED)
3413 flags |= DE_MUST_HAVE_BUFFER;
3415 /* if buffer is dead, then convert extent to have no buffer. */
3416 if (BUFFERP(obj) && !BUFFER_LIVE_P(XBUFFER(obj)))
3417 obj = extent_object(extent) = Qnil;
3419 assert(!NILP(obj) || extent_detached_p(extent));
3421 if ((NILP(obj) && (flags & DE_MUST_HAVE_BUFFER))
3422 || (extent_detached_p(extent) && (flags & DE_MUST_BE_ATTACHED))) {
3423 invalid_argument("extent doesn't belong to a buffer or string",
3430 /* Note that the returned value is a buffer position, not a byte index. */
3432 static Lisp_Object extent_endpoint_external(Lisp_Object extent_obj, int endp)
3434 EXTENT extent = decode_extent(extent_obj, 0);
3436 if (extent_detached_p(extent))
3439 return make_int(extent_endpoint_bufpos(extent, endp));
3442 DEFUN("extentp", Fextentp, 1, 1, 0, /*
3443 Return t if OBJECT is an extent.
3447 return EXTENTP(object) ? Qt : Qnil;
3450 DEFUN("extent-live-p", Fextent_live_p, 1, 1, 0, /*
3451 Return t if OBJECT is an extent that has not been destroyed.
3455 return EXTENTP(object) && EXTENT_LIVE_P(XEXTENT(object)) ? Qt : Qnil;
3458 DEFUN("extent-detached-p", Fextent_detached_p, 1, 1, 0, /*
3459 Return t if EXTENT is detached.
3463 return extent_detached_p(decode_extent(extent, 0)) ? Qt : Qnil;
3466 DEFUN("extent-object", Fextent_object, 1, 1, 0, /*
3467 Return object (buffer or string) that EXTENT refers to.
3471 return extent_object(decode_extent(extent, 0));
3474 DEFUN("extent-start-position", Fextent_start_position, 1, 1, 0, /*
3475 Return start position of EXTENT, or nil if EXTENT is detached.
3479 return extent_endpoint_external(extent, 0);
3482 DEFUN("extent-end-position", Fextent_end_position, 1, 1, 0, /*
3483 Return end position of EXTENT, or nil if EXTENT is detached.
3487 return extent_endpoint_external(extent, 1);
3490 DEFUN("extent-length", Fextent_length, 1, 1, 0, /*
3491 Return length of EXTENT in characters.
3495 EXTENT e = decode_extent(extent, DE_MUST_BE_ATTACHED);
3496 return make_int(extent_endpoint_bufpos(e, 1)
3497 - extent_endpoint_bufpos(e, 0));
3500 DEFUN("next-extent", Fnext_extent, 1, 1, 0, /*
3501 Find next extent after EXTENT.
3502 If EXTENT is a buffer return the first extent in the buffer; likewise
3504 Extents in a buffer are ordered in what is called the "display"
3505 order, which sorts by increasing start positions and then by *decreasing*
3507 If you want to perform an operation on a series of extents, use
3508 `map-extents' instead of this function; it is much more efficient.
3509 The primary use of this function should be to enumerate all the
3510 extents in a buffer.
3511 Note: The display order is not necessarily the order that `map-extents'
3512 processes extents in!
3519 if (EXTENTP(extent))
3520 next = extent_next(decode_extent(extent, DE_MUST_BE_ATTACHED));
3522 next = extent_first(decode_buffer_or_string(extent));
3526 XSETEXTENT(val, next);
3530 DEFUN("previous-extent", Fprevious_extent, 1, 1, 0, /*
3531 Find last extent before EXTENT.
3532 If EXTENT is a buffer return the last extent in the buffer; likewise
3534 This function is analogous to `next-extent'.
3541 if (EXTENTP(extent))
3543 extent_previous(decode_extent(extent, DE_MUST_BE_ATTACHED));
3545 prev = extent_last(decode_buffer_or_string(extent));
3549 XSETEXTENT(val, prev);
3553 #ifdef DEBUG_SXEMACS
3555 DEFUN("next-e-extent", Fnext_e_extent, 1, 1, 0, /*
3556 Find next extent after EXTENT using the "e" order.
3557 If EXTENT is a buffer return the first extent in the buffer; likewise
3565 if (EXTENTP(extent))
3567 extent_e_next(decode_extent(extent, DE_MUST_BE_ATTACHED));
3569 next = extent_e_first(decode_buffer_or_string(extent));
3573 XSETEXTENT(val, next);
3577 DEFUN("previous-e-extent", Fprevious_e_extent, 1, 1, 0, /*
3578 Find last extent before EXTENT using the "e" order.
3579 If EXTENT is a buffer return the last extent in the buffer; likewise
3581 This function is analogous to `next-e-extent'.
3588 if (EXTENTP(extent))
3590 extent_e_previous(decode_extent
3591 (extent, DE_MUST_BE_ATTACHED));
3593 prev = extent_e_last(decode_buffer_or_string(extent));
3597 XSETEXTENT(val, prev);
3603 DEFUN("next-extent-change", Fnext_extent_change, 1, 2, 0, /*
3604 Return the next position after POS where an extent begins or ends.
3605 If POS is at the end of the buffer or string, POS will be returned;
3606 otherwise a position greater than POS will always be returned.
3607 If OBJECT is nil, the current buffer is assumed.
3611 Lisp_Object obj = decode_buffer_or_string(object);
3615 get_buffer_or_string_pos_byte(obj, pos, GB_ALLOW_PAST_ACCESSIBLE);
3616 bpos = extent_find_end_of_run(obj, bpos, 1);
3617 return make_int(buffer_or_string_bytind_to_bufpos(obj, bpos));
3620 DEFUN("previous-extent-change", Fprevious_extent_change, 1, 2, 0, /*
3621 Return the last position before POS where an extent begins or ends.
3622 If POS is at the beginning of the buffer or string, POS will be returned;
3623 otherwise a position less than POS will always be returned.
3624 If OBJECT is nil, the current buffer is assumed.
3628 Lisp_Object obj = decode_buffer_or_string(object);
3632 get_buffer_or_string_pos_byte(obj, pos, GB_ALLOW_PAST_ACCESSIBLE);
3633 bpos = extent_find_beginning_of_run(obj, bpos, 1);
3634 return make_int(buffer_or_string_bytind_to_bufpos(obj, bpos));
3637 /************************************************************************/
3638 /* parent and children stuff */
3639 /************************************************************************/
3641 DEFUN("extent-parent", Fextent_parent, 1, 1, 0, /*
3642 Return the parent (if any) of EXTENT.
3643 If an extent has a parent, it derives all its properties from that extent
3644 and has no properties of its own. (The only "properties" that the
3645 extent keeps are the buffer/string it refers to and the start and end
3646 points.) It is possible for an extent's parent to itself have a parent.
3649 /* do I win the prize for the strangest split infinitive? */
3651 EXTENT e = decode_extent(extent, 0);
3652 return extent_parent(e);
3655 DEFUN("extent-children", Fextent_children, 1, 1, 0, /*
3656 Return a list of the children (if any) of EXTENT.
3657 The children of an extent are all those extents whose parent is that extent.
3658 This function does not recursively trace children of children.
3659 \(To do that, use `extent-descendants'.)
3663 EXTENT e = decode_extent(extent, 0);
3664 Lisp_Object children = extent_children(e);
3666 if (!NILP(children))
3667 return Fcopy_sequence(XWEAK_LIST_LIST(children));
3672 static void remove_extent_from_children_list(EXTENT e, Lisp_Object child)
3674 Lisp_Object children = extent_children(e);
3676 #ifdef ERROR_CHECK_EXTENTS
3677 assert(!NILP(memq_no_quit(child, XWEAK_LIST_LIST(children))));
3679 XWEAK_LIST_LIST(children) =
3680 delq_no_quit(child, XWEAK_LIST_LIST(children));
3683 static void add_extent_to_children_list(EXTENT e, Lisp_Object child)
3685 Lisp_Object children = extent_children(e);
3687 if (NILP(children)) {
3688 children = make_weak_list(WEAK_LIST_SIMPLE);
3689 set_extent_no_chase_aux_field(e, children, children);
3691 #ifdef ERROR_CHECK_EXTENTS
3692 assert(NILP(memq_no_quit(child, XWEAK_LIST_LIST(children))));
3694 XWEAK_LIST_LIST(children) = Fcons(child, XWEAK_LIST_LIST(children));
3697 DEFUN("set-extent-parent", Fset_extent_parent, 2, 2, 0, /*
3698 Set the parent of EXTENT to PARENT (may be nil).
3699 See `extent-parent'.
3703 EXTENT e = decode_extent(extent, 0);
3704 Lisp_Object cur_parent = extent_parent(e);
3707 XSETEXTENT(extent, e);
3709 CHECK_LIVE_EXTENT(parent);
3710 if (EQ(parent, cur_parent))
3712 for (rest = parent; !NILP(rest); rest = extent_parent(XEXTENT(rest)))
3713 if (EQ(rest, extent))
3714 signal_type_error(Qinvalid_change,
3715 "Circular parent chain would result",
3718 remove_extent_from_children_list(XEXTENT(cur_parent), extent);
3719 set_extent_no_chase_aux_field(e, parent, Qnil);
3720 e->flags.has_parent = 0;
3722 add_extent_to_children_list(XEXTENT(parent), extent);
3723 set_extent_no_chase_aux_field(e, parent, parent);
3724 e->flags.has_parent = 1;
3726 /* changing the parent also changes the properties of all children. */
3728 int old_invis = (!NILP(cur_parent) &&
3729 !NILP(extent_invisible(XEXTENT(cur_parent))));
3730 int new_invis = (!NILP(parent) &&
3731 !NILP(extent_invisible(XEXTENT(parent))));
3733 extent_maybe_changed_for_redisplay(e, 1,
3734 new_invis != old_invis);
3740 /************************************************************************/
3741 /* basic extent mutators */
3742 /************************************************************************/
3744 /* Note: If you track non-duplicable extents by undo, you'll get bogus
3745 undo records for transient extents via update-extent.
3746 For example, query-replace will do this.
3749 static void set_extent_endpoints_1(EXTENT extent, Memind start, Memind end)
3751 #ifdef ERROR_CHECK_EXTENTS
3752 Lisp_Object obj = extent_object(extent);
3754 assert(start <= end);
3756 assert(valid_memind_p(XBUFFER(obj), start));
3757 assert(valid_memind_p(XBUFFER(obj), end));
3761 /* Optimization: if the extent is already where we want it to be,
3763 if (!extent_detached_p(extent) && extent_start(extent) == start &&
3764 extent_end(extent) == end)
3767 if (extent_detached_p(extent)) {
3768 if (extent_duplicable_p(extent)) {
3769 Lisp_Object extent_obj;
3770 XSETEXTENT(extent_obj, extent);
3771 record_extent(extent_obj, 1);
3774 extent_detach(extent);
3776 set_extent_start(extent, start);
3777 set_extent_end(extent, end);
3778 extent_attach(extent);
3781 /* Set extent's endpoints to S and E, and put extent in buffer or string
3782 OBJECT. (If OBJECT is nil, do not change the extent's object.) */
3784 void set_extent_endpoints(EXTENT extent, Bytind s, Bytind e, Lisp_Object object)
3789 object = extent_object(extent);
3790 assert(!NILP(object));
3791 } else if (!EQ(object, extent_object(extent))) {
3792 extent_detach(extent);
3793 extent_object(extent) = object;
3796 start = s < 0 ? extent_start(extent) :
3797 buffer_or_string_bytind_to_memind(object, s);
3798 end = e < 0 ? extent_end(extent) :
3799 buffer_or_string_bytind_to_memind(object, e);
3800 set_extent_endpoints_1(extent, start, end);
3803 static void set_extent_openness(EXTENT extent, int start_open, int end_open)
3805 if (start_open != -1)
3806 extent_start_open_p(extent) = start_open;
3808 extent_end_open_p(extent) = end_open;
3809 /* changing the open/closedness of an extent does not affect
3813 static EXTENT make_extent_internal(Lisp_Object object, Bytind from, Bytind to)
3817 extent = make_extent_detached(object);
3818 set_extent_endpoints(extent, from, to, Qnil);
3823 copy_extent(EXTENT original, Bytind from, Bytind to, Lisp_Object object)
3827 e = make_extent_detached(object);
3829 set_extent_endpoints(e, from, to, Qnil);
3831 e->plist = Fcopy_sequence(original->plist);
3832 memcpy(&e->flags, &original->flags, sizeof(e->flags));
3833 if (e->flags.has_aux) {
3834 /* also need to copy the aux struct. It won't work for
3835 this extent to share the same aux struct as the original
3837 struct extent_auxiliary *data =
3838 alloc_lcrecord_type(struct extent_auxiliary,
3839 &lrecord_extent_auxiliary);
3841 copy_lcrecord(data, XEXTENT_AUXILIARY(XCAR(original->plist)));
3842 XSETEXTENT_AUXILIARY(XCAR(e->plist), data);
3846 /* we may have just added another child to the parent extent. */
3847 Lisp_Object parent = extent_parent(e);
3848 if (!NILP(parent)) {
3850 XSETEXTENT(extent, e);
3851 add_extent_to_children_list(XEXTENT(parent), extent);
3858 static void destroy_extent(EXTENT extent)
3860 Lisp_Object rest, nextrest, children;
3861 Lisp_Object extent_obj;
3863 if (!extent_detached_p(extent))
3864 extent_detach(extent);
3865 /* disassociate the extent from its children and parent */
3866 children = extent_children(extent);
3867 if (!NILP(children)) {
3868 LIST_LOOP_DELETING(rest, nextrest, XWEAK_LIST_LIST(children))
3869 Fset_extent_parent(XCAR(rest), Qnil);
3871 XSETEXTENT(extent_obj, extent);
3872 Fset_extent_parent(extent_obj, Qnil);
3873 /* mark the extent as destroyed */
3874 extent_object(extent) = Qt;
3877 DEFUN("make-extent", Fmake_extent, 2, 3, 0, /*
3878 Make an extent for the range [FROM, TO) in BUFFER-OR-STRING.
3879 BUFFER-OR-STRING defaults to the current buffer. Insertions at point
3880 TO will be outside of the extent; insertions at FROM will be inside the
3881 extent, causing the extent to grow. (This is the same way that markers
3882 behave.) You can change the behavior of insertions at the endpoints
3883 using `set-extent-property'. The extent is initially detached if both
3884 FROM and TO are nil, and in this case BUFFER-OR-STRING defaults to nil,
3885 meaning the extent is in no buffer and no string.
3887 (from, to, buffer_or_string))
3889 Lisp_Object extent_obj;
3892 obj = decode_buffer_or_string(buffer_or_string);
3893 if (NILP(from) && NILP(to)) {
3894 if (NILP(buffer_or_string))
3896 XSETEXTENT(extent_obj, make_extent_detached(obj));
3900 get_buffer_or_string_range_byte(obj, from, to, &start, &end,
3901 GB_ALLOW_PAST_ACCESSIBLE);
3902 XSETEXTENT(extent_obj, make_extent_internal(obj, start, end));
3907 DEFUN("copy-extent", Fcopy_extent, 1, 2, 0, /*
3908 Make a copy of EXTENT. It is initially detached.
3909 Optional argument BUFFER-OR-STRING defaults to EXTENT's buffer or string.
3911 (extent, buffer_or_string))
3913 EXTENT ext = decode_extent(extent, 0);
3915 if (NILP(buffer_or_string))
3916 buffer_or_string = extent_object(ext);
3918 buffer_or_string = decode_buffer_or_string(buffer_or_string);
3920 XSETEXTENT(extent, copy_extent(ext, -1, -1, buffer_or_string));
3924 DEFUN("delete-extent", Fdelete_extent, 1, 1, 0, /*
3925 Remove EXTENT from its buffer and destroy it.
3926 This does not modify the buffer's text, only its display properties.
3927 The extent cannot be used thereafter.
3933 /* We do not call decode_extent() here because already-destroyed
3935 CHECK_EXTENT(extent);
3936 ext = XEXTENT(extent);
3938 if (!EXTENT_LIVE_P(ext))
3940 destroy_extent(ext);
3944 DEFUN("detach-extent", Fdetach_extent, 1, 1, 0, /*
3945 Remove EXTENT from its buffer in such a way that it can be re-inserted.
3946 An extent is also detached when all of its characters are all killed by a
3947 deletion, unless its `detachable' property has been unset.
3949 Extents which have the `duplicable' attribute are tracked by the undo
3950 mechanism. Detachment via `detach-extent' and string deletion is recorded,
3951 as is attachment via `insert-extent' and string insertion. Extent motion,
3952 face changes, and attachment via `make-extent' and `set-extent-endpoints'
3953 are not recorded. This means that extent changes which are to be undo-able
3954 must be performed by character editing, or by insertion and detachment of
3959 EXTENT ext = decode_extent(extent, 0);
3961 if (extent_detached_p(ext))
3963 if (extent_duplicable_p(ext))
3964 record_extent(extent, 0);
3970 DEFUN("set-extent-endpoints", Fset_extent_endpoints, 3, 4, 0, /*
3971 Set the endpoints of EXTENT to START, END.
3972 If START and END are null, call detach-extent on EXTENT.
3973 BUFFER-OR-STRING specifies the new buffer or string that the extent should
3974 be in, and defaults to EXTENT's buffer or string. (If nil, and EXTENT
3975 is in no buffer and no string, it defaults to the current buffer.)
3976 See documentation on `detach-extent' for a discussion of undo recording.
3978 (extent, start, end, buffer_or_string))
3983 ext = decode_extent(extent, 0);
3985 if (NILP(buffer_or_string)) {
3986 buffer_or_string = extent_object(ext);
3987 if (NILP(buffer_or_string))
3988 buffer_or_string = Fcurrent_buffer();
3990 buffer_or_string = decode_buffer_or_string(buffer_or_string);
3992 if (NILP(start) && NILP(end))
3993 return Fdetach_extent(extent);
3995 get_buffer_or_string_range_byte(buffer_or_string, start, end, &s, &e,
3996 GB_ALLOW_PAST_ACCESSIBLE);
3998 buffer_or_string_extent_info_force(buffer_or_string);
3999 set_extent_endpoints(ext, s, e, buffer_or_string);
4003 /************************************************************************/
4004 /* mapping over extents */
4005 /************************************************************************/
4007 static unsigned int decode_map_extents_flags(Lisp_Object flags)
4009 unsigned int retval = 0;
4010 unsigned int all_extents_specified = 0;
4011 unsigned int in_region_specified = 0;
4013 if (EQ(flags, Qt)) /* obsoleteness compatibility */
4014 return ME_END_CLOSED;
4018 flags = Fcons(flags, Qnil);
4019 while (!NILP(flags)) {
4024 if (EQ(sym, Qall_extents_closed) || EQ(sym, Qall_extents_open)
4025 || EQ(sym, Qall_extents_closed_open)
4026 || EQ(sym, Qall_extents_open_closed)) {
4027 if (all_extents_specified)
4029 ("Only one `all-extents-*' flag may be specified");
4030 all_extents_specified = 1;
4032 if (EQ(sym, Qstart_in_region) || EQ(sym, Qend_in_region) ||
4033 EQ(sym, Qstart_and_end_in_region) ||
4034 EQ(sym, Qstart_or_end_in_region)) {
4035 if (in_region_specified)
4037 ("Only one `*-in-region' flag may be specified");
4038 in_region_specified = 1;
4041 /* I do so love that conditional operator ... */
4043 EQ(sym, Qend_closed) ? ME_END_CLOSED :
4044 EQ(sym, Qstart_open) ? ME_START_OPEN :
4045 EQ(sym, Qall_extents_closed) ? ME_ALL_EXTENTS_CLOSED :
4046 EQ(sym, Qall_extents_open) ? ME_ALL_EXTENTS_OPEN :
4048 Qall_extents_closed_open) ? ME_ALL_EXTENTS_CLOSED_OPEN :
4050 Qall_extents_open_closed) ? ME_ALL_EXTENTS_OPEN_CLOSED :
4051 EQ(sym, Qstart_in_region) ? ME_START_IN_REGION : EQ(sym,
4053 ? ME_END_IN_REGION : EQ(sym,
4054 Qstart_and_end_in_region) ?
4055 ME_START_AND_END_IN_REGION : EQ(sym,
4056 Qstart_or_end_in_region) ?
4057 ME_START_OR_END_IN_REGION : EQ(sym,
4058 Qnegate_in_region) ?
4060 : (invalid_argument("Invalid `map-extents' flag", sym), 0);
4062 flags = XCDR(flags);
4067 DEFUN("extent-in-region-p", Fextent_in_region_p, 1, 4, 0, /*
4068 Return whether EXTENT overlaps a specified region.
4069 This is equivalent to whether `map-extents' would visit EXTENT when called
4072 (extent, from, to, flags))
4075 EXTENT ext = decode_extent(extent, DE_MUST_BE_ATTACHED);
4076 Lisp_Object obj = extent_object(ext);
4078 get_buffer_or_string_range_byte(obj, from, to, &start, &end,
4080 GB_ALLOW_PAST_ACCESSIBLE);
4082 return extent_in_region_p(ext, start, end,
4083 decode_map_extents_flags(flags)) ? Qt : Qnil;
4086 struct slow_map_extents_arg {
4087 Lisp_Object map_arg;
4088 Lisp_Object map_routine;
4090 Lisp_Object property;
4094 static int slow_map_extents_function(EXTENT extent, void *arg)
4096 /* This function can GC */
4097 struct slow_map_extents_arg *closure =
4098 (struct slow_map_extents_arg *)arg;
4099 Lisp_Object extent_obj;
4101 XSETEXTENT(extent_obj, extent);
4103 /* make sure this extent qualifies according to the PROPERTY
4106 if (!NILP(closure->property)) {
4108 Fextent_property(extent_obj, closure->property,
4110 if ((NILP(closure->value) && NILP(value)) ||
4111 (!NILP(closure->value) && !EQ(value, closure->value)))
4115 closure->result = call2(closure->map_routine, extent_obj,
4117 return !NILP(closure->result);
4120 DEFUN("map-extents", Fmap_extents, 1, 8, 0, /*
4121 Map FUNCTION over the extents which overlap a region in OBJECT.
4122 OBJECT is normally a buffer or string but could be an extent (see below).
4123 The region is normally bounded by [FROM, TO) (i.e. the beginning of the
4124 region is closed and the end of the region is open), but this can be
4125 changed with the FLAGS argument (see below for a complete discussion).
4127 FUNCTION is called with the arguments (extent, MAPARG). The arguments
4128 OBJECT, FROM, TO, MAPARG, and FLAGS are all optional and default to
4129 the current buffer, the beginning of OBJECT, the end of OBJECT, nil,
4130 and nil, respectively. `map-extents' returns the first non-nil result
4131 produced by FUNCTION, and no more calls to FUNCTION are made after it
4134 If OBJECT is an extent, FROM and TO default to the extent's endpoints,
4135 and the mapping omits that extent and its predecessors. This feature
4136 supports restarting a loop based on `map-extents'. Note: OBJECT must
4137 be attached to a buffer or string, and the mapping is done over that
4140 An extent overlaps the region if there is any point in the extent that is
4141 also in the region. (For the purpose of overlap, zero-length extents and
4142 regions are treated as closed on both ends regardless of their endpoints'
4143 specified open/closedness.) Note that the endpoints of an extent or region
4144 are considered to be in that extent or region if and only if the
4145 corresponding end is closed. For example, the extent [5,7] overlaps the
4146 region [2,5] because 5 is in both the extent and the region. However, (5,7]
4147 does not overlap [2,5] because 5 is not in the extent, and neither [5,7] nor
4148 \(5,7] overlaps the region [2,5) because 5 is not in the region.
4150 The optional FLAGS can be a symbol or a list of one or more symbols,
4151 modifying the behavior of `map-extents'. Allowed symbols are:
4153 end-closed The region's end is closed.
4155 start-open The region's start is open.
4157 all-extents-closed Treat all extents as closed on both ends for the
4158 purpose of determining whether they overlap the
4159 region, irrespective of their actual open- or
4161 all-extents-open Treat all extents as open on both ends.
4162 all-extents-closed-open Treat all extents as start-closed, end-open.
4163 all-extents-open-closed Treat all extents as start-open, end-closed.
4165 start-in-region In addition to the above conditions for extent
4166 overlap, the extent's start position must lie within
4167 the specified region. Note that, for this
4168 condition, open start positions are treated as if
4169 0.5 was added to the endpoint's value, and open
4170 end positions are treated as if 0.5 was subtracted
4171 from the endpoint's value.
4172 end-in-region The extent's end position must lie within the
4174 start-and-end-in-region Both the extent's start and end positions must lie
4176 start-or-end-in-region Either the extent's start or end position must lie
4179 negate-in-region The condition specified by a `*-in-region' flag
4180 must NOT hold for the extent to be considered.
4182 At most one of `all-extents-closed', `all-extents-open',
4183 `all-extents-closed-open', and `all-extents-open-closed' may be specified.
4185 At most one of `start-in-region', `end-in-region',
4186 `start-and-end-in-region', and `start-or-end-in-region' may be specified.
4188 If optional arg PROPERTY is non-nil, only extents with that property set
4189 on them will be visited. If optional arg VALUE is non-nil, only extents
4190 whose value for that property is `eq' to VALUE will be visited.
4192 (function, object, from, to, maparg, flags, property, value))
4194 /* This function can GC */
4195 struct slow_map_extents_arg closure;
4196 unsigned int me_flags;
4198 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
4201 if (EXTENTP(object)) {
4202 after = decode_extent(object, DE_MUST_BE_ATTACHED);
4204 from = Fextent_start_position(object);
4206 to = Fextent_end_position(object);
4207 object = extent_object(after);
4209 object = decode_buffer_or_string(object);
4211 get_buffer_or_string_range_byte(object, from, to, &start, &end,
4213 GB_ALLOW_PAST_ACCESSIBLE);
4215 me_flags = decode_map_extents_flags(flags);
4217 if (!NILP(property)) {
4219 value = canonicalize_extent_property(property, value);
4222 GCPRO5(function, maparg, object, property, value);
4224 closure.map_arg = maparg;
4225 closure.map_routine = function;
4226 closure.result = Qnil;
4227 closure.property = property;
4228 closure.value = value;
4230 map_extents_bytind(start, end, slow_map_extents_function,
4231 (void *)&closure, object, after,
4232 /* You never know what the user might do ... */
4233 me_flags | ME_MIGHT_CALL_ELISP);
4236 return closure.result;
4239 /************************************************************************/
4240 /* mapping over extents -- other functions */
4241 /************************************************************************/
4243 /* ------------------------------- */
4244 /* map-extent-children */
4245 /* ------------------------------- */
4247 struct slow_map_extent_children_arg {
4248 Lisp_Object map_arg;
4249 Lisp_Object map_routine;
4251 Lisp_Object property;
4258 static int slow_map_extent_children_function(EXTENT extent, void *arg)
4260 /* This function can GC */
4261 struct slow_map_extent_children_arg *closure =
4262 (struct slow_map_extent_children_arg *)arg;
4263 Lisp_Object extent_obj;
4264 Bytind start = extent_endpoint_bytind(extent, 0);
4265 Bytind end = extent_endpoint_bytind(extent, 1);
4266 /* Make sure the extent starts inside the region of interest,
4267 rather than just overlaps it.
4269 if (start < closure->start_min)
4271 /* Make sure the extent is not a child of a previous visited one.
4272 We know already, because of extent ordering,
4273 that start >= prev_start, and that if
4274 start == prev_start, then end <= prev_end.
4276 if (start == closure->prev_start) {
4277 if (end < closure->prev_end)
4279 } else { /* start > prev_start */
4281 if (start < closure->prev_end)
4283 /* corner case: prev_end can be -1 if there is no prev */
4285 XSETEXTENT(extent_obj, extent);
4287 /* make sure this extent qualifies according to the PROPERTY
4290 if (!NILP(closure->property)) {
4292 Fextent_property(extent_obj, closure->property,
4294 if ((NILP(closure->value) && NILP(value)) ||
4295 (!NILP(closure->value) && !EQ(value, closure->value)))
4299 closure->result = call2(closure->map_routine, extent_obj,
4302 /* Since the callback may change the buffer, compute all stored
4303 buffer positions here.
4305 closure->start_min = -1; /* no need for this any more */
4306 closure->prev_start = extent_endpoint_bytind(extent, 0);
4307 closure->prev_end = extent_endpoint_bytind(extent, 1);
4309 return !NILP(closure->result);
4312 DEFUN("map-extent-children", Fmap_extent_children, 1, 8, 0, /*
4313 Map FUNCTION over the extents in the region from FROM to TO.
4314 FUNCTION is called with arguments (extent, MAPARG). See `map-extents'
4315 for a full discussion of the arguments FROM, TO, and FLAGS.
4317 The arguments are the same as for `map-extents', but this function differs
4318 in that it only visits extents which start in the given region, and also
4319 in that, after visiting an extent E, it skips all other extents which start
4320 inside E but end before E's end.
4322 Thus, this function may be used to walk a tree of extents in a buffer:
4323 (defun walk-extents (buffer &optional ignore)
4324 (map-extent-children 'walk-extents buffer))
4326 (function, object, from, to, maparg, flags, property, value))
4328 /* This function can GC */
4329 struct slow_map_extent_children_arg closure;
4330 unsigned int me_flags;
4332 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
4335 if (EXTENTP(object)) {
4336 after = decode_extent(object, DE_MUST_BE_ATTACHED);
4338 from = Fextent_start_position(object);
4340 to = Fextent_end_position(object);
4341 object = extent_object(after);
4343 object = decode_buffer_or_string(object);
4345 get_buffer_or_string_range_byte(object, from, to, &start, &end,
4347 GB_ALLOW_PAST_ACCESSIBLE);
4349 me_flags = decode_map_extents_flags(flags);
4351 if (!NILP(property)) {
4353 value = canonicalize_extent_property(property, value);
4356 GCPRO5(function, maparg, object, property, value);
4358 closure.map_arg = maparg;
4359 closure.map_routine = function;
4360 closure.result = Qnil;
4361 closure.property = property;
4362 closure.value = value;
4363 closure.start_min = start;
4364 closure.prev_start = -1;
4365 closure.prev_end = -1;
4366 map_extents_bytind(start, end, slow_map_extent_children_function,
4367 (void *)&closure, object, after,
4368 /* You never know what the user might do ... */
4369 me_flags | ME_MIGHT_CALL_ELISP);
4372 return closure.result;
4375 /* ------------------------------- */
4377 /* ------------------------------- */
4379 /* find "smallest" matching extent containing pos -- (flag == 0) means
4380 all extents match, else (EXTENT_FLAGS (extent) & flag) must be true;
4381 for more than one matching extent with precisely the same endpoints,
4382 we choose the last extent in the extents_list.
4383 The search stops just before "before", if that is non-null.
4386 struct extent_at_arg {
4387 Lisp_Object best_match; /* or list of extents */
4395 enum extent_at_flag {
4401 static enum extent_at_flag decode_extent_at_flag(Lisp_Object at_flag)
4404 return EXTENT_AT_AFTER;
4406 CHECK_SYMBOL(at_flag);
4407 if (EQ(at_flag, Qafter))
4408 return EXTENT_AT_AFTER;
4409 if (EQ(at_flag, Qbefore))
4410 return EXTENT_AT_BEFORE;
4411 if (EQ(at_flag, Qat))
4412 return EXTENT_AT_AT;
4414 invalid_argument("Invalid AT-FLAG in `extent-at'", at_flag);
4415 return EXTENT_AT_AFTER; /* unreached */
4418 static int extent_at_mapper(EXTENT e, void *arg)
4420 struct extent_at_arg *closure = (struct extent_at_arg *)arg;
4422 if (e == closure->before)
4425 /* If closure->prop is non-nil, then the extent is only acceptable
4426 if it has a non-nil value for that property. */
4427 if (!NILP(closure->prop)) {
4429 XSETEXTENT(extent, e);
4430 if (NILP(Fextent_property(extent, closure->prop, Qnil)))
4434 if (!closure->all_extents) {
4437 if (NILP(closure->best_match))
4439 current = XEXTENT(closure->best_match);
4440 /* redundant but quick test */
4441 if (extent_start(current) > extent_start(e))
4444 /* we return the "last" best fit, instead of the first --
4445 this is because then the glyph closest to two equivalent
4446 extents corresponds to the "extent-at" the text just past
4448 else if (!EXTENT_LESS_VALS(e, closure->best_start,
4454 XSETEXTENT(closure->best_match, e);
4455 closure->best_start = extent_start(e);
4456 closure->best_end = extent_end(e);
4460 XSETEXTENT(extent, e);
4461 closure->best_match = Fcons(extent, closure->best_match);
4468 extent_at_bytind(Bytind position, Lisp_Object object, Lisp_Object property,
4469 EXTENT before, enum extent_at_flag at_flag, int all_extents)
4471 struct extent_at_arg closure;
4472 struct gcpro gcpro1;
4474 /* it might be argued that invalid positions should cause
4475 errors, but the principle of least surprise dictates that
4476 nil should be returned (extent-at is often used in
4477 response to a mouse event, and in many cases previous events
4478 have changed the buffer contents).
4480 Also, the openness stuff in the text-property code currently
4481 does not check its limits and might go off the end. */
4482 if ((at_flag == EXTENT_AT_BEFORE
4483 ? position <= buffer_or_string_absolute_begin_byte(object)
4484 : position < buffer_or_string_absolute_begin_byte(object))
4485 || (at_flag == EXTENT_AT_AFTER
4486 ? position >= buffer_or_string_absolute_end_byte(object)
4487 : position > buffer_or_string_absolute_end_byte(object)))
4490 closure.best_match = Qnil;
4491 closure.prop = property;
4492 closure.before = before;
4493 closure.all_extents = all_extents;
4495 GCPRO1(closure.best_match);
4496 map_extents_bytind(at_flag ==
4497 EXTENT_AT_BEFORE ? position - 1 : position,
4498 at_flag == EXTENT_AT_AFTER ? position + 1 : position,
4499 extent_at_mapper, (void *)&closure, object, 0,
4500 ME_START_OPEN | ME_ALL_EXTENTS_CLOSED);
4502 closure.best_match = Fnreverse(closure.best_match);
4505 return closure.best_match;
4508 DEFUN("extent-at", Fextent_at, 1, 5, 0, /*
4509 Find "smallest" extent at POS in OBJECT having PROPERTY set.
4510 Normally, an extent is "at" POS if it overlaps the region (POS, POS+1);
4511 i.e. if it covers the character after POS. (However, see the definition
4512 of AT-FLAG.) "Smallest" means the extent that comes last in the display
4513 order; this normally means the extent whose start position is closest to
4514 POS. See `next-extent' for more information.
4515 OBJECT specifies a buffer or string and defaults to the current buffer.
4516 PROPERTY defaults to nil, meaning that any extent will do.
4517 Properties are attached to extents with `set-extent-property', which see.
4518 Returns nil if POS is invalid or there is no matching extent at POS.
4519 If the fourth argument BEFORE is not nil, it must be an extent; any returned
4520 extent will precede that extent. This feature allows `extent-at' to be
4521 used by a loop over extents.
4522 AT-FLAG controls how end cases are handled, and should be one of:
4524 nil or `after' An extent is at POS if it covers the character
4525 after POS. This is consistent with the way
4526 that text properties work.
4527 `before' An extent is at POS if it covers the character
4529 `at' An extent is at POS if it overlaps or abuts POS.
4530 This includes all zero-length extents at POS.
4532 Note that in all cases, the start-openness and end-openness of the extents
4533 considered is ignored. If you want to pay attention to those properties,
4534 you should use `map-extents', which gives you more control.
4536 (pos, object, property, before, at_flag))
4539 EXTENT before_extent;
4540 enum extent_at_flag fl;
4542 object = decode_buffer_or_string(object);
4544 get_buffer_or_string_pos_byte(object, pos, GB_NO_ERROR_IF_BAD);
4548 before_extent = decode_extent(before, DE_MUST_BE_ATTACHED);
4549 if (before_extent && !EQ(object, extent_object(before_extent)))
4550 invalid_argument("extent not in specified buffer or string",
4552 fl = decode_extent_at_flag(at_flag);
4554 return extent_at_bytind(position, object, property, before_extent, fl,
4558 DEFUN("extents-at", Fextents_at, 1, 5, 0, /*
4559 Find all extents at POS in OBJECT having PROPERTY set.
4560 Normally, an extent is "at" POS if it overlaps the region (POS, POS+1);
4561 i.e. if it covers the character after POS. (However, see the definition
4563 This provides similar functionality to `extent-list', but does so in a way
4564 that is compatible with `extent-at'. (For example, errors due to POS out of
4565 range are ignored; this makes it safer to use this function in response to
4566 a mouse event, because in many cases previous events have changed the buffer
4568 OBJECT specifies a buffer or string and defaults to the current buffer.
4569 PROPERTY defaults to nil, meaning that any extent will do.
4570 Properties are attached to extents with `set-extent-property', which see.
4571 Returns nil if POS is invalid or there is no matching extent at POS.
4572 If the fourth argument BEFORE is not nil, it must be an extent; any returned
4573 extent will precede that extent. This feature allows `extents-at' to be
4574 used by a loop over extents.
4575 AT-FLAG controls how end cases are handled, and should be one of:
4577 nil or `after' An extent is at POS if it covers the character
4578 after POS. This is consistent with the way
4579 that text properties work.
4580 `before' An extent is at POS if it covers the character
4582 `at' An extent is at POS if it overlaps or abuts POS.
4583 This includes all zero-length extents at POS.
4585 Note that in all cases, the start-openness and end-openness of the extents
4586 considered is ignored. If you want to pay attention to those properties,
4587 you should use `map-extents', which gives you more control.
4589 (pos, object, property, before, at_flag))
4592 EXTENT before_extent;
4593 enum extent_at_flag fl;
4595 object = decode_buffer_or_string(object);
4597 get_buffer_or_string_pos_byte(object, pos, GB_NO_ERROR_IF_BAD);
4601 before_extent = decode_extent(before, DE_MUST_BE_ATTACHED);
4602 if (before_extent && !EQ(object, extent_object(before_extent)))
4603 invalid_argument("extent not in specified buffer or string",
4605 fl = decode_extent_at_flag(at_flag);
4607 return extent_at_bytind(position, object, property, before_extent, fl,
4611 /* ------------------------------- */
4612 /* verify_extent_modification() */
4613 /* ------------------------------- */
4615 /* verify_extent_modification() is called when a buffer or string is
4616 modified to check whether the modification is occuring inside a
4620 struct verify_extents_arg {
4624 Lisp_Object iro; /* value of inhibit-read-only */
4627 static int verify_extent_mapper(EXTENT extent, void *arg)
4629 struct verify_extents_arg *closure = (struct verify_extents_arg *)arg;
4630 Lisp_Object prop = extent_read_only(extent);
4635 if (CONSP(closure->iro) && !NILP(Fmemq(prop, closure->iro)))
4638 #if 0 /* Nobody seems to care for this any more -sb */
4639 /* Allow deletion if the extent is completely contained in
4640 the region being deleted.
4641 This is important for supporting tokens which are internally
4642 write-protected, but which can be killed and yanked as a whole.
4643 Ignore open/closed distinctions at this point.
4646 if (closure->start != closure->end &&
4647 extent_start(extent) >= closure->start &&
4648 extent_end(extent) <= closure->end)
4653 Fsignal(Qbuffer_read_only, (list1(closure->object)));
4655 RETURN_NOT_REACHED(0)
4658 /* Value of Vinhibit_read_only is precomputed and passed in for
4662 verify_extent_modification(Lisp_Object object, Bytind from, Bytind to,
4663 Lisp_Object inhibit_read_only_value)
4666 struct verify_extents_arg closure;
4668 /* If insertion, visit closed-endpoint extents touching the insertion
4669 point because the text would go inside those extents. If deletion,
4670 treat the range as open on both ends so that touching extents are not
4671 visited. Note that we assume that an insertion is occurring if the
4672 changed range has zero length, and a deletion otherwise. This
4673 fails if a change (i.e. non-insertion, non-deletion) is happening.
4674 As far as I know, this doesn't currently occur in XEmacs. --ben */
4675 closed = (from == to);
4676 closure.object = object;
4677 closure.start = buffer_or_string_bytind_to_memind(object, from);
4678 closure.end = buffer_or_string_bytind_to_memind(object, to);
4679 closure.iro = inhibit_read_only_value;
4681 map_extents_bytind(from, to, verify_extent_mapper, (void *)&closure,
4682 object, 0, closed ? ME_END_CLOSED : ME_START_OPEN);
4685 /* ------------------------------------ */
4686 /* process_extents_for_insertion() */
4687 /* ------------------------------------ */
4689 struct process_extents_for_insertion_arg {
4695 /* A region of length LENGTH was just inserted at OPOINT. Modify all
4696 of the extents as required for the insertion, based on their
4697 start-open/end-open properties.
4700 static int process_extents_for_insertion_mapper(EXTENT extent, void *arg)
4702 struct process_extents_for_insertion_arg *closure =
4703 (struct process_extents_for_insertion_arg *)arg;
4704 Memind indice = buffer_or_string_bytind_to_memind(closure->object,
4707 /* When this function is called, one end of the newly-inserted text should
4708 be adjacent to some endpoint of the extent, or disjoint from it. If
4709 the insertion overlaps any existing extent, something is wrong.
4711 #ifdef ERROR_CHECK_EXTENTS
4712 if (extent_start(extent) > indice &&
4713 extent_start(extent) < indice + closure->length)
4715 if (extent_end(extent) > indice &&
4716 extent_end(extent) < indice + closure->length)
4720 /* The extent-adjustment code adjusted the extent's endpoints as if
4721 all extents were closed-open -- endpoints at the insertion point
4722 remain unchanged. We need to fix the other kinds of extents:
4724 1. Start position of start-open extents needs to be moved.
4726 2. End position of end-closed extents needs to be moved.
4728 Note that both conditions hold for zero-length (] extents at the
4729 insertion point. But under these rules, zero-length () extents
4730 would get adjusted such that their start is greater than their
4731 end; instead of allowing that, we treat them as [) extents by
4732 modifying condition #1 to not fire nothing when dealing with a
4733 zero-length open-open extent.
4735 Existence of zero-length open-open extents is unfortunately an
4736 inelegant part of the extent model, but there is no way around
4740 Memind new_start = extent_start(extent);
4741 Memind new_end = extent_end(extent);
4743 if (indice == extent_start(extent)
4744 && extent_start_open_p(extent)
4745 /* zero-length () extents are exempt; see comment above. */
4746 && !(new_start == new_end && extent_end_open_p(extent))
4748 new_start += closure->length;
4749 if (indice == extent_end(extent) && !extent_end_open_p(extent))
4750 new_end += closure->length;
4752 set_extent_endpoints_1(extent, new_start, new_end);
4759 process_extents_for_insertion(Lisp_Object object, Bytind opoint,
4762 struct process_extents_for_insertion_arg closure;
4764 closure.opoint = opoint;
4765 closure.length = length;
4766 closure.object = object;
4768 map_extents_bytind(opoint, opoint + length,
4769 process_extents_for_insertion_mapper,
4770 (void *)&closure, object, 0,
4771 ME_END_CLOSED | ME_MIGHT_MODIFY_EXTENTS |
4772 ME_INCLUDE_INTERNAL);
4775 /* ------------------------------------ */
4776 /* process_extents_for_deletion() */
4777 /* ------------------------------------ */
4779 struct process_extents_for_deletion_arg {
4781 int destroy_included_extents;
4784 /* This function is called when we're about to delete the range [from, to].
4785 Detach all of the extents that are completely inside the range [from, to],
4786 if they're detachable or open-open. */
4788 static int process_extents_for_deletion_mapper(EXTENT extent, void *arg)
4790 struct process_extents_for_deletion_arg *closure =
4791 (struct process_extents_for_deletion_arg *)arg;
4793 /* If the extent lies completely within the range that
4794 is being deleted, then nuke the extent if it's detachable
4795 (otherwise, it will become a zero-length extent). */
4797 if (closure->start <= extent_start(extent) &&
4798 extent_end(extent) <= closure->end) {
4799 if (extent_detachable_p(extent)) {
4800 if (closure->destroy_included_extents)
4801 destroy_extent(extent);
4803 extent_detach(extent);
4810 /* DESTROY_THEM means destroy the extents instead of just deleting them.
4811 It is unused currently, but perhaps might be used (there used to
4812 be a function process_extents_for_destruction(), #if 0'd out,
4813 that did the equivalent). */
4815 process_extents_for_deletion(Lisp_Object object, Bytind from,
4816 Bytind to, int destroy_them)
4818 struct process_extents_for_deletion_arg closure;
4820 closure.start = buffer_or_string_bytind_to_memind(object, from);
4821 closure.end = buffer_or_string_bytind_to_memind(object, to);
4822 closure.destroy_included_extents = destroy_them;
4824 map_extents_bytind(from, to, process_extents_for_deletion_mapper,
4825 (void *)&closure, object, 0,
4826 ME_END_CLOSED | ME_MIGHT_MODIFY_EXTENTS);
4829 /* ------------------------------- */
4830 /* report_extent_modification() */
4831 /* ------------------------------- */
4832 struct report_extent_modification_closure {
4839 static Lisp_Object report_extent_modification_restore(Lisp_Object buffer)
4841 if (current_buffer != XBUFFER(buffer))
4842 Fset_buffer(buffer);
4846 static int report_extent_modification_mapper(EXTENT extent, void *arg)
4848 struct report_extent_modification_closure *closure =
4849 (struct report_extent_modification_closure *)arg;
4850 Lisp_Object exobj, startobj, endobj;
4851 Lisp_Object hook = (closure->afterp
4852 ? extent_after_change_functions(extent)
4853 : extent_before_change_functions(extent));
4857 XSETEXTENT(exobj, extent);
4858 XSETINT(startobj, closure->start);
4859 XSETINT(endobj, closure->end);
4861 /* Now that we are sure to call elisp, set up an unwind-protect so
4862 inside_change_hook gets restored in case we throw. Also record
4863 the current buffer, in case we change it. Do the recording only
4866 One confusing thing here is that our caller never actually calls
4867 unbind_to (closure.speccount, Qnil). This is because
4868 map_extents_bytind() unbinds before, and with a smaller
4869 speccount. The additional unbind_to() in
4870 report_extent_modification() would cause XEmacs to abort. */
4871 if (closure->speccount == -1) {
4872 closure->speccount = specpdl_depth();
4873 record_unwind_protect(report_extent_modification_restore,
4877 /* The functions will expect closure->buffer to be the current
4878 buffer, so change it if it isn't. */
4879 if (current_buffer != XBUFFER(closure->buffer))
4880 Fset_buffer(closure->buffer);
4882 /* #### It's a shame that we can't use any of the existing run_hook*
4883 functions here. This is so because all of them work with
4884 symbols, to be able to retrieve default values of local hooks.
4887 #### Idea: we could set up a dummy symbol, and call the hook
4888 functions on *that*. */
4890 if (!CONSP(hook) || EQ(XCAR(hook), Qlambda))
4891 call3(hook, exobj, startobj, endobj);
4894 EXTERNAL_LIST_LOOP(tail, hook)
4895 /* #### Shouldn't this perform the same Fset_buffer() check as
4897 call3(XCAR(tail), exobj, startobj, endobj);
4903 report_extent_modification(Lisp_Object buffer, Bufpos start, Bufpos end,
4906 struct report_extent_modification_closure closure;
4908 closure.buffer = buffer;
4909 closure.start = start;
4911 closure.afterp = afterp;
4912 closure.speccount = -1;
4914 map_extents(start, end, report_extent_modification_mapper,
4915 (void *)&closure, buffer, NULL, ME_MIGHT_CALL_ELISP);
4918 /************************************************************************/
4919 /* extent properties */
4920 /************************************************************************/
4922 static void set_extent_invisible(EXTENT extent, Lisp_Object value)
4924 if (!EQ(extent_invisible(extent), value)) {
4925 set_extent_invisible_1(extent, value);
4926 extent_changed_for_redisplay(extent, 1, 1);
4930 /* This function does "memoization" -- similar to the interning
4931 that happens with symbols. Given a list of faces, an equivalent
4932 list is returned such that if this function is called twice with
4933 input that is `equal', the resulting outputs will be `eq'.
4935 Note that the inputs and outputs are in general *not* `equal' --
4936 faces in symbol form become actual face objects in the output.
4937 This is necessary so that temporary faces stay around. */
4939 static Lisp_Object memoize_extent_face_internal(Lisp_Object list)
4943 Lisp_Object cons, thecons;
4944 Lisp_Object oldtail, tail;
4945 struct gcpro gcpro1;
4950 return Fget_face(list);
4952 /* To do the memoization, we use a hash table mapping from
4953 external lists to internal lists. We do `equal' comparisons
4954 on the keys so the memoization works correctly.
4956 Note that we canonicalize things so that the keys in the
4957 hash table (the external lists) always contain symbols and
4958 the values (the internal lists) always contain face objects.
4960 We also maintain a "reverse" table that maps from the internal
4961 lists to the external equivalents. The idea here is twofold:
4963 1) `extent-face' wants to return a list containing face symbols
4964 rather than face objects.
4965 2) We don't want things to get quite so messed up if the user
4966 maliciously side-effects the returned lists.
4969 len = XINT(Flength(list));
4970 thelen = XINT(Flength(Vextent_face_reusable_list));
4975 /* We canonicalize the given list into another list.
4976 We try to avoid consing except when necessary, so we have
4981 cons = Vextent_face_reusable_list;
4982 while (!NILP(XCDR(cons)))
4984 XCDR(cons) = Fmake_list(make_int(len - thelen), Qnil);
4985 } else if (thelen > len) {
4988 /* Truncate the list temporarily so it's the right length;
4989 remember the old tail. */
4990 cons = Vextent_face_reusable_list;
4991 for (i = 0; i < len - 1; i++)
4994 oldtail = XCDR(cons);
4998 thecons = Vextent_face_reusable_list;
4999 EXTERNAL_LIST_LOOP(cons, list) {
5000 Lisp_Object face = Fget_face(XCAR(cons));
5002 XCAR(thecons) = Fface_name(face);
5003 thecons = XCDR(thecons);
5007 Fgethash(Vextent_face_reusable_list,
5008 Vextent_face_memoize_hash_table, Qnil);
5010 Lisp_Object symlist =
5011 Fcopy_sequence(Vextent_face_reusable_list);
5012 Lisp_Object facelist =
5013 Fcopy_sequence(Vextent_face_reusable_list);
5015 LIST_LOOP(cons, facelist) {
5016 XCAR(cons) = Fget_face(XCAR(cons));
5018 Fputhash(symlist, facelist, Vextent_face_memoize_hash_table);
5019 Fputhash(facelist, symlist,
5020 Vextent_face_reverse_memoize_hash_table);
5024 /* Now restore the truncated tail of the reusable list, if necessary. */
5026 XCDR(tail) = oldtail;
5032 static Lisp_Object external_of_internal_memoized_face(Lisp_Object face)
5036 else if (!CONSP(face))
5037 return XFACE(face)->name;
5039 face = Fgethash(face, Vextent_face_reverse_memoize_hash_table,
5041 assert(!UNBOUNDP(face));
5047 canonicalize_extent_property(Lisp_Object prop, Lisp_Object value)
5049 if (EQ(prop, Qface) || EQ(prop, Qmouse_face))
5050 value = (external_of_internal_memoized_face
5051 (memoize_extent_face_internal(value)));
5055 /* Do we need a lisp-level function ? */
5056 DEFUN("set-extent-initial-redisplay-function", Fset_extent_initial_redisplay_function, 2, 2, 0, /*
5057 Note: This feature is experimental!
5059 Set initial-redisplay-function of EXTENT to the function
5062 The first time the EXTENT is (re)displayed, an eval event will be
5063 dispatched calling FUNCTION with EXTENT as its only argument.
5067 EXTENT e = decode_extent(extent, DE_MUST_BE_ATTACHED);
5069 e = extent_ancestor(e); /* Is this needed? Macro also does chasing! */
5070 set_extent_initial_redisplay_function(e, function);
5071 extent_in_red_event_p(e) = 0; /* If the function changed we can spawn
5073 extent_changed_for_redisplay(e, 1, 0); /* Do we need to mark children too ? */
5078 DEFUN("extent-face", Fextent_face, 1, 1, 0, /*
5079 Return the name of the face in which EXTENT is displayed, or nil
5080 if the extent's face is unspecified. This might also return a list
5087 CHECK_EXTENT(extent);
5088 face = extent_face(XEXTENT(extent));
5090 return external_of_internal_memoized_face(face);
5093 DEFUN("set-extent-face", Fset_extent_face, 2, 2, 0, /*
5094 Make the given EXTENT have the graphic attributes specified by FACE.
5095 FACE can also be a list of faces, and all faces listed will apply,
5096 with faces earlier in the list taking priority over those later in the
5101 EXTENT e = decode_extent(extent, 0);
5102 Lisp_Object orig_face = face;
5104 /* retrieve the ancestor for efficiency and proper redisplay noting. */
5105 e = extent_ancestor(e);
5107 face = memoize_extent_face_internal(face);
5109 extent_face(e) = face;
5110 extent_changed_for_redisplay(e, 1, 0);
5115 DEFUN("extent-mouse-face", Fextent_mouse_face, 1, 1, 0, /*
5116 Return the face used to highlight EXTENT when the mouse passes over it.
5117 The return value will be a face name, a list of face names, or nil
5118 if the extent's mouse face is unspecified.
5124 CHECK_EXTENT(extent);
5125 face = extent_mouse_face(XEXTENT(extent));
5127 return external_of_internal_memoized_face(face);
5130 DEFUN("set-extent-mouse-face", Fset_extent_mouse_face, 2, 2, 0, /*
5131 Set the face used to highlight EXTENT when the mouse passes over it.
5132 FACE can also be a list of faces, and all faces listed will apply,
5133 with faces earlier in the list taking priority over those later in the
5139 Lisp_Object orig_face = face;
5141 CHECK_EXTENT(extent);
5142 e = XEXTENT(extent);
5143 /* retrieve the ancestor for efficiency and proper redisplay noting. */
5144 e = extent_ancestor(e);
5146 face = memoize_extent_face_internal(face);
5148 set_extent_mouse_face(e, face);
5149 extent_changed_for_redisplay(e, 1, 0);
5155 set_extent_glyph(EXTENT extent, Lisp_Object glyph, int endp,
5156 glyph_layout layout)
5158 extent = extent_ancestor(extent);
5161 set_extent_begin_glyph(extent, glyph);
5162 extent_begin_glyph_layout(extent) = layout;
5164 set_extent_end_glyph(extent, glyph);
5165 extent_end_glyph_layout(extent) = layout;
5168 extent_changed_for_redisplay(extent, 1, 0);
5171 static Lisp_Object glyph_layout_to_symbol(glyph_layout layout)
5176 case GL_OUTSIDE_MARGIN:
5177 return Qoutside_margin;
5178 case GL_INSIDE_MARGIN:
5179 return Qinside_margin;
5184 return Qnil; /* unreached */
5188 static glyph_layout symbol_to_glyph_layout(Lisp_Object layout_obj)
5190 if (NILP(layout_obj))
5193 CHECK_SYMBOL(layout_obj);
5194 if (EQ(layout_obj, Qoutside_margin))
5195 return GL_OUTSIDE_MARGIN;
5196 if (EQ(layout_obj, Qinside_margin))
5197 return GL_INSIDE_MARGIN;
5198 if (EQ(layout_obj, Qwhitespace))
5199 return GL_WHITESPACE;
5200 if (EQ(layout_obj, Qtext))
5203 invalid_argument("Unknown glyph layout type", layout_obj);
5204 return GL_TEXT; /* unreached */
5208 set_extent_glyph_1(Lisp_Object extent_obj, Lisp_Object glyph, int endp,
5209 Lisp_Object layout_obj)
5211 EXTENT extent = decode_extent(extent_obj, 0);
5212 glyph_layout layout = symbol_to_glyph_layout(layout_obj);
5214 /* Make sure we've actually been given a valid glyph or it's nil
5215 (meaning we're deleting a glyph from an extent). */
5217 CHECK_BUFFER_GLYPH(glyph);
5219 set_extent_glyph(extent, glyph, endp, layout);
5223 DEFUN("set-extent-begin-glyph", Fset_extent_begin_glyph, 2, 3, 0, /*
5224 Display a bitmap, subwindow or string at the beginning of EXTENT.
5225 BEGIN-GLYPH must be a glyph object. The layout policy defaults to `text'.
5227 (extent, begin_glyph, layout))
5229 return set_extent_glyph_1(extent, begin_glyph, 0, layout);
5232 DEFUN("set-extent-end-glyph", Fset_extent_end_glyph, 2, 3, 0, /*
5233 Display a bitmap, subwindow or string at the end of EXTENT.
5234 END-GLYPH must be a glyph object. The layout policy defaults to `text'.
5236 (extent, end_glyph, layout))
5238 return set_extent_glyph_1(extent, end_glyph, 1, layout);
5241 DEFUN("extent-begin-glyph", Fextent_begin_glyph, 1, 1, 0, /*
5242 Return the glyph object displayed at the beginning of EXTENT.
5243 If there is none, nil is returned.
5247 return extent_begin_glyph(decode_extent(extent, 0));
5250 DEFUN("extent-end-glyph", Fextent_end_glyph, 1, 1, 0, /*
5251 Return the glyph object displayed at the end of EXTENT.
5252 If there is none, nil is returned.
5256 return extent_end_glyph(decode_extent(extent, 0));
5259 DEFUN("set-extent-begin-glyph-layout", Fset_extent_begin_glyph_layout, 2, 2, 0, /*
5260 Set the layout policy of EXTENT's begin glyph.
5261 Access this using the `extent-begin-glyph-layout' function.
5265 EXTENT e = decode_extent(extent, 0);
5266 e = extent_ancestor(e);
5267 extent_begin_glyph_layout(e) = symbol_to_glyph_layout(layout);
5268 extent_maybe_changed_for_redisplay(e, 1, 0);
5272 DEFUN("set-extent-end-glyph-layout", Fset_extent_end_glyph_layout, 2, 2, 0, /*
5273 Set the layout policy of EXTENT's end glyph.
5274 Access this using the `extent-end-glyph-layout' function.
5278 EXTENT e = decode_extent(extent, 0);
5279 e = extent_ancestor(e);
5280 extent_end_glyph_layout(e) = symbol_to_glyph_layout(layout);
5281 extent_maybe_changed_for_redisplay(e, 1, 0);
5285 DEFUN("extent-begin-glyph-layout", Fextent_begin_glyph_layout, 1, 1, 0, /*
5286 Return the layout policy associated with EXTENT's begin glyph.
5287 Set this using the `set-extent-begin-glyph-layout' function.
5291 EXTENT e = decode_extent(extent, 0);
5292 return glyph_layout_to_symbol((glyph_layout)
5293 extent_begin_glyph_layout(e));
5296 DEFUN("extent-end-glyph-layout", Fextent_end_glyph_layout, 1, 1, 0, /*
5297 Return the layout policy associated with EXTENT's end glyph.
5298 Set this using the `set-extent-end-glyph-layout' function.
5302 EXTENT e = decode_extent(extent, 0);
5303 return glyph_layout_to_symbol((glyph_layout)
5304 extent_end_glyph_layout(e));
5307 DEFUN("set-extent-priority", Fset_extent_priority, 2, 2, 0, /*
5308 Set the display priority of EXTENT to PRIORITY (an integer).
5309 When the extent attributes are being merged for display, the priority
5310 is used to determine which extent takes precedence in the event of a
5311 conflict (two extents whose faces both specify font, for example: the
5312 font of the extent with the higher priority will be used).
5313 Extents are created with priority 0; priorities may be negative.
5317 EXTENT e = decode_extent(extent, 0);
5319 CHECK_INT(priority);
5320 e = extent_ancestor(e);
5321 set_extent_priority(e, XINT(priority));
5322 extent_maybe_changed_for_redisplay(e, 1, 0);
5326 DEFUN("extent-priority", Fextent_priority, 1, 1, 0, /*
5327 Return the display priority of EXTENT; see `set-extent-priority'.
5331 EXTENT e = decode_extent(extent, 0);
5332 return make_int(extent_priority(e));
5335 DEFUN("set-extent-property", Fset_extent_property, 3, 3, 0, /*
5336 Change a property of an extent.
5337 PROPERTY may be any symbol; the value stored may be accessed with
5338 the `extent-property' function.
5339 The following symbols have predefined meanings:
5341 detached Removes the extent from its buffer; setting this is
5342 the same as calling `detach-extent'.
5344 destroyed Removes the extent from its buffer, and makes it
5345 unusable in the future; this is the same calling
5348 priority Change redisplay priority; same as `set-extent-priority'.
5350 start-open Whether the set of characters within the extent is
5351 treated being open on the left, that is, whether
5352 the start position is an exclusive, rather than
5353 inclusive, boundary. If true, then characters
5354 inserted exactly at the beginning of the extent
5355 will remain outside of the extent; otherwise they
5356 will go into the extent, extending it.
5358 end-open Whether the set of characters within the extent is
5359 treated being open on the right, that is, whether
5360 the end position is an exclusive, rather than
5361 inclusive, boundary. If true, then characters
5362 inserted exactly at the end of the extent will
5363 remain outside of the extent; otherwise they will
5364 go into the extent, extending it.
5366 By default, extents have the `end-open' but not the
5367 `start-open' property set.
5369 read-only Text within this extent will be unmodifiable.
5371 initial-redisplay-function (EXPERIMENTAL)
5372 function to be called the first time (part of) the extent
5373 is redisplayed. It will be called with the extent as its
5375 Note: The function will not be called immediately
5376 during redisplay, an eval event will be dispatched.
5378 detachable Whether the extent gets detached (as with
5379 `detach-extent') when all the text within the
5380 extent is deleted. This is true by default. If
5381 this property is not set, the extent becomes a
5382 zero-length extent when its text is deleted. (In
5383 such a case, the `start-open' property is
5384 automatically removed if both the `start-open' and
5385 `end-open' properties are set, since zero-length
5386 extents open on both ends are not allowed.)
5388 face The face in which to display the text. Setting
5389 this is the same as calling `set-extent-face'.
5391 mouse-face If non-nil, the extent will be highlighted in this
5392 face when the mouse moves over it.
5394 pointer If non-nil, and a valid pointer glyph, this specifies
5395 the shape of the mouse pointer while over the extent.
5397 highlight Obsolete: Setting this property is equivalent to
5398 setting a `mouse-face' property of `highlight'.
5399 Reading this property returns non-nil if
5400 the extent has a non-nil `mouse-face' property.
5402 duplicable Whether this extent should be copied into strings,
5403 so that kill, yank, and undo commands will restore
5404 or copy it. `duplicable' extents are copied from
5405 an extent into a string when `buffer-substring' or
5406 a similar function creates a string. The extents
5407 in a string are copied into other strings created
5408 from the string using `concat' or `substring'.
5409 When `insert' or a similar function inserts the
5410 string into a buffer, the extents are copied back
5413 unique Meaningful only in conjunction with `duplicable'.
5414 When this is set, there may be only one instance
5415 of this extent attached at a time: if it is copied
5416 to the kill ring and then yanked, the extent is
5417 not copied. If, however, it is killed (removed
5418 from the buffer) and then yanked, it will be
5419 re-attached at the new position.
5421 invisible If the value is non-nil, text under this extent
5422 may be treated as not present for the purpose of
5423 redisplay, or may be displayed using an ellipsis
5424 or other marker; see `buffer-invisibility-spec'
5425 and `invisible-text-glyph'. In all cases,
5426 however, the text is still visible to other
5427 functions that examine a buffer's text.
5429 keymap This keymap is consulted for mouse clicks on this
5430 extent, or keypresses made while point is within the
5433 copy-function This is a hook that is run when a duplicable extent
5434 is about to be copied from a buffer to a string (or
5435 the kill ring). It is called with three arguments,
5436 the extent, and the buffer-positions within it
5437 which are being copied. If this function returns
5438 nil, then the extent will not be copied; otherwise
5441 paste-function This is a hook that is run when a duplicable extent is
5442 about to be copied from a string (or the kill ring)
5443 into a buffer. It is called with three arguments,
5444 the original extent, and the buffer positions which
5445 the copied extent will occupy. (This hook is run
5446 after the corresponding text has already been
5447 inserted into the buffer.) Note that the extent
5448 argument may be detached when this function is run.
5449 If this function returns nil, no extent will be
5450 inserted. Otherwise, there will be an extent
5451 covering the range in question.
5453 If the original extent is not attached to a buffer,
5454 then it will be re-attached at this range.
5455 Otherwise, a copy will be made, and that copy
5458 The copy-function and paste-function are meaningful
5459 only for extents with the `duplicable' flag set,
5460 and if they are not specified, behave as if `t' was
5461 the returned value. When these hooks are invoked,
5462 the current buffer is the buffer which the extent
5463 is being copied from/to, respectively.
5465 begin-glyph A glyph to be displayed at the beginning of the extent,
5468 end-glyph A glyph to be displayed at the end of the extent,
5471 begin-glyph-layout The layout policy (one of `text', `whitespace',
5472 `inside-margin', or `outside-margin') of the extent's
5475 end-glyph-layout The layout policy of the extent's end glyph.
5477 syntax-table A cons or a syntax table object. If a cons, the car must
5478 be an integer (interpreted as a syntax code, applicable to
5479 all characters in the extent). Otherwise, syntax of
5480 characters in the extent is looked up in the syntax table.
5481 You should use the text property API to manipulate this
5482 property. (This may be required in the future.)
5484 (extent, property, value))
5486 /* This function can GC if property is `keymap' */
5487 EXTENT e = decode_extent(extent, 0);
5489 if (EQ(property, Qread_only))
5490 set_extent_read_only(e, value);
5491 else if (EQ(property, Qunique))
5492 extent_unique_p(e) = !NILP(value);
5493 else if (EQ(property, Qduplicable))
5494 extent_duplicable_p(e) = !NILP(value);
5495 else if (EQ(property, Qinvisible))
5496 set_extent_invisible(e, value);
5497 else if (EQ(property, Qdetachable))
5498 extent_detachable_p(e) = !NILP(value);
5500 else if (EQ(property, Qdetached)) {
5502 error("can only set `detached' to t");
5503 Fdetach_extent(extent);
5504 } else if (EQ(property, Qdestroyed)) {
5506 error("can only set `destroyed' to t");
5507 Fdelete_extent(extent);
5508 } else if (EQ(property, Qpriority))
5509 Fset_extent_priority(extent, value);
5510 else if (EQ(property, Qface))
5511 Fset_extent_face(extent, value);
5512 else if (EQ(property, Qinitial_redisplay_function))
5513 Fset_extent_initial_redisplay_function(extent, value);
5514 else if (EQ(property, Qbefore_change_functions))
5515 set_extent_before_change_functions(e, value);
5516 else if (EQ(property, Qafter_change_functions))
5517 set_extent_after_change_functions(e, value);
5518 else if (EQ(property, Qmouse_face))
5519 Fset_extent_mouse_face(extent, value);
5521 else if (EQ(property, Qhighlight))
5522 Fset_extent_mouse_face(extent, Qhighlight);
5523 else if (EQ(property, Qbegin_glyph_layout))
5524 Fset_extent_begin_glyph_layout(extent, value);
5525 else if (EQ(property, Qend_glyph_layout))
5526 Fset_extent_end_glyph_layout(extent, value);
5527 /* For backwards compatibility. We use begin glyph because it is by
5528 far the more used of the two. */
5529 else if (EQ(property, Qglyph_layout))
5530 Fset_extent_begin_glyph_layout(extent, value);
5531 else if (EQ(property, Qbegin_glyph))
5532 Fset_extent_begin_glyph(extent, value, Qnil);
5533 else if (EQ(property, Qend_glyph))
5534 Fset_extent_end_glyph(extent, value, Qnil);
5535 else if (EQ(property, Qstart_open))
5536 set_extent_openness(e, !NILP(value), -1);
5537 else if (EQ(property, Qend_open))
5538 set_extent_openness(e, -1, !NILP(value));
5539 /* Support (but don't document...) the obvious *_closed antonyms. */
5540 else if (EQ(property, Qstart_closed))
5541 set_extent_openness(e, NILP(value), -1);
5542 else if (EQ(property, Qend_closed))
5543 set_extent_openness(e, -1, NILP(value));
5545 if (EQ(property, Qkeymap))
5546 while (!NILP(value) && NILP(Fkeymapp(value)))
5547 value = wrong_type_argument(Qkeymapp, value);
5549 external_plist_put(extent_plist_addr(e), property, value, 0,
5556 DEFUN("set-extent-properties", Fset_extent_properties, 2, 2, 0, /*
5557 Change some properties of EXTENT.
5558 PLIST is a property list.
5559 For a list of built-in properties, see `set-extent-property'.
5563 /* This function can GC, if one of the properties is `keymap' */
5564 Lisp_Object property, value;
5565 struct gcpro gcpro1;
5568 plist = Fcopy_sequence(plist);
5569 Fcanonicalize_plist(plist, Qnil);
5571 while (!NILP(plist)) {
5572 property = Fcar(plist);
5573 plist = Fcdr(plist);
5574 value = Fcar(plist);
5575 plist = Fcdr(plist);
5576 Fset_extent_property(extent, property, value);
5582 DEFUN("extent-property", Fextent_property, 2, 3, 0, /*
5583 Return EXTENT's value for property PROPERTY.
5584 If no such property exists, DEFAULT is returned.
5585 See `set-extent-property' for the built-in property names.
5587 (extent, property, default_))
5589 EXTENT e = decode_extent(extent, 0);
5591 if (EQ(property, Qdetached))
5592 return extent_detached_p(e) ? Qt : Qnil;
5593 else if (EQ(property, Qdestroyed))
5594 return !EXTENT_LIVE_P(e) ? Qt : Qnil;
5595 else if (EQ(property, Qstart_open))
5596 return extent_normal_field(e, start_open) ? Qt : Qnil;
5597 else if (EQ(property, Qend_open))
5598 return extent_normal_field(e, end_open) ? Qt : Qnil;
5599 else if (EQ(property, Qunique))
5600 return extent_normal_field(e, unique) ? Qt : Qnil;
5601 else if (EQ(property, Qduplicable))
5602 return extent_normal_field(e, duplicable) ? Qt : Qnil;
5603 else if (EQ(property, Qdetachable))
5604 return extent_normal_field(e, detachable) ? Qt : Qnil;
5605 /* Support (but don't document...) the obvious *_closed antonyms. */
5606 else if (EQ(property, Qstart_closed))
5607 return extent_start_open_p(e) ? Qnil : Qt;
5608 else if (EQ(property, Qend_closed))
5609 return extent_end_open_p(e) ? Qnil : Qt;
5610 else if (EQ(property, Qpriority))
5611 return make_int(extent_priority(e));
5612 else if (EQ(property, Qread_only))
5613 return extent_read_only(e);
5614 else if (EQ(property, Qinvisible))
5615 return extent_invisible(e);
5616 else if (EQ(property, Qface))
5617 return Fextent_face(extent);
5618 else if (EQ(property, Qinitial_redisplay_function))
5619 return extent_initial_redisplay_function(e);
5620 else if (EQ(property, Qbefore_change_functions))
5621 return extent_before_change_functions(e);
5622 else if (EQ(property, Qafter_change_functions))
5623 return extent_after_change_functions(e);
5624 else if (EQ(property, Qmouse_face))
5625 return Fextent_mouse_face(extent);
5627 else if (EQ(property, Qhighlight))
5628 return !NILP(Fextent_mouse_face(extent)) ? Qt : Qnil;
5629 else if (EQ(property, Qbegin_glyph_layout))
5630 return Fextent_begin_glyph_layout(extent);
5631 else if (EQ(property, Qend_glyph_layout))
5632 return Fextent_end_glyph_layout(extent);
5633 /* For backwards compatibility. We use begin glyph because it is by
5634 far the more used of the two. */
5635 else if (EQ(property, Qglyph_layout))
5636 return Fextent_begin_glyph_layout(extent);
5637 else if (EQ(property, Qbegin_glyph))
5638 return extent_begin_glyph(e);
5639 else if (EQ(property, Qend_glyph))
5640 return extent_end_glyph(e);
5642 Lisp_Object value = external_plist_get(extent_plist_addr(e),
5643 property, 0, ERROR_ME);
5644 return UNBOUNDP(value) ? default_ : value;
5648 DEFUN("extent-properties", Fextent_properties, 1, 1, 0, /*
5649 Return a property list of the attributes of EXTENT.
5650 Do not modify this list; use `set-extent-property' instead.
5655 Lisp_Object result, face, anc_obj;
5656 glyph_layout layout;
5658 CHECK_EXTENT(extent);
5659 e = XEXTENT(extent);
5660 if (!EXTENT_LIVE_P(e))
5661 return cons3(Qdestroyed, Qt, Qnil);
5663 anc = extent_ancestor(e);
5664 XSETEXTENT(anc_obj, anc);
5666 /* For efficiency, use the ancestor for all properties except detached */
5668 result = extent_plist_slot(anc);
5670 if (!NILP(face = Fextent_face(anc_obj)))
5671 result = cons3(Qface, face, result);
5673 if (!NILP(face = Fextent_mouse_face(anc_obj)))
5674 result = cons3(Qmouse_face, face, result);
5676 if ((layout = (glyph_layout) extent_begin_glyph_layout(anc)) != GL_TEXT) {
5677 Lisp_Object sym = glyph_layout_to_symbol(layout);
5678 result = cons3(Qglyph_layout, sym, result); /* compatibility */
5679 result = cons3(Qbegin_glyph_layout, sym, result);
5682 if ((layout = (glyph_layout) extent_end_glyph_layout(anc)) != GL_TEXT)
5684 cons3(Qend_glyph_layout, glyph_layout_to_symbol(layout),
5687 if (!NILP(extent_end_glyph(anc)))
5688 result = cons3(Qend_glyph, extent_end_glyph(anc), result);
5690 if (!NILP(extent_begin_glyph(anc)))
5691 result = cons3(Qbegin_glyph, extent_begin_glyph(anc), result);
5693 if (extent_priority(anc) != 0)
5695 cons3(Qpriority, make_int(extent_priority(anc)), result);
5697 if (!NILP(extent_initial_redisplay_function(anc)))
5698 result = cons3(Qinitial_redisplay_function,
5699 extent_initial_redisplay_function(anc), result);
5701 if (!NILP(extent_before_change_functions(anc)))
5702 result = cons3(Qbefore_change_functions,
5703 extent_before_change_functions(anc), result);
5705 if (!NILP(extent_after_change_functions(anc)))
5706 result = cons3(Qafter_change_functions,
5707 extent_after_change_functions(anc), result);
5709 if (!NILP(extent_invisible(anc)))
5710 result = cons3(Qinvisible, extent_invisible(anc), result);
5712 if (!NILP(extent_read_only(anc)))
5713 result = cons3(Qread_only, extent_read_only(anc), result);
5715 if (extent_normal_field(anc, end_open))
5716 result = cons3(Qend_open, Qt, result);
5718 if (extent_normal_field(anc, start_open))
5719 result = cons3(Qstart_open, Qt, result);
5721 if (extent_normal_field(anc, detachable))
5722 result = cons3(Qdetachable, Qt, result);
5724 if (extent_normal_field(anc, duplicable))
5725 result = cons3(Qduplicable, Qt, result);
5727 if (extent_normal_field(anc, unique))
5728 result = cons3(Qunique, Qt, result);
5730 /* detached is not an inherited property */
5731 if (extent_detached_p(e))
5732 result = cons3(Qdetached, Qt, result);
5737 /************************************************************************/
5739 /************************************************************************/
5741 /* The display code looks into the Vlast_highlighted_extent variable to
5742 correctly display highlighted extents. This updates that variable,
5743 and marks the appropriate buffers as needing some redisplay.
5745 static void do_highlight(Lisp_Object extent_obj, int highlight_p)
5747 if ((highlight_p && (EQ(Vlast_highlighted_extent, extent_obj))) ||
5748 (!highlight_p && (EQ(Vlast_highlighted_extent, Qnil))))
5750 if (EXTENTP(Vlast_highlighted_extent) &&
5751 EXTENT_LIVE_P(XEXTENT(Vlast_highlighted_extent))) {
5752 /* do not recurse on descendants. Only one extent is highlighted
5754 extent_changed_for_redisplay(XEXTENT(Vlast_highlighted_extent),
5757 Vlast_highlighted_extent = Qnil;
5758 if (!NILP(extent_obj)
5759 && BUFFERP(extent_object(XEXTENT(extent_obj)))
5761 extent_changed_for_redisplay(XEXTENT(extent_obj), 0, 0);
5762 Vlast_highlighted_extent = extent_obj;
5766 DEFUN("force-highlight-extent", Fforce_highlight_extent, 1, 2, 0, /*
5767 Highlight or unhighlight the given extent.
5768 If the second arg is non-nil, it will be highlighted, else dehighlighted.
5769 This is the same as `highlight-extent', except that it will work even
5770 on extents without the `mouse-face' property.
5772 (extent, highlight_p))
5777 XSETEXTENT(extent, decode_extent(extent, DE_MUST_BE_ATTACHED));
5778 do_highlight(extent, !NILP(highlight_p));
5782 DEFUN("highlight-extent", Fhighlight_extent, 1, 2, 0, /*
5783 Highlight EXTENT, if it is highlightable.
5784 \(that is, if it has the `mouse-face' property).
5785 If the second arg is non-nil, it will be highlighted, else dehighlighted.
5786 Highlighted extents are displayed as if they were merged with the face
5787 or faces specified by the `mouse-face' property.
5789 (extent, highlight_p))
5791 if (EXTENTP(extent) && NILP(extent_mouse_face(XEXTENT(extent))))
5794 return Fforce_highlight_extent(extent, highlight_p);
5797 /************************************************************************/
5798 /* strings and extents */
5799 /************************************************************************/
5801 /* copy/paste hooks */
5804 run_extent_copy_paste_internal(EXTENT e, Bufpos from, Bufpos to,
5805 Lisp_Object object, Lisp_Object prop)
5807 /* This function can GC */
5809 Lisp_Object copy_fn;
5810 XSETEXTENT(extent, e);
5811 copy_fn = Fextent_property(extent, prop, Qnil);
5812 if (!NILP(copy_fn)) {
5814 struct gcpro gcpro1, gcpro2, gcpro3;
5815 GCPRO3(extent, copy_fn, object);
5816 if (BUFFERP(object))
5817 flag = call3_in_buffer(XBUFFER(object), copy_fn, extent,
5818 make_int(from), make_int(to));
5821 call3(copy_fn, extent, make_int(from),
5824 if (NILP(flag) || !EXTENT_LIVE_P(XEXTENT(extent)))
5830 static int run_extent_copy_function(EXTENT e, Bytind from, Bytind to)
5832 Lisp_Object object = extent_object(e);
5833 /* This function can GC */
5834 return run_extent_copy_paste_internal
5835 (e, buffer_or_string_bytind_to_bufpos(object, from),
5836 buffer_or_string_bytind_to_bufpos(object, to), object,
5841 run_extent_paste_function(EXTENT e, Bytind from, Bytind to, Lisp_Object object)
5843 /* This function can GC */
5844 return run_extent_copy_paste_internal
5845 (e, buffer_or_string_bytind_to_bufpos(object, from),
5846 buffer_or_string_bytind_to_bufpos(object, to), object,
5850 static void update_extent(EXTENT extent, Bytind from, Bytind to)
5852 set_extent_endpoints(extent, from, to, Qnil);
5855 /* Insert an extent, usually from the dup_list of a string which
5856 has just been inserted.
5857 This code does not handle the case of undo.
5860 insert_extent(EXTENT extent, Bytind new_start, Bytind new_end,
5861 Lisp_Object object, int run_hooks)
5863 /* This function can GC */
5866 if (!EQ(extent_object(extent), object))
5869 if (extent_detached_p(extent)) {
5871 !run_extent_paste_function(extent, new_start, new_end,
5873 /* The paste-function said don't re-attach this extent here. */
5876 update_extent(extent, new_start, new_end);
5878 Bytind exstart = extent_endpoint_bytind(extent, 0);
5879 Bytind exend = extent_endpoint_bytind(extent, 1);
5881 if (exend < new_start || exstart > new_end)
5884 new_start = min(exstart, new_start);
5885 new_end = max(exend, new_end);
5886 if (exstart != new_start || exend != new_end)
5887 update_extent(extent, new_start, new_end);
5891 XSETEXTENT(tmp, extent);
5896 !run_extent_paste_function(extent, new_start, new_end, object))
5897 /* The paste-function said don't attach a copy of the extent here. */
5901 copy_extent(extent, new_start, new_end, object));
5906 DEFUN("insert-extent", Finsert_extent, 1, 5, 0, /*
5907 Insert EXTENT from START to END in BUFFER-OR-STRING.
5908 BUFFER-OR-STRING defaults to the current buffer if omitted.
5909 This operation does not insert any characters,
5910 but otherwise acts as if there were a replicating extent whose
5911 parent is EXTENT in some string that was just inserted.
5912 Returns the newly-inserted extent.
5913 The fourth arg, NO-HOOKS, can be used to inhibit the running of the
5914 extent's `paste-function' property if it has one.
5915 See documentation on `detach-extent' for a discussion of undo recording.
5917 (extent, start, end, no_hooks, buffer_or_string))
5919 EXTENT ext = decode_extent(extent, 0);
5923 buffer_or_string = decode_buffer_or_string(buffer_or_string);
5924 get_buffer_or_string_range_byte(buffer_or_string, start, end, &s, &e,
5925 GB_ALLOW_PAST_ACCESSIBLE);
5927 copy = insert_extent(ext, s, e, buffer_or_string, NILP(no_hooks));
5928 if (EXTENTP(copy)) {
5929 if (extent_duplicable_p(XEXTENT(copy)))
5930 record_extent(copy, 1);
5935 /* adding buffer extents to a string */
5937 struct add_string_extents_arg {
5943 static int add_string_extents_mapper(EXTENT extent, void *arg)
5945 /* This function can GC */
5946 struct add_string_extents_arg *closure =
5947 (struct add_string_extents_arg *)arg;
5948 Bytecount start = extent_endpoint_bytind(extent, 0) - closure->from;
5949 Bytecount end = extent_endpoint_bytind(extent, 1) - closure->from;
5951 if (extent_duplicable_p(extent)) {
5952 start = max(start, 0);
5953 end = min(end, closure->length);
5955 /* Run the copy-function to give an extent the option of
5956 not being copied into the string (or kill ring).
5958 if (extent_duplicable_p(extent) &&
5959 !run_extent_copy_function(extent, start + closure->from,
5960 end + closure->from))
5962 copy_extent(extent, start, end, closure->string);
5968 /* Add the extents in buffer BUF from OPOINT to OPOINT+LENGTH to
5969 the string STRING. */
5971 add_string_extents(Lisp_Object string, struct buffer *buf, Bytind opoint,
5974 /* This function can GC */
5975 struct add_string_extents_arg closure;
5976 struct gcpro gcpro1, gcpro2;
5979 closure.from = opoint;
5980 closure.length = length;
5981 closure.string = string;
5982 buffer = make_buffer(buf);
5983 GCPRO2(buffer, string);
5984 map_extents_bytind(opoint, opoint + length, add_string_extents_mapper,
5985 (void *)&closure, buffer, 0,
5986 /* ignore extents that just abut the region */
5987 ME_END_CLOSED | ME_ALL_EXTENTS_OPEN |
5988 /* we are calling E-Lisp (the extent's copy function)
5989 so anything might happen */
5990 ME_MIGHT_CALL_ELISP);
5994 struct splice_in_string_extents_arg {
6001 static int splice_in_string_extents_mapper(EXTENT extent, void *arg)
6003 /* This function can GC */
6004 struct splice_in_string_extents_arg *closure =
6005 (struct splice_in_string_extents_arg *)arg;
6006 /* BASE_START and BASE_END are the limits in the buffer of the string
6007 that was just inserted.
6009 NEW_START and NEW_END are the prospective buffer positions of the
6010 extent that is going into the buffer. */
6011 Bytind base_start = closure->opoint;
6012 Bytind base_end = base_start + closure->length;
6013 Bytind new_start = (base_start + extent_endpoint_bytind(extent, 0) -
6015 Bytind new_end = (base_start + extent_endpoint_bytind(extent, 1) -
6018 if (new_start < base_start)
6019 new_start = base_start;
6020 if (new_end > base_end)
6022 if (new_end <= new_start)
6025 if (!extent_duplicable_p(extent))
6029 !run_extent_paste_function(extent, new_start, new_end,
6032 copy_extent(extent, new_start, new_end, closure->buffer);
6037 /* We have just inserted a section of STRING (starting at POS, of
6038 length LENGTH) into buffer BUF at OPOINT. Do whatever is necessary
6039 to get the string's extents into the buffer. */
6042 splice_in_string_extents(Lisp_Object string, struct buffer *buf,
6043 Bytind opoint, Bytecount length, Bytecount pos)
6045 struct splice_in_string_extents_arg closure;
6046 struct gcpro gcpro1, gcpro2;
6049 buffer = make_buffer(buf);
6050 closure.opoint = opoint;
6052 closure.length = length;
6053 closure.buffer = buffer;
6054 GCPRO2(buffer, string);
6055 map_extents_bytind(pos, pos + length,
6056 splice_in_string_extents_mapper,
6057 (void *)&closure, string, 0,
6058 /* ignore extents that just abut the region */
6059 ME_END_CLOSED | ME_ALL_EXTENTS_OPEN |
6060 /* we are calling E-Lisp (the extent's copy function)
6061 so anything might happen */
6062 ME_MIGHT_CALL_ELISP);
6066 struct copy_string_extents_arg {
6070 Lisp_Object new_string;
6073 struct copy_string_extents_1_arg {
6074 Lisp_Object parent_in_question;
6075 EXTENT found_extent;
6078 static int copy_string_extents_mapper(EXTENT extent, void *arg)
6080 struct copy_string_extents_arg *closure =
6081 (struct copy_string_extents_arg *)arg;
6082 Bytecount old_start, old_end, new_start, new_end;
6084 old_start = extent_endpoint_bytind(extent, 0);
6085 old_end = extent_endpoint_bytind(extent, 1);
6087 old_start = max(closure->old_pos, old_start);
6088 old_end = min(closure->old_pos + closure->length, old_end);
6090 if (old_start >= old_end)
6093 new_start = old_start + closure->new_pos - closure->old_pos;
6094 new_end = old_end + closure->new_pos - closure->old_pos;
6096 copy_extent(extent, new_start, new_end, closure->new_string);
6100 /* The string NEW_STRING was partially constructed from OLD_STRING.
6101 In particular, the section of length LEN starting at NEW_POS in
6102 NEW_STRING came from the section of the same length starting at
6103 OLD_POS in OLD_STRING. Copy the extents as appropriate. */
6106 copy_string_extents(Lisp_Object new_string, Lisp_Object old_string,
6107 Bytecount new_pos, Bytecount old_pos, Bytecount length)
6109 struct copy_string_extents_arg closure;
6110 struct gcpro gcpro1, gcpro2;
6112 closure.new_pos = new_pos;
6113 closure.old_pos = old_pos;
6114 closure.new_string = new_string;
6115 closure.length = length;
6116 GCPRO2(new_string, old_string);
6117 map_extents_bytind(old_pos, old_pos + length,
6118 copy_string_extents_mapper,
6119 (void *)&closure, old_string, 0,
6120 /* ignore extents that just abut the region */
6121 ME_END_CLOSED | ME_ALL_EXTENTS_OPEN |
6122 /* we are calling E-Lisp (the extent's copy function)
6123 so anything might happen */
6124 ME_MIGHT_CALL_ELISP);
6128 /* Checklist for sanity checking:
6129 - {kill, yank, copy} at {open, closed} {start, end} of {writable, read-only} extent
6130 - {kill, copy} & yank {once, repeatedly} duplicable extent in {same, different} buffer
6133 /************************************************************************/
6134 /* text properties */
6135 /************************************************************************/
6138 Originally this stuff was implemented in lisp (all of the functionality
6139 exists to make that possible) but speed was a problem.
6142 Lisp_Object Qtext_prop;
6143 Lisp_Object Qtext_prop_extent_paste_function;
6146 get_text_property_bytind(Bytind position, Lisp_Object prop,
6147 Lisp_Object object, enum extent_at_flag fl,
6148 int text_props_only)
6152 /* text_props_only specifies whether we only consider text-property
6153 extents (those with the 'text-prop property set) or all extents. */
6154 if (!text_props_only)
6155 extent = extent_at_bytind(position, object, prop, 0, fl, 0);
6160 extent_at_bytind(position, object, Qtext_prop,
6165 (prop, Fextent_property(extent, Qtext_prop, Qnil)))
6167 prior = XEXTENT(extent);
6172 return Fextent_property(extent, prop, Qnil);
6173 if (!NILP(Vdefault_text_properties))
6174 return Fplist_get(Vdefault_text_properties, prop, Qnil);
6179 get_text_property_1(Lisp_Object pos, Lisp_Object prop, Lisp_Object object,
6180 Lisp_Object at_flag, int text_props_only)
6185 object = decode_buffer_or_string(object);
6187 get_buffer_or_string_pos_byte(object, pos, GB_NO_ERROR_IF_BAD);
6189 /* We canonicalize the start/end-open/closed properties to the
6190 non-default version -- "adding" the default property really
6191 needs to remove the non-default one. See below for more
6193 if (EQ(prop, Qstart_closed)) {
6198 if (EQ(prop, Qend_open)) {
6205 get_text_property_bytind(position, prop, object,
6206 decode_extent_at_flag(at_flag),
6209 val = NILP(val) ? Qt : Qnil;
6214 DEFUN("get-text-property", Fget_text_property, 2, 4, 0, /*
6215 Return the value of the PROP property at the given position.
6216 Optional arg OBJECT specifies the buffer or string to look in, and
6217 defaults to the current buffer.
6218 Optional arg AT-FLAG controls what it means for a property to be "at"
6219 a position, and has the same meaning as in `extent-at'.
6220 This examines only those properties added with `put-text-property'.
6221 See also `get-char-property'.
6223 (pos, prop, object, at_flag))
6225 return get_text_property_1(pos, prop, object, at_flag, 1);
6228 DEFUN("get-char-property", Fget_char_property, 2, 4, 0, /*
6229 Return the value of the PROP property at the given position.
6230 Optional arg OBJECT specifies the buffer or string to look in, and
6231 defaults to the current buffer.
6232 Optional arg AT-FLAG controls what it means for a property to be "at"
6233 a position, and has the same meaning as in `extent-at'.
6234 This examines properties on all extents.
6235 See also `get-text-property'.
6237 (pos, prop, object, at_flag))
6239 return get_text_property_1(pos, prop, object, at_flag, 0);
6242 /* About start/end-open/closed:
6244 These properties have to be handled specially because of their
6245 strange behavior. If I put the "start-open" property on a region,
6246 then *all* text-property extents in the region have to have their
6247 start be open. This is unlike all other properties, which don't
6248 affect the extents of text properties other than their own.
6252 1) We have to map start-closed to (not start-open) and end-open
6253 to (not end-closed) -- i.e. adding the default is really the
6254 same as remove the non-default property. It won't work, for
6255 example, to have both "start-open" and "start-closed" on
6257 2) Whenever we add one of these properties, we go through all
6258 text-property extents in the region and set the appropriate
6259 open/closedness on them.
6260 3) Whenever we change a text-property extent for a property,
6261 we have to make sure we set the open/closedness properly.
6263 (2) and (3) together rely on, and maintain, the invariant
6264 that the open/closedness of text-property extents is correct
6265 at the beginning and end of each operation.
6268 struct put_text_prop_arg {
6269 Lisp_Object prop, value; /* The property and value we are storing */
6270 Bytind start, end; /* The region into which we are storing it */
6272 Lisp_Object the_extent; /* Our chosen extent; this is used for
6273 communication between subsequent passes. */
6274 int changed_p; /* Output: whether we have modified anything */
6277 static int put_text_prop_mapper(EXTENT e, void *arg)
6279 struct put_text_prop_arg *closure = (struct put_text_prop_arg *)arg;
6281 Lisp_Object object = closure->object;
6282 Lisp_Object value = closure->value;
6283 Bytind e_start, e_end;
6284 Bytind start = closure->start;
6285 Bytind end = closure->end;
6286 Lisp_Object extent, e_val;
6289 XSETEXTENT(extent, e);
6291 /* Note: in some cases when the property itself is 'start-open
6292 or 'end-closed, the checks to set the openness may do a bit
6293 of extra work; but it won't hurt because we then fix up the
6294 openness later on in put_text_prop_openness_mapper(). */
6295 if (!EQ(Fextent_property(extent, Qtext_prop, Qnil), closure->prop))
6296 /* It's not for this property; do nothing. */
6299 e_start = extent_endpoint_bytind(e, 0);
6300 e_end = extent_endpoint_bytind(e, 1);
6301 e_val = Fextent_property(extent, closure->prop, Qnil);
6302 is_eq = EQ(value, e_val);
6304 if (!NILP(value) && NILP(closure->the_extent) && is_eq) {
6305 /* We want there to be an extent here at the end, and we haven't picked
6306 one yet, so use this one. Extend it as necessary. We only reuse an
6307 extent which has an EQ value for the prop in question to avoid
6308 side-effecting the kill ring (that is, we never change the property
6309 on an extent after it has been created.)
6311 if (e_start != start || e_end != end) {
6312 Bytind new_start = min(e_start, start);
6313 Bytind new_end = max(e_end, end);
6314 set_extent_endpoints(e, new_start, new_end, Qnil);
6315 /* If we changed the endpoint, then we need to set its
6317 set_extent_openness(e, new_start != e_start
6318 ? !NILP(get_text_property_bytind
6319 (start, Qstart_open, object,
6320 EXTENT_AT_AFTER, 1)) : -1,
6322 ? NILP(get_text_property_bytind
6323 (end - 1, Qend_closed,
6324 object, EXTENT_AT_AFTER, 1))
6326 closure->changed_p = 1;
6328 closure->the_extent = extent;
6331 /* Even if we're adding a prop, at this point, we want all other extents of
6332 this prop to go away (as now they overlap). So the theory here is that,
6333 when we are adding a prop to a region that has multiple (disjoint)
6334 occurrences of that prop in it already, we pick one of those and extend
6335 it, and remove the others.
6338 else if (EQ(extent, closure->the_extent)) {
6339 /* just in case map-extents hits it again (does that happen?) */
6341 } else if (e_start >= start && e_end <= end) {
6342 /* Extent is contained in region; remove it. Don't destroy or modify
6343 it, because we don't want to change the attributes pointed to by the
6344 duplicates in the kill ring.
6347 closure->changed_p = 1;
6348 } else if (!NILP(closure->the_extent) &&
6349 is_eq && e_start <= end && e_end >= start) {
6350 EXTENT te = XEXTENT(closure->the_extent);
6351 /* This extent overlaps, and has the same prop/value as the extent we've
6352 decided to reuse, so we can remove this existing extent as well (the
6353 whole thing, even the part outside of the region) and extend
6354 the-extent to cover it, resulting in the minimum number of extents in
6357 Bytind the_start = extent_endpoint_bytind(te, 0);
6358 Bytind the_end = extent_endpoint_bytind(te, 1);
6359 if (e_start != the_start && /* note AND not OR -- hmm, why is this
6360 the case? I think it's because the
6361 assumption that the text-property
6362 extents don't overlap makes it
6363 OK; changing it to an OR would
6364 result in changed_p sometimes getting
6365 falsely marked. Is this bad? */
6367 Bytind new_start = min(e_start, the_start);
6368 Bytind new_end = max(e_end, the_end);
6369 set_extent_endpoints(te, new_start, new_end, Qnil);
6370 /* If we changed the endpoint, then we need to set its
6371 openness. We are setting the endpoint to be the same as
6372 that of the extent we're about to remove, and we assume
6373 (the invariant mentioned above) that extent has the
6374 proper endpoint setting, so we just use it. */
6375 set_extent_openness(te, new_start != e_start ?
6376 (int)extent_start_open_p(e) : -1,
6378 (int)extent_end_open_p(e) : -1);
6379 closure->changed_p = 1;
6382 } else if (e_end <= end) {
6383 /* Extent begins before start but ends before end, so we can just
6384 decrease its end position.
6386 if (e_end != start) {
6387 set_extent_endpoints(e, e_start, start, Qnil);
6388 set_extent_openness(e, -1, NILP(get_text_property_bytind
6389 (start - 1, Qend_closed,
6391 EXTENT_AT_AFTER, 1)));
6392 closure->changed_p = 1;
6394 } else if (e_start >= start) {
6395 /* Extent ends after end but begins after start, so we can just
6396 increase its start position.
6398 if (e_start != end) {
6399 set_extent_endpoints(e, end, e_end, Qnil);
6400 set_extent_openness(e, !NILP(get_text_property_bytind
6401 (end, Qstart_open, object,
6402 EXTENT_AT_AFTER, 1)), -1);
6403 closure->changed_p = 1;
6406 /* Otherwise, `extent' straddles the region. We need to split it.
6408 set_extent_endpoints(e, e_start, start, Qnil);
6409 set_extent_openness(e, -1, NILP(get_text_property_bytind
6410 (start - 1, Qend_closed, object,
6411 EXTENT_AT_AFTER, 1)));
6412 set_extent_openness(copy_extent
6413 (e, end, e_end, extent_object(e)),
6414 !NILP(get_text_property_bytind
6415 (end, Qstart_open, object,
6416 EXTENT_AT_AFTER, 1)), -1);
6417 closure->changed_p = 1;
6420 return 0; /* to continue mapping. */
6423 static int put_text_prop_openness_mapper(EXTENT e, void *arg)
6425 struct put_text_prop_arg *closure = (struct put_text_prop_arg *)arg;
6426 Bytind e_start, e_end;
6427 Bytind start = closure->start;
6428 Bytind end = closure->end;
6430 XSETEXTENT(extent, e);
6431 e_start = extent_endpoint_bytind(e, 0);
6432 e_end = extent_endpoint_bytind(e, 1);
6434 if (NILP(Fextent_property(extent, Qtext_prop, Qnil))) {
6435 /* It's not a text-property extent; do nothing. */
6438 /* Note end conditions and NILP/!NILP's carefully. */
6439 else if (EQ(closure->prop, Qstart_open)
6440 && e_start >= start && e_start < end)
6441 set_extent_openness(e, !NILP(closure->value), -1);
6442 else if (EQ(closure->prop, Qend_closed)
6443 && e_end > start && e_end <= end)
6444 set_extent_openness(e, -1, NILP(closure->value));
6446 return 0; /* to continue mapping. */
6450 put_text_prop(Bytind start, Bytind end, Lisp_Object object,
6451 Lisp_Object prop, Lisp_Object value, int duplicable_p)
6453 /* This function can GC */
6454 struct put_text_prop_arg closure;
6456 if (start == end) /* There are no characters in the region. */
6459 /* convert to the non-default versions, since a nil property is
6460 the same as it not being present. */
6461 if (EQ(prop, Qstart_closed)) {
6463 value = NILP(value) ? Qt : Qnil;
6464 } else if (EQ(prop, Qend_open)) {
6466 value = NILP(value) ? Qt : Qnil;
6469 value = canonicalize_extent_property(prop, value);
6471 closure.prop = prop;
6472 closure.value = value;
6473 closure.start = start;
6475 closure.object = object;
6476 closure.changed_p = 0;
6477 closure.the_extent = Qnil;
6479 map_extents_bytind(start, end,
6480 put_text_prop_mapper, (void *)&closure, object, 0,
6481 /* get all extents that abut the region */
6482 ME_ALL_EXTENTS_CLOSED | ME_END_CLOSED |
6483 /* it might QUIT or error if the user has
6484 fucked with the extent plist. */
6485 /* #### dmoore - I think this should include
6486 ME_MIGHT_MOVE_SOE, since the callback function
6487 might recurse back into map_extents_bytind. */
6488 ME_MIGHT_THROW | ME_MIGHT_MODIFY_EXTENTS);
6490 /* If we made it through the loop without reusing an extent
6491 (and we want there to be one) make it now.
6493 if (!NILP(value) && NILP(closure.the_extent)) {
6496 XSETEXTENT(extent, make_extent_internal(object, start, end));
6497 closure.changed_p = 1;
6498 Fset_extent_property(extent, Qtext_prop, prop);
6499 Fset_extent_property(extent, prop, value);
6501 extent_duplicable_p(XEXTENT(extent)) = 1;
6502 Fset_extent_property(extent, Qpaste_function,
6503 Qtext_prop_extent_paste_function);
6505 set_extent_openness(XEXTENT(extent),
6506 !NILP(get_text_property_bytind
6507 (start, Qstart_open, object,
6508 EXTENT_AT_AFTER, 1)),
6509 NILP(get_text_property_bytind
6510 (end - 1, Qend_closed, object,
6511 EXTENT_AT_AFTER, 1)));
6514 if (EQ(prop, Qstart_open) || EQ(prop, Qend_closed)) {
6515 map_extents_bytind(start, end,
6516 put_text_prop_openness_mapper,
6517 (void *)&closure, object, 0,
6518 /* get all extents that abut the region */
6519 ME_ALL_EXTENTS_CLOSED | ME_END_CLOSED |
6520 ME_MIGHT_MODIFY_EXTENTS);
6523 return closure.changed_p;
6526 DEFUN("put-text-property", Fput_text_property, 4, 5, 0, /*
6527 Adds the given property/value to all characters in the specified region.
6528 The property is conceptually attached to the characters rather than the
6529 region. The properties are copied when the characters are copied/pasted.
6530 Fifth argument OBJECT is the buffer or string containing the text, and
6531 defaults to the current buffer.
6533 (start, end, prop, value, object))
6535 /* This function can GC */
6538 object = decode_buffer_or_string(object);
6539 get_buffer_or_string_range_byte(object, start, end, &s, &e, 0);
6540 put_text_prop(s, e, object, prop, value, 1);
6544 DEFUN("put-nonduplicable-text-property", Fput_nonduplicable_text_property, 4, 5, 0, /*
6545 Adds the given property/value to all characters in the specified region.
6546 The property is conceptually attached to the characters rather than the
6547 region, however the properties will not be copied when the characters
6549 Fifth argument OBJECT is the buffer or string containing the text, and
6550 defaults to the current buffer.
6552 (start, end, prop, value, object))
6554 /* This function can GC */
6557 object = decode_buffer_or_string(object);
6558 get_buffer_or_string_range_byte(object, start, end, &s, &e, 0);
6559 put_text_prop(s, e, object, prop, value, 0);
6563 DEFUN("add-text-properties", Fadd_text_properties, 3, 4, 0, /*
6564 Add properties to the characters from START to END.
6565 The third argument PROPS is a property list specifying the property values
6566 to add. The optional fourth argument, OBJECT, is the buffer or string
6567 containing the text and defaults to the current buffer. Returns t if
6568 any property was changed, nil otherwise.
6570 (start, end, props, object))
6572 /* This function can GC */
6576 object = decode_buffer_or_string(object);
6577 get_buffer_or_string_range_byte(object, start, end, &s, &e, 0);
6579 for (; !NILP(props); props = Fcdr(Fcdr(props))) {
6580 Lisp_Object prop = XCAR(props);
6581 Lisp_Object value = Fcar(XCDR(props));
6582 changed |= put_text_prop(s, e, object, prop, value, 1);
6584 return changed ? Qt : Qnil;
6587 DEFUN("add-nonduplicable-text-properties", Fadd_nonduplicable_text_properties, 3, 4, 0, /*
6588 Add nonduplicable properties to the characters from START to END.
6589 \(The properties will not be copied when the characters are copied.)
6590 The third argument PROPS is a property list specifying the property values
6591 to add. The optional fourth argument, OBJECT, is the buffer or string
6592 containing the text and defaults to the current buffer. Returns t if
6593 any property was changed, nil otherwise.
6595 (start, end, props, object))
6597 /* This function can GC */
6601 object = decode_buffer_or_string(object);
6602 get_buffer_or_string_range_byte(object, start, end, &s, &e, 0);
6604 for (; !NILP(props); props = Fcdr(Fcdr(props))) {
6605 Lisp_Object prop = XCAR(props);
6606 Lisp_Object value = Fcar(XCDR(props));
6607 changed |= put_text_prop(s, e, object, prop, value, 0);
6609 return changed ? Qt : Qnil;
6612 DEFUN("remove-text-properties", Fremove_text_properties, 3, 4, 0, /*
6613 Remove the given properties from all characters in the specified region.
6614 PROPS should be a plist, but the values in that plist are ignored (treated
6615 as nil). Returns t if any property was changed, nil otherwise.
6616 Fourth argument OBJECT is the buffer or string containing the text, and
6617 defaults to the current buffer.
6619 (start, end, props, object))
6621 /* This function can GC */
6625 object = decode_buffer_or_string(object);
6626 get_buffer_or_string_range_byte(object, start, end, &s, &e, 0);
6628 for (; !NILP(props); props = Fcdr(Fcdr(props))) {
6629 Lisp_Object prop = XCAR(props);
6630 changed |= put_text_prop(s, e, object, prop, Qnil, 1);
6632 return changed ? Qt : Qnil;
6635 /* Whenever a text-prop extent is pasted into a buffer (via `yank' or `insert'
6636 or whatever) we attach the properties to the buffer by calling
6637 `put-text-property' instead of by simply allowing the extent to be copied or
6638 re-attached. Then we return nil, telling the extents code not to attach it
6639 again. By handing the insertion hackery in this way, we make kill/yank
6640 behave consistently with put-text-property and not fragment the extents
6641 (since text-prop extents must partition, not overlap).
6643 The lisp implementation of this was probably fast enough, but since I moved
6644 the rest of the put-text-prop code here, I moved this as well for
6647 DEFUN("text-prop-extent-paste-function", Ftext_prop_extent_paste_function, 3, 3, 0, /*
6648 Used as the `paste-function' property of `text-prop' extents.
6652 /* This function can GC */
6653 Lisp_Object prop, val;
6655 prop = Fextent_property(extent, Qtext_prop, Qnil);
6657 signal_type_error(Qinternal_error,
6658 "Internal error: no text-prop", extent);
6659 val = Fextent_property(extent, prop, Qnil);
6661 /* removed by bill perry, 2/9/97
6662 ** This little bit of code would not allow you to have a text property
6663 ** with a value of Qnil. This is bad bad bad.
6666 signal_type_error_2(Qinternal_error,
6667 "Internal error: no text-prop",
6670 Fput_text_property(from, to, prop, val, Qnil);
6671 return Qnil; /* important! */
6674 /* This function could easily be written in Lisp but the C code wants
6675 to use it in connection with invisible extents (at least currently).
6676 If this changes, consider moving this back into Lisp. */
6678 DEFUN("next-single-property-change", Fnext_single_property_change, 2, 4, 0, /*
6679 Return the position of next property change for a specific property.
6680 Scans characters forward from POS till it finds a change in the PROP
6681 property, then returns the position of the change. The optional third
6682 argument OBJECT is the buffer or string to scan (defaults to the current
6684 The property values are compared with `eq'.
6685 Return nil if the property is constant all the way to the end of OBJECT.
6686 If the value is non-nil, it is a position greater than POS, never equal.
6688 If the optional fourth argument LIMIT is non-nil, don't search
6689 past position LIMIT; return LIMIT if nothing is found before LIMIT.
6690 If two or more extents with conflicting non-nil values for PROP overlap
6691 a particular character, it is undefined which value is considered to be
6692 the value of PROP. (Note that this situation will not happen if you always
6693 use the text-property primitives.)
6695 (pos, prop, object, limit))
6699 Lisp_Object extent, value;
6702 object = decode_buffer_or_string(object);
6703 bpos = get_buffer_or_string_pos_char(object, pos, 0);
6705 blim = buffer_or_string_accessible_end_char(object);
6708 blim = get_buffer_or_string_pos_char(object, limit, 0);
6712 extent = Fextent_at(make_int(bpos), object, prop, Qnil, Qnil);
6714 value = Fextent_property(extent, prop, Qnil);
6719 bpos = XINT(Fnext_extent_change(make_int(bpos), object));
6721 break; /* property is the same all the way to the end */
6722 extent = Fextent_at(make_int(bpos), object, prop, Qnil, Qnil);
6723 if ((NILP(extent) && !NILP(value)) ||
6724 (!NILP(extent) && !EQ(value,
6725 Fextent_property(extent, prop,
6727 return make_int(bpos);
6730 /* I think it's more sensible for this function to return nil always
6731 in this situation and it used to do it this way, but it's been changed
6732 for FSF compatibility. */
6736 return make_int(blim);
6739 /* See comment on previous function about why this is written in C. */
6741 DEFUN("previous-single-property-change", Fprevious_single_property_change, 2, 4, 0, /*
6742 Return the position of next property change for a specific property.
6743 Scans characters backward from POS till it finds a change in the PROP
6744 property, then returns the position of the change. The optional third
6745 argument OBJECT is the buffer or string to scan (defaults to the current
6747 The property values are compared with `eq'.
6748 Return nil if the property is constant all the way to the start of OBJECT.
6749 If the value is non-nil, it is a position less than POS, never equal.
6751 If the optional fourth argument LIMIT is non-nil, don't search back
6752 past position LIMIT; return LIMIT if nothing is found until LIMIT.
6753 If two or more extents with conflicting non-nil values for PROP overlap
6754 a particular character, it is undefined which value is considered to be
6755 the value of PROP. (Note that this situation will not happen if you always
6756 use the text-property primitives.)
6758 (pos, prop, object, limit))
6762 Lisp_Object extent, value;
6765 object = decode_buffer_or_string(object);
6766 bpos = get_buffer_or_string_pos_char(object, pos, 0);
6768 blim = buffer_or_string_accessible_begin_char(object);
6771 blim = get_buffer_or_string_pos_char(object, limit, 0);
6775 /* extent-at refers to the character AFTER bpos, but we want the
6776 character before bpos. Thus the - 1. extent-at simply
6777 returns nil on bogus positions, so not to worry. */
6778 extent = Fextent_at(make_int(bpos - 1), object, prop, Qnil, Qnil);
6780 value = Fextent_property(extent, prop, Qnil);
6785 bpos = XINT(Fprevious_extent_change(make_int(bpos), object));
6787 break; /* property is the same all the way to the beginning */
6789 Fextent_at(make_int(bpos - 1), object, prop, Qnil, Qnil);
6790 if ((NILP(extent) && !NILP(value))
6792 && !EQ(value, Fextent_property(extent, prop, Qnil))))
6793 return make_int(bpos);
6796 /* I think it's more sensible for this function to return nil always
6797 in this situation and it used to do it this way, but it's been changed
6798 for FSF compatibility. */
6802 return make_int(blim);
6805 #ifdef MEMORY_USAGE_STATS
6808 compute_buffer_extent_usage(struct buffer *b, struct overhead_stats *ovstats)
6810 /* #### not yet written */
6814 #endif /* MEMORY_USAGE_STATS */
6816 /************************************************************************/
6817 /* initialization */
6818 /************************************************************************/
6820 void syms_of_extents(void)
6822 INIT_LRECORD_IMPLEMENTATION(extent);
6823 INIT_LRECORD_IMPLEMENTATION(extent_info);
6824 INIT_LRECORD_IMPLEMENTATION(extent_auxiliary);
6826 defsymbol(&Qextentp, "extentp");
6827 defsymbol(&Qextent_live_p, "extent-live-p");
6829 defsymbol(&Qall_extents_closed, "all-extents-closed");
6830 defsymbol(&Qall_extents_open, "all-extents-open");
6831 defsymbol(&Qall_extents_closed_open, "all-extents-closed-open");
6832 defsymbol(&Qall_extents_open_closed, "all-extents-open-closed");
6833 defsymbol(&Qstart_in_region, "start-in-region");
6834 defsymbol(&Qend_in_region, "end-in-region");
6835 defsymbol(&Qstart_and_end_in_region, "start-and-end-in-region");
6836 defsymbol(&Qstart_or_end_in_region, "start-or-end-in-region");
6837 defsymbol(&Qnegate_in_region, "negate-in-region");
6839 defsymbol(&Qdetached, "detached");
6840 defsymbol(&Qdestroyed, "destroyed");
6841 defsymbol(&Qbegin_glyph, "begin-glyph");
6842 defsymbol(&Qend_glyph, "end-glyph");
6843 defsymbol(&Qstart_open, "start-open");
6844 defsymbol(&Qend_open, "end-open");
6845 defsymbol(&Qstart_closed, "start-closed");
6846 defsymbol(&Qend_closed, "end-closed");
6847 defsymbol(&Qread_only, "read-only");
6848 /* defsymbol (&Qhighlight, "highlight"); in faces.c */
6849 defsymbol(&Qunique, "unique");
6850 defsymbol(&Qduplicable, "duplicable");
6851 defsymbol(&Qdetachable, "detachable");
6852 defsymbol(&Qpriority, "priority");
6853 defsymbol(&Qmouse_face, "mouse-face");
6854 defsymbol(&Qinitial_redisplay_function, "initial-redisplay-function");
6856 defsymbol(&Qglyph_layout, "glyph-layout"); /* backwards compatibility */
6857 defsymbol(&Qbegin_glyph_layout, "begin-glyph-layout");
6858 defsymbol(&Qend_glyph_layout, "end-glyph-layout");
6859 defsymbol(&Qoutside_margin, "outside-margin");
6860 defsymbol(&Qinside_margin, "inside-margin");
6861 defsymbol(&Qwhitespace, "whitespace");
6862 /* Qtext defined in general.c */
6864 defsymbol(&Qpaste_function, "paste-function");
6865 defsymbol(&Qcopy_function, "copy-function");
6867 defsymbol(&Qtext_prop, "text-prop");
6868 defsymbol(&Qtext_prop_extent_paste_function,
6869 "text-prop-extent-paste-function");
6872 DEFSUBR(Fextent_live_p);
6873 DEFSUBR(Fextent_detached_p);
6874 DEFSUBR(Fextent_start_position);
6875 DEFSUBR(Fextent_end_position);
6876 DEFSUBR(Fextent_object);
6877 DEFSUBR(Fextent_length);
6879 DEFSUBR(Fmake_extent);
6880 DEFSUBR(Fcopy_extent);
6881 DEFSUBR(Fdelete_extent);
6882 DEFSUBR(Fdetach_extent);
6883 DEFSUBR(Fset_extent_endpoints);
6884 DEFSUBR(Fnext_extent);
6885 DEFSUBR(Fprevious_extent);
6887 DEFSUBR(Fnext_e_extent);
6888 DEFSUBR(Fprevious_e_extent);
6890 DEFSUBR(Fnext_extent_change);
6891 DEFSUBR(Fprevious_extent_change);
6893 DEFSUBR(Fextent_parent);
6894 DEFSUBR(Fextent_children);
6895 DEFSUBR(Fset_extent_parent);
6897 DEFSUBR(Fextent_in_region_p);
6898 DEFSUBR(Fmap_extents);
6899 DEFSUBR(Fmap_extent_children);
6900 DEFSUBR(Fextent_at);
6901 DEFSUBR(Fextents_at);
6903 DEFSUBR(Fset_extent_initial_redisplay_function);
6904 DEFSUBR(Fextent_face);
6905 DEFSUBR(Fset_extent_face);
6906 DEFSUBR(Fextent_mouse_face);
6907 DEFSUBR(Fset_extent_mouse_face);
6908 DEFSUBR(Fset_extent_begin_glyph);
6909 DEFSUBR(Fset_extent_end_glyph);
6910 DEFSUBR(Fextent_begin_glyph);
6911 DEFSUBR(Fextent_end_glyph);
6912 DEFSUBR(Fset_extent_begin_glyph_layout);
6913 DEFSUBR(Fset_extent_end_glyph_layout);
6914 DEFSUBR(Fextent_begin_glyph_layout);
6915 DEFSUBR(Fextent_end_glyph_layout);
6916 DEFSUBR(Fset_extent_priority);
6917 DEFSUBR(Fextent_priority);
6918 DEFSUBR(Fset_extent_property);
6919 DEFSUBR(Fset_extent_properties);
6920 DEFSUBR(Fextent_property);
6921 DEFSUBR(Fextent_properties);
6923 DEFSUBR(Fhighlight_extent);
6924 DEFSUBR(Fforce_highlight_extent);
6926 DEFSUBR(Finsert_extent);
6928 DEFSUBR(Fget_text_property);
6929 DEFSUBR(Fget_char_property);
6930 DEFSUBR(Fput_text_property);
6931 DEFSUBR(Fput_nonduplicable_text_property);
6932 DEFSUBR(Fadd_text_properties);
6933 DEFSUBR(Fadd_nonduplicable_text_properties);
6934 DEFSUBR(Fremove_text_properties);
6935 DEFSUBR(Ftext_prop_extent_paste_function);
6936 DEFSUBR(Fnext_single_property_change);
6937 DEFSUBR(Fprevious_single_property_change);
6940 void reinit_vars_of_extents(void)
6942 extent_auxiliary_defaults.begin_glyph = Qnil;
6943 extent_auxiliary_defaults.end_glyph = Qnil;
6944 extent_auxiliary_defaults.parent = Qnil;
6945 extent_auxiliary_defaults.children = Qnil;
6946 extent_auxiliary_defaults.priority = 0;
6947 extent_auxiliary_defaults.invisible = Qnil;
6948 extent_auxiliary_defaults.read_only = Qnil;
6949 extent_auxiliary_defaults.mouse_face = Qnil;
6950 extent_auxiliary_defaults.initial_redisplay_function = Qnil;
6951 extent_auxiliary_defaults.before_change_functions = Qnil;
6952 extent_auxiliary_defaults.after_change_functions = Qnil;
6955 void vars_of_extents(void)
6957 reinit_vars_of_extents();
6959 DEFVAR_INT("mouse-highlight-priority", &mouse_highlight_priority /*
6960 The priority to use for the mouse-highlighting pseudo-extent
6961 that is used to highlight extents with the `mouse-face' attribute set.
6962 See `set-extent-priority'.
6964 /* Set mouse-highlight-priority (which ends up being used both for the
6965 mouse-highlighting pseudo-extent and the primary selection extent)
6966 to a very high value because very few extents should override it.
6967 1000 gives lots of room below it for different-prioritized extents.
6968 10 doesn't. ediff, for example, likes to use priorities around 100.
6970 mouse_highlight_priority = /* 10 */ 1000;
6972 DEFVAR_LISP("default-text-properties", &Vdefault_text_properties /*
6973 Property list giving default values for text properties.
6974 Whenever a character does not specify a value for a property, the value
6975 stored in this list is used instead. This only applies when the
6976 functions `get-text-property' or `get-char-property' are called.
6978 Vdefault_text_properties = Qnil;
6980 staticpro(&Vlast_highlighted_extent);
6981 Vlast_highlighted_extent = Qnil;
6983 Vextent_face_reusable_list = Fcons(Qnil, Qnil);
6984 staticpro(&Vextent_face_reusable_list);
6987 void complex_vars_of_extents(void)
6989 staticpro(&Vextent_face_memoize_hash_table);
6990 /* The memoize hash table maps from lists of symbols to lists of
6991 faces. It needs to be `equal' to implement the memoization.
6992 The reverse table maps in the other direction and just needs
6993 to do `eq' comparison because the lists of faces are already
6995 Vextent_face_memoize_hash_table =
6996 make_lisp_hash_table(100, HASH_TABLE_VALUE_WEAK, HASH_TABLE_EQUAL);
6997 staticpro(&Vextent_face_reverse_memoize_hash_table);
6998 Vextent_face_reverse_memoize_hash_table =
6999 make_lisp_hash_table(100, HASH_TABLE_KEY_WEAK, HASH_TABLE_EQ);