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);
922 prev->next = p->next;
924 el->markers = p->next;
926 #if defined HAVE_BDWGC && defined EF_USE_BDWGC
929 m->next = extent_list_marker_freelist;
930 extent_list_marker_freelist = m;
932 gap_array_delete_marker(m->endp ? el->end : el->start, m->m);
936 #define extent_list_marker_pos(el, mkr) \
937 gap_array_marker_pos ((mkr)->endp \
939 : (el)->start, (mkr)->m)
942 allocate_extent_list(void)
944 extent_list_t el = xnew(struct extent_list_s);
945 el->start = make_gap_array(sizeof(EXTENT));
946 el->end = make_gap_array(sizeof(EXTENT));
952 free_extent_list(extent_list_t el)
954 free_gap_array(el->start);
955 free_gap_array(el->end);
960 /************************************************************************/
961 /* Auxiliary extent structure */
962 /************************************************************************/
964 static Lisp_Object mark_extent_auxiliary(Lisp_Object obj)
966 struct extent_auxiliary *data = XEXTENT_AUXILIARY(obj);
967 mark_object(data->begin_glyph);
968 mark_object(data->end_glyph);
969 mark_object(data->invisible);
970 mark_object(data->children);
971 mark_object(data->read_only);
972 mark_object(data->mouse_face);
973 mark_object(data->initial_redisplay_function);
974 mark_object(data->before_change_functions);
975 mark_object(data->after_change_functions);
979 DEFINE_LRECORD_IMPLEMENTATION("extent-auxiliary", extent_auxiliary,
980 mark_extent_auxiliary, internal_object_printer,
981 0, 0, 0, 0, struct extent_auxiliary);
983 void allocate_extent_auxiliary(EXTENT ext)
985 Lisp_Object extent_aux;
986 struct extent_auxiliary *data =
987 alloc_lcrecord_type(struct extent_auxiliary,
988 &lrecord_extent_auxiliary);
990 copy_lcrecord(data, &extent_auxiliary_defaults);
991 XSETEXTENT_AUXILIARY(extent_aux, data);
992 ext->plist = Fcons(extent_aux, ext->plist);
993 ext->flags.has_aux = 1;
997 /************************************************************************/
998 /* Extent info structure */
999 /************************************************************************/
1001 /* An extent-info structure consists of a list of the buffer or string's
1002 extents and a "stack of extents" that lists all of the extents over
1003 a particular position. The stack-of-extents info is used for
1004 optimization purposes -- it basically caches some info that might
1005 be expensive to compute. Certain otherwise hard computations are easy
1006 given the stack of extents over a particular position, and if the
1007 stack of extents over a nearby position is known (because it was
1008 calculated at some prior point in time), it's easy to move the stack
1009 of extents to the proper position.
1011 Given that the stack of extents is an optimization, and given that
1012 it requires memory, a string's stack of extents is wiped out each
1013 time a garbage collection occurs. Therefore, any time you retrieve
1014 the stack of extents, it might not be there. If you need it to
1015 be there, use the _force version.
1017 Similarly, a string may or may not have an extent_info structure.
1018 (Generally it won't if there haven't been any extents added to the
1019 string.) So use the _force version if you need the extent_info
1020 structure to be there. */
1022 static extent_stack_t allocate_soe(void);
1023 static void free_soe(extent_stack_t);
1024 static void soe_invalidate(Lisp_Object obj);
1026 #if !defined HAVE_BDWGC || !defined EF_USE_BDWGC
1028 mark_extent_info(Lisp_Object obj)
1030 struct extent_info *data = (struct extent_info *)XEXTENT_INFO(obj);
1032 extent_list_t list = data->extents;
1034 /* Vbuffer_defaults and Vbuffer_local_symbols are buffer-like
1035 objects that are created specially and never have their extent
1036 list initialized (or rather, it is set to zero in
1037 nuke_all_buffer_slots()). However, these objects get
1038 garbage-collected so we have to deal.
1040 (Also the list can be zero when we're dealing with a destroyed
1044 for (i = 0; i < extent_list_num_els(list); i++) {
1045 struct extent *extent = extent_list_at(list, i, 0);
1048 XSETEXTENT(exobj, extent);
1057 finalize_extent_info(void *header, int for_disksave)
1059 struct extent_info *data = (struct extent_info *)header;
1065 free_soe(data->soe);
1068 if (data->extents) {
1069 free_extent_list(data->extents);
1074 /* just define dummies */
1076 mark_extent_info(Lisp_Object SXE_UNUSED(obj))
1082 finalize_extent_info(void *SXE_UNUSED(header), int SXE_UNUSED(for_disksave))
1088 DEFINE_LRECORD_IMPLEMENTATION("extent-info", extent_info,
1089 mark_extent_info, internal_object_printer,
1090 finalize_extent_info, 0, 0, 0,
1091 struct extent_info);
1094 allocate_extent_info(void)
1096 Lisp_Object extent_info;
1097 struct extent_info *data =
1098 alloc_lcrecord_type(struct extent_info, &lrecord_extent_info);
1100 XSETEXTENT_INFO(extent_info, data);
1101 data->extents = allocate_extent_list();
1107 flush_cached_extent_info(Lisp_Object extent_info)
1109 struct extent_info *data = XEXTENT_INFO(extent_info);
1112 free_soe(data->soe);
1117 /************************************************************************/
1118 /* Buffer/string extent primitives */
1119 /************************************************************************/
1121 /* The functions in this section are the ONLY ones that should know
1122 about the internal implementation of the extent lists. Other functions
1123 should only know that there are two orderings on extents, the "display"
1124 order (sorted by start position, basically) and the e-order (sorted
1125 by end position, basically), and that certain operations are provided
1126 to manipulate the list. */
1128 /* ------------------------------- */
1129 /* basic primitives */
1130 /* ------------------------------- */
1133 decode_buffer_or_string(Lisp_Object object)
1135 if (LIKELY(NILP(object))) {
1136 XSETBUFFER(object, current_buffer);
1137 } else if (BUFFERP(object)) {
1138 CHECK_LIVE_BUFFER(object);
1139 } else if (STRINGP(object)) {
1142 dead_wrong_type_argument(Qbuffer_or_string_p, object);
1147 EXTENT extent_ancestor_1(EXTENT e)
1149 while (e->flags.has_parent) {
1150 /* There should be no circularities except in case of a logic
1151 error somewhere in the extent code */
1152 e = XEXTENT(XEXTENT_AUXILIARY(XCAR(e->plist))->parent);
1157 /* Given an extent object (string or buffer or nil), return its extent info.
1158 This may be 0 for a string. */
1160 static struct extent_info*
1161 buffer_or_string_extent_info(Lisp_Object object)
1163 if (STRINGP(object)) {
1164 Lisp_Object plist = XSTRING(object)->plist;
1165 if (!CONSP(plist) || !EXTENT_INFOP(XCAR(plist))) {
1168 return XEXTENT_INFO(XCAR(plist));
1169 } else if (NILP(object)) {
1172 return XEXTENT_INFO(XBUFFER(object)->extent_info);
1176 /* Given a string or buffer, return its extent list. This may be
1179 static extent_list_t
1180 buffer_or_string_extent_list(Lisp_Object object)
1182 struct extent_info *info = buffer_or_string_extent_info(object);
1187 return info->extents;
1190 /* Given a string or buffer, return its extent info. If it's not there,
1193 static struct extent_info*
1194 buffer_or_string_extent_info_force(Lisp_Object object)
1196 struct extent_info *info = buffer_or_string_extent_info(object);
1199 Lisp_Object extent_info;
1201 /* should never happen for buffers --
1202 the only buffers without an extent
1203 info are those after finalization,
1204 destroyed buffers, or special
1205 Lisp-inaccessible buffer objects. */
1206 assert(STRINGP(object));
1208 extent_info = allocate_extent_info();
1209 XSTRING(object)->plist =
1210 Fcons(extent_info, XSTRING(object)->plist);
1211 return XEXTENT_INFO(extent_info);
1216 /* Detach all the extents in OBJECT. Called from redisplay. */
1219 detach_all_extents(Lisp_Object object)
1221 struct extent_info *data = buffer_or_string_extent_info(object);
1224 if (data->extents) {
1226 i < extent_list_num_els(data->extents);
1228 EXTENT e = extent_list_at(data->extents, i, 0);
1229 /* No need to do detach_extent(). Just nuke the
1230 damn things, which results in the equivalent
1232 set_extent_start(e, -1);
1233 set_extent_end(e, -1);
1235 /* But we need to clear all the lists containing extents
1236 or havoc will result. */
1237 extent_list_delete_all(data->extents);
1239 soe_invalidate(object);
1245 init_buffer_extents(struct buffer *b)
1247 b->extent_info = allocate_extent_info();
1252 uninit_buffer_extents(struct buffer *b)
1254 struct extent_info *data = XEXTENT_INFO(b->extent_info);
1256 /* Don't destroy the extents here -- there may still be children
1257 extents pointing to the extents. */
1258 detach_all_extents(make_buffer(b));
1259 finalize_extent_info(data, 0);
1263 /* Retrieve the extent list that an extent is a member of; the
1264 return value will never be 0 except in destroyed buffers (in which
1265 case the only extents that can refer to this buffer are detached
1268 #define extent_extent_list(e) buffer_or_string_extent_list (extent_object (e))
1270 /* ------------------------------- */
1271 /* stack of extents */
1272 /* ------------------------------- */
1274 #ifdef ERROR_CHECK_EXTENTS
1277 sledgehammer_extent_check(Lisp_Object object)
1279 extent_list_t el = buffer_or_string_extent_list(object);
1280 struct buffer *buf = 0;
1285 if (BUFFERP(object)) {
1286 buf = XBUFFER(object);
1288 for (int endp = 0; endp < 2; endp++) {
1289 for (int i = 1; i < extent_list_num_els(el); i++) {
1290 EXTENT e1 = extent_list_at(el, i - 1, endp);
1291 EXTENT e2 = extent_list_at(el, i, endp);
1293 assert(extent_start(e1) <= buf->text->gpt ||
1295 buf->text->gpt + buf->text->gap_size);
1296 assert(extent_end(e1) <= buf->text->gpt
1298 buf->text->gpt + buf->text->gap_size);
1300 assert(extent_start(e1) <= extent_end(e1));
1302 ? (EXTENT_E_LESS_EQUAL(e1, e2))
1303 : (EXTENT_LESS_EQUAL(e1, e2)));
1308 #endif /* ERROR_CHECK_EXTENTS */
1310 static extent_stack_t
1311 buffer_or_string_stack_of_extents(Lisp_Object object)
1313 struct extent_info *info = buffer_or_string_extent_info(object);
1320 static extent_stack_t
1321 buffer_or_string_stack_of_extents_force(Lisp_Object object)
1323 struct extent_info *info = buffer_or_string_extent_info_force(object);
1325 info->soe = allocate_soe();
1330 /* #define SOE_DEBUG */
1334 static void print_extent_1(char *buf, Lisp_Object extent);
1337 print_extent_2(EXTENT e)
1342 XSETEXTENT(extent, e);
1343 print_extent_1(buf, extent);
1348 soe_dump(Lisp_Object obj)
1351 extent_stack_t soe = buffer_or_string_stack_of_extents(obj);
1360 printf("SOE pos is %d (memind %d)\n",
1361 soe->pos < 0 ? soe->pos :
1362 buffer_or_string_memind_to_bytind(obj, soe->pos), soe->pos);
1363 for (endp = 0; endp < 2; endp++) {
1364 printf(endp ? "SOE end:" : "SOE start:");
1365 for (i = 0; i < extent_list_num_els(sel); i++) {
1366 EXTENT e = extent_list_at(sel, i, endp);
1375 #endif /* SOE_DEBUG */
1377 /* Insert EXTENT into OBJ's stack of extents, if necessary. */
1380 soe_insert(Lisp_Object obj, EXTENT extent)
1382 extent_stack_t soe = buffer_or_string_stack_of_extents(obj);
1385 printf("Inserting into SOE: ");
1386 print_extent_2(extent);
1389 if (!soe || soe->pos < extent_start(extent) ||
1390 soe->pos > extent_end(extent)) {
1392 printf("(not needed)\n\n");
1396 extent_list_insert(soe->extents, extent);
1398 puts("SOE afterwards is:");
1404 /* Delete EXTENT from OBJ's stack of extents, if necessary. */
1407 soe_delete(Lisp_Object obj, EXTENT extent)
1409 extent_stack_t soe = buffer_or_string_stack_of_extents(obj);
1412 printf("Deleting from SOE: ");
1413 print_extent_2(extent);
1416 if (!soe || soe->pos < extent_start(extent) ||
1417 soe->pos > extent_end(extent)) {
1419 puts("(not needed)\n");
1423 extent_list_delete(soe->extents, extent);
1425 puts("SOE afterwards is:");
1431 /* Move OBJ's stack of extents to lie over the specified position. */
1434 soe_move(Lisp_Object obj, Memind pos)
1436 extent_stack_t soe = buffer_or_string_stack_of_extents_force(obj);
1437 extent_list_t sel = soe->extents;
1438 int numsoe = extent_list_num_els(sel);
1439 extent_list_t bel = buffer_or_string_extent_list(obj);
1443 #ifdef ERROR_CHECK_EXTENTS
1448 printf("Moving SOE from %d (memind %d) to %d (memind %d)\n",
1449 soe->pos < 0 ? soe->pos :
1450 buffer_or_string_memind_to_bytind(obj, soe->pos), soe->pos,
1451 buffer_or_string_memind_to_bytind(obj, pos), pos);
1453 if (soe->pos < pos) {
1456 } else if (soe->pos > pos) {
1461 puts("(not needed)\n");
1466 /* For DIRECTION = 1: Any extent that overlaps POS is either in the
1467 SOE (if the extent starts at or before SOE->POS) or is greater
1468 (in the display order) than any extent in the SOE (if it starts
1471 For DIRECTION = -1: Any extent that overlaps POS is either in the
1472 SOE (if the extent ends at or after SOE->POS) or is less (in the
1473 e-order) than any extent in the SOE (if it ends before SOE->POS).
1475 We proceed in two stages:
1477 1) delete all extents in the SOE that don't overlap POS.
1478 2) insert all extents into the SOE that start (or end, when
1479 DIRECTION = -1) in (SOE->POS, POS] and that overlap
1480 POS. (Don't include SOE->POS in the range because those
1481 extents would already be in the SOE.)
1487 /* Delete all extents in the SOE that don't overlap POS.
1488 This is all extents that end before (or start after,
1489 if DIRECTION = -1) POS.
1492 /* Deleting extents from the SOE is tricky because it changes
1493 the positions of extents. If we are deleting in the forward
1494 direction we have to call extent_list_at() on the same position
1495 over and over again because positions after the deleted element
1496 get shifted back by 1. To make life simplest, we delete forward
1497 irrespective of DIRECTION.
1502 if (direction > 0) {
1504 end = extent_list_locate_from_pos(sel, pos, 1);
1506 start = extent_list_locate_from_pos(sel, pos + 1, 0);
1510 for (i = start; i < end; i++) {
1512 sel, extent_list_at(sel, start, !endp));
1521 if (direction < 0) {
1523 extent_list_locate_from_pos(
1524 bel, soe->pos, endp) - 1;
1527 extent_list_locate_from_pos(
1528 bel, soe->pos + 1, endp);
1531 for (; start_pos >= 0 && start_pos < extent_list_num_els(bel);
1532 start_pos += direction) {
1533 EXTENT e = extent_list_at(bel, start_pos, endp);
1535 ? (extent_start(e) > pos)
1536 : (extent_end(e) < pos)) {
1537 /* All further extents lie on the far side of
1538 POS and thus can't overlap. */
1542 ? (extent_end(e) >= pos)
1543 : (extent_start(e) <= pos)) {
1544 extent_list_insert(sel, e);
1551 puts("SOE afterwards is:");
1558 soe_invalidate(Lisp_Object obj)
1560 extent_stack_t soe = buffer_or_string_stack_of_extents(obj);
1563 extent_list_delete_all(soe->extents);
1569 static extent_stack_t
1572 extent_stack_t soe = xnew_and_zero(struct extent_stack_s);
1573 soe->extents = allocate_extent_list();
1579 free_soe(extent_stack_t soe)
1581 free_extent_list(soe->extents);
1586 /* ------------------------------- */
1587 /* other primitives */
1588 /* ------------------------------- */
1590 /* Return the start (endp == 0) or end (endp == 1) of an extent as
1591 a byte index. If you want the value as a memory index, use
1592 extent_endpoint(). If you want the value as a buffer position,
1593 use extent_endpoint_bufpos(). */
1595 static Bytind extent_endpoint_bytind(EXTENT extent, int endp)
1597 assert(EXTENT_LIVE_P(extent));
1598 assert(!extent_detached_p(extent));
1600 Memind i = endp ? extent_end(extent) : extent_start(extent);
1601 Lisp_Object obj = extent_object(extent);
1602 return buffer_or_string_memind_to_bytind(obj, i);
1606 static Bufpos extent_endpoint_bufpos(EXTENT extent, int endp)
1608 assert(EXTENT_LIVE_P(extent));
1609 assert(!extent_detached_p(extent));
1611 Memind i = endp ? extent_end(extent) : extent_start(extent);
1612 Lisp_Object obj = extent_object(extent);
1613 return buffer_or_string_memind_to_bufpos(obj, i);
1617 /* A change to an extent occurred that will change the display, so
1618 notify redisplay. Maybe also recurse over all the extent's
1622 extent_changed_for_redisplay(EXTENT extent, int descendants_too,
1623 int invisibility_change)
1628 /* we could easily encounter a detached extent while traversing the
1629 children, but we should never be able to encounter a dead extent. */
1630 assert(EXTENT_LIVE_P(extent));
1632 if (descendants_too) {
1633 Lisp_Object children = extent_children(extent);
1635 if (!NILP(children)) {
1636 /* first mark all of the extent's children. We will
1637 lose big-time if there are any circularities here, so
1638 we sure as hell better ensure that there aren't. */
1639 LIST_LOOP(rest, XWEAK_LIST_LIST(children)) {
1640 extent_changed_for_redisplay(
1641 XEXTENT(XCAR(rest)), 1,
1642 invisibility_change);
1647 /* now mark the extent itself. */
1649 object = extent_object(extent);
1651 if (extent_detached_p(extent)) {
1654 } else if (STRINGP(object)) {
1655 /* #### Changes to string extents can affect redisplay if they
1656 are in the modeline or in the gutters.
1658 If the extent is in some generated-modeline-string: when we
1659 change an extent in generated-modeline-string, this changes
1660 its parent, which is in `modeline-format', so we should force
1661 the modeline to be updated. But how to determine whether a
1662 string is a `generated-modeline-string'? Looping through all
1663 buffers is not very efficient. Should we add all
1664 `generated-modeline-string' strings to a hash table? Maybe
1665 efficiency is not the greatest concern here and there's no
1666 big loss in looping over the buffers.
1668 If the extent is in a gutter we mark the gutter as
1669 changed. This means (a) we can update extents in the gutters
1670 when we need it. (b) we don't have to update the gutters when
1671 only extents attached to buffers have changed. */
1673 if (!in_modeline_generation) {
1674 MARK_EXTENTS_CHANGED;
1676 gutter_extent_signal_changed_region_maybe(
1678 extent_endpoint_bufpos(extent, 0),
1679 extent_endpoint_bufpos(extent, 1));
1681 } else if (BUFFERP(object)) {
1683 b = XBUFFER(object);
1684 BUF_FACECHANGE(b)++;
1685 MARK_EXTENTS_CHANGED;
1686 if (invisibility_change) {
1689 buffer_extent_signal_changed_region(
1691 extent_endpoint_bufpos(extent, 0),
1692 extent_endpoint_bufpos(extent, 1));
1696 /* A change to an extent occurred that might affect redisplay.
1697 This is called when properties such as the endpoints, the layout,
1698 or the priority changes. Redisplay will be affected only if
1699 the extent has any displayable attributes. */
1702 extent_maybe_changed_for_redisplay(EXTENT extent, int descendants_too,
1703 int invisibility_change)
1705 /* Retrieve the ancestor for efficiency */
1706 EXTENT anc = extent_ancestor(extent);
1707 if (!NILP(extent_face(anc)) ||
1708 !NILP(extent_begin_glyph(anc)) ||
1709 !NILP(extent_end_glyph(anc)) ||
1710 !NILP(extent_mouse_face(anc)) ||
1711 !NILP(extent_invisible(anc)) ||
1712 !NILP(extent_initial_redisplay_function(anc)) ||
1713 invisibility_change)
1714 extent_changed_for_redisplay(extent, descendants_too,
1715 invisibility_change);
1719 make_extent_detached(Lisp_Object object)
1721 EXTENT extent = allocate_extent();
1723 assert(NILP(object) || STRINGP(object) ||
1724 (BUFFERP(object) && BUFFER_LIVE_P(XBUFFER(object))));
1725 extent_object(extent) = object;
1726 /* Now make sure the extent info exists. */
1727 if (!NILP(object)) {
1728 buffer_or_string_extent_info_force(object);
1733 /* A "real" extent is any extent other than the internal (not-user-visible)
1734 extents used by `map-extents'. */
1737 real_extent_at_forward(extent_list_t el, int pos, int endp)
1739 for (; pos < extent_list_num_els(el); pos++) {
1740 EXTENT e = extent_list_at(el, pos, endp);
1741 if (!extent_internal_p(e)) {
1749 real_extent_at_backward(extent_list_t el, int pos, int endp)
1751 for (; pos >= 0; pos--) {
1752 EXTENT e = extent_list_at(el, pos, endp);
1753 if (!extent_internal_p(e)) {
1761 extent_first(Lisp_Object obj)
1763 extent_list_t el = buffer_or_string_extent_list(obj);
1768 return real_extent_at_forward(el, 0, 0);
1771 #ifdef DEBUG_SXEMACS
1773 extent_e_first(Lisp_Object obj)
1775 extent_list_t el = buffer_or_string_extent_list(obj);
1780 return real_extent_at_forward(el, 0, 1);
1782 #endif /* DEBUG_SXEMACS */
1785 extent_next(EXTENT e)
1787 extent_list_t el = extent_extent_list(e);
1789 int pos = extent_list_locate(el, e, 0, &foundp);
1791 return real_extent_at_forward(el, pos + 1, 0);
1794 #ifdef DEBUG_SXEMACS
1796 extent_e_next(EXTENT e)
1798 extent_list_t el = extent_extent_list(e);
1800 int pos = extent_list_locate(el, e, 1, &foundp);
1802 return real_extent_at_forward(el, pos + 1, 1);
1804 #endif /* DEBUG_SXEMACS */
1807 extent_last(Lisp_Object obj)
1809 extent_list_t el = buffer_or_string_extent_list(obj);
1814 return real_extent_at_backward(el, extent_list_num_els(el) - 1, 0);
1817 #ifdef DEBUG_SXEMACS
1819 extent_e_last(Lisp_Object obj)
1821 extent_list_t el = buffer_or_string_extent_list(obj);
1826 return real_extent_at_backward(el, extent_list_num_els(el) - 1, 1);
1828 #endif /* DEBUG_SXEMACS */
1831 extent_previous(EXTENT e)
1833 extent_list_t el = extent_extent_list(e);
1835 int pos = extent_list_locate(el, e, 0, &foundp);
1837 return real_extent_at_backward(el, pos - 1, 0);
1840 #ifdef DEBUG_SXEMACS
1842 extent_e_previous(EXTENT e)
1844 extent_list_t el = extent_extent_list(e);
1846 int pos = extent_list_locate(el, e, 1, &foundp);
1848 return real_extent_at_backward(el, pos - 1, 1);
1850 #endif /* DEBUG_SXEMACS */
1853 extent_attach(EXTENT extent)
1855 extent_list_t el = extent_extent_list(extent);
1857 extent_list_insert(el, extent);
1858 soe_insert(extent_object(extent), extent);
1859 /* only this extent changed */
1860 extent_maybe_changed_for_redisplay(
1861 extent, 0, !NILP(extent_invisible(extent)));
1866 extent_detach(EXTENT extent)
1870 if (extent_detached_p(extent)) {
1873 el = extent_extent_list(extent);
1875 /* call this before messing with the extent. */
1876 extent_maybe_changed_for_redisplay(
1877 extent, 0, !NILP(extent_invisible(extent)));
1878 extent_list_delete(el, extent);
1879 soe_delete(extent_object(extent), extent);
1880 set_extent_start(extent, -1);
1881 set_extent_end(extent, -1);
1885 /* ------------------------------- */
1886 /* map-extents et al. */
1887 /* ------------------------------- */
1889 /* Returns true iff map_extents() would visit the given extent.
1890 See the comments at map_extents() for info on the overlap rule.
1891 Assumes that all validation on the extent and buffer positions has
1892 already been performed (see Fextent_in_region_p ()).
1895 extent_in_region_p(EXTENT extent, Bytind from, Bytind to, unsigned int flags)
1897 Lisp_Object obj = extent_object(extent);
1898 Endpoint_Index start, end, exs, exe;
1899 int start_open, end_open;
1900 unsigned int all_extents_flags = flags & ME_ALL_EXTENTS_MASK;
1901 unsigned int in_region_flags = flags & ME_IN_REGION_MASK;
1904 /* A zero-length region is treated as closed-closed. */
1906 flags |= ME_END_CLOSED;
1907 flags &= ~ME_START_OPEN;
1910 /* So is a zero-length extent. */
1911 if (extent_start(extent) == extent_end(extent)) {
1912 start_open = 0, end_open = 0;
1913 } else if (LIKELY(all_extents_flags == 0)) {
1914 /* `all_extents_flags' will almost always be zero. */
1915 start_open = extent_start_open_p(extent);
1916 end_open = extent_end_open_p(extent);
1918 switch (all_extents_flags) {
1919 case ME_ALL_EXTENTS_CLOSED:
1920 start_open = 0, end_open = 0;
1922 case ME_ALL_EXTENTS_OPEN:
1923 start_open = 1, end_open = 1;
1925 case ME_ALL_EXTENTS_CLOSED_OPEN:
1926 start_open = 0, end_open = 1;
1928 case ME_ALL_EXTENTS_OPEN_CLOSED:
1929 start_open = 1, end_open = 0;
1936 start = buffer_or_string_bytind_to_startind(obj, from,
1937 flags & ME_START_OPEN);
1938 end = buffer_or_string_bytind_to_endind(obj, to,
1939 !(flags & ME_END_CLOSED));
1940 exs = memind_to_startind(extent_start(extent), start_open);
1941 exe = memind_to_endind(extent_end(extent), end_open);
1943 /* It's easy to determine whether an extent lies *outside* the
1944 region -- just determine whether it's completely before
1945 or completely after the region. Reject all such extents, so
1946 we're now left with only the extents that overlap the region.
1949 if (exs > end || exe < start) {
1952 /* See if any further restrictions are called for. */
1953 /* in_region_flags will almost always be zero. */
1954 if (in_region_flags == 0) {
1957 switch (in_region_flags) {
1958 case ME_START_IN_REGION:
1959 retval = start <= exs && exs <= end;
1961 case ME_END_IN_REGION:
1962 retval = start <= exe && exe <= end;
1964 case ME_START_AND_END_IN_REGION:
1965 retval = start <= exs && exe <= end;
1967 case ME_START_OR_END_IN_REGION:
1968 retval = (start <= exs && exs <= end) ||
1969 (start <= exe && exe <= end);
1976 return flags & ME_NEGATE_IN_REGION ? !retval : retval;
1979 struct map_extents_struct {
1981 extent_list_marker_t mkr;
1986 map_extents_unwind(Lisp_Object obj)
1988 struct map_extents_struct *closure =
1989 (struct map_extents_struct *)get_opaque_ptr(obj);
1990 free_opaque_ptr(obj);
1991 if (closure->range) {
1992 extent_detach(closure->range);
1995 extent_list_delete_marker(closure->el, closure->mkr);
2000 /* This is the guts of `map-extents' and the other functions that
2001 map over extents. In theory the operation of this function is
2002 simple: just figure out what extents we're mapping over, and
2003 call the function on each one of them in the range. Unfortunately
2004 there are a wide variety of things that the mapping function
2005 might do, and we have to be very tricky to avoid getting messed
2006 up. Furthermore, this function needs to be very fast (it is
2007 called multiple times every time text is inserted or deleted
2008 from a buffer), and so we can't always afford the overhead of
2009 dealing with all the possible things that the mapping function
2010 might do; thus, there are many flags that can be specified
2011 indicating what the mapping function might or might not do.
2013 The result of all this is that this is the most complicated
2014 function in this file. Change it at your own risk!
2016 A potential simplification to the logic below is to determine
2017 all the extents that the mapping function should be called on
2018 before any calls are actually made and save them in an array.
2019 That introduces its own complications, however (the array
2020 needs to be marked for garbage-collection, and a static array
2021 cannot be used because map_extents() needs to be reentrant).
2022 Furthermore, the results might be a little less sensible than
2026 map_extents_bytind(Bytind from, Bytind to, map_extents_fun fn, void *arg,
2027 Lisp_Object obj, EXTENT after, unsigned int flags)
2029 Memind st, en; /* range we're mapping over */
2030 EXTENT range = 0; /* extent for this, if ME_MIGHT_MODIFY_TEXT */
2031 extent_list_t el = 0; /* extent list we're iterating over */
2032 extent_list_marker_t posm = 0; /* marker for extent list,
2033 if ME_MIGHT_MODIFY_EXTENTS */
2034 /* count and struct for unwind-protect, if ME_MIGHT_THROW */
2036 struct map_extents_struct closure;
2038 #ifdef ERROR_CHECK_EXTENTS
2040 assert(from >= buffer_or_string_absolute_begin_byte(obj) &&
2041 from <= buffer_or_string_absolute_end_byte(obj) &&
2042 to >= buffer_or_string_absolute_begin_byte(obj) &&
2043 to <= buffer_or_string_absolute_end_byte(obj));
2047 assert(EQ(obj, extent_object(after)));
2048 assert(!extent_detached_p(after));
2051 el = buffer_or_string_extent_list(obj);
2052 if (!el || !extent_list_num_els(el))
2056 st = buffer_or_string_bytind_to_memind(obj, from);
2057 en = buffer_or_string_bytind_to_memind(obj, to);
2059 if (flags & ME_MIGHT_MODIFY_TEXT) {
2060 /* The mapping function might change the text in the buffer,
2061 so make an internal extent to hold the range we're mapping
2063 range = make_extent_detached(obj);
2064 set_extent_start(range, st);
2065 set_extent_end(range, en);
2066 range->flags.start_open = flags & ME_START_OPEN;
2067 range->flags.end_open = !(flags & ME_END_CLOSED);
2068 range->flags.internal = 1;
2069 range->flags.detachable = 0;
2070 extent_attach(range);
2073 if (flags & ME_MIGHT_THROW) {
2074 /* The mapping function might throw past us so we need to use an
2075 unwind_protect() to eliminate the internal extent and range
2077 count = specpdl_depth();
2078 closure.range = range;
2080 record_unwind_protect(map_extents_unwind,
2081 make_opaque_ptr(&closure));
2084 /* ---------- Figure out where we start and what direction
2085 we move in. This is the trickiest part of this
2086 function. ---------- */
2088 /* If ME_START_IN_REGION, ME_END_IN_REGION or ME_START_AND_END_IN_REGION
2089 was specified and ME_NEGATE_IN_REGION was not specified, our job
2090 is simple because of the presence of the display order and e-order.
2091 (Note that theoretically do something similar for
2092 ME_START_OR_END_IN_REGION, but that would require more trickiness
2093 than it's worth to avoid hitting the same extent twice.)
2095 In the general case, all the extents that overlap a range can be
2096 divided into two classes: those whose start position lies within
2097 the range (including the range's end but not including the
2098 range's start), and those that overlap the start position,
2099 i.e. those in the SOE for the start position. Or equivalently,
2100 the extents can be divided into those whose end position lies
2101 within the range and those in the SOE for the end position. Note
2102 that for this purpose we treat both the range and all extents in
2103 the buffer as closed on both ends. If this is not what the ME_
2104 flags specified, then we've mapped over a few too many extents,
2105 but no big deal because extent_in_region_p() will filter them
2106 out. Ideally, we could move the SOE to the closer of the range's
2107 two ends and work forwards or backwards from there. However, in
2108 order to make the semantics of the AFTER argument work out, we
2109 have to always go in the same direction; so we choose to always
2110 move the SOE to the start position.
2112 When it comes time to do the SOE stage, we first call soe_move()
2113 so that the SOE gets set up. Note that the SOE might get
2114 changed while we are mapping over its contents. If we can
2115 guarantee that the SOE won't get moved to a new position, we
2116 simply need to put a marker in the SOE and we will track deletions
2117 and insertions of extents in the SOE. If the SOE might get moved,
2118 however (this would happen as a result of a recursive invocation
2119 of map-extents or a call to a redisplay-type function), then
2120 trying to track its changes is hopeless, so we just keep a
2121 marker to the first (or last) extent in the SOE and use that as
2124 Finally, if DONT_USE_SOE is defined, we don't use the SOE at all
2125 and instead just map from the beginning of the buffer. This is
2126 used for testing purposes and allows the SOE to be calculated
2127 using map_extents() instead of the other way around. */
2130 int range_flag; /* ME_*_IN_REGION subset of flags */
2131 int do_soe_stage = 0; /* Are we mapping over the SOE? */
2132 /* Does the range stage map over start or end positions? */
2134 /* If type == 0, we include the start position in the range
2136 If type == 1, we exclude the start position in the range
2138 If type == 2, we begin at range_start_pos, an extent-list
2141 int range_start_type = 0;
2142 int range_start_pos = 0;
2145 range_flag = flags & ME_IN_REGION_MASK;
2146 if ((range_flag == ME_START_IN_REGION ||
2147 range_flag == ME_START_AND_END_IN_REGION) &&
2148 !(flags & ME_NEGATE_IN_REGION)) {
2149 /* map over start position in [range-start, range-end].
2152 } else if (range_flag == ME_END_IN_REGION
2153 && !(flags & ME_NEGATE_IN_REGION)) {
2154 /* map over end position in [range-start, range-end].
2158 /* Need to include the SOE extents. */
2160 /* Just brute-force it: start from the beginning. */
2162 range_start_type = 2;
2163 range_start_pos = 0;
2165 extent_stack_t soe =
2166 buffer_or_string_stack_of_extents_force(obj);
2169 /* Move the SOE to the closer end of the range. This
2170 dictates whether we map over start positions or end
2174 numsoe = extent_list_num_els(soe->extents);
2176 if (flags & ME_MIGHT_MOVE_SOE) {
2178 /* Can't map over SOE, so just extend
2179 range to cover the SOE. */
2180 EXTENT e = extent_list_at(
2181 soe->extents, 0, 0);
2182 range_start_pos = extent_list_locate
2183 (buffer_or_string_extent_list
2184 (obj), e, 0, &foundp);
2186 range_start_type = 2;
2188 /* We can map over the SOE. */
2190 range_start_type = 1;
2193 /* No extents in the SOE to map over, so we act
2194 just as if ME_START_IN_REGION or
2195 ME_END_IN_REGION was specified. RANGE_ENDP
2196 already specified so no need to do anything
2202 /* ---------- Now loop over the extents. ---------- */
2204 /* We combine the code for the two stages because much of it
2206 for (stage = 0; stage < 2; stage++) {
2207 int pos = 0; /* Position in extent list */
2209 /* First set up start conditions */
2210 if (stage == 0) { /* The SOE stage */
2213 el = buffer_or_string_stack_of_extents_force
2215 /* We will always be looping over start extents
2217 assert(!range_endp);
2219 } else { /* The range stage */
2220 el = buffer_or_string_extent_list(obj);
2221 switch (range_start_type) {
2223 pos = extent_list_locate_from_pos
2224 (el, st, range_endp);
2227 pos = extent_list_locate_from_pos
2228 (el, st + 1, range_endp);
2231 pos = range_start_pos;
2238 if (flags & ME_MIGHT_MODIFY_EXTENTS) {
2239 /* Create a marker to track changes to the
2242 /* Delete the marker used in the SOE
2244 extent_list_delete_marker
2245 (buffer_or_string_stack_of_extents_force
2246 (obj)->extents, posm);
2247 posm = extent_list_make_marker(
2248 el, pos, range_endp);
2249 /* tell the unwind function about the marker. */
2259 /* ----- update position in extent list
2260 and fetch next extent ----- */
2263 /* fetch POS again to track extent
2264 insertions or deletions */
2265 pos = extent_list_marker_pos(el, posm);
2267 if (pos >= extent_list_num_els(el)) {
2270 e = extent_list_at(el, pos, range_endp);
2273 /* now point the marker to the next one
2274 we're going to process. This ensures
2275 graceful behavior if this extent is
2277 extent_list_move_marker(el, posm, pos);
2279 /* ----- deal with internal extents ----- */
2281 if (extent_internal_p(e)) {
2282 if (!(flags & ME_INCLUDE_INTERNAL)) {
2284 } else if (e == range) {
2285 /* We're processing internal
2286 extents and we've come across
2287 our own special range extent.
2288 (This happens only in
2289 adjust_extents*() and
2290 process_extents*(), which
2291 handle text insertion and
2292 deletion.) We need to omit
2293 processing of this extent;
2294 otherwise we will probably
2296 terminating this loop. */
2301 /* ----- deal with AFTER condition ----- */
2304 /* if e > after, then we can stop
2305 skipping extents. */
2306 if (EXTENT_LESS(after, e)) {
2309 /* otherwise, skip this
2315 /* ----- stop if we're completely outside the
2318 /* fetch ST and EN again to track text
2319 insertions or deletions */
2321 st = extent_start(range);
2322 en = extent_end(range);
2324 if (extent_endpoint(e, range_endp) > en) {
2325 /* Can't be mapping over SOE because all
2326 extents in there should overlap ST */
2331 /* ----- Now actually call the function ----- */
2333 obj2 = extent_object(e);
2334 if (extent_in_region_p(
2336 buffer_or_string_memind_to_bytind
2338 buffer_or_string_memind_to_bytind
2339 (obj2, en), flags)) {
2340 if ((*fn) (e, arg)) {
2341 /* Function wants us to stop
2344 /* so outer for loop will
2351 /* ---------- Finished looping. ---------- */
2354 if (flags & ME_MIGHT_THROW) {
2355 /* This deletes the range extent and frees the marker. */
2356 unbind_to(count, Qnil);
2358 /* Delete them ourselves */
2360 extent_detach(range);
2363 extent_list_delete_marker(el, posm);
2369 map_extents(Bufpos from, Bufpos to, map_extents_fun fn,
2370 void *arg, Lisp_Object obj, EXTENT after, unsigned int flags)
2372 map_extents_bytind(buffer_or_string_bufpos_to_bytind(obj, from),
2373 buffer_or_string_bufpos_to_bytind(obj, to), fn, arg,
2377 /* ------------------------------- */
2378 /* adjust_extents() */
2379 /* ------------------------------- */
2381 /* Add AMOUNT to all extent endpoints in the range (FROM, TO]. This
2382 happens whenever the gap is moved or (under Mule) a character in a
2383 string is substituted for a different-length one. The reason for
2384 this is that extent endpoints behave just like markers (all memory
2385 indices do) and this adjustment correct for markers -- see
2386 adjust_markers(). Note that it is important that we visit all
2387 extent endpoints in the range, irrespective of whether the
2388 endpoints are open or closed.
2390 We could use map_extents() for this (and in fact the function
2391 was originally written that way), but the gap is in an incoherent
2392 state when this function is called and this function plays
2393 around with extent endpoints without detaching and reattaching
2394 the extents (this is provably correct and saves lots of time),
2395 so for safety we make it just look at the extent lists directly. */
2398 adjust_extents(Lisp_Object obj, Memind from, Memind to, int amount)
2406 #ifdef ERROR_CHECK_EXTENTS
2407 sledgehammer_extent_check(obj);
2409 el = buffer_or_string_extent_list(obj);
2411 if (!el || !extent_list_num_els(el)) {
2414 /* IMPORTANT! Compute the starting positions of the extents to
2415 modify BEFORE doing any modification! Otherwise the starting
2416 position for the second time through the loop might get
2417 incorrectly calculated (I got bit by this bug real bad). */
2418 startpos[0] = extent_list_locate_from_pos(el, from + 1, 0);
2419 startpos[1] = extent_list_locate_from_pos(el, from + 1, 1);
2420 for (endp = 0; endp < 2; endp++) {
2421 for (pos = startpos[endp]; pos < extent_list_num_els(el);
2423 EXTENT e = extent_list_at(el, pos, endp);
2424 if (extent_endpoint(e, endp) > to) {
2427 set_extent_endpoint(
2429 do_marker_adjustment(
2430 extent_endpoint(e, endp),
2436 /* The index for the buffer's SOE is a memory index and thus
2437 needs to be adjusted like a marker. */
2438 soe = buffer_or_string_stack_of_extents(obj);
2439 if (soe && soe->pos >= 0) {
2440 soe->pos = do_marker_adjustment(soe->pos, from, to, amount);
2445 /* ------------------------------- */
2446 /* adjust_extents_for_deletion() */
2447 /* ------------------------------- */
2449 struct adjust_extents_for_deletion_arg {
2450 EXTENT_dynarr *list;
2453 static int adjust_extents_for_deletion_mapper(EXTENT extent, void *arg)
2455 struct adjust_extents_for_deletion_arg *closure =
2456 (struct adjust_extents_for_deletion_arg *)arg;
2458 Dynarr_add(closure->list, extent);
2459 /* continue mapping */
2463 /* For all extent endpoints in the range (FROM, TO], move them to the beginning
2464 of the new gap. Note that it is important that we visit all extent
2465 endpoints in the range, irrespective of whether the endpoints are open or
2468 This function deals with weird stuff such as the fact that extents
2471 There is no string correspondent for this because you can't
2472 delete characters from a string.
2476 adjust_extents_for_deletion(Lisp_Object object, Bytind from,
2477 Bytind to, int gapsize, int numdel, int movegapsize)
2479 struct adjust_extents_for_deletion_arg closure;
2481 Memind adjust_to = (Memind) (to + gapsize);
2482 Bytecount amount = -numdel - movegapsize;
2483 Memind oldsoe = 0, newsoe = 0;
2484 extent_stack_t soe = buffer_or_string_stack_of_extents(object);
2486 #ifdef ERROR_CHECK_EXTENTS
2487 sledgehammer_extent_check(object);
2489 closure.list = Dynarr_new(EXTENT);
2491 /* We're going to be playing weird games below with extents and the SOE
2492 and such, so compute the list now of all the extents that we're going
2493 to muck with. If we do the mapping and adjusting together, things
2494 can get all screwed up. */
2496 map_extents_bytind(from, to, adjust_extents_for_deletion_mapper,
2497 (void *)&closure, object, 0,
2498 /* extent endpoints move like markers regardless
2499 of their open/closeness. */
2500 ME_ALL_EXTENTS_CLOSED | ME_END_CLOSED |
2501 ME_START_OR_END_IN_REGION | ME_INCLUDE_INTERNAL);
2504 Old and new values for the SOE's position. (It gets adjusted
2505 like a marker, just like extent endpoints.)
2510 if (soe->pos >= 0) {
2511 newsoe = do_marker_adjustment(
2512 soe->pos, adjust_to, adjust_to, amount);
2518 for (i = 0; i < Dynarr_length(closure.list); i++) {
2519 EXTENT extent = Dynarr_at(closure.list, i);
2520 Memind new_start = extent_start(extent);
2521 Memind new_end = extent_end(extent);
2523 /* do_marker_adjustment() will not adjust values that should not
2524 be adjusted. We're passing the same funky arguments to
2525 do_marker_adjustment() as buffer_delete_range() does. */
2526 new_start = do_marker_adjustment(
2527 new_start, adjust_to, adjust_to, amount);
2528 new_end = do_marker_adjustment(
2529 new_end, adjust_to, adjust_to, amount);
2531 /* We need to be very careful here so that the SOE doesn't get
2532 corrupted. We are shrinking extents out of the deleted
2533 region and simultaneously moving the SOE's pos out of the
2534 deleted region, so the SOE should contain the same extents at
2535 the end as at the beginning. However, extents may get
2536 reordered by this process, so we have to operate by pulling
2537 the extents out of the buffer and SOE, changing their bounds,
2538 and then reinserting them. In order for the SOE not to get
2539 screwed up, we have to make sure that the SOE's pos points to
2540 its old location whenever we pull an extent out, and points
2541 to its new location whenever we put the extent back in.
2544 if (new_start != extent_start(extent) ||
2545 new_end != extent_end(extent)) {
2546 extent_detach(extent);
2547 set_extent_start(extent, new_start);
2548 set_extent_end(extent, new_end);
2552 extent_attach(extent);
2563 #ifdef ERROR_CHECK_EXTENTS
2564 sledgehammer_extent_check(object);
2566 Dynarr_free(closure.list);
2570 /* ------------------------------- */
2571 /* extent fragments */
2572 /* ------------------------------- */
2574 /* Imagine that the buffer is divided up into contiguous,
2575 nonoverlapping "runs" of text such that no extent
2576 starts or ends within a run (extents that abut the
2579 An extent fragment is a structure that holds data about
2580 the run that contains a particular buffer position (if
2581 the buffer position is at the junction of two runs, the
2582 run after the position is used) -- the beginning and
2583 end of the run, a list of all of the extents in that
2584 run, the "merged face" that results from merging all of
2585 the faces corresponding to those extents, the begin and
2586 end glyphs at the beginning of the run, etc. This is
2587 the information that redisplay needs in order to
2590 Extent fragments have to be very quick to update to
2591 a new buffer position when moving linearly through
2592 the buffer. They rely on the stack-of-extents code,
2593 which does the heavy-duty algorithmic work of determining
2594 which extents overly a particular position. */
2596 /* This function returns the position of the beginning of
2597 the first run that begins after POS, or returns POS if
2598 there are no such runs. */
2601 extent_find_end_of_run(Lisp_Object obj, Bytind pos, int outside_accessible)
2604 extent_list_t bel = buffer_or_string_extent_list(obj);
2607 Memind mempos = buffer_or_string_bytind_to_memind(obj, pos);
2608 Bytind limit = outside_accessible ?
2609 buffer_or_string_absolute_end_byte(obj) :
2610 buffer_or_string_accessible_end_byte(obj);
2612 if (!bel || !extent_list_num_els(bel)) {
2615 sel = buffer_or_string_stack_of_extents_force(obj)->extents;
2616 soe_move(obj, mempos);
2618 /* Find the first start position after POS. */
2619 elind1 = extent_list_locate_from_pos(bel, mempos + 1, 0);
2620 if (elind1 < extent_list_num_els(bel)) {
2621 pos1 = buffer_or_string_memind_to_bytind(
2622 obj, extent_start(extent_list_at(bel, elind1, 0)));
2627 /* Find the first end position after POS. The extent corresponding
2628 to this position is either in the SOE or is greater than or
2629 equal to POS1, so we just have to look in the SOE. */
2630 elind2 = extent_list_locate_from_pos(sel, mempos + 1, 1);
2631 if (elind2 < extent_list_num_els(sel)) {
2632 pos2 = buffer_or_string_memind_to_bytind(
2633 obj, extent_end(extent_list_at(sel, elind2, 1)));
2637 return min(min(pos1, pos2), limit);
2641 extent_find_beginning_of_run(Lisp_Object obj, Bytind pos,
2642 int outside_accessible)
2645 extent_list_t bel = buffer_or_string_extent_list(obj);
2648 Memind mempos = buffer_or_string_bytind_to_memind(obj, pos);
2649 Bytind limit = outside_accessible
2650 ? buffer_or_string_absolute_begin_byte(obj)
2651 : buffer_or_string_accessible_begin_byte(obj);
2653 if (!bel || !extent_list_num_els(bel)) {
2656 sel = buffer_or_string_stack_of_extents_force(obj)->extents;
2657 soe_move(obj, mempos);
2659 /* Find the first end position before POS. */
2660 elind1 = extent_list_locate_from_pos(bel, mempos, 1);
2662 pos1 = buffer_or_string_memind_to_bytind(
2663 obj, extent_end(extent_list_at(bel, elind1 - 1, 1)));
2667 /* Find the first start position before POS. The extent corresponding
2668 to this position is either in the SOE or is less than or
2669 equal to POS1, so we just have to look in the SOE. */
2670 elind2 = extent_list_locate_from_pos(sel, mempos, 0);
2672 pos2 = buffer_or_string_memind_to_bytind(
2673 obj, extent_start(extent_list_at(sel, elind2 - 1, 0)));
2677 return max(max(pos1, pos2), limit);
2680 struct extent_fragment*
2681 extent_fragment_new(Lisp_Object buffer_or_string, struct frame *frm)
2683 struct extent_fragment *ef = xnew_and_zero(struct extent_fragment);
2685 ef->object = buffer_or_string;
2687 ef->extents = Dynarr_new(EXTENT);
2688 ef->glyphs = Dynarr_new(glyph_block);
2693 void extent_fragment_delete(struct extent_fragment *ef)
2695 Dynarr_free(ef->extents);
2696 Dynarr_free(ef->glyphs);
2701 extent_priority_sort_function(const void *humpty, const void *dumpty)
2703 const EXTENT foo = *(const EXTENT *)humpty;
2704 const EXTENT bar = *(const EXTENT *)dumpty;
2705 if (extent_priority(foo) < extent_priority(bar)) {
2708 return extent_priority(foo) > extent_priority(bar);
2712 extent_fragment_sort_by_priority(EXTENT_dynarr * extarr)
2716 /* Sort our copy of the stack by extent_priority. We use a bubble
2717 sort here because it's going to be faster than qsort() for small
2718 numbers of extents (less than 10 or so), and 99.999% of the time
2719 there won't ever be more extents than this in the stack. */
2720 if (Dynarr_length(extarr) < 10) {
2721 for (i = 1; i < Dynarr_length(extarr); i++) {
2724 (extent_priority(Dynarr_at(extarr, j)) >
2725 extent_priority(Dynarr_at(extarr, j + 1)))) {
2726 EXTENT tmp = Dynarr_at(extarr, j);
2727 Dynarr_at(extarr, j) = Dynarr_at(extarr, j + 1);
2728 Dynarr_at(extarr, j + 1) = tmp;
2733 /* But some loser programs mess up and may create a large number
2734 of extents overlapping the same spot. This will result in
2735 catastrophic behavior if we use the bubble sort above. */
2736 qsort(Dynarr_atp(extarr, 0), Dynarr_length(extarr),
2737 sizeof(EXTENT), extent_priority_sort_function);
2741 /* If PROP is the `invisible' property of an extent,
2742 this is 1 if the extent should be treated as invisible. */
2744 #define EXTENT_PROP_MEANS_INVISIBLE(buf, prop) \
2745 (EQ (buf->invisibility_spec, Qt) \
2747 : invisible_p (prop, buf->invisibility_spec))
2749 /* If PROP is the `invisible' property of a extent,
2750 this is 1 if the extent should be treated as invisible
2751 and should have an ellipsis. */
2753 #define EXTENT_PROP_MEANS_INVISIBLE_WITH_ELLIPSIS(buf, prop) \
2754 (EQ (buf->invisibility_spec, Qt) \
2756 : invisible_ellipsis_p (prop, buf->invisibility_spec))
2758 /* This is like a combination of memq and assq.
2759 Return 1 if PROPVAL appears as an element of LIST
2760 or as the car of an element of LIST.
2761 If PROPVAL is a list, compare each element against LIST
2762 in that way, and return 1 if any element of PROPVAL is found in LIST.
2764 This function cannot quit. */
2767 invisible_p(REGISTER Lisp_Object propval, Lisp_Object list)
2769 REGISTER Lisp_Object tail, proptail;
2770 for (tail = list; CONSP(tail); tail = XCDR(tail)) {
2771 REGISTER Lisp_Object tem;
2773 if (EQ(propval, tem))
2775 if (CONSP(tem) && EQ(propval, XCAR(tem)))
2778 if (CONSP(propval)) {
2779 for (proptail = propval; CONSP(proptail);
2780 proptail = XCDR(proptail)) {
2781 Lisp_Object propelt;
2782 propelt = XCAR(proptail);
2783 for (tail = list; CONSP(tail); tail = XCDR(tail)) {
2784 REGISTER Lisp_Object tem;
2786 if (EQ(propelt, tem)) {
2789 if (CONSP(tem) && EQ(propelt, XCAR(tem))) {
2798 /* Return 1 if PROPVAL appears as the car of an element of LIST
2799 and the cdr of that element is non-nil.
2800 If PROPVAL is a list, check each element of PROPVAL in that way,
2801 and the first time some element is found,
2802 return 1 if the cdr of that element is non-nil.
2804 This function cannot quit. */
2807 invisible_ellipsis_p(REGISTER Lisp_Object propval, Lisp_Object list)
2809 REGISTER Lisp_Object tail, proptail;
2811 for (tail = list; CONSP(tail); tail = XCDR(tail)) {
2812 REGISTER Lisp_Object tem;
2814 if (CONSP(tem) && EQ(propval, XCAR(tem))) {
2815 return !NILP(XCDR(tem));
2818 if (CONSP(propval)) {
2819 for (proptail = propval; CONSP(proptail);
2820 proptail = XCDR(proptail)) {
2821 Lisp_Object propelt;
2822 propelt = XCAR(proptail);
2823 for (tail = list; CONSP(tail); tail = XCDR(tail)) {
2824 REGISTER Lisp_Object tem;
2826 if (CONSP(tem) && EQ(propelt, XCAR(tem))) {
2827 return !NILP(XCDR(tem));
2836 extent_fragment_update(struct window * w, struct extent_fragment * ef,
2837 Bytind pos, Lisp_Object last_glyph)
2840 int seen_glyph = NILP(last_glyph) ? 1 : 0;
2842 buffer_or_string_stack_of_extents_force(ef->object)->extents;
2844 struct extent dummy_lhe_extent;
2845 Memind mempos = buffer_or_string_bytind_to_memind(ef->object, pos);
2846 glyph_block_dynarr *glyphs; /* List of glyphs to post process */
2847 int invis_before = 0; /* Exiting an invisible extent. */
2848 int invis_after = 0; /* Entering an invisible extent. */
2849 int insert_empty = 0; /* Position to insert empty extent glyphs */
2850 int queuing_begin = 0; /* Queuing begin glyphs. */
2852 #ifdef ERROR_CHECK_EXTENTS
2853 assert(pos >= buffer_or_string_accessible_begin_byte(ef->object)
2854 && pos <= buffer_or_string_accessible_end_byte(ef->object));
2857 Dynarr_reset(ef->extents);
2858 Dynarr_reset(ef->glyphs);
2860 ef->previously_invisible = ef->invisible;
2861 if (ef->invisible) {
2862 if (ef->invisible_ellipses)
2863 ef->invisible_ellipses_already_displayed = 1;
2865 ef->invisible_ellipses_already_displayed = 0;
2868 ef->invisible_ellipses = 0;
2870 /* Set up the begin and end positions. */
2872 ef->end = extent_find_end_of_run(ef->object, pos, 0);
2874 /* Note that extent_find_end_of_run() already moved the SOE for us. */
2875 /* soe_move (ef->object, mempos); */
2877 /* We tried determining all the charsets used in the run here,
2878 but that fails even if we only do the current line -- display
2879 tables or non-printable characters might cause other charsets
2882 /* Determine whether the last-highlighted-extent is present. */
2883 if (EXTENTP(Vlast_highlighted_extent))
2884 lhe = XEXTENT(Vlast_highlighted_extent);
2886 /* Now add all extents that overlap the character after POS and
2887 have a non-nil face. Also check if the character is
2888 invisible. We also queue begin and end glyphs of extents
2889 that being/end at just before POS. These are ordered as
2890 follows. 1) end glyphs of non-empty extents in reverse
2891 display order. 2) begin glyphs of empty extents. 3) end
2892 glyphs of empty extents. 4) begin glyphs of non-empty
2893 extents in display order. Empty extents are shown nested,
2894 but the invisibility property of an empty extent is
2895 ignored and not used to determine whether an 'interior'
2896 empty extent's glyphs should be shown or not. */
2897 glyphs = Dynarr_new(glyph_block);
2898 for (i = 0; i < extent_list_num_els(sel); i++) {
2899 EXTENT e = extent_list_at(sel, i, 0);
2900 int zero_width = extent_start(e) == extent_end(e);
2901 Lisp_Object invis_prop = extent_invisible(e);
2904 if (extent_start(e) == mempos) {
2905 /* The extent starts here. If we are queuing
2906 end glyphs, we should display all the end
2907 glyphs we've pushed. */
2909 if (!queuing_begin) {
2910 /* Append any already seen end glyphs */
2911 for (j = Dynarr_length(glyphs); j--;) {
2912 struct glyph_block *gbp
2913 = Dynarr_atp(glyphs, j);
2916 Dynarr_add(ef->glyphs, *gbp);
2917 else if (EQ(gbp->glyph, last_glyph))
2921 /* Pop the end glyphs just displayed. */
2922 Dynarr_set_size(glyphs, 0);
2923 /* We are now queuing begin glyphs. */
2925 /* And will insert empty extent glyphs
2927 insert_empty = Dynarr_length (ef->glyphs);
2930 glyph = extent_begin_glyph(e);
2933 struct glyph_block gb;
2935 memset(&gb,0,sizeof(gb));
2938 gb.active = 0; /* BEGIN_GLYPH */
2940 XSETEXTENT(gb.extent, e);
2944 == Dynarr_length (ef->glyphs))
2945 Dynarr_add (ef->glyphs, gb);
2950 } else if (!invis_after)
2951 Dynarr_add (glyphs, gb);
2955 if (extent_end(e) == mempos) {
2956 /* The extend ends here. Push the end glyph. */
2957 glyph = extent_end_glyph(e);
2959 if (!NILP (glyph)) {
2960 struct glyph_block gb;
2962 gb.width = gb.findex = 0; /* just init */
2964 gb.active = 1; /* END_GLYPH */
2965 XSETEXTENT(gb.extent, e);
2968 Dynarr_add (ef->glyphs, gb);
2969 else if (!invis_before)
2970 Dynarr_add(glyphs, gb);
2972 /* If this extent is not empty, any inner
2973 extents ending here will not be visible. */
2974 if (extent_start (e) < mempos && !NILP (invis_prop))
2978 if (extent_end(e) > mempos) {
2979 /* This extent covers POS. */
2980 if (!NILP(invis_prop)) {
2982 /* If this extend spans POS, all
2983 glyphs are invisible. */
2984 if (extent_start (e) < mempos)
2985 Dynarr_set_size (glyphs, 0);
2987 if (!BUFFERP(ef->object))
2988 /* #### no `string-invisibility-spec' */
2992 invisible_ellipses_already_displayed
2994 EXTENT_PROP_MEANS_INVISIBLE_WITH_ELLIPSIS
2995 (XBUFFER(ef->object), invis_prop)) {
2997 ef->invisible_ellipses = 1;
2998 } else if (EXTENT_PROP_MEANS_INVISIBLE
2999 (XBUFFER(ef->object),
3005 /* Remember that one of the extents in the list might be
3006 our dummy extent representing the highlighting that
3007 is attached to some other extent that is currently
3008 mouse-highlighted. When an extent is
3009 mouse-highlighted, it is as if there are two extents
3010 there, of potentially different priorities: the
3011 extent being highlighted, with whatever face and
3012 priority it has; and an ephemeral extent in the
3013 `mouse-face' face with `mouse-highlight-priority'.
3016 if (!NILP(extent_face(e)))
3017 Dynarr_add(ef->extents, e);
3020 /* zeroing isn't really necessary; we only deref
3021 `priority' and `face' */
3022 xzero(dummy_lhe_extent);
3023 set_extent_priority(&dummy_lhe_extent,
3024 mouse_highlight_priority);
3025 /* Need to break up the following expression,
3027 /* error in the Digital UNIX 3.2g C compiler
3029 /* UNIX Compiler Driver 3.11). */
3030 f = extent_mouse_face(lhe);
3031 extent_face(&dummy_lhe_extent) = f;
3032 Dynarr_add(ef->extents, &dummy_lhe_extent);
3034 /* since we are looping anyway, we might as well do this
3036 if ((!NILP(extent_initial_redisplay_function(e))) &&
3037 !extent_in_red_event_p(e)) {
3038 Lisp_Object function =
3039 extent_initial_redisplay_function(e);
3042 /* print_extent_2 (e);
3045 /* FIXME: One should probably inhibit the
3046 displaying of this extent to reduce
3048 extent_in_red_event_p(e) = 1;
3050 /* call the function */
3052 if (!NILP(function)) {
3053 Fenqueue_eval_event(function, obj);
3059 if (!queuing_begin) {
3060 /* Append end glyphs in reverse order */
3061 for (j = Dynarr_length(glyphs); j--;) {
3062 struct glyph_block *gbp = Dynarr_atp(glyphs, j);
3065 Dynarr_add(ef->glyphs, *gbp);
3066 else if (EQ(gbp->glyph, last_glyph))
3071 /* Scan the zero length glyphs and see where we
3072 start a glyph that has not been displayed yet. */
3073 for (j = insert_empty;
3074 j != Dynarr_length (ef->glyphs); j++) {
3075 struct glyph_block *gbp
3076 = Dynarr_atp(ef->glyphs, j);
3078 if (EQ(gbp->glyph, last_glyph)) {
3084 Dynarr_delete_many (ef->glyphs, insert_empty,
3088 /* Now copy the begin glyphs. */
3089 for (j = 0; j != Dynarr_length (glyphs); j++) {
3090 struct glyph_block *gbp = Dynarr_atp(glyphs, j);
3093 Dynarr_add(ef->glyphs, *gbp);
3094 else if (EQ(gbp->glyph, last_glyph))
3099 Dynarr_free(glyphs);
3101 extent_fragment_sort_by_priority(ef->extents);
3103 /* Now merge the faces together into a single face. The code to
3104 do this is in faces.c because it involves manipulating faces. */
3105 return get_extent_fragment_face_cache_index(w, ef);
3108 /************************************************************************/
3109 /* extent-object methods */
3110 /************************************************************************/
3112 /* These are the basic helper functions for handling the allocation of
3113 extent objects. They are similar to the functions for other
3114 lrecord objects. allocate_extent() is in alloc.c, not here. */
3116 static Lisp_Object mark_extent(Lisp_Object obj)
3118 struct extent *extent = XEXTENT(obj);
3120 mark_object(extent_object(extent));
3121 mark_object(extent_no_chase_normal_field(extent, face));
3122 return extent->plist;
3126 print_extent_1(Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
3128 EXTENT ext = XEXTENT(obj);
3129 EXTENT anc = extent_ancestor(ext);
3131 char buf[100], *bp = buf;
3134 /* Retrieve the ancestor and use it, for faster retrieval of properties */
3136 if (!NILP(extent_begin_glyph(anc)))
3138 *bp++ = (extent_start_open_p(anc) ? '(' : '[');
3139 if (extent_detached_p(ext))
3140 strncpy(bp, "detached", sizeof(buf)-1);
3142 sz=snprintf(bp, sizeof(buf)-2, "%ld, %ld",
3143 XINT(Fextent_start_position(obj)),
3144 XINT(Fextent_end_position(obj)));
3145 assert(sz>=0 && (size_t)sz<(sizeof(buf)-2));
3148 *bp++ = (extent_end_open_p(anc) ? ')' : ']');
3149 if (!NILP(extent_end_glyph(anc)))
3153 if (!NILP(extent_read_only(anc)))
3155 if (!NILP(extent_mouse_face(anc)))
3157 if (extent_unique_p(anc))
3159 else if (extent_duplicable_p(anc))
3161 if (!NILP(extent_invisible(anc)))
3164 if (!NILP(extent_read_only(anc)) || !NILP(extent_mouse_face(anc)) ||
3165 extent_unique_p(anc) ||
3166 extent_duplicable_p(anc) || !NILP(extent_invisible(anc)))
3169 write_c_string(buf, printcharfun);
3171 tail = extent_plist_slot(anc);
3173 for (; !NILP(tail); tail = Fcdr(Fcdr(tail))) {
3174 Lisp_Object v = XCAR(XCDR(tail));
3177 print_internal(XCAR(tail), printcharfun, escapeflag);
3178 write_c_string(" ", printcharfun);
3181 write_fmt_str(printcharfun, "0x%lx", (long)ext);
3185 print_extent(Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
3188 const char *title = "";
3189 const char *name = "";
3190 const char *posttitle = "";
3191 Lisp_Object obj2 = Qnil;
3193 /* Destroyed extents have 't' in the object field, causing
3194 extent_object() to abort (maybe). */
3195 if (EXTENT_LIVE_P(XEXTENT(obj)))
3196 obj2 = extent_object(XEXTENT(obj));
3199 title = "no buffer";
3200 else if (BUFFERP(obj2)) {
3201 if (BUFFER_LIVE_P(XBUFFER(obj2))) {
3204 (char *)XSTRING_DATA(XBUFFER(obj2)->name);
3206 title = "Killed Buffer";
3210 assert(STRINGP(obj2));
3211 title = "string \"";
3213 name = (char *)XSTRING_DATA(obj2);
3216 if (print_readably) {
3217 if (!EXTENT_LIVE_P(XEXTENT(obj))) {
3218 error("printing unreadable object "
3219 "#<destroyed extent>");
3221 error("printing unreadable object "
3222 "#<extent %p>", XEXTENT(obj));
3226 if (!EXTENT_LIVE_P(XEXTENT(obj))) {
3227 write_c_string("#<destroyed extent", printcharfun);
3229 write_c_string("#<extent ", printcharfun);
3230 print_extent_1(obj, printcharfun, escapeflag);
3231 write_c_string(extent_detached_p(XEXTENT(obj))
3232 ? " from " : " in ", printcharfun);
3233 write_fmt_string(printcharfun, "%s%s%s", title, name, posttitle);
3237 error("printing unreadable object #<extent>");
3238 write_c_string("#<extent", printcharfun);
3240 write_c_string(">", printcharfun);
3243 static int properties_equal(EXTENT e1, EXTENT e2, int depth)
3245 /* When this function is called, all indirections have been followed.
3246 Thus, the indirection checks in the various macros below will not
3247 amount to anything, and could be removed. However, the time
3248 savings would probably not be significant. */
3249 if (!(EQ(extent_face(e1), extent_face(e2)) &&
3250 extent_priority(e1) == extent_priority(e2) &&
3251 internal_equal(extent_begin_glyph(e1), extent_begin_glyph(e2),
3253 internal_equal(extent_end_glyph(e1), extent_end_glyph(e2),
3257 /* compare the bit flags. */
3259 /* The has_aux field should not be relevant. */
3260 int e1_has_aux = e1->flags.has_aux;
3261 int e2_has_aux = e2->flags.has_aux;
3264 e1->flags.has_aux = e2->flags.has_aux = 0;
3265 value = memcmp(&e1->flags, &e2->flags, sizeof(e1->flags));
3266 e1->flags.has_aux = e1_has_aux;
3267 e2->flags.has_aux = e2_has_aux;
3272 /* compare the random elements of the plists. */
3273 return !plists_differ(extent_no_chase_plist(e1),
3274 extent_no_chase_plist(e2), 0, 0, depth + 1);
3277 static int extent_equal(Lisp_Object obj1, Lisp_Object obj2, int depth)
3279 struct extent *e1 = XEXTENT(obj1);
3280 struct extent *e2 = XEXTENT(obj2);
3282 (extent_start(e1) == extent_start(e2) &&
3283 extent_end(e1) == extent_end(e2) &&
3284 internal_equal(extent_object(e1), extent_object(e2), depth + 1) &&
3285 properties_equal(extent_ancestor(e1), extent_ancestor(e2), depth));
3288 static unsigned long extent_hash(Lisp_Object obj, int depth)
3290 struct extent *e = XEXTENT(obj);
3291 /* No need to hash all of the elements; that would take too long.
3292 Just hash the most common ones. */
3293 return HASH3(extent_start(e), extent_end(e),
3294 internal_hash(extent_object(e), depth + 1));
3297 static const struct lrecord_description extent_description[] = {
3298 {XD_LISP_OBJECT, offsetof(struct extent, object)},
3299 {XD_LISP_OBJECT, offsetof(struct extent, flags.face)},
3300 {XD_LISP_OBJECT, offsetof(struct extent, plist)},
3304 static Lisp_Object extent_getprop(Lisp_Object obj, Lisp_Object prop)
3306 return Fextent_property(obj, prop, Qunbound);
3309 static int extent_putprop(Lisp_Object obj, Lisp_Object prop, Lisp_Object value)
3311 Fset_extent_property(obj, prop, value);
3315 static int extent_remprop(Lisp_Object obj, Lisp_Object prop)
3317 EXTENT ext = XEXTENT(obj);
3319 /* This list is taken from Fset_extent_property, and should be kept
3321 if (EQ(prop, Qread_only)
3322 || EQ(prop, Qunique)
3323 || EQ(prop, Qduplicable)
3324 || EQ(prop, Qinvisible)
3325 || EQ(prop, Qdetachable)
3326 || EQ(prop, Qdetached)
3327 || EQ(prop, Qdestroyed)
3328 || EQ(prop, Qpriority)
3330 || EQ(prop, Qinitial_redisplay_function)
3331 || EQ(prop, Qafter_change_functions)
3332 || EQ(prop, Qbefore_change_functions)
3333 || EQ(prop, Qmouse_face)
3334 || EQ(prop, Qhighlight)
3335 || EQ(prop, Qbegin_glyph_layout)
3336 || EQ(prop, Qend_glyph_layout)
3337 || EQ(prop, Qglyph_layout)
3338 || EQ(prop, Qbegin_glyph)
3339 || EQ(prop, Qend_glyph)
3340 || EQ(prop, Qstart_open)
3341 || EQ(prop, Qend_open)
3342 || EQ(prop, Qstart_closed)
3343 || EQ(prop, Qend_closed)
3344 || EQ(prop, Qkeymap)) {
3345 /* #### Is this correct, anyway? */
3349 return external_remprop(extent_plist_addr(ext), prop, 0, ERROR_ME);
3352 static Lisp_Object extent_plist(Lisp_Object obj)
3354 return Fextent_properties(obj);
3357 DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS("extent", extent,
3358 mark_extent, print_extent,
3359 /* NOTE: If you declare a
3360 finalization method here,
3361 it will NOT be called.
3364 extent_equal, extent_hash,
3366 extent_getprop, extent_putprop,
3367 extent_remprop, extent_plist,
3370 /************************************************************************/
3371 /* basic extent accessors */
3372 /************************************************************************/
3374 /* These functions are for checking externally-passed extent objects
3375 and returning an extent's basic properties, which include the
3376 buffer the extent is associated with, the endpoints of the extent's
3377 range, the open/closed-ness of those endpoints, and whether the
3378 extent is detached. Manipulating these properties requires
3379 manipulating the ordered lists that hold extents; thus, functions
3380 to do that are in a later section. */
3382 /* Given a Lisp_Object that is supposed to be an extent, make sure it
3383 is OK and return an extent pointer. Extents can be in one of four
3387 2) detached and not associated with a buffer
3388 3) detached and associated with a buffer
3389 4) attached to a buffer
3391 If FLAGS is 0, types 2-4 are allowed. If FLAGS is DE_MUST_HAVE_BUFFER,
3392 types 3-4 are allowed. If FLAGS is DE_MUST_BE_ATTACHED, only type 4
3396 static EXTENT decode_extent(Lisp_Object extent_obj, unsigned int flags)
3401 CHECK_LIVE_EXTENT(extent_obj);
3402 extent = XEXTENT(extent_obj);
3403 obj = extent_object(extent);
3405 /* the following condition will fail if we're dealing with a freed extent */
3406 assert(NILP(obj) || BUFFERP(obj) || STRINGP(obj));
3408 if (flags & DE_MUST_BE_ATTACHED)
3409 flags |= DE_MUST_HAVE_BUFFER;
3411 /* if buffer is dead, then convert extent to have no buffer. */
3412 if (BUFFERP(obj) && !BUFFER_LIVE_P(XBUFFER(obj)))
3413 obj = extent_object(extent) = Qnil;
3415 assert(!NILP(obj) || extent_detached_p(extent));
3417 if ((NILP(obj) && (flags & DE_MUST_HAVE_BUFFER))
3418 || (extent_detached_p(extent) && (flags & DE_MUST_BE_ATTACHED))) {
3419 invalid_argument("extent doesn't belong to a buffer or string",
3426 /* Note that the returned value is a buffer position, not a byte index. */
3428 static Lisp_Object extent_endpoint_external(Lisp_Object extent_obj, int endp)
3430 EXTENT extent = decode_extent(extent_obj, 0);
3432 if (extent_detached_p(extent))
3435 return make_int(extent_endpoint_bufpos(extent, endp));
3438 DEFUN("extentp", Fextentp, 1, 1, 0, /*
3439 Return t if OBJECT is an extent.
3443 return EXTENTP(object) ? Qt : Qnil;
3446 DEFUN("extent-live-p", Fextent_live_p, 1, 1, 0, /*
3447 Return t if OBJECT is an extent that has not been destroyed.
3451 return EXTENTP(object) && EXTENT_LIVE_P(XEXTENT(object)) ? Qt : Qnil;
3454 DEFUN("extent-detached-p", Fextent_detached_p, 1, 1, 0, /*
3455 Return t if EXTENT is detached.
3459 return extent_detached_p(decode_extent(extent, 0)) ? Qt : Qnil;
3462 DEFUN("extent-object", Fextent_object, 1, 1, 0, /*
3463 Return object (buffer or string) that EXTENT refers to.
3467 return extent_object(decode_extent(extent, 0));
3470 DEFUN("extent-start-position", Fextent_start_position, 1, 1, 0, /*
3471 Return start position of EXTENT, or nil if EXTENT is detached.
3475 return extent_endpoint_external(extent, 0);
3478 DEFUN("extent-end-position", Fextent_end_position, 1, 1, 0, /*
3479 Return end position of EXTENT, or nil if EXTENT is detached.
3483 return extent_endpoint_external(extent, 1);
3486 DEFUN("extent-length", Fextent_length, 1, 1, 0, /*
3487 Return length of EXTENT in characters.
3491 EXTENT e = decode_extent(extent, DE_MUST_BE_ATTACHED);
3492 return make_int(extent_endpoint_bufpos(e, 1)
3493 - extent_endpoint_bufpos(e, 0));
3496 DEFUN("next-extent", Fnext_extent, 1, 1, 0, /*
3497 Find next extent after EXTENT.
3498 If EXTENT is a buffer return the first extent in the buffer; likewise
3500 Extents in a buffer are ordered in what is called the "display"
3501 order, which sorts by increasing start positions and then by *decreasing*
3503 If you want to perform an operation on a series of extents, use
3504 `map-extents' instead of this function; it is much more efficient.
3505 The primary use of this function should be to enumerate all the
3506 extents in a buffer.
3507 Note: The display order is not necessarily the order that `map-extents'
3508 processes extents in!
3515 if (EXTENTP(extent))
3516 next = extent_next(decode_extent(extent, DE_MUST_BE_ATTACHED));
3518 next = extent_first(decode_buffer_or_string(extent));
3522 XSETEXTENT(val, next);
3526 DEFUN("previous-extent", Fprevious_extent, 1, 1, 0, /*
3527 Find last extent before EXTENT.
3528 If EXTENT is a buffer return the last extent in the buffer; likewise
3530 This function is analogous to `next-extent'.
3537 if (EXTENTP(extent))
3539 extent_previous(decode_extent(extent, DE_MUST_BE_ATTACHED));
3541 prev = extent_last(decode_buffer_or_string(extent));
3545 XSETEXTENT(val, prev);
3549 #ifdef DEBUG_SXEMACS
3551 DEFUN("next-e-extent", Fnext_e_extent, 1, 1, 0, /*
3552 Find next extent after EXTENT using the "e" order.
3553 If EXTENT is a buffer return the first extent in the buffer; likewise
3561 if (EXTENTP(extent))
3563 extent_e_next(decode_extent(extent, DE_MUST_BE_ATTACHED));
3565 next = extent_e_first(decode_buffer_or_string(extent));
3569 XSETEXTENT(val, next);
3573 DEFUN("previous-e-extent", Fprevious_e_extent, 1, 1, 0, /*
3574 Find last extent before EXTENT using the "e" order.
3575 If EXTENT is a buffer return the last extent in the buffer; likewise
3577 This function is analogous to `next-e-extent'.
3584 if (EXTENTP(extent))
3586 extent_e_previous(decode_extent
3587 (extent, DE_MUST_BE_ATTACHED));
3589 prev = extent_e_last(decode_buffer_or_string(extent));
3593 XSETEXTENT(val, prev);
3599 DEFUN("next-extent-change", Fnext_extent_change, 1, 2, 0, /*
3600 Return the next position after POS where an extent begins or ends.
3601 If POS is at the end of the buffer or string, POS will be returned;
3602 otherwise a position greater than POS will always be returned.
3603 If OBJECT is nil, the current buffer is assumed.
3607 Lisp_Object obj = decode_buffer_or_string(object);
3611 get_buffer_or_string_pos_byte(obj, pos, GB_ALLOW_PAST_ACCESSIBLE);
3612 bpos = extent_find_end_of_run(obj, bpos, 1);
3613 return make_int(buffer_or_string_bytind_to_bufpos(obj, bpos));
3616 DEFUN("previous-extent-change", Fprevious_extent_change, 1, 2, 0, /*
3617 Return the last position before POS where an extent begins or ends.
3618 If POS is at the beginning of the buffer or string, POS will be returned;
3619 otherwise a position less than POS will always be returned.
3620 If OBJECT is nil, the current buffer is assumed.
3624 Lisp_Object obj = decode_buffer_or_string(object);
3628 get_buffer_or_string_pos_byte(obj, pos, GB_ALLOW_PAST_ACCESSIBLE);
3629 bpos = extent_find_beginning_of_run(obj, bpos, 1);
3630 return make_int(buffer_or_string_bytind_to_bufpos(obj, bpos));
3633 /************************************************************************/
3634 /* parent and children stuff */
3635 /************************************************************************/
3637 DEFUN("extent-parent", Fextent_parent, 1, 1, 0, /*
3638 Return the parent (if any) of EXTENT.
3639 If an extent has a parent, it derives all its properties from that extent
3640 and has no properties of its own. (The only "properties" that the
3641 extent keeps are the buffer/string it refers to and the start and end
3642 points.) It is possible for an extent's parent to itself have a parent.
3645 /* do I win the prize for the strangest split infinitive? */
3647 EXTENT e = decode_extent(extent, 0);
3648 return extent_parent(e);
3651 DEFUN("extent-children", Fextent_children, 1, 1, 0, /*
3652 Return a list of the children (if any) of EXTENT.
3653 The children of an extent are all those extents whose parent is that extent.
3654 This function does not recursively trace children of children.
3655 \(To do that, use `extent-descendants'.)
3659 EXTENT e = decode_extent(extent, 0);
3660 Lisp_Object children = extent_children(e);
3662 if (!NILP(children))
3663 return Fcopy_sequence(XWEAK_LIST_LIST(children));
3668 static void remove_extent_from_children_list(EXTENT e, Lisp_Object child)
3670 Lisp_Object children = extent_children(e);
3672 #ifdef ERROR_CHECK_EXTENTS
3673 assert(!NILP(memq_no_quit(child, XWEAK_LIST_LIST(children))));
3675 XWEAK_LIST_LIST(children) =
3676 delq_no_quit(child, XWEAK_LIST_LIST(children));
3679 static void add_extent_to_children_list(EXTENT e, Lisp_Object child)
3681 Lisp_Object children = extent_children(e);
3683 if (NILP(children)) {
3684 children = make_weak_list(WEAK_LIST_SIMPLE);
3685 set_extent_no_chase_aux_field(e, children, children);
3687 #ifdef ERROR_CHECK_EXTENTS
3688 assert(NILP(memq_no_quit(child, XWEAK_LIST_LIST(children))));
3690 XWEAK_LIST_LIST(children) = Fcons(child, XWEAK_LIST_LIST(children));
3693 DEFUN("set-extent-parent", Fset_extent_parent, 2, 2, 0, /*
3694 Set the parent of EXTENT to PARENT (may be nil).
3695 See `extent-parent'.
3699 EXTENT e = decode_extent(extent, 0);
3700 Lisp_Object cur_parent = extent_parent(e);
3703 XSETEXTENT(extent, e);
3705 CHECK_LIVE_EXTENT(parent);
3706 if (EQ(parent, cur_parent))
3708 for (rest = parent; !NILP(rest); rest = extent_parent(XEXTENT(rest)))
3709 if (EQ(rest, extent))
3710 signal_type_error(Qinvalid_change,
3711 "Circular parent chain would result",
3714 remove_extent_from_children_list(XEXTENT(cur_parent), extent);
3715 set_extent_no_chase_aux_field(e, parent, Qnil);
3716 e->flags.has_parent = 0;
3718 add_extent_to_children_list(XEXTENT(parent), extent);
3719 set_extent_no_chase_aux_field(e, parent, parent);
3720 e->flags.has_parent = 1;
3722 /* changing the parent also changes the properties of all children. */
3724 int old_invis = (!NILP(cur_parent) &&
3725 !NILP(extent_invisible(XEXTENT(cur_parent))));
3726 int new_invis = (!NILP(parent) &&
3727 !NILP(extent_invisible(XEXTENT(parent))));
3729 extent_maybe_changed_for_redisplay(e, 1,
3730 new_invis != old_invis);
3736 /************************************************************************/
3737 /* basic extent mutators */
3738 /************************************************************************/
3740 /* Note: If you track non-duplicable extents by undo, you'll get bogus
3741 undo records for transient extents via update-extent.
3742 For example, query-replace will do this.
3745 static void set_extent_endpoints_1(EXTENT extent, Memind start, Memind end)
3747 #ifdef ERROR_CHECK_EXTENTS
3748 Lisp_Object obj = extent_object(extent);
3750 assert(start <= end);
3752 assert(valid_memind_p(XBUFFER(obj), start));
3753 assert(valid_memind_p(XBUFFER(obj), end));
3757 /* Optimization: if the extent is already where we want it to be,
3759 if (!extent_detached_p(extent) && extent_start(extent) == start &&
3760 extent_end(extent) == end)
3763 if (extent_detached_p(extent)) {
3764 if (extent_duplicable_p(extent)) {
3765 Lisp_Object extent_obj;
3766 XSETEXTENT(extent_obj, extent);
3767 record_extent(extent_obj, 1);
3770 extent_detach(extent);
3772 set_extent_start(extent, start);
3773 set_extent_end(extent, end);
3774 extent_attach(extent);
3777 /* Set extent's endpoints to S and E, and put extent in buffer or string
3778 OBJECT. (If OBJECT is nil, do not change the extent's object.) */
3780 void set_extent_endpoints(EXTENT extent, Bytind s, Bytind e, Lisp_Object object)
3785 object = extent_object(extent);
3786 assert(!NILP(object));
3787 } else if (!EQ(object, extent_object(extent))) {
3788 extent_detach(extent);
3789 extent_object(extent) = object;
3792 start = s < 0 ? extent_start(extent) :
3793 buffer_or_string_bytind_to_memind(object, s);
3794 end = e < 0 ? extent_end(extent) :
3795 buffer_or_string_bytind_to_memind(object, e);
3796 set_extent_endpoints_1(extent, start, end);
3799 static void set_extent_openness(EXTENT extent, int start_open, int end_open)
3801 if (start_open != -1)
3802 extent_start_open_p(extent) = start_open;
3804 extent_end_open_p(extent) = end_open;
3805 /* changing the open/closedness of an extent does not affect
3809 static EXTENT make_extent_internal(Lisp_Object object, Bytind from, Bytind to)
3813 extent = make_extent_detached(object);
3814 set_extent_endpoints(extent, from, to, Qnil);
3819 copy_extent(EXTENT original, Bytind from, Bytind to, Lisp_Object object)
3823 e = make_extent_detached(object);
3825 set_extent_endpoints(e, from, to, Qnil);
3827 e->plist = Fcopy_sequence(original->plist);
3828 memcpy(&e->flags, &original->flags, sizeof(e->flags));
3829 if (e->flags.has_aux) {
3830 /* also need to copy the aux struct. It won't work for
3831 this extent to share the same aux struct as the original
3833 struct extent_auxiliary *data =
3834 alloc_lcrecord_type(struct extent_auxiliary,
3835 &lrecord_extent_auxiliary);
3837 copy_lcrecord(data, XEXTENT_AUXILIARY(XCAR(original->plist)));
3838 XSETEXTENT_AUXILIARY(XCAR(e->plist), data);
3842 /* we may have just added another child to the parent extent. */
3843 Lisp_Object parent = extent_parent(e);
3844 if (!NILP(parent)) {
3846 XSETEXTENT(extent, e);
3847 add_extent_to_children_list(XEXTENT(parent), extent);
3854 static void destroy_extent(EXTENT extent)
3856 Lisp_Object rest, nextrest, children;
3857 Lisp_Object extent_obj;
3859 if (!extent_detached_p(extent))
3860 extent_detach(extent);
3861 /* disassociate the extent from its children and parent */
3862 children = extent_children(extent);
3863 if (!NILP(children)) {
3864 LIST_LOOP_DELETING(rest, nextrest, XWEAK_LIST_LIST(children))
3865 Fset_extent_parent(XCAR(rest), Qnil);
3867 XSETEXTENT(extent_obj, extent);
3868 Fset_extent_parent(extent_obj, Qnil);
3869 /* mark the extent as destroyed */
3870 extent_object(extent) = Qt;
3873 DEFUN("make-extent", Fmake_extent, 2, 3, 0, /*
3874 Make an extent for the range [FROM, TO) in BUFFER-OR-STRING.
3875 BUFFER-OR-STRING defaults to the current buffer. Insertions at point
3876 TO will be outside of the extent; insertions at FROM will be inside the
3877 extent, causing the extent to grow. (This is the same way that markers
3878 behave.) You can change the behavior of insertions at the endpoints
3879 using `set-extent-property'. The extent is initially detached if both
3880 FROM and TO are nil, and in this case BUFFER-OR-STRING defaults to nil,
3881 meaning the extent is in no buffer and no string.
3883 (from, to, buffer_or_string))
3885 Lisp_Object extent_obj;
3888 obj = decode_buffer_or_string(buffer_or_string);
3889 if (NILP(from) && NILP(to)) {
3890 if (NILP(buffer_or_string))
3892 XSETEXTENT(extent_obj, make_extent_detached(obj));
3896 get_buffer_or_string_range_byte(obj, from, to, &start, &end,
3897 GB_ALLOW_PAST_ACCESSIBLE);
3898 XSETEXTENT(extent_obj, make_extent_internal(obj, start, end));
3903 DEFUN("copy-extent", Fcopy_extent, 1, 2, 0, /*
3904 Make a copy of EXTENT. It is initially detached.
3905 Optional argument BUFFER-OR-STRING defaults to EXTENT's buffer or string.
3907 (extent, buffer_or_string))
3909 EXTENT ext = decode_extent(extent, 0);
3911 if (NILP(buffer_or_string))
3912 buffer_or_string = extent_object(ext);
3914 buffer_or_string = decode_buffer_or_string(buffer_or_string);
3916 XSETEXTENT(extent, copy_extent(ext, -1, -1, buffer_or_string));
3920 DEFUN("delete-extent", Fdelete_extent, 1, 1, 0, /*
3921 Remove EXTENT from its buffer and destroy it.
3922 This does not modify the buffer's text, only its display properties.
3923 The extent cannot be used thereafter.
3929 /* We do not call decode_extent() here because already-destroyed
3931 CHECK_EXTENT(extent);
3932 ext = XEXTENT(extent);
3934 if (!EXTENT_LIVE_P(ext))
3936 destroy_extent(ext);
3940 DEFUN("detach-extent", Fdetach_extent, 1, 1, 0, /*
3941 Remove EXTENT from its buffer in such a way that it can be re-inserted.
3942 An extent is also detached when all of its characters are all killed by a
3943 deletion, unless its `detachable' property has been unset.
3945 Extents which have the `duplicable' attribute are tracked by the undo
3946 mechanism. Detachment via `detach-extent' and string deletion is recorded,
3947 as is attachment via `insert-extent' and string insertion. Extent motion,
3948 face changes, and attachment via `make-extent' and `set-extent-endpoints'
3949 are not recorded. This means that extent changes which are to be undo-able
3950 must be performed by character editing, or by insertion and detachment of
3955 EXTENT ext = decode_extent(extent, 0);
3957 if (extent_detached_p(ext))
3959 if (extent_duplicable_p(ext))
3960 record_extent(extent, 0);
3966 DEFUN("set-extent-endpoints", Fset_extent_endpoints, 3, 4, 0, /*
3967 Set the endpoints of EXTENT to START, END.
3968 If START and END are null, call detach-extent on EXTENT.
3969 BUFFER-OR-STRING specifies the new buffer or string that the extent should
3970 be in, and defaults to EXTENT's buffer or string. (If nil, and EXTENT
3971 is in no buffer and no string, it defaults to the current buffer.)
3972 See documentation on `detach-extent' for a discussion of undo recording.
3974 (extent, start, end, buffer_or_string))
3979 ext = decode_extent(extent, 0);
3981 if (NILP(buffer_or_string)) {
3982 buffer_or_string = extent_object(ext);
3983 if (NILP(buffer_or_string))
3984 buffer_or_string = Fcurrent_buffer();
3986 buffer_or_string = decode_buffer_or_string(buffer_or_string);
3988 if (NILP(start) && NILP(end))
3989 return Fdetach_extent(extent);
3991 get_buffer_or_string_range_byte(buffer_or_string, start, end, &s, &e,
3992 GB_ALLOW_PAST_ACCESSIBLE);
3994 buffer_or_string_extent_info_force(buffer_or_string);
3995 set_extent_endpoints(ext, s, e, buffer_or_string);
3999 /************************************************************************/
4000 /* mapping over extents */
4001 /************************************************************************/
4003 static unsigned int decode_map_extents_flags(Lisp_Object flags)
4005 unsigned int retval = 0;
4006 unsigned int all_extents_specified = 0;
4007 unsigned int in_region_specified = 0;
4009 if (EQ(flags, Qt)) /* obsoleteness compatibility */
4010 return ME_END_CLOSED;
4014 flags = Fcons(flags, Qnil);
4015 while (!NILP(flags)) {
4020 if (EQ(sym, Qall_extents_closed) || EQ(sym, Qall_extents_open)
4021 || EQ(sym, Qall_extents_closed_open)
4022 || EQ(sym, Qall_extents_open_closed)) {
4023 if (all_extents_specified)
4025 ("Only one `all-extents-*' flag may be specified");
4026 all_extents_specified = 1;
4028 if (EQ(sym, Qstart_in_region) || EQ(sym, Qend_in_region) ||
4029 EQ(sym, Qstart_and_end_in_region) ||
4030 EQ(sym, Qstart_or_end_in_region)) {
4031 if (in_region_specified)
4033 ("Only one `*-in-region' flag may be specified");
4034 in_region_specified = 1;
4037 /* I do so love that conditional operator ... */
4039 EQ(sym, Qend_closed) ? ME_END_CLOSED :
4040 EQ(sym, Qstart_open) ? ME_START_OPEN :
4041 EQ(sym, Qall_extents_closed) ? ME_ALL_EXTENTS_CLOSED :
4042 EQ(sym, Qall_extents_open) ? ME_ALL_EXTENTS_OPEN :
4044 Qall_extents_closed_open) ? ME_ALL_EXTENTS_CLOSED_OPEN :
4046 Qall_extents_open_closed) ? ME_ALL_EXTENTS_OPEN_CLOSED :
4047 EQ(sym, Qstart_in_region) ? ME_START_IN_REGION : EQ(sym,
4049 ? ME_END_IN_REGION : EQ(sym,
4050 Qstart_and_end_in_region) ?
4051 ME_START_AND_END_IN_REGION : EQ(sym,
4052 Qstart_or_end_in_region) ?
4053 ME_START_OR_END_IN_REGION : EQ(sym,
4054 Qnegate_in_region) ?
4056 : (invalid_argument("Invalid `map-extents' flag", sym), 0);
4058 flags = XCDR(flags);
4063 DEFUN("extent-in-region-p", Fextent_in_region_p, 1, 4, 0, /*
4064 Return whether EXTENT overlaps a specified region.
4065 This is equivalent to whether `map-extents' would visit EXTENT when called
4068 (extent, from, to, flags))
4071 EXTENT ext = decode_extent(extent, DE_MUST_BE_ATTACHED);
4072 Lisp_Object obj = extent_object(ext);
4074 get_buffer_or_string_range_byte(obj, from, to, &start, &end,
4076 GB_ALLOW_PAST_ACCESSIBLE);
4078 return extent_in_region_p(ext, start, end,
4079 decode_map_extents_flags(flags)) ? Qt : Qnil;
4082 struct slow_map_extents_arg {
4083 Lisp_Object map_arg;
4084 Lisp_Object map_routine;
4086 Lisp_Object property;
4090 static int slow_map_extents_function(EXTENT extent, void *arg)
4092 /* This function can GC */
4093 struct slow_map_extents_arg *closure =
4094 (struct slow_map_extents_arg *)arg;
4095 Lisp_Object extent_obj;
4097 XSETEXTENT(extent_obj, extent);
4099 /* make sure this extent qualifies according to the PROPERTY
4102 if (!NILP(closure->property)) {
4104 Fextent_property(extent_obj, closure->property,
4106 if ((NILP(closure->value) && NILP(value)) ||
4107 (!NILP(closure->value) && !EQ(value, closure->value)))
4111 closure->result = call2(closure->map_routine, extent_obj,
4113 return !NILP(closure->result);
4116 DEFUN("map-extents", Fmap_extents, 1, 8, 0, /*
4117 Map FUNCTION over the extents which overlap a region in OBJECT.
4118 OBJECT is normally a buffer or string but could be an extent (see below).
4119 The region is normally bounded by [FROM, TO) (i.e. the beginning of the
4120 region is closed and the end of the region is open), but this can be
4121 changed with the FLAGS argument (see below for a complete discussion).
4123 FUNCTION is called with the arguments (extent, MAPARG). The arguments
4124 OBJECT, FROM, TO, MAPARG, and FLAGS are all optional and default to
4125 the current buffer, the beginning of OBJECT, the end of OBJECT, nil,
4126 and nil, respectively. `map-extents' returns the first non-nil result
4127 produced by FUNCTION, and no more calls to FUNCTION are made after it
4130 If OBJECT is an extent, FROM and TO default to the extent's endpoints,
4131 and the mapping omits that extent and its predecessors. This feature
4132 supports restarting a loop based on `map-extents'. Note: OBJECT must
4133 be attached to a buffer or string, and the mapping is done over that
4136 An extent overlaps the region if there is any point in the extent that is
4137 also in the region. (For the purpose of overlap, zero-length extents and
4138 regions are treated as closed on both ends regardless of their endpoints'
4139 specified open/closedness.) Note that the endpoints of an extent or region
4140 are considered to be in that extent or region if and only if the
4141 corresponding end is closed. For example, the extent [5,7] overlaps the
4142 region [2,5] because 5 is in both the extent and the region. However, (5,7]
4143 does not overlap [2,5] because 5 is not in the extent, and neither [5,7] nor
4144 \(5,7] overlaps the region [2,5) because 5 is not in the region.
4146 The optional FLAGS can be a symbol or a list of one or more symbols,
4147 modifying the behavior of `map-extents'. Allowed symbols are:
4149 end-closed The region's end is closed.
4151 start-open The region's start is open.
4153 all-extents-closed Treat all extents as closed on both ends for the
4154 purpose of determining whether they overlap the
4155 region, irrespective of their actual open- or
4157 all-extents-open Treat all extents as open on both ends.
4158 all-extents-closed-open Treat all extents as start-closed, end-open.
4159 all-extents-open-closed Treat all extents as start-open, end-closed.
4161 start-in-region In addition to the above conditions for extent
4162 overlap, the extent's start position must lie within
4163 the specified region. Note that, for this
4164 condition, open start positions are treated as if
4165 0.5 was added to the endpoint's value, and open
4166 end positions are treated as if 0.5 was subtracted
4167 from the endpoint's value.
4168 end-in-region The extent's end position must lie within the
4170 start-and-end-in-region Both the extent's start and end positions must lie
4172 start-or-end-in-region Either the extent's start or end position must lie
4175 negate-in-region The condition specified by a `*-in-region' flag
4176 must NOT hold for the extent to be considered.
4178 At most one of `all-extents-closed', `all-extents-open',
4179 `all-extents-closed-open', and `all-extents-open-closed' may be specified.
4181 At most one of `start-in-region', `end-in-region',
4182 `start-and-end-in-region', and `start-or-end-in-region' may be specified.
4184 If optional arg PROPERTY is non-nil, only extents with that property set
4185 on them will be visited. If optional arg VALUE is non-nil, only extents
4186 whose value for that property is `eq' to VALUE will be visited.
4188 (function, object, from, to, maparg, flags, property, value))
4190 /* This function can GC */
4191 struct slow_map_extents_arg closure;
4192 unsigned int me_flags;
4194 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
4197 if (EXTENTP(object)) {
4198 after = decode_extent(object, DE_MUST_BE_ATTACHED);
4200 from = Fextent_start_position(object);
4202 to = Fextent_end_position(object);
4203 object = extent_object(after);
4205 object = decode_buffer_or_string(object);
4207 get_buffer_or_string_range_byte(object, from, to, &start, &end,
4209 GB_ALLOW_PAST_ACCESSIBLE);
4211 me_flags = decode_map_extents_flags(flags);
4213 if (!NILP(property)) {
4215 value = canonicalize_extent_property(property, value);
4218 GCPRO5(function, maparg, object, property, value);
4220 closure.map_arg = maparg;
4221 closure.map_routine = function;
4222 closure.result = Qnil;
4223 closure.property = property;
4224 closure.value = value;
4226 map_extents_bytind(start, end, slow_map_extents_function,
4227 (void *)&closure, object, after,
4228 /* You never know what the user might do ... */
4229 me_flags | ME_MIGHT_CALL_ELISP);
4232 return closure.result;
4235 /************************************************************************/
4236 /* mapping over extents -- other functions */
4237 /************************************************************************/
4239 /* ------------------------------- */
4240 /* map-extent-children */
4241 /* ------------------------------- */
4243 struct slow_map_extent_children_arg {
4244 Lisp_Object map_arg;
4245 Lisp_Object map_routine;
4247 Lisp_Object property;
4254 static int slow_map_extent_children_function(EXTENT extent, void *arg)
4256 /* This function can GC */
4257 struct slow_map_extent_children_arg *closure =
4258 (struct slow_map_extent_children_arg *)arg;
4259 Lisp_Object extent_obj;
4260 Bytind start = extent_endpoint_bytind(extent, 0);
4261 Bytind end = extent_endpoint_bytind(extent, 1);
4262 /* Make sure the extent starts inside the region of interest,
4263 rather than just overlaps it.
4265 if (start < closure->start_min)
4267 /* Make sure the extent is not a child of a previous visited one.
4268 We know already, because of extent ordering,
4269 that start >= prev_start, and that if
4270 start == prev_start, then end <= prev_end.
4272 if (start == closure->prev_start) {
4273 if (end < closure->prev_end)
4275 } else { /* start > prev_start */
4277 if (start < closure->prev_end)
4279 /* corner case: prev_end can be -1 if there is no prev */
4281 XSETEXTENT(extent_obj, extent);
4283 /* make sure this extent qualifies according to the PROPERTY
4286 if (!NILP(closure->property)) {
4288 Fextent_property(extent_obj, closure->property,
4290 if ((NILP(closure->value) && NILP(value)) ||
4291 (!NILP(closure->value) && !EQ(value, closure->value)))
4295 closure->result = call2(closure->map_routine, extent_obj,
4298 /* Since the callback may change the buffer, compute all stored
4299 buffer positions here.
4301 closure->start_min = -1; /* no need for this any more */
4302 closure->prev_start = extent_endpoint_bytind(extent, 0);
4303 closure->prev_end = extent_endpoint_bytind(extent, 1);
4305 return !NILP(closure->result);
4308 DEFUN("map-extent-children", Fmap_extent_children, 1, 8, 0, /*
4309 Map FUNCTION over the extents in the region from FROM to TO.
4310 FUNCTION is called with arguments (extent, MAPARG). See `map-extents'
4311 for a full discussion of the arguments FROM, TO, and FLAGS.
4313 The arguments are the same as for `map-extents', but this function differs
4314 in that it only visits extents which start in the given region, and also
4315 in that, after visiting an extent E, it skips all other extents which start
4316 inside E but end before E's end.
4318 Thus, this function may be used to walk a tree of extents in a buffer:
4319 (defun walk-extents (buffer &optional ignore)
4320 (map-extent-children 'walk-extents buffer))
4322 (function, object, from, to, maparg, flags, property, value))
4324 /* This function can GC */
4325 struct slow_map_extent_children_arg closure;
4326 unsigned int me_flags;
4328 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
4331 if (EXTENTP(object)) {
4332 after = decode_extent(object, DE_MUST_BE_ATTACHED);
4334 from = Fextent_start_position(object);
4336 to = Fextent_end_position(object);
4337 object = extent_object(after);
4339 object = decode_buffer_or_string(object);
4341 get_buffer_or_string_range_byte(object, from, to, &start, &end,
4343 GB_ALLOW_PAST_ACCESSIBLE);
4345 me_flags = decode_map_extents_flags(flags);
4347 if (!NILP(property)) {
4349 value = canonicalize_extent_property(property, value);
4352 GCPRO5(function, maparg, object, property, value);
4354 closure.map_arg = maparg;
4355 closure.map_routine = function;
4356 closure.result = Qnil;
4357 closure.property = property;
4358 closure.value = value;
4359 closure.start_min = start;
4360 closure.prev_start = -1;
4361 closure.prev_end = -1;
4362 map_extents_bytind(start, end, slow_map_extent_children_function,
4363 (void *)&closure, object, after,
4364 /* You never know what the user might do ... */
4365 me_flags | ME_MIGHT_CALL_ELISP);
4368 return closure.result;
4371 /* ------------------------------- */
4373 /* ------------------------------- */
4375 /* find "smallest" matching extent containing pos -- (flag == 0) means
4376 all extents match, else (EXTENT_FLAGS (extent) & flag) must be true;
4377 for more than one matching extent with precisely the same endpoints,
4378 we choose the last extent in the extents_list.
4379 The search stops just before "before", if that is non-null.
4382 struct extent_at_arg {
4383 Lisp_Object best_match; /* or list of extents */
4391 enum extent_at_flag {
4397 static enum extent_at_flag decode_extent_at_flag(Lisp_Object at_flag)
4400 return EXTENT_AT_AFTER;
4402 CHECK_SYMBOL(at_flag);
4403 if (EQ(at_flag, Qafter))
4404 return EXTENT_AT_AFTER;
4405 if (EQ(at_flag, Qbefore))
4406 return EXTENT_AT_BEFORE;
4407 if (EQ(at_flag, Qat))
4408 return EXTENT_AT_AT;
4410 invalid_argument("Invalid AT-FLAG in `extent-at'", at_flag);
4411 return EXTENT_AT_AFTER; /* unreached */
4414 static int extent_at_mapper(EXTENT e, void *arg)
4416 struct extent_at_arg *closure = (struct extent_at_arg *)arg;
4418 if (e == closure->before)
4421 /* If closure->prop is non-nil, then the extent is only acceptable
4422 if it has a non-nil value for that property. */
4423 if (!NILP(closure->prop)) {
4425 XSETEXTENT(extent, e);
4426 if (NILP(Fextent_property(extent, closure->prop, Qnil)))
4430 if (!closure->all_extents) {
4433 if (NILP(closure->best_match))
4435 current = XEXTENT(closure->best_match);
4436 /* redundant but quick test */
4437 if (extent_start(current) > extent_start(e))
4440 /* we return the "last" best fit, instead of the first --
4441 this is because then the glyph closest to two equivalent
4442 extents corresponds to the "extent-at" the text just past
4444 else if (!EXTENT_LESS_VALS(e, closure->best_start,
4450 XSETEXTENT(closure->best_match, e);
4451 closure->best_start = extent_start(e);
4452 closure->best_end = extent_end(e);
4456 XSETEXTENT(extent, e);
4457 closure->best_match = Fcons(extent, closure->best_match);
4464 extent_at_bytind(Bytind position, Lisp_Object object, Lisp_Object property,
4465 EXTENT before, enum extent_at_flag at_flag, int all_extents)
4467 struct extent_at_arg closure;
4468 struct gcpro gcpro1;
4470 /* it might be argued that invalid positions should cause
4471 errors, but the principle of least surprise dictates that
4472 nil should be returned (extent-at is often used in
4473 response to a mouse event, and in many cases previous events
4474 have changed the buffer contents).
4476 Also, the openness stuff in the text-property code currently
4477 does not check its limits and might go off the end. */
4478 if ((at_flag == EXTENT_AT_BEFORE
4479 ? position <= buffer_or_string_absolute_begin_byte(object)
4480 : position < buffer_or_string_absolute_begin_byte(object))
4481 || (at_flag == EXTENT_AT_AFTER
4482 ? position >= buffer_or_string_absolute_end_byte(object)
4483 : position > buffer_or_string_absolute_end_byte(object)))
4486 closure.best_match = Qnil;
4487 closure.prop = property;
4488 closure.before = before;
4489 closure.all_extents = all_extents;
4491 GCPRO1(closure.best_match);
4492 map_extents_bytind(at_flag ==
4493 EXTENT_AT_BEFORE ? position - 1 : position,
4494 at_flag == EXTENT_AT_AFTER ? position + 1 : position,
4495 extent_at_mapper, (void *)&closure, object, 0,
4496 ME_START_OPEN | ME_ALL_EXTENTS_CLOSED);
4498 closure.best_match = Fnreverse(closure.best_match);
4501 return closure.best_match;
4504 DEFUN("extent-at", Fextent_at, 1, 5, 0, /*
4505 Find "smallest" extent at POS in OBJECT having PROPERTY set.
4506 Normally, an extent is "at" POS if it overlaps the region (POS, POS+1);
4507 i.e. if it covers the character after POS. (However, see the definition
4508 of AT-FLAG.) "Smallest" means the extent that comes last in the display
4509 order; this normally means the extent whose start position is closest to
4510 POS. See `next-extent' for more information.
4511 OBJECT specifies a buffer or string and defaults to the current buffer.
4512 PROPERTY defaults to nil, meaning that any extent will do.
4513 Properties are attached to extents with `set-extent-property', which see.
4514 Returns nil if POS is invalid or there is no matching extent at POS.
4515 If the fourth argument BEFORE is not nil, it must be an extent; any returned
4516 extent will precede that extent. This feature allows `extent-at' to be
4517 used by a loop over extents.
4518 AT-FLAG controls how end cases are handled, and should be one of:
4520 nil or `after' An extent is at POS if it covers the character
4521 after POS. This is consistent with the way
4522 that text properties work.
4523 `before' An extent is at POS if it covers the character
4525 `at' An extent is at POS if it overlaps or abuts POS.
4526 This includes all zero-length extents at POS.
4528 Note that in all cases, the start-openness and end-openness of the extents
4529 considered is ignored. If you want to pay attention to those properties,
4530 you should use `map-extents', which gives you more control.
4532 (pos, object, property, before, at_flag))
4535 EXTENT before_extent;
4536 enum extent_at_flag fl;
4538 object = decode_buffer_or_string(object);
4540 get_buffer_or_string_pos_byte(object, pos, GB_NO_ERROR_IF_BAD);
4544 before_extent = decode_extent(before, DE_MUST_BE_ATTACHED);
4545 if (before_extent && !EQ(object, extent_object(before_extent)))
4546 invalid_argument("extent not in specified buffer or string",
4548 fl = decode_extent_at_flag(at_flag);
4550 return extent_at_bytind(position, object, property, before_extent, fl,
4554 DEFUN("extents-at", Fextents_at, 1, 5, 0, /*
4555 Find all extents at POS in OBJECT having PROPERTY set.
4556 Normally, an extent is "at" POS if it overlaps the region (POS, POS+1);
4557 i.e. if it covers the character after POS. (However, see the definition
4559 This provides similar functionality to `extent-list', but does so in a way
4560 that is compatible with `extent-at'. (For example, errors due to POS out of
4561 range are ignored; this makes it safer to use this function in response to
4562 a mouse event, because in many cases previous events have changed the buffer
4564 OBJECT specifies a buffer or string and defaults to the current buffer.
4565 PROPERTY defaults to nil, meaning that any extent will do.
4566 Properties are attached to extents with `set-extent-property', which see.
4567 Returns nil if POS is invalid or there is no matching extent at POS.
4568 If the fourth argument BEFORE is not nil, it must be an extent; any returned
4569 extent will precede that extent. This feature allows `extents-at' to be
4570 used by a loop over extents.
4571 AT-FLAG controls how end cases are handled, and should be one of:
4573 nil or `after' An extent is at POS if it covers the character
4574 after POS. This is consistent with the way
4575 that text properties work.
4576 `before' An extent is at POS if it covers the character
4578 `at' An extent is at POS if it overlaps or abuts POS.
4579 This includes all zero-length extents at POS.
4581 Note that in all cases, the start-openness and end-openness of the extents
4582 considered is ignored. If you want to pay attention to those properties,
4583 you should use `map-extents', which gives you more control.
4585 (pos, object, property, before, at_flag))
4588 EXTENT before_extent;
4589 enum extent_at_flag fl;
4591 object = decode_buffer_or_string(object);
4593 get_buffer_or_string_pos_byte(object, pos, GB_NO_ERROR_IF_BAD);
4597 before_extent = decode_extent(before, DE_MUST_BE_ATTACHED);
4598 if (before_extent && !EQ(object, extent_object(before_extent)))
4599 invalid_argument("extent not in specified buffer or string",
4601 fl = decode_extent_at_flag(at_flag);
4603 return extent_at_bytind(position, object, property, before_extent, fl,
4607 /* ------------------------------- */
4608 /* verify_extent_modification() */
4609 /* ------------------------------- */
4611 /* verify_extent_modification() is called when a buffer or string is
4612 modified to check whether the modification is occuring inside a
4616 struct verify_extents_arg {
4620 Lisp_Object iro; /* value of inhibit-read-only */
4623 static int verify_extent_mapper(EXTENT extent, void *arg)
4625 struct verify_extents_arg *closure = (struct verify_extents_arg *)arg;
4626 Lisp_Object prop = extent_read_only(extent);
4631 if (CONSP(closure->iro) && !NILP(Fmemq(prop, closure->iro)))
4634 #if 0 /* Nobody seems to care for this any more -sb */
4635 /* Allow deletion if the extent is completely contained in
4636 the region being deleted.
4637 This is important for supporting tokens which are internally
4638 write-protected, but which can be killed and yanked as a whole.
4639 Ignore open/closed distinctions at this point.
4642 if (closure->start != closure->end &&
4643 extent_start(extent) >= closure->start &&
4644 extent_end(extent) <= closure->end)
4649 Fsignal(Qbuffer_read_only, (list1(closure->object)));
4651 RETURN_NOT_REACHED(0)
4654 /* Value of Vinhibit_read_only is precomputed and passed in for
4658 verify_extent_modification(Lisp_Object object, Bytind from, Bytind to,
4659 Lisp_Object inhibit_read_only_value)
4662 struct verify_extents_arg closure;
4664 /* If insertion, visit closed-endpoint extents touching the insertion
4665 point because the text would go inside those extents. If deletion,
4666 treat the range as open on both ends so that touching extents are not
4667 visited. Note that we assume that an insertion is occurring if the
4668 changed range has zero length, and a deletion otherwise. This
4669 fails if a change (i.e. non-insertion, non-deletion) is happening.
4670 As far as I know, this doesn't currently occur in XEmacs. --ben */
4671 closed = (from == to);
4672 closure.object = object;
4673 closure.start = buffer_or_string_bytind_to_memind(object, from);
4674 closure.end = buffer_or_string_bytind_to_memind(object, to);
4675 closure.iro = inhibit_read_only_value;
4677 map_extents_bytind(from, to, verify_extent_mapper, (void *)&closure,
4678 object, 0, closed ? ME_END_CLOSED : ME_START_OPEN);
4681 /* ------------------------------------ */
4682 /* process_extents_for_insertion() */
4683 /* ------------------------------------ */
4685 struct process_extents_for_insertion_arg {
4691 /* A region of length LENGTH was just inserted at OPOINT. Modify all
4692 of the extents as required for the insertion, based on their
4693 start-open/end-open properties.
4696 static int process_extents_for_insertion_mapper(EXTENT extent, void *arg)
4698 struct process_extents_for_insertion_arg *closure =
4699 (struct process_extents_for_insertion_arg *)arg;
4700 Memind indice = buffer_or_string_bytind_to_memind(closure->object,
4703 /* When this function is called, one end of the newly-inserted text should
4704 be adjacent to some endpoint of the extent, or disjoint from it. If
4705 the insertion overlaps any existing extent, something is wrong.
4707 #ifdef ERROR_CHECK_EXTENTS
4708 if (extent_start(extent) > indice &&
4709 extent_start(extent) < indice + closure->length)
4711 if (extent_end(extent) > indice &&
4712 extent_end(extent) < indice + closure->length)
4716 /* The extent-adjustment code adjusted the extent's endpoints as if
4717 all extents were closed-open -- endpoints at the insertion point
4718 remain unchanged. We need to fix the other kinds of extents:
4720 1. Start position of start-open extents needs to be moved.
4722 2. End position of end-closed extents needs to be moved.
4724 Note that both conditions hold for zero-length (] extents at the
4725 insertion point. But under these rules, zero-length () extents
4726 would get adjusted such that their start is greater than their
4727 end; instead of allowing that, we treat them as [) extents by
4728 modifying condition #1 to not fire nothing when dealing with a
4729 zero-length open-open extent.
4731 Existence of zero-length open-open extents is unfortunately an
4732 inelegant part of the extent model, but there is no way around
4736 Memind new_start = extent_start(extent);
4737 Memind new_end = extent_end(extent);
4739 if (indice == extent_start(extent)
4740 && extent_start_open_p(extent)
4741 /* zero-length () extents are exempt; see comment above. */
4742 && !(new_start == new_end && extent_end_open_p(extent))
4744 new_start += closure->length;
4745 if (indice == extent_end(extent) && !extent_end_open_p(extent))
4746 new_end += closure->length;
4748 set_extent_endpoints_1(extent, new_start, new_end);
4755 process_extents_for_insertion(Lisp_Object object, Bytind opoint,
4758 struct process_extents_for_insertion_arg closure;
4760 closure.opoint = opoint;
4761 closure.length = length;
4762 closure.object = object;
4764 map_extents_bytind(opoint, opoint + length,
4765 process_extents_for_insertion_mapper,
4766 (void *)&closure, object, 0,
4767 ME_END_CLOSED | ME_MIGHT_MODIFY_EXTENTS |
4768 ME_INCLUDE_INTERNAL);
4771 /* ------------------------------------ */
4772 /* process_extents_for_deletion() */
4773 /* ------------------------------------ */
4775 struct process_extents_for_deletion_arg {
4777 int destroy_included_extents;
4780 /* This function is called when we're about to delete the range [from, to].
4781 Detach all of the extents that are completely inside the range [from, to],
4782 if they're detachable or open-open. */
4784 static int process_extents_for_deletion_mapper(EXTENT extent, void *arg)
4786 struct process_extents_for_deletion_arg *closure =
4787 (struct process_extents_for_deletion_arg *)arg;
4789 /* If the extent lies completely within the range that
4790 is being deleted, then nuke the extent if it's detachable
4791 (otherwise, it will become a zero-length extent). */
4793 if (closure->start <= extent_start(extent) &&
4794 extent_end(extent) <= closure->end) {
4795 if (extent_detachable_p(extent)) {
4796 if (closure->destroy_included_extents)
4797 destroy_extent(extent);
4799 extent_detach(extent);
4806 /* DESTROY_THEM means destroy the extents instead of just deleting them.
4807 It is unused currently, but perhaps might be used (there used to
4808 be a function process_extents_for_destruction(), #if 0'd out,
4809 that did the equivalent). */
4811 process_extents_for_deletion(Lisp_Object object, Bytind from,
4812 Bytind to, int destroy_them)
4814 struct process_extents_for_deletion_arg closure;
4816 closure.start = buffer_or_string_bytind_to_memind(object, from);
4817 closure.end = buffer_or_string_bytind_to_memind(object, to);
4818 closure.destroy_included_extents = destroy_them;
4820 map_extents_bytind(from, to, process_extents_for_deletion_mapper,
4821 (void *)&closure, object, 0,
4822 ME_END_CLOSED | ME_MIGHT_MODIFY_EXTENTS);
4825 /* ------------------------------- */
4826 /* report_extent_modification() */
4827 /* ------------------------------- */
4828 struct report_extent_modification_closure {
4835 static Lisp_Object report_extent_modification_restore(Lisp_Object buffer)
4837 if (current_buffer != XBUFFER(buffer))
4838 Fset_buffer(buffer);
4842 static int report_extent_modification_mapper(EXTENT extent, void *arg)
4844 struct report_extent_modification_closure *closure =
4845 (struct report_extent_modification_closure *)arg;
4846 Lisp_Object exobj, startobj, endobj;
4847 Lisp_Object hook = (closure->afterp
4848 ? extent_after_change_functions(extent)
4849 : extent_before_change_functions(extent));
4853 XSETEXTENT(exobj, extent);
4854 XSETINT(startobj, closure->start);
4855 XSETINT(endobj, closure->end);
4857 /* Now that we are sure to call elisp, set up an unwind-protect so
4858 inside_change_hook gets restored in case we throw. Also record
4859 the current buffer, in case we change it. Do the recording only
4862 One confusing thing here is that our caller never actually calls
4863 unbind_to (closure.speccount, Qnil). This is because
4864 map_extents_bytind() unbinds before, and with a smaller
4865 speccount. The additional unbind_to() in
4866 report_extent_modification() would cause XEmacs to abort. */
4867 if (closure->speccount == -1) {
4868 closure->speccount = specpdl_depth();
4869 record_unwind_protect(report_extent_modification_restore,
4873 /* The functions will expect closure->buffer to be the current
4874 buffer, so change it if it isn't. */
4875 if (current_buffer != XBUFFER(closure->buffer))
4876 Fset_buffer(closure->buffer);
4878 /* #### It's a shame that we can't use any of the existing run_hook*
4879 functions here. This is so because all of them work with
4880 symbols, to be able to retrieve default values of local hooks.
4883 #### Idea: we could set up a dummy symbol, and call the hook
4884 functions on *that*. */
4886 if (!CONSP(hook) || EQ(XCAR(hook), Qlambda))
4887 call3(hook, exobj, startobj, endobj);
4890 EXTERNAL_LIST_LOOP(tail, hook)
4891 /* #### Shouldn't this perform the same Fset_buffer() check as
4893 call3(XCAR(tail), exobj, startobj, endobj);
4899 report_extent_modification(Lisp_Object buffer, Bufpos start, Bufpos end,
4902 struct report_extent_modification_closure closure;
4904 closure.buffer = buffer;
4905 closure.start = start;
4907 closure.afterp = afterp;
4908 closure.speccount = -1;
4910 map_extents(start, end, report_extent_modification_mapper,
4911 (void *)&closure, buffer, NULL, ME_MIGHT_CALL_ELISP);
4914 /************************************************************************/
4915 /* extent properties */
4916 /************************************************************************/
4918 static void set_extent_invisible(EXTENT extent, Lisp_Object value)
4920 if (!EQ(extent_invisible(extent), value)) {
4921 set_extent_invisible_1(extent, value);
4922 extent_changed_for_redisplay(extent, 1, 1);
4926 /* This function does "memoization" -- similar to the interning
4927 that happens with symbols. Given a list of faces, an equivalent
4928 list is returned such that if this function is called twice with
4929 input that is `equal', the resulting outputs will be `eq'.
4931 Note that the inputs and outputs are in general *not* `equal' --
4932 faces in symbol form become actual face objects in the output.
4933 This is necessary so that temporary faces stay around. */
4935 static Lisp_Object memoize_extent_face_internal(Lisp_Object list)
4939 Lisp_Object cons, thecons;
4940 Lisp_Object oldtail, tail;
4941 struct gcpro gcpro1;
4946 return Fget_face(list);
4948 /* To do the memoization, we use a hash table mapping from
4949 external lists to internal lists. We do `equal' comparisons
4950 on the keys so the memoization works correctly.
4952 Note that we canonicalize things so that the keys in the
4953 hash table (the external lists) always contain symbols and
4954 the values (the internal lists) always contain face objects.
4956 We also maintain a "reverse" table that maps from the internal
4957 lists to the external equivalents. The idea here is twofold:
4959 1) `extent-face' wants to return a list containing face symbols
4960 rather than face objects.
4961 2) We don't want things to get quite so messed up if the user
4962 maliciously side-effects the returned lists.
4965 len = XINT(Flength(list));
4966 thelen = XINT(Flength(Vextent_face_reusable_list));
4971 /* We canonicalize the given list into another list.
4972 We try to avoid consing except when necessary, so we have
4977 cons = Vextent_face_reusable_list;
4978 while (!NILP(XCDR(cons)))
4980 XCDR(cons) = Fmake_list(make_int(len - thelen), Qnil);
4981 } else if (thelen > len) {
4984 /* Truncate the list temporarily so it's the right length;
4985 remember the old tail. */
4986 cons = Vextent_face_reusable_list;
4987 for (i = 0; i < len - 1; i++)
4990 oldtail = XCDR(cons);
4994 thecons = Vextent_face_reusable_list;
4995 EXTERNAL_LIST_LOOP(cons, list) {
4996 Lisp_Object face = Fget_face(XCAR(cons));
4998 XCAR(thecons) = Fface_name(face);
4999 thecons = XCDR(thecons);
5003 Fgethash(Vextent_face_reusable_list,
5004 Vextent_face_memoize_hash_table, Qnil);
5006 Lisp_Object symlist =
5007 Fcopy_sequence(Vextent_face_reusable_list);
5008 Lisp_Object facelist =
5009 Fcopy_sequence(Vextent_face_reusable_list);
5011 LIST_LOOP(cons, facelist) {
5012 XCAR(cons) = Fget_face(XCAR(cons));
5014 Fputhash(symlist, facelist, Vextent_face_memoize_hash_table);
5015 Fputhash(facelist, symlist,
5016 Vextent_face_reverse_memoize_hash_table);
5020 /* Now restore the truncated tail of the reusable list, if necessary. */
5022 XCDR(tail) = oldtail;
5028 static Lisp_Object external_of_internal_memoized_face(Lisp_Object face)
5032 else if (!CONSP(face))
5033 return XFACE(face)->name;
5035 face = Fgethash(face, Vextent_face_reverse_memoize_hash_table,
5037 assert(!UNBOUNDP(face));
5043 canonicalize_extent_property(Lisp_Object prop, Lisp_Object value)
5045 if (EQ(prop, Qface) || EQ(prop, Qmouse_face))
5046 value = (external_of_internal_memoized_face
5047 (memoize_extent_face_internal(value)));
5051 /* Do we need a lisp-level function ? */
5052 DEFUN("set-extent-initial-redisplay-function", Fset_extent_initial_redisplay_function, 2, 2, 0, /*
5053 Note: This feature is experimental!
5055 Set initial-redisplay-function of EXTENT to the function
5058 The first time the EXTENT is (re)displayed, an eval event will be
5059 dispatched calling FUNCTION with EXTENT as its only argument.
5063 EXTENT e = decode_extent(extent, DE_MUST_BE_ATTACHED);
5065 e = extent_ancestor(e); /* Is this needed? Macro also does chasing! */
5066 set_extent_initial_redisplay_function(e, function);
5067 extent_in_red_event_p(e) = 0; /* If the function changed we can spawn
5069 extent_changed_for_redisplay(e, 1, 0); /* Do we need to mark children too ? */
5074 DEFUN("extent-face", Fextent_face, 1, 1, 0, /*
5075 Return the name of the face in which EXTENT is displayed, or nil
5076 if the extent's face is unspecified. This might also return a list
5083 CHECK_EXTENT(extent);
5084 face = extent_face(XEXTENT(extent));
5086 return external_of_internal_memoized_face(face);
5089 DEFUN("set-extent-face", Fset_extent_face, 2, 2, 0, /*
5090 Make the given EXTENT have the graphic attributes specified by FACE.
5091 FACE can also be a list of faces, and all faces listed will apply,
5092 with faces earlier in the list taking priority over those later in the
5097 EXTENT e = decode_extent(extent, 0);
5098 Lisp_Object orig_face = face;
5100 /* retrieve the ancestor for efficiency and proper redisplay noting. */
5101 e = extent_ancestor(e);
5103 face = memoize_extent_face_internal(face);
5105 extent_face(e) = face;
5106 extent_changed_for_redisplay(e, 1, 0);
5111 DEFUN("extent-mouse-face", Fextent_mouse_face, 1, 1, 0, /*
5112 Return the face used to highlight EXTENT when the mouse passes over it.
5113 The return value will be a face name, a list of face names, or nil
5114 if the extent's mouse face is unspecified.
5120 CHECK_EXTENT(extent);
5121 face = extent_mouse_face(XEXTENT(extent));
5123 return external_of_internal_memoized_face(face);
5126 DEFUN("set-extent-mouse-face", Fset_extent_mouse_face, 2, 2, 0, /*
5127 Set the face used to highlight EXTENT when the mouse passes over it.
5128 FACE can also be a list of faces, and all faces listed will apply,
5129 with faces earlier in the list taking priority over those later in the
5135 Lisp_Object orig_face = face;
5137 CHECK_EXTENT(extent);
5138 e = XEXTENT(extent);
5139 /* retrieve the ancestor for efficiency and proper redisplay noting. */
5140 e = extent_ancestor(e);
5142 face = memoize_extent_face_internal(face);
5144 set_extent_mouse_face(e, face);
5145 extent_changed_for_redisplay(e, 1, 0);
5151 set_extent_glyph(EXTENT extent, Lisp_Object glyph, int endp,
5152 glyph_layout layout)
5154 extent = extent_ancestor(extent);
5157 set_extent_begin_glyph(extent, glyph);
5158 extent_begin_glyph_layout(extent) = layout;
5160 set_extent_end_glyph(extent, glyph);
5161 extent_end_glyph_layout(extent) = layout;
5164 extent_changed_for_redisplay(extent, 1, 0);
5167 static Lisp_Object glyph_layout_to_symbol(glyph_layout layout)
5172 case GL_OUTSIDE_MARGIN:
5173 return Qoutside_margin;
5174 case GL_INSIDE_MARGIN:
5175 return Qinside_margin;
5180 return Qnil; /* unreached */
5184 static glyph_layout symbol_to_glyph_layout(Lisp_Object layout_obj)
5186 if (NILP(layout_obj))
5189 CHECK_SYMBOL(layout_obj);
5190 if (EQ(layout_obj, Qoutside_margin))
5191 return GL_OUTSIDE_MARGIN;
5192 if (EQ(layout_obj, Qinside_margin))
5193 return GL_INSIDE_MARGIN;
5194 if (EQ(layout_obj, Qwhitespace))
5195 return GL_WHITESPACE;
5196 if (EQ(layout_obj, Qtext))
5199 invalid_argument("Unknown glyph layout type", layout_obj);
5200 return GL_TEXT; /* unreached */
5204 set_extent_glyph_1(Lisp_Object extent_obj, Lisp_Object glyph, int endp,
5205 Lisp_Object layout_obj)
5207 EXTENT extent = decode_extent(extent_obj, 0);
5208 glyph_layout layout = symbol_to_glyph_layout(layout_obj);
5210 /* Make sure we've actually been given a valid glyph or it's nil
5211 (meaning we're deleting a glyph from an extent). */
5213 CHECK_BUFFER_GLYPH(glyph);
5215 set_extent_glyph(extent, glyph, endp, layout);
5219 DEFUN("set-extent-begin-glyph", Fset_extent_begin_glyph, 2, 3, 0, /*
5220 Display a bitmap, subwindow or string at the beginning of EXTENT.
5221 BEGIN-GLYPH must be a glyph object. The layout policy defaults to `text'.
5223 (extent, begin_glyph, layout))
5225 return set_extent_glyph_1(extent, begin_glyph, 0, layout);
5228 DEFUN("set-extent-end-glyph", Fset_extent_end_glyph, 2, 3, 0, /*
5229 Display a bitmap, subwindow or string at the end of EXTENT.
5230 END-GLYPH must be a glyph object. The layout policy defaults to `text'.
5232 (extent, end_glyph, layout))
5234 return set_extent_glyph_1(extent, end_glyph, 1, layout);
5237 DEFUN("extent-begin-glyph", Fextent_begin_glyph, 1, 1, 0, /*
5238 Return the glyph object displayed at the beginning of EXTENT.
5239 If there is none, nil is returned.
5243 return extent_begin_glyph(decode_extent(extent, 0));
5246 DEFUN("extent-end-glyph", Fextent_end_glyph, 1, 1, 0, /*
5247 Return the glyph object displayed at the end of EXTENT.
5248 If there is none, nil is returned.
5252 return extent_end_glyph(decode_extent(extent, 0));
5255 DEFUN("set-extent-begin-glyph-layout", Fset_extent_begin_glyph_layout, 2, 2, 0, /*
5256 Set the layout policy of EXTENT's begin glyph.
5257 Access this using the `extent-begin-glyph-layout' function.
5261 EXTENT e = decode_extent(extent, 0);
5262 e = extent_ancestor(e);
5263 extent_begin_glyph_layout(e) = symbol_to_glyph_layout(layout);
5264 extent_maybe_changed_for_redisplay(e, 1, 0);
5268 DEFUN("set-extent-end-glyph-layout", Fset_extent_end_glyph_layout, 2, 2, 0, /*
5269 Set the layout policy of EXTENT's end glyph.
5270 Access this using the `extent-end-glyph-layout' function.
5274 EXTENT e = decode_extent(extent, 0);
5275 e = extent_ancestor(e);
5276 extent_end_glyph_layout(e) = symbol_to_glyph_layout(layout);
5277 extent_maybe_changed_for_redisplay(e, 1, 0);
5281 DEFUN("extent-begin-glyph-layout", Fextent_begin_glyph_layout, 1, 1, 0, /*
5282 Return the layout policy associated with EXTENT's begin glyph.
5283 Set this using the `set-extent-begin-glyph-layout' function.
5287 EXTENT e = decode_extent(extent, 0);
5288 return glyph_layout_to_symbol((glyph_layout)
5289 extent_begin_glyph_layout(e));
5292 DEFUN("extent-end-glyph-layout", Fextent_end_glyph_layout, 1, 1, 0, /*
5293 Return the layout policy associated with EXTENT's end glyph.
5294 Set this using the `set-extent-end-glyph-layout' function.
5298 EXTENT e = decode_extent(extent, 0);
5299 return glyph_layout_to_symbol((glyph_layout)
5300 extent_end_glyph_layout(e));
5303 DEFUN("set-extent-priority", Fset_extent_priority, 2, 2, 0, /*
5304 Set the display priority of EXTENT to PRIORITY (an integer).
5305 When the extent attributes are being merged for display, the priority
5306 is used to determine which extent takes precedence in the event of a
5307 conflict (two extents whose faces both specify font, for example: the
5308 font of the extent with the higher priority will be used).
5309 Extents are created with priority 0; priorities may be negative.
5313 EXTENT e = decode_extent(extent, 0);
5315 CHECK_INT(priority);
5316 e = extent_ancestor(e);
5317 set_extent_priority(e, XINT(priority));
5318 extent_maybe_changed_for_redisplay(e, 1, 0);
5322 DEFUN("extent-priority", Fextent_priority, 1, 1, 0, /*
5323 Return the display priority of EXTENT; see `set-extent-priority'.
5327 EXTENT e = decode_extent(extent, 0);
5328 return make_int(extent_priority(e));
5331 DEFUN("set-extent-property", Fset_extent_property, 3, 3, 0, /*
5332 Change a property of an extent.
5333 PROPERTY may be any symbol; the value stored may be accessed with
5334 the `extent-property' function.
5335 The following symbols have predefined meanings:
5337 detached Removes the extent from its buffer; setting this is
5338 the same as calling `detach-extent'.
5340 destroyed Removes the extent from its buffer, and makes it
5341 unusable in the future; this is the same calling
5344 priority Change redisplay priority; same as `set-extent-priority'.
5346 start-open Whether the set of characters within the extent is
5347 treated being open on the left, that is, whether
5348 the start position is an exclusive, rather than
5349 inclusive, boundary. If true, then characters
5350 inserted exactly at the beginning of the extent
5351 will remain outside of the extent; otherwise they
5352 will go into the extent, extending it.
5354 end-open Whether the set of characters within the extent is
5355 treated being open on the right, that is, whether
5356 the end position is an exclusive, rather than
5357 inclusive, boundary. If true, then characters
5358 inserted exactly at the end of the extent will
5359 remain outside of the extent; otherwise they will
5360 go into the extent, extending it.
5362 By default, extents have the `end-open' but not the
5363 `start-open' property set.
5365 read-only Text within this extent will be unmodifiable.
5367 initial-redisplay-function (EXPERIMENTAL)
5368 function to be called the first time (part of) the extent
5369 is redisplayed. It will be called with the extent as its
5371 Note: The function will not be called immediately
5372 during redisplay, an eval event will be dispatched.
5374 detachable Whether the extent gets detached (as with
5375 `detach-extent') when all the text within the
5376 extent is deleted. This is true by default. If
5377 this property is not set, the extent becomes a
5378 zero-length extent when its text is deleted. (In
5379 such a case, the `start-open' property is
5380 automatically removed if both the `start-open' and
5381 `end-open' properties are set, since zero-length
5382 extents open on both ends are not allowed.)
5384 face The face in which to display the text. Setting
5385 this is the same as calling `set-extent-face'.
5387 mouse-face If non-nil, the extent will be highlighted in this
5388 face when the mouse moves over it.
5390 pointer If non-nil, and a valid pointer glyph, this specifies
5391 the shape of the mouse pointer while over the extent.
5393 highlight Obsolete: Setting this property is equivalent to
5394 setting a `mouse-face' property of `highlight'.
5395 Reading this property returns non-nil if
5396 the extent has a non-nil `mouse-face' property.
5398 duplicable Whether this extent should be copied into strings,
5399 so that kill, yank, and undo commands will restore
5400 or copy it. `duplicable' extents are copied from
5401 an extent into a string when `buffer-substring' or
5402 a similar function creates a string. The extents
5403 in a string are copied into other strings created
5404 from the string using `concat' or `substring'.
5405 When `insert' or a similar function inserts the
5406 string into a buffer, the extents are copied back
5409 unique Meaningful only in conjunction with `duplicable'.
5410 When this is set, there may be only one instance
5411 of this extent attached at a time: if it is copied
5412 to the kill ring and then yanked, the extent is
5413 not copied. If, however, it is killed (removed
5414 from the buffer) and then yanked, it will be
5415 re-attached at the new position.
5417 invisible If the value is non-nil, text under this extent
5418 may be treated as not present for the purpose of
5419 redisplay, or may be displayed using an ellipsis
5420 or other marker; see `buffer-invisibility-spec'
5421 and `invisible-text-glyph'. In all cases,
5422 however, the text is still visible to other
5423 functions that examine a buffer's text.
5425 keymap This keymap is consulted for mouse clicks on this
5426 extent, or keypresses made while point is within the
5429 copy-function This is a hook that is run when a duplicable extent
5430 is about to be copied from a buffer to a string (or
5431 the kill ring). It is called with three arguments,
5432 the extent, and the buffer-positions within it
5433 which are being copied. If this function returns
5434 nil, then the extent will not be copied; otherwise
5437 paste-function This is a hook that is run when a duplicable extent is
5438 about to be copied from a string (or the kill ring)
5439 into a buffer. It is called with three arguments,
5440 the original extent, and the buffer positions which
5441 the copied extent will occupy. (This hook is run
5442 after the corresponding text has already been
5443 inserted into the buffer.) Note that the extent
5444 argument may be detached when this function is run.
5445 If this function returns nil, no extent will be
5446 inserted. Otherwise, there will be an extent
5447 covering the range in question.
5449 If the original extent is not attached to a buffer,
5450 then it will be re-attached at this range.
5451 Otherwise, a copy will be made, and that copy
5454 The copy-function and paste-function are meaningful
5455 only for extents with the `duplicable' flag set,
5456 and if they are not specified, behave as if `t' was
5457 the returned value. When these hooks are invoked,
5458 the current buffer is the buffer which the extent
5459 is being copied from/to, respectively.
5461 begin-glyph A glyph to be displayed at the beginning of the extent,
5464 end-glyph A glyph to be displayed at the end of the extent,
5467 begin-glyph-layout The layout policy (one of `text', `whitespace',
5468 `inside-margin', or `outside-margin') of the extent's
5471 end-glyph-layout The layout policy of the extent's end glyph.
5473 syntax-table A cons or a syntax table object. If a cons, the car must
5474 be an integer (interpreted as a syntax code, applicable to
5475 all characters in the extent). Otherwise, syntax of
5476 characters in the extent is looked up in the syntax table.
5477 You should use the text property API to manipulate this
5478 property. (This may be required in the future.)
5480 (extent, property, value))
5482 /* This function can GC if property is `keymap' */
5483 EXTENT e = decode_extent(extent, 0);
5485 if (EQ(property, Qread_only))
5486 set_extent_read_only(e, value);
5487 else if (EQ(property, Qunique))
5488 extent_unique_p(e) = !NILP(value);
5489 else if (EQ(property, Qduplicable))
5490 extent_duplicable_p(e) = !NILP(value);
5491 else if (EQ(property, Qinvisible))
5492 set_extent_invisible(e, value);
5493 else if (EQ(property, Qdetachable))
5494 extent_detachable_p(e) = !NILP(value);
5496 else if (EQ(property, Qdetached)) {
5498 error("can only set `detached' to t");
5499 Fdetach_extent(extent);
5500 } else if (EQ(property, Qdestroyed)) {
5502 error("can only set `destroyed' to t");
5503 Fdelete_extent(extent);
5504 } else if (EQ(property, Qpriority))
5505 Fset_extent_priority(extent, value);
5506 else if (EQ(property, Qface))
5507 Fset_extent_face(extent, value);
5508 else if (EQ(property, Qinitial_redisplay_function))
5509 Fset_extent_initial_redisplay_function(extent, value);
5510 else if (EQ(property, Qbefore_change_functions))
5511 set_extent_before_change_functions(e, value);
5512 else if (EQ(property, Qafter_change_functions))
5513 set_extent_after_change_functions(e, value);
5514 else if (EQ(property, Qmouse_face))
5515 Fset_extent_mouse_face(extent, value);
5517 else if (EQ(property, Qhighlight))
5518 Fset_extent_mouse_face(extent, Qhighlight);
5519 else if (EQ(property, Qbegin_glyph_layout))
5520 Fset_extent_begin_glyph_layout(extent, value);
5521 else if (EQ(property, Qend_glyph_layout))
5522 Fset_extent_end_glyph_layout(extent, value);
5523 /* For backwards compatibility. We use begin glyph because it is by
5524 far the more used of the two. */
5525 else if (EQ(property, Qglyph_layout))
5526 Fset_extent_begin_glyph_layout(extent, value);
5527 else if (EQ(property, Qbegin_glyph))
5528 Fset_extent_begin_glyph(extent, value, Qnil);
5529 else if (EQ(property, Qend_glyph))
5530 Fset_extent_end_glyph(extent, value, Qnil);
5531 else if (EQ(property, Qstart_open))
5532 set_extent_openness(e, !NILP(value), -1);
5533 else if (EQ(property, Qend_open))
5534 set_extent_openness(e, -1, !NILP(value));
5535 /* Support (but don't document...) the obvious *_closed antonyms. */
5536 else if (EQ(property, Qstart_closed))
5537 set_extent_openness(e, NILP(value), -1);
5538 else if (EQ(property, Qend_closed))
5539 set_extent_openness(e, -1, NILP(value));
5541 if (EQ(property, Qkeymap))
5542 while (!NILP(value) && NILP(Fkeymapp(value)))
5543 value = wrong_type_argument(Qkeymapp, value);
5545 external_plist_put(extent_plist_addr(e), property, value, 0,
5552 DEFUN("set-extent-properties", Fset_extent_properties, 2, 2, 0, /*
5553 Change some properties of EXTENT.
5554 PLIST is a property list.
5555 For a list of built-in properties, see `set-extent-property'.
5559 /* This function can GC, if one of the properties is `keymap' */
5560 Lisp_Object property, value;
5561 struct gcpro gcpro1;
5564 plist = Fcopy_sequence(plist);
5565 Fcanonicalize_plist(plist, Qnil);
5567 while (!NILP(plist)) {
5568 property = Fcar(plist);
5569 plist = Fcdr(plist);
5570 value = Fcar(plist);
5571 plist = Fcdr(plist);
5572 Fset_extent_property(extent, property, value);
5578 DEFUN("extent-property", Fextent_property, 2, 3, 0, /*
5579 Return EXTENT's value for property PROPERTY.
5580 If no such property exists, DEFAULT is returned.
5581 See `set-extent-property' for the built-in property names.
5583 (extent, property, default_))
5585 EXTENT e = decode_extent(extent, 0);
5587 if (EQ(property, Qdetached))
5588 return extent_detached_p(e) ? Qt : Qnil;
5589 else if (EQ(property, Qdestroyed))
5590 return !EXTENT_LIVE_P(e) ? Qt : Qnil;
5591 else if (EQ(property, Qstart_open))
5592 return extent_normal_field(e, start_open) ? Qt : Qnil;
5593 else if (EQ(property, Qend_open))
5594 return extent_normal_field(e, end_open) ? Qt : Qnil;
5595 else if (EQ(property, Qunique))
5596 return extent_normal_field(e, unique) ? Qt : Qnil;
5597 else if (EQ(property, Qduplicable))
5598 return extent_normal_field(e, duplicable) ? Qt : Qnil;
5599 else if (EQ(property, Qdetachable))
5600 return extent_normal_field(e, detachable) ? Qt : Qnil;
5601 /* Support (but don't document...) the obvious *_closed antonyms. */
5602 else if (EQ(property, Qstart_closed))
5603 return extent_start_open_p(e) ? Qnil : Qt;
5604 else if (EQ(property, Qend_closed))
5605 return extent_end_open_p(e) ? Qnil : Qt;
5606 else if (EQ(property, Qpriority))
5607 return make_int(extent_priority(e));
5608 else if (EQ(property, Qread_only))
5609 return extent_read_only(e);
5610 else if (EQ(property, Qinvisible))
5611 return extent_invisible(e);
5612 else if (EQ(property, Qface))
5613 return Fextent_face(extent);
5614 else if (EQ(property, Qinitial_redisplay_function))
5615 return extent_initial_redisplay_function(e);
5616 else if (EQ(property, Qbefore_change_functions))
5617 return extent_before_change_functions(e);
5618 else if (EQ(property, Qafter_change_functions))
5619 return extent_after_change_functions(e);
5620 else if (EQ(property, Qmouse_face))
5621 return Fextent_mouse_face(extent);
5623 else if (EQ(property, Qhighlight))
5624 return !NILP(Fextent_mouse_face(extent)) ? Qt : Qnil;
5625 else if (EQ(property, Qbegin_glyph_layout))
5626 return Fextent_begin_glyph_layout(extent);
5627 else if (EQ(property, Qend_glyph_layout))
5628 return Fextent_end_glyph_layout(extent);
5629 /* For backwards compatibility. We use begin glyph because it is by
5630 far the more used of the two. */
5631 else if (EQ(property, Qglyph_layout))
5632 return Fextent_begin_glyph_layout(extent);
5633 else if (EQ(property, Qbegin_glyph))
5634 return extent_begin_glyph(e);
5635 else if (EQ(property, Qend_glyph))
5636 return extent_end_glyph(e);
5638 Lisp_Object value = external_plist_get(extent_plist_addr(e),
5639 property, 0, ERROR_ME);
5640 return UNBOUNDP(value) ? default_ : value;
5644 DEFUN("extent-properties", Fextent_properties, 1, 1, 0, /*
5645 Return a property list of the attributes of EXTENT.
5646 Do not modify this list; use `set-extent-property' instead.
5651 Lisp_Object result, face, anc_obj;
5652 glyph_layout layout;
5654 CHECK_EXTENT(extent);
5655 e = XEXTENT(extent);
5656 if (!EXTENT_LIVE_P(e))
5657 return cons3(Qdestroyed, Qt, Qnil);
5659 anc = extent_ancestor(e);
5660 XSETEXTENT(anc_obj, anc);
5662 /* For efficiency, use the ancestor for all properties except detached */
5664 result = extent_plist_slot(anc);
5666 if (!NILP(face = Fextent_face(anc_obj)))
5667 result = cons3(Qface, face, result);
5669 if (!NILP(face = Fextent_mouse_face(anc_obj)))
5670 result = cons3(Qmouse_face, face, result);
5672 if ((layout = (glyph_layout) extent_begin_glyph_layout(anc)) != GL_TEXT) {
5673 Lisp_Object sym = glyph_layout_to_symbol(layout);
5674 result = cons3(Qglyph_layout, sym, result); /* compatibility */
5675 result = cons3(Qbegin_glyph_layout, sym, result);
5678 if ((layout = (glyph_layout) extent_end_glyph_layout(anc)) != GL_TEXT)
5680 cons3(Qend_glyph_layout, glyph_layout_to_symbol(layout),
5683 if (!NILP(extent_end_glyph(anc)))
5684 result = cons3(Qend_glyph, extent_end_glyph(anc), result);
5686 if (!NILP(extent_begin_glyph(anc)))
5687 result = cons3(Qbegin_glyph, extent_begin_glyph(anc), result);
5689 if (extent_priority(anc) != 0)
5691 cons3(Qpriority, make_int(extent_priority(anc)), result);
5693 if (!NILP(extent_initial_redisplay_function(anc)))
5694 result = cons3(Qinitial_redisplay_function,
5695 extent_initial_redisplay_function(anc), result);
5697 if (!NILP(extent_before_change_functions(anc)))
5698 result = cons3(Qbefore_change_functions,
5699 extent_before_change_functions(anc), result);
5701 if (!NILP(extent_after_change_functions(anc)))
5702 result = cons3(Qafter_change_functions,
5703 extent_after_change_functions(anc), result);
5705 if (!NILP(extent_invisible(anc)))
5706 result = cons3(Qinvisible, extent_invisible(anc), result);
5708 if (!NILP(extent_read_only(anc)))
5709 result = cons3(Qread_only, extent_read_only(anc), result);
5711 if (extent_normal_field(anc, end_open))
5712 result = cons3(Qend_open, Qt, result);
5714 if (extent_normal_field(anc, start_open))
5715 result = cons3(Qstart_open, Qt, result);
5717 if (extent_normal_field(anc, detachable))
5718 result = cons3(Qdetachable, Qt, result);
5720 if (extent_normal_field(anc, duplicable))
5721 result = cons3(Qduplicable, Qt, result);
5723 if (extent_normal_field(anc, unique))
5724 result = cons3(Qunique, Qt, result);
5726 /* detached is not an inherited property */
5727 if (extent_detached_p(e))
5728 result = cons3(Qdetached, Qt, result);
5733 /************************************************************************/
5735 /************************************************************************/
5737 /* The display code looks into the Vlast_highlighted_extent variable to
5738 correctly display highlighted extents. This updates that variable,
5739 and marks the appropriate buffers as needing some redisplay.
5741 static void do_highlight(Lisp_Object extent_obj, int highlight_p)
5743 if ((highlight_p && (EQ(Vlast_highlighted_extent, extent_obj))) ||
5744 (!highlight_p && (EQ(Vlast_highlighted_extent, Qnil))))
5746 if (EXTENTP(Vlast_highlighted_extent) &&
5747 EXTENT_LIVE_P(XEXTENT(Vlast_highlighted_extent))) {
5748 /* do not recurse on descendants. Only one extent is highlighted
5750 extent_changed_for_redisplay(XEXTENT(Vlast_highlighted_extent),
5753 Vlast_highlighted_extent = Qnil;
5754 if (!NILP(extent_obj)
5755 && BUFFERP(extent_object(XEXTENT(extent_obj)))
5757 extent_changed_for_redisplay(XEXTENT(extent_obj), 0, 0);
5758 Vlast_highlighted_extent = extent_obj;
5762 DEFUN("force-highlight-extent", Fforce_highlight_extent, 1, 2, 0, /*
5763 Highlight or unhighlight the given extent.
5764 If the second arg is non-nil, it will be highlighted, else dehighlighted.
5765 This is the same as `highlight-extent', except that it will work even
5766 on extents without the `mouse-face' property.
5768 (extent, highlight_p))
5773 XSETEXTENT(extent, decode_extent(extent, DE_MUST_BE_ATTACHED));
5774 do_highlight(extent, !NILP(highlight_p));
5778 DEFUN("highlight-extent", Fhighlight_extent, 1, 2, 0, /*
5779 Highlight EXTENT, if it is highlightable.
5780 \(that is, if it has the `mouse-face' property).
5781 If the second arg is non-nil, it will be highlighted, else dehighlighted.
5782 Highlighted extents are displayed as if they were merged with the face
5783 or faces specified by the `mouse-face' property.
5785 (extent, highlight_p))
5787 if (EXTENTP(extent) && NILP(extent_mouse_face(XEXTENT(extent))))
5790 return Fforce_highlight_extent(extent, highlight_p);
5793 /************************************************************************/
5794 /* strings and extents */
5795 /************************************************************************/
5797 /* copy/paste hooks */
5800 run_extent_copy_paste_internal(EXTENT e, Bufpos from, Bufpos to,
5801 Lisp_Object object, Lisp_Object prop)
5803 /* This function can GC */
5805 Lisp_Object copy_fn;
5806 XSETEXTENT(extent, e);
5807 copy_fn = Fextent_property(extent, prop, Qnil);
5808 if (!NILP(copy_fn)) {
5810 struct gcpro gcpro1, gcpro2, gcpro3;
5811 GCPRO3(extent, copy_fn, object);
5812 if (BUFFERP(object))
5813 flag = call3_in_buffer(XBUFFER(object), copy_fn, extent,
5814 make_int(from), make_int(to));
5817 call3(copy_fn, extent, make_int(from),
5820 if (NILP(flag) || !EXTENT_LIVE_P(XEXTENT(extent)))
5826 static int run_extent_copy_function(EXTENT e, Bytind from, Bytind to)
5828 Lisp_Object object = extent_object(e);
5829 /* This function can GC */
5830 return run_extent_copy_paste_internal
5831 (e, buffer_or_string_bytind_to_bufpos(object, from),
5832 buffer_or_string_bytind_to_bufpos(object, to), object,
5837 run_extent_paste_function(EXTENT e, Bytind from, Bytind to, Lisp_Object object)
5839 /* This function can GC */
5840 return run_extent_copy_paste_internal
5841 (e, buffer_or_string_bytind_to_bufpos(object, from),
5842 buffer_or_string_bytind_to_bufpos(object, to), object,
5846 static void update_extent(EXTENT extent, Bytind from, Bytind to)
5848 set_extent_endpoints(extent, from, to, Qnil);
5851 /* Insert an extent, usually from the dup_list of a string which
5852 has just been inserted.
5853 This code does not handle the case of undo.
5856 insert_extent(EXTENT extent, Bytind new_start, Bytind new_end,
5857 Lisp_Object object, int run_hooks)
5859 /* This function can GC */
5862 if (!EQ(extent_object(extent), object))
5865 if (extent_detached_p(extent)) {
5867 !run_extent_paste_function(extent, new_start, new_end,
5869 /* The paste-function said don't re-attach this extent here. */
5872 update_extent(extent, new_start, new_end);
5874 Bytind exstart = extent_endpoint_bytind(extent, 0);
5875 Bytind exend = extent_endpoint_bytind(extent, 1);
5877 if (exend < new_start || exstart > new_end)
5880 new_start = min(exstart, new_start);
5881 new_end = max(exend, new_end);
5882 if (exstart != new_start || exend != new_end)
5883 update_extent(extent, new_start, new_end);
5887 XSETEXTENT(tmp, extent);
5892 !run_extent_paste_function(extent, new_start, new_end, object))
5893 /* The paste-function said don't attach a copy of the extent here. */
5897 copy_extent(extent, new_start, new_end, object));
5902 DEFUN("insert-extent", Finsert_extent, 1, 5, 0, /*
5903 Insert EXTENT from START to END in BUFFER-OR-STRING.
5904 BUFFER-OR-STRING defaults to the current buffer if omitted.
5905 This operation does not insert any characters,
5906 but otherwise acts as if there were a replicating extent whose
5907 parent is EXTENT in some string that was just inserted.
5908 Returns the newly-inserted extent.
5909 The fourth arg, NO-HOOKS, can be used to inhibit the running of the
5910 extent's `paste-function' property if it has one.
5911 See documentation on `detach-extent' for a discussion of undo recording.
5913 (extent, start, end, no_hooks, buffer_or_string))
5915 EXTENT ext = decode_extent(extent, 0);
5919 buffer_or_string = decode_buffer_or_string(buffer_or_string);
5920 get_buffer_or_string_range_byte(buffer_or_string, start, end, &s, &e,
5921 GB_ALLOW_PAST_ACCESSIBLE);
5923 copy = insert_extent(ext, s, e, buffer_or_string, NILP(no_hooks));
5924 if (EXTENTP(copy)) {
5925 if (extent_duplicable_p(XEXTENT(copy)))
5926 record_extent(copy, 1);
5931 /* adding buffer extents to a string */
5933 struct add_string_extents_arg {
5939 static int add_string_extents_mapper(EXTENT extent, void *arg)
5941 /* This function can GC */
5942 struct add_string_extents_arg *closure =
5943 (struct add_string_extents_arg *)arg;
5944 Bytecount start = extent_endpoint_bytind(extent, 0) - closure->from;
5945 Bytecount end = extent_endpoint_bytind(extent, 1) - closure->from;
5947 if (extent_duplicable_p(extent)) {
5948 start = max(start, 0);
5949 end = min(end, closure->length);
5951 /* Run the copy-function to give an extent the option of
5952 not being copied into the string (or kill ring).
5954 if (extent_duplicable_p(extent) &&
5955 !run_extent_copy_function(extent, start + closure->from,
5956 end + closure->from))
5958 copy_extent(extent, start, end, closure->string);
5964 /* Add the extents in buffer BUF from OPOINT to OPOINT+LENGTH to
5965 the string STRING. */
5967 add_string_extents(Lisp_Object string, struct buffer *buf, Bytind opoint,
5970 /* This function can GC */
5971 struct add_string_extents_arg closure;
5972 struct gcpro gcpro1, gcpro2;
5975 closure.from = opoint;
5976 closure.length = length;
5977 closure.string = string;
5978 buffer = make_buffer(buf);
5979 GCPRO2(buffer, string);
5980 map_extents_bytind(opoint, opoint + length, add_string_extents_mapper,
5981 (void *)&closure, buffer, 0,
5982 /* ignore extents that just abut the region */
5983 ME_END_CLOSED | ME_ALL_EXTENTS_OPEN |
5984 /* we are calling E-Lisp (the extent's copy function)
5985 so anything might happen */
5986 ME_MIGHT_CALL_ELISP);
5990 struct splice_in_string_extents_arg {
5997 static int splice_in_string_extents_mapper(EXTENT extent, void *arg)
5999 /* This function can GC */
6000 struct splice_in_string_extents_arg *closure =
6001 (struct splice_in_string_extents_arg *)arg;
6002 /* BASE_START and BASE_END are the limits in the buffer of the string
6003 that was just inserted.
6005 NEW_START and NEW_END are the prospective buffer positions of the
6006 extent that is going into the buffer. */
6007 Bytind base_start = closure->opoint;
6008 Bytind base_end = base_start + closure->length;
6009 Bytind new_start = (base_start + extent_endpoint_bytind(extent, 0) -
6011 Bytind new_end = (base_start + extent_endpoint_bytind(extent, 1) -
6014 if (new_start < base_start)
6015 new_start = base_start;
6016 if (new_end > base_end)
6018 if (new_end <= new_start)
6021 if (!extent_duplicable_p(extent))
6025 !run_extent_paste_function(extent, new_start, new_end,
6028 copy_extent(extent, new_start, new_end, closure->buffer);
6033 /* We have just inserted a section of STRING (starting at POS, of
6034 length LENGTH) into buffer BUF at OPOINT. Do whatever is necessary
6035 to get the string's extents into the buffer. */
6038 splice_in_string_extents(Lisp_Object string, struct buffer *buf,
6039 Bytind opoint, Bytecount length, Bytecount pos)
6041 struct splice_in_string_extents_arg closure;
6042 struct gcpro gcpro1, gcpro2;
6045 buffer = make_buffer(buf);
6046 closure.opoint = opoint;
6048 closure.length = length;
6049 closure.buffer = buffer;
6050 GCPRO2(buffer, string);
6051 map_extents_bytind(pos, pos + length,
6052 splice_in_string_extents_mapper,
6053 (void *)&closure, string, 0,
6054 /* ignore extents that just abut the region */
6055 ME_END_CLOSED | ME_ALL_EXTENTS_OPEN |
6056 /* we are calling E-Lisp (the extent's copy function)
6057 so anything might happen */
6058 ME_MIGHT_CALL_ELISP);
6062 struct copy_string_extents_arg {
6066 Lisp_Object new_string;
6069 struct copy_string_extents_1_arg {
6070 Lisp_Object parent_in_question;
6071 EXTENT found_extent;
6074 static int copy_string_extents_mapper(EXTENT extent, void *arg)
6076 struct copy_string_extents_arg *closure =
6077 (struct copy_string_extents_arg *)arg;
6078 Bytecount old_start, old_end, new_start, new_end;
6080 old_start = extent_endpoint_bytind(extent, 0);
6081 old_end = extent_endpoint_bytind(extent, 1);
6083 old_start = max(closure->old_pos, old_start);
6084 old_end = min(closure->old_pos + closure->length, old_end);
6086 if (old_start >= old_end)
6089 new_start = old_start + closure->new_pos - closure->old_pos;
6090 new_end = old_end + closure->new_pos - closure->old_pos;
6092 copy_extent(extent, new_start, new_end, closure->new_string);
6096 /* The string NEW_STRING was partially constructed from OLD_STRING.
6097 In particular, the section of length LEN starting at NEW_POS in
6098 NEW_STRING came from the section of the same length starting at
6099 OLD_POS in OLD_STRING. Copy the extents as appropriate. */
6102 copy_string_extents(Lisp_Object new_string, Lisp_Object old_string,
6103 Bytecount new_pos, Bytecount old_pos, Bytecount length)
6105 struct copy_string_extents_arg closure;
6106 struct gcpro gcpro1, gcpro2;
6108 closure.new_pos = new_pos;
6109 closure.old_pos = old_pos;
6110 closure.new_string = new_string;
6111 closure.length = length;
6112 GCPRO2(new_string, old_string);
6113 map_extents_bytind(old_pos, old_pos + length,
6114 copy_string_extents_mapper,
6115 (void *)&closure, old_string, 0,
6116 /* ignore extents that just abut the region */
6117 ME_END_CLOSED | ME_ALL_EXTENTS_OPEN |
6118 /* we are calling E-Lisp (the extent's copy function)
6119 so anything might happen */
6120 ME_MIGHT_CALL_ELISP);
6124 /* Checklist for sanity checking:
6125 - {kill, yank, copy} at {open, closed} {start, end} of {writable, read-only} extent
6126 - {kill, copy} & yank {once, repeatedly} duplicable extent in {same, different} buffer
6129 /************************************************************************/
6130 /* text properties */
6131 /************************************************************************/
6134 Originally this stuff was implemented in lisp (all of the functionality
6135 exists to make that possible) but speed was a problem.
6138 Lisp_Object Qtext_prop;
6139 Lisp_Object Qtext_prop_extent_paste_function;
6142 get_text_property_bytind(Bytind position, Lisp_Object prop,
6143 Lisp_Object object, enum extent_at_flag fl,
6144 int text_props_only)
6148 /* text_props_only specifies whether we only consider text-property
6149 extents (those with the 'text-prop property set) or all extents. */
6150 if (!text_props_only)
6151 extent = extent_at_bytind(position, object, prop, 0, fl, 0);
6156 extent_at_bytind(position, object, Qtext_prop,
6161 (prop, Fextent_property(extent, Qtext_prop, Qnil)))
6163 prior = XEXTENT(extent);
6168 return Fextent_property(extent, prop, Qnil);
6169 if (!NILP(Vdefault_text_properties))
6170 return Fplist_get(Vdefault_text_properties, prop, Qnil);
6175 get_text_property_1(Lisp_Object pos, Lisp_Object prop, Lisp_Object object,
6176 Lisp_Object at_flag, int text_props_only)
6181 object = decode_buffer_or_string(object);
6183 get_buffer_or_string_pos_byte(object, pos, GB_NO_ERROR_IF_BAD);
6185 /* We canonicalize the start/end-open/closed properties to the
6186 non-default version -- "adding" the default property really
6187 needs to remove the non-default one. See below for more
6189 if (EQ(prop, Qstart_closed)) {
6194 if (EQ(prop, Qend_open)) {
6201 get_text_property_bytind(position, prop, object,
6202 decode_extent_at_flag(at_flag),
6205 val = NILP(val) ? Qt : Qnil;
6210 DEFUN("get-text-property", Fget_text_property, 2, 4, 0, /*
6211 Return the value of the PROP property at the given position.
6212 Optional arg OBJECT specifies the buffer or string to look in, and
6213 defaults to the current buffer.
6214 Optional arg AT-FLAG controls what it means for a property to be "at"
6215 a position, and has the same meaning as in `extent-at'.
6216 This examines only those properties added with `put-text-property'.
6217 See also `get-char-property'.
6219 (pos, prop, object, at_flag))
6221 return get_text_property_1(pos, prop, object, at_flag, 1);
6224 DEFUN("get-char-property", Fget_char_property, 2, 4, 0, /*
6225 Return the value of the PROP property at the given position.
6226 Optional arg OBJECT specifies the buffer or string to look in, and
6227 defaults to the current buffer.
6228 Optional arg AT-FLAG controls what it means for a property to be "at"
6229 a position, and has the same meaning as in `extent-at'.
6230 This examines properties on all extents.
6231 See also `get-text-property'.
6233 (pos, prop, object, at_flag))
6235 return get_text_property_1(pos, prop, object, at_flag, 0);
6238 /* About start/end-open/closed:
6240 These properties have to be handled specially because of their
6241 strange behavior. If I put the "start-open" property on a region,
6242 then *all* text-property extents in the region have to have their
6243 start be open. This is unlike all other properties, which don't
6244 affect the extents of text properties other than their own.
6248 1) We have to map start-closed to (not start-open) and end-open
6249 to (not end-closed) -- i.e. adding the default is really the
6250 same as remove the non-default property. It won't work, for
6251 example, to have both "start-open" and "start-closed" on
6253 2) Whenever we add one of these properties, we go through all
6254 text-property extents in the region and set the appropriate
6255 open/closedness on them.
6256 3) Whenever we change a text-property extent for a property,
6257 we have to make sure we set the open/closedness properly.
6259 (2) and (3) together rely on, and maintain, the invariant
6260 that the open/closedness of text-property extents is correct
6261 at the beginning and end of each operation.
6264 struct put_text_prop_arg {
6265 Lisp_Object prop, value; /* The property and value we are storing */
6266 Bytind start, end; /* The region into which we are storing it */
6268 Lisp_Object the_extent; /* Our chosen extent; this is used for
6269 communication between subsequent passes. */
6270 int changed_p; /* Output: whether we have modified anything */
6273 static int put_text_prop_mapper(EXTENT e, void *arg)
6275 struct put_text_prop_arg *closure = (struct put_text_prop_arg *)arg;
6277 Lisp_Object object = closure->object;
6278 Lisp_Object value = closure->value;
6279 Bytind e_start, e_end;
6280 Bytind start = closure->start;
6281 Bytind end = closure->end;
6282 Lisp_Object extent, e_val;
6285 XSETEXTENT(extent, e);
6287 /* Note: in some cases when the property itself is 'start-open
6288 or 'end-closed, the checks to set the openness may do a bit
6289 of extra work; but it won't hurt because we then fix up the
6290 openness later on in put_text_prop_openness_mapper(). */
6291 if (!EQ(Fextent_property(extent, Qtext_prop, Qnil), closure->prop))
6292 /* It's not for this property; do nothing. */
6295 e_start = extent_endpoint_bytind(e, 0);
6296 e_end = extent_endpoint_bytind(e, 1);
6297 e_val = Fextent_property(extent, closure->prop, Qnil);
6298 is_eq = EQ(value, e_val);
6300 if (!NILP(value) && NILP(closure->the_extent) && is_eq) {
6301 /* We want there to be an extent here at the end, and we haven't picked
6302 one yet, so use this one. Extend it as necessary. We only reuse an
6303 extent which has an EQ value for the prop in question to avoid
6304 side-effecting the kill ring (that is, we never change the property
6305 on an extent after it has been created.)
6307 if (e_start != start || e_end != end) {
6308 Bytind new_start = min(e_start, start);
6309 Bytind new_end = max(e_end, end);
6310 set_extent_endpoints(e, new_start, new_end, Qnil);
6311 /* If we changed the endpoint, then we need to set its
6313 set_extent_openness(e, new_start != e_start
6314 ? !NILP(get_text_property_bytind
6315 (start, Qstart_open, object,
6316 EXTENT_AT_AFTER, 1)) : -1,
6318 ? NILP(get_text_property_bytind
6319 (end - 1, Qend_closed,
6320 object, EXTENT_AT_AFTER, 1))
6322 closure->changed_p = 1;
6324 closure->the_extent = extent;
6327 /* Even if we're adding a prop, at this point, we want all other extents of
6328 this prop to go away (as now they overlap). So the theory here is that,
6329 when we are adding a prop to a region that has multiple (disjoint)
6330 occurrences of that prop in it already, we pick one of those and extend
6331 it, and remove the others.
6334 else if (EQ(extent, closure->the_extent)) {
6335 /* just in case map-extents hits it again (does that happen?) */
6337 } else if (e_start >= start && e_end <= end) {
6338 /* Extent is contained in region; remove it. Don't destroy or modify
6339 it, because we don't want to change the attributes pointed to by the
6340 duplicates in the kill ring.
6343 closure->changed_p = 1;
6344 } else if (!NILP(closure->the_extent) &&
6345 is_eq && e_start <= end && e_end >= start) {
6346 EXTENT te = XEXTENT(closure->the_extent);
6347 /* This extent overlaps, and has the same prop/value as the extent we've
6348 decided to reuse, so we can remove this existing extent as well (the
6349 whole thing, even the part outside of the region) and extend
6350 the-extent to cover it, resulting in the minimum number of extents in
6353 Bytind the_start = extent_endpoint_bytind(te, 0);
6354 Bytind the_end = extent_endpoint_bytind(te, 1);
6355 if (e_start != the_start && /* note AND not OR -- hmm, why is this
6356 the case? I think it's because the
6357 assumption that the text-property
6358 extents don't overlap makes it
6359 OK; changing it to an OR would
6360 result in changed_p sometimes getting
6361 falsely marked. Is this bad? */
6363 Bytind new_start = min(e_start, the_start);
6364 Bytind new_end = max(e_end, the_end);
6365 set_extent_endpoints(te, new_start, new_end, Qnil);
6366 /* If we changed the endpoint, then we need to set its
6367 openness. We are setting the endpoint to be the same as
6368 that of the extent we're about to remove, and we assume
6369 (the invariant mentioned above) that extent has the
6370 proper endpoint setting, so we just use it. */
6371 set_extent_openness(te, new_start != e_start ?
6372 (int)extent_start_open_p(e) : -1,
6374 (int)extent_end_open_p(e) : -1);
6375 closure->changed_p = 1;
6378 } else if (e_end <= end) {
6379 /* Extent begins before start but ends before end, so we can just
6380 decrease its end position.
6382 if (e_end != start) {
6383 set_extent_endpoints(e, e_start, start, Qnil);
6384 set_extent_openness(e, -1, NILP(get_text_property_bytind
6385 (start - 1, Qend_closed,
6387 EXTENT_AT_AFTER, 1)));
6388 closure->changed_p = 1;
6390 } else if (e_start >= start) {
6391 /* Extent ends after end but begins after start, so we can just
6392 increase its start position.
6394 if (e_start != end) {
6395 set_extent_endpoints(e, end, e_end, Qnil);
6396 set_extent_openness(e, !NILP(get_text_property_bytind
6397 (end, Qstart_open, object,
6398 EXTENT_AT_AFTER, 1)), -1);
6399 closure->changed_p = 1;
6402 /* Otherwise, `extent' straddles the region. We need to split it.
6404 set_extent_endpoints(e, e_start, start, Qnil);
6405 set_extent_openness(e, -1, NILP(get_text_property_bytind
6406 (start - 1, Qend_closed, object,
6407 EXTENT_AT_AFTER, 1)));
6408 set_extent_openness(copy_extent
6409 (e, end, e_end, extent_object(e)),
6410 !NILP(get_text_property_bytind
6411 (end, Qstart_open, object,
6412 EXTENT_AT_AFTER, 1)), -1);
6413 closure->changed_p = 1;
6416 return 0; /* to continue mapping. */
6419 static int put_text_prop_openness_mapper(EXTENT e, void *arg)
6421 struct put_text_prop_arg *closure = (struct put_text_prop_arg *)arg;
6422 Bytind e_start, e_end;
6423 Bytind start = closure->start;
6424 Bytind end = closure->end;
6426 XSETEXTENT(extent, e);
6427 e_start = extent_endpoint_bytind(e, 0);
6428 e_end = extent_endpoint_bytind(e, 1);
6430 if (NILP(Fextent_property(extent, Qtext_prop, Qnil))) {
6431 /* It's not a text-property extent; do nothing. */
6434 /* Note end conditions and NILP/!NILP's carefully. */
6435 else if (EQ(closure->prop, Qstart_open)
6436 && e_start >= start && e_start < end)
6437 set_extent_openness(e, !NILP(closure->value), -1);
6438 else if (EQ(closure->prop, Qend_closed)
6439 && e_end > start && e_end <= end)
6440 set_extent_openness(e, -1, NILP(closure->value));
6442 return 0; /* to continue mapping. */
6446 put_text_prop(Bytind start, Bytind end, Lisp_Object object,
6447 Lisp_Object prop, Lisp_Object value, int duplicable_p)
6449 /* This function can GC */
6450 struct put_text_prop_arg closure;
6452 if (start == end) /* There are no characters in the region. */
6455 /* convert to the non-default versions, since a nil property is
6456 the same as it not being present. */
6457 if (EQ(prop, Qstart_closed)) {
6459 value = NILP(value) ? Qt : Qnil;
6460 } else if (EQ(prop, Qend_open)) {
6462 value = NILP(value) ? Qt : Qnil;
6465 value = canonicalize_extent_property(prop, value);
6467 closure.prop = prop;
6468 closure.value = value;
6469 closure.start = start;
6471 closure.object = object;
6472 closure.changed_p = 0;
6473 closure.the_extent = Qnil;
6475 map_extents_bytind(start, end,
6476 put_text_prop_mapper, (void *)&closure, object, 0,
6477 /* get all extents that abut the region */
6478 ME_ALL_EXTENTS_CLOSED | ME_END_CLOSED |
6479 /* it might QUIT or error if the user has
6480 fucked with the extent plist. */
6481 /* #### dmoore - I think this should include
6482 ME_MIGHT_MOVE_SOE, since the callback function
6483 might recurse back into map_extents_bytind. */
6484 ME_MIGHT_THROW | ME_MIGHT_MODIFY_EXTENTS);
6486 /* If we made it through the loop without reusing an extent
6487 (and we want there to be one) make it now.
6489 if (!NILP(value) && NILP(closure.the_extent)) {
6492 XSETEXTENT(extent, make_extent_internal(object, start, end));
6493 closure.changed_p = 1;
6494 Fset_extent_property(extent, Qtext_prop, prop);
6495 Fset_extent_property(extent, prop, value);
6497 extent_duplicable_p(XEXTENT(extent)) = 1;
6498 Fset_extent_property(extent, Qpaste_function,
6499 Qtext_prop_extent_paste_function);
6501 set_extent_openness(XEXTENT(extent),
6502 !NILP(get_text_property_bytind
6503 (start, Qstart_open, object,
6504 EXTENT_AT_AFTER, 1)),
6505 NILP(get_text_property_bytind
6506 (end - 1, Qend_closed, object,
6507 EXTENT_AT_AFTER, 1)));
6510 if (EQ(prop, Qstart_open) || EQ(prop, Qend_closed)) {
6511 map_extents_bytind(start, end,
6512 put_text_prop_openness_mapper,
6513 (void *)&closure, object, 0,
6514 /* get all extents that abut the region */
6515 ME_ALL_EXTENTS_CLOSED | ME_END_CLOSED |
6516 ME_MIGHT_MODIFY_EXTENTS);
6519 return closure.changed_p;
6522 DEFUN("put-text-property", Fput_text_property, 4, 5, 0, /*
6523 Adds the given property/value to all characters in the specified region.
6524 The property is conceptually attached to the characters rather than the
6525 region. The properties are copied when the characters are copied/pasted.
6526 Fifth argument OBJECT is the buffer or string containing the text, and
6527 defaults to the current buffer.
6529 (start, end, prop, value, object))
6531 /* This function can GC */
6534 object = decode_buffer_or_string(object);
6535 get_buffer_or_string_range_byte(object, start, end, &s, &e, 0);
6536 put_text_prop(s, e, object, prop, value, 1);
6540 DEFUN("put-nonduplicable-text-property", Fput_nonduplicable_text_property, 4, 5, 0, /*
6541 Adds the given property/value to all characters in the specified region.
6542 The property is conceptually attached to the characters rather than the
6543 region, however the properties will not be copied when the characters
6545 Fifth argument OBJECT is the buffer or string containing the text, and
6546 defaults to the current buffer.
6548 (start, end, prop, value, object))
6550 /* This function can GC */
6553 object = decode_buffer_or_string(object);
6554 get_buffer_or_string_range_byte(object, start, end, &s, &e, 0);
6555 put_text_prop(s, e, object, prop, value, 0);
6559 DEFUN("add-text-properties", Fadd_text_properties, 3, 4, 0, /*
6560 Add properties to the characters from START to END.
6561 The third argument PROPS is a property list specifying the property values
6562 to add. The optional fourth argument, OBJECT, is the buffer or string
6563 containing the text and defaults to the current buffer. Returns t if
6564 any property was changed, nil otherwise.
6566 (start, end, props, object))
6568 /* This function can GC */
6572 object = decode_buffer_or_string(object);
6573 get_buffer_or_string_range_byte(object, start, end, &s, &e, 0);
6575 for (; !NILP(props); props = Fcdr(Fcdr(props))) {
6576 Lisp_Object prop = XCAR(props);
6577 Lisp_Object value = Fcar(XCDR(props));
6578 changed |= put_text_prop(s, e, object, prop, value, 1);
6580 return changed ? Qt : Qnil;
6583 DEFUN("add-nonduplicable-text-properties", Fadd_nonduplicable_text_properties, 3, 4, 0, /*
6584 Add nonduplicable properties to the characters from START to END.
6585 \(The properties will not be copied when the characters are copied.)
6586 The third argument PROPS is a property list specifying the property values
6587 to add. The optional fourth argument, OBJECT, is the buffer or string
6588 containing the text and defaults to the current buffer. Returns t if
6589 any property was changed, nil otherwise.
6591 (start, end, props, object))
6593 /* This function can GC */
6597 object = decode_buffer_or_string(object);
6598 get_buffer_or_string_range_byte(object, start, end, &s, &e, 0);
6600 for (; !NILP(props); props = Fcdr(Fcdr(props))) {
6601 Lisp_Object prop = XCAR(props);
6602 Lisp_Object value = Fcar(XCDR(props));
6603 changed |= put_text_prop(s, e, object, prop, value, 0);
6605 return changed ? Qt : Qnil;
6608 DEFUN("remove-text-properties", Fremove_text_properties, 3, 4, 0, /*
6609 Remove the given properties from all characters in the specified region.
6610 PROPS should be a plist, but the values in that plist are ignored (treated
6611 as nil). Returns t if any property was changed, nil otherwise.
6612 Fourth argument OBJECT is the buffer or string containing the text, and
6613 defaults to the current buffer.
6615 (start, end, props, object))
6617 /* This function can GC */
6621 object = decode_buffer_or_string(object);
6622 get_buffer_or_string_range_byte(object, start, end, &s, &e, 0);
6624 for (; !NILP(props); props = Fcdr(Fcdr(props))) {
6625 Lisp_Object prop = XCAR(props);
6626 changed |= put_text_prop(s, e, object, prop, Qnil, 1);
6628 return changed ? Qt : Qnil;
6631 /* Whenever a text-prop extent is pasted into a buffer (via `yank' or `insert'
6632 or whatever) we attach the properties to the buffer by calling
6633 `put-text-property' instead of by simply allowing the extent to be copied or
6634 re-attached. Then we return nil, telling the extents code not to attach it
6635 again. By handing the insertion hackery in this way, we make kill/yank
6636 behave consistently with put-text-property and not fragment the extents
6637 (since text-prop extents must partition, not overlap).
6639 The lisp implementation of this was probably fast enough, but since I moved
6640 the rest of the put-text-prop code here, I moved this as well for
6643 DEFUN("text-prop-extent-paste-function", Ftext_prop_extent_paste_function, 3, 3, 0, /*
6644 Used as the `paste-function' property of `text-prop' extents.
6648 /* This function can GC */
6649 Lisp_Object prop, val;
6651 prop = Fextent_property(extent, Qtext_prop, Qnil);
6653 signal_type_error(Qinternal_error,
6654 "Internal error: no text-prop", extent);
6655 val = Fextent_property(extent, prop, Qnil);
6657 /* removed by bill perry, 2/9/97
6658 ** This little bit of code would not allow you to have a text property
6659 ** with a value of Qnil. This is bad bad bad.
6662 signal_type_error_2(Qinternal_error,
6663 "Internal error: no text-prop",
6666 Fput_text_property(from, to, prop, val, Qnil);
6667 return Qnil; /* important! */
6670 /* This function could easily be written in Lisp but the C code wants
6671 to use it in connection with invisible extents (at least currently).
6672 If this changes, consider moving this back into Lisp. */
6674 DEFUN("next-single-property-change", Fnext_single_property_change, 2, 4, 0, /*
6675 Return the position of next property change for a specific property.
6676 Scans characters forward from POS till it finds a change in the PROP
6677 property, then returns the position of the change. The optional third
6678 argument OBJECT is the buffer or string to scan (defaults to the current
6680 The property values are compared with `eq'.
6681 Return nil if the property is constant all the way to the end of OBJECT.
6682 If the value is non-nil, it is a position greater than POS, never equal.
6684 If the optional fourth argument LIMIT is non-nil, don't search
6685 past position LIMIT; return LIMIT if nothing is found before LIMIT.
6686 If two or more extents with conflicting non-nil values for PROP overlap
6687 a particular character, it is undefined which value is considered to be
6688 the value of PROP. (Note that this situation will not happen if you always
6689 use the text-property primitives.)
6691 (pos, prop, object, limit))
6695 Lisp_Object extent, value;
6698 object = decode_buffer_or_string(object);
6699 bpos = get_buffer_or_string_pos_char(object, pos, 0);
6701 blim = buffer_or_string_accessible_end_char(object);
6704 blim = get_buffer_or_string_pos_char(object, limit, 0);
6708 extent = Fextent_at(make_int(bpos), object, prop, Qnil, Qnil);
6710 value = Fextent_property(extent, prop, Qnil);
6715 bpos = XINT(Fnext_extent_change(make_int(bpos), object));
6717 break; /* property is the same all the way to the end */
6718 extent = Fextent_at(make_int(bpos), object, prop, Qnil, Qnil);
6719 if ((NILP(extent) && !NILP(value)) ||
6720 (!NILP(extent) && !EQ(value,
6721 Fextent_property(extent, prop,
6723 return make_int(bpos);
6726 /* I think it's more sensible for this function to return nil always
6727 in this situation and it used to do it this way, but it's been changed
6728 for FSF compatibility. */
6732 return make_int(blim);
6735 /* See comment on previous function about why this is written in C. */
6737 DEFUN("previous-single-property-change", Fprevious_single_property_change, 2, 4, 0, /*
6738 Return the position of next property change for a specific property.
6739 Scans characters backward from POS till it finds a change in the PROP
6740 property, then returns the position of the change. The optional third
6741 argument OBJECT is the buffer or string to scan (defaults to the current
6743 The property values are compared with `eq'.
6744 Return nil if the property is constant all the way to the start of OBJECT.
6745 If the value is non-nil, it is a position less than POS, never equal.
6747 If the optional fourth argument LIMIT is non-nil, don't search back
6748 past position LIMIT; return LIMIT if nothing is found until LIMIT.
6749 If two or more extents with conflicting non-nil values for PROP overlap
6750 a particular character, it is undefined which value is considered to be
6751 the value of PROP. (Note that this situation will not happen if you always
6752 use the text-property primitives.)
6754 (pos, prop, object, limit))
6758 Lisp_Object extent, value;
6761 object = decode_buffer_or_string(object);
6762 bpos = get_buffer_or_string_pos_char(object, pos, 0);
6764 blim = buffer_or_string_accessible_begin_char(object);
6767 blim = get_buffer_or_string_pos_char(object, limit, 0);
6771 /* extent-at refers to the character AFTER bpos, but we want the
6772 character before bpos. Thus the - 1. extent-at simply
6773 returns nil on bogus positions, so not to worry. */
6774 extent = Fextent_at(make_int(bpos - 1), object, prop, Qnil, Qnil);
6776 value = Fextent_property(extent, prop, Qnil);
6781 bpos = XINT(Fprevious_extent_change(make_int(bpos), object));
6783 break; /* property is the same all the way to the beginning */
6785 Fextent_at(make_int(bpos - 1), object, prop, Qnil, Qnil);
6786 if ((NILP(extent) && !NILP(value))
6788 && !EQ(value, Fextent_property(extent, prop, Qnil))))
6789 return make_int(bpos);
6792 /* I think it's more sensible for this function to return nil always
6793 in this situation and it used to do it this way, but it's been changed
6794 for FSF compatibility. */
6798 return make_int(blim);
6801 #ifdef MEMORY_USAGE_STATS
6804 compute_buffer_extent_usage(struct buffer *b, struct overhead_stats *ovstats)
6806 /* #### not yet written */
6810 #endif /* MEMORY_USAGE_STATS */
6812 /************************************************************************/
6813 /* initialization */
6814 /************************************************************************/
6816 void syms_of_extents(void)
6818 INIT_LRECORD_IMPLEMENTATION(extent);
6819 INIT_LRECORD_IMPLEMENTATION(extent_info);
6820 INIT_LRECORD_IMPLEMENTATION(extent_auxiliary);
6822 defsymbol(&Qextentp, "extentp");
6823 defsymbol(&Qextent_live_p, "extent-live-p");
6825 defsymbol(&Qall_extents_closed, "all-extents-closed");
6826 defsymbol(&Qall_extents_open, "all-extents-open");
6827 defsymbol(&Qall_extents_closed_open, "all-extents-closed-open");
6828 defsymbol(&Qall_extents_open_closed, "all-extents-open-closed");
6829 defsymbol(&Qstart_in_region, "start-in-region");
6830 defsymbol(&Qend_in_region, "end-in-region");
6831 defsymbol(&Qstart_and_end_in_region, "start-and-end-in-region");
6832 defsymbol(&Qstart_or_end_in_region, "start-or-end-in-region");
6833 defsymbol(&Qnegate_in_region, "negate-in-region");
6835 defsymbol(&Qdetached, "detached");
6836 defsymbol(&Qdestroyed, "destroyed");
6837 defsymbol(&Qbegin_glyph, "begin-glyph");
6838 defsymbol(&Qend_glyph, "end-glyph");
6839 defsymbol(&Qstart_open, "start-open");
6840 defsymbol(&Qend_open, "end-open");
6841 defsymbol(&Qstart_closed, "start-closed");
6842 defsymbol(&Qend_closed, "end-closed");
6843 defsymbol(&Qread_only, "read-only");
6844 /* defsymbol (&Qhighlight, "highlight"); in faces.c */
6845 defsymbol(&Qunique, "unique");
6846 defsymbol(&Qduplicable, "duplicable");
6847 defsymbol(&Qdetachable, "detachable");
6848 defsymbol(&Qpriority, "priority");
6849 defsymbol(&Qmouse_face, "mouse-face");
6850 defsymbol(&Qinitial_redisplay_function, "initial-redisplay-function");
6852 defsymbol(&Qglyph_layout, "glyph-layout"); /* backwards compatibility */
6853 defsymbol(&Qbegin_glyph_layout, "begin-glyph-layout");
6854 defsymbol(&Qend_glyph_layout, "end-glyph-layout");
6855 defsymbol(&Qoutside_margin, "outside-margin");
6856 defsymbol(&Qinside_margin, "inside-margin");
6857 defsymbol(&Qwhitespace, "whitespace");
6858 /* Qtext defined in general.c */
6860 defsymbol(&Qpaste_function, "paste-function");
6861 defsymbol(&Qcopy_function, "copy-function");
6863 defsymbol(&Qtext_prop, "text-prop");
6864 defsymbol(&Qtext_prop_extent_paste_function,
6865 "text-prop-extent-paste-function");
6868 DEFSUBR(Fextent_live_p);
6869 DEFSUBR(Fextent_detached_p);
6870 DEFSUBR(Fextent_start_position);
6871 DEFSUBR(Fextent_end_position);
6872 DEFSUBR(Fextent_object);
6873 DEFSUBR(Fextent_length);
6875 DEFSUBR(Fmake_extent);
6876 DEFSUBR(Fcopy_extent);
6877 DEFSUBR(Fdelete_extent);
6878 DEFSUBR(Fdetach_extent);
6879 DEFSUBR(Fset_extent_endpoints);
6880 DEFSUBR(Fnext_extent);
6881 DEFSUBR(Fprevious_extent);
6883 DEFSUBR(Fnext_e_extent);
6884 DEFSUBR(Fprevious_e_extent);
6886 DEFSUBR(Fnext_extent_change);
6887 DEFSUBR(Fprevious_extent_change);
6889 DEFSUBR(Fextent_parent);
6890 DEFSUBR(Fextent_children);
6891 DEFSUBR(Fset_extent_parent);
6893 DEFSUBR(Fextent_in_region_p);
6894 DEFSUBR(Fmap_extents);
6895 DEFSUBR(Fmap_extent_children);
6896 DEFSUBR(Fextent_at);
6897 DEFSUBR(Fextents_at);
6899 DEFSUBR(Fset_extent_initial_redisplay_function);
6900 DEFSUBR(Fextent_face);
6901 DEFSUBR(Fset_extent_face);
6902 DEFSUBR(Fextent_mouse_face);
6903 DEFSUBR(Fset_extent_mouse_face);
6904 DEFSUBR(Fset_extent_begin_glyph);
6905 DEFSUBR(Fset_extent_end_glyph);
6906 DEFSUBR(Fextent_begin_glyph);
6907 DEFSUBR(Fextent_end_glyph);
6908 DEFSUBR(Fset_extent_begin_glyph_layout);
6909 DEFSUBR(Fset_extent_end_glyph_layout);
6910 DEFSUBR(Fextent_begin_glyph_layout);
6911 DEFSUBR(Fextent_end_glyph_layout);
6912 DEFSUBR(Fset_extent_priority);
6913 DEFSUBR(Fextent_priority);
6914 DEFSUBR(Fset_extent_property);
6915 DEFSUBR(Fset_extent_properties);
6916 DEFSUBR(Fextent_property);
6917 DEFSUBR(Fextent_properties);
6919 DEFSUBR(Fhighlight_extent);
6920 DEFSUBR(Fforce_highlight_extent);
6922 DEFSUBR(Finsert_extent);
6924 DEFSUBR(Fget_text_property);
6925 DEFSUBR(Fget_char_property);
6926 DEFSUBR(Fput_text_property);
6927 DEFSUBR(Fput_nonduplicable_text_property);
6928 DEFSUBR(Fadd_text_properties);
6929 DEFSUBR(Fadd_nonduplicable_text_properties);
6930 DEFSUBR(Fremove_text_properties);
6931 DEFSUBR(Ftext_prop_extent_paste_function);
6932 DEFSUBR(Fnext_single_property_change);
6933 DEFSUBR(Fprevious_single_property_change);
6936 void reinit_vars_of_extents(void)
6938 extent_auxiliary_defaults.begin_glyph = Qnil;
6939 extent_auxiliary_defaults.end_glyph = Qnil;
6940 extent_auxiliary_defaults.parent = Qnil;
6941 extent_auxiliary_defaults.children = Qnil;
6942 extent_auxiliary_defaults.priority = 0;
6943 extent_auxiliary_defaults.invisible = Qnil;
6944 extent_auxiliary_defaults.read_only = Qnil;
6945 extent_auxiliary_defaults.mouse_face = Qnil;
6946 extent_auxiliary_defaults.initial_redisplay_function = Qnil;
6947 extent_auxiliary_defaults.before_change_functions = Qnil;
6948 extent_auxiliary_defaults.after_change_functions = Qnil;
6951 void vars_of_extents(void)
6953 reinit_vars_of_extents();
6955 DEFVAR_INT("mouse-highlight-priority", &mouse_highlight_priority /*
6956 The priority to use for the mouse-highlighting pseudo-extent
6957 that is used to highlight extents with the `mouse-face' attribute set.
6958 See `set-extent-priority'.
6960 /* Set mouse-highlight-priority (which ends up being used both for the
6961 mouse-highlighting pseudo-extent and the primary selection extent)
6962 to a very high value because very few extents should override it.
6963 1000 gives lots of room below it for different-prioritized extents.
6964 10 doesn't. ediff, for example, likes to use priorities around 100.
6966 mouse_highlight_priority = /* 10 */ 1000;
6968 DEFVAR_LISP("default-text-properties", &Vdefault_text_properties /*
6969 Property list giving default values for text properties.
6970 Whenever a character does not specify a value for a property, the value
6971 stored in this list is used instead. This only applies when the
6972 functions `get-text-property' or `get-char-property' are called.
6974 Vdefault_text_properties = Qnil;
6976 staticpro(&Vlast_highlighted_extent);
6977 Vlast_highlighted_extent = Qnil;
6979 Vextent_face_reusable_list = Fcons(Qnil, Qnil);
6980 staticpro(&Vextent_face_reusable_list);
6983 void complex_vars_of_extents(void)
6985 staticpro(&Vextent_face_memoize_hash_table);
6986 /* The memoize hash table maps from lists of symbols to lists of
6987 faces. It needs to be `equal' to implement the memoization.
6988 The reverse table maps in the other direction and just needs
6989 to do `eq' comparison because the lists of faces are already
6991 Vextent_face_memoize_hash_table =
6992 make_lisp_hash_table(100, HASH_TABLE_VALUE_WEAK, HASH_TABLE_EQUAL);
6993 staticpro(&Vextent_face_reverse_memoize_hash_table);
6994 Vextent_face_reverse_memoize_hash_table =
6995 make_lisp_hash_table(100, HASH_TABLE_KEY_WEAK, HASH_TABLE_EQ);