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 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)) {
672 prev->next = p->next;
674 ga->markers = p->next;
676 #if defined HAVE_BDWGC && defined EF_USE_BDWGC
679 m->next = gap_array_marker_freelist;
681 gap_array_marker_freelist = m;
687 gap_array_delete_all_markers(gap_array_t ga)
689 for (gap_array_marker_t p = ga->markers, next; p; p = next) {
691 #if defined HAVE_BDWGC && defined EF_USE_BDWGC
694 p->next = gap_array_marker_freelist;
696 gap_array_marker_freelist = p;
704 gap_array_move_marker(gap_array_t ga, gap_array_marker_t m, int pos)
706 assert(pos >= 0 && pos <= ga->numels);
707 m->pos = GAP_ARRAY_ARRAY_TO_MEMORY_POS(ga, pos);
710 #define gap_array_marker_pos(ga, m) \
711 GAP_ARRAY_MEMORY_TO_ARRAY_POS (ga, (m)->pos)
714 make_gap_array(int elsize)
716 gap_array_t ga = xnew_and_zero(struct gap_array_s);
722 free_gap_array(gap_array_t ga)
727 gap_array_delete_all_markers(ga);
732 /************************************************************************/
733 /* Extent list primitives */
734 /************************************************************************/
736 /* A list of extents is maintained as a double gap array: one gap array
737 is ordered by start index (the "display order") and the other is
738 ordered by end index (the "e-order"). Note that positions in an
739 extent list should logically be conceived of as referring *to*
740 a particular extent (as is the norm in programs) rather than
741 sitting between two extents. Note also that callers of these
742 functions should not be aware of the fact that the extent list is
743 implemented as an array, except for the fact that positions are
744 integers (this should be generalized to handle integers and linked
748 /* Number of elements in an extent list */
749 #define extent_list_num_els(el) GAP_ARRAY_NUM_ELS(el->start)
751 /* Return the position at which EXTENT is located in the specified extent
752 list (in the display order if ENDP is 0, in the e-order otherwise).
753 If the extent is not found, the position where the extent would
754 be inserted is returned. If ENDP is 0, the insertion would go after
755 all other equal extents. If ENDP is not 0, the insertion would go
756 before all other equal extents. If FOUNDP is not 0, then whether
757 the extent was found will get written into it. */
760 extent_list_locate(extent_list_t el, EXTENT extent, int endp, bool *foundp)
762 gap_array_t ga = endp ? el->end : el->start;
763 int left = 0, right = GAP_ARRAY_NUM_ELS(ga);
764 int oldfoundpos, foundpos;
767 while (left != right) {
768 /* RIGHT might not point to a valid extent (i.e. it's at the end
769 of the list), so NEWPOS must round down. */
770 unsigned int newpos = (left + right) >> 1;
771 EXTENT e = EXTENT_GAP_ARRAY_AT(ga, (int)newpos);
773 if (endp ? EXTENT_E_LESS(e, extent) : EXTENT_LESS(e, extent)) {
780 /* Now we're at the beginning of all equal extents. */
782 oldfoundpos = foundpos = left;
783 while (foundpos < GAP_ARRAY_NUM_ELS(ga)) {
784 EXTENT e = EXTENT_GAP_ARRAY_AT(ga, foundpos);
789 if (!EXTENT_EQUAL(e, extent)) {
797 if (found || !endp) {
804 /* Return the position of the first extent that begins at or after POS
805 (or ends at or after POS, if ENDP is not 0).
807 An out-of-range value for POS is allowed, and guarantees that the
808 position at the beginning or end of the extent list is returned. */
811 extent_list_locate_from_pos(extent_list_t el, Memind pos, int endp)
813 struct extent fake_extent;
816 Note that if we search for [POS, POS], then we get the following:
818 -- if ENDP is 0, then all extents whose start position is <= POS
819 lie before the returned position, and all extents whose start
820 position is > POS lie at or after the returned position.
822 -- if ENDP is not 0, then all extents whose end position is < POS
823 lie before the returned position, and all extents whose end
824 position is >= POS lie at or after the returned position.
827 set_extent_start(&fake_extent, endp ? pos : pos - 1);
828 set_extent_end(&fake_extent, endp ? pos : pos - 1);
829 return extent_list_locate(el, &fake_extent, endp, 0);
832 /* Return the extent at POS. */
835 extent_list_at(extent_list_t el, Memind pos, int endp)
837 gap_array_t ga = endp ? el->end : el->start;
839 assert(pos >= 0 && pos < GAP_ARRAY_NUM_ELS(ga));
840 return EXTENT_GAP_ARRAY_AT(ga, pos);
843 /* Insert an extent into an extent list. */
846 extent_list_insert(extent_list_t el, EXTENT extent)
851 pos = extent_list_locate(el, extent, 0, &foundp);
853 gap_array_insert_els(el->start, pos, &extent, 1);
854 pos = extent_list_locate(el, extent, 1, &foundp);
856 gap_array_insert_els(el->end, pos, &extent, 1);
860 /* Delete an extent from an extent list. */
863 extent_list_delete(extent_list_t el, EXTENT extent)
868 pos = extent_list_locate(el, extent, 0, &foundp);
870 gap_array_delete_els(el->start, pos, 1);
871 pos = extent_list_locate(el, extent, 1, &foundp);
873 gap_array_delete_els(el->end, pos, 1);
878 extent_list_delete_all(extent_list_t el)
880 gap_array_delete_els(el->start, 0, GAP_ARRAY_NUM_ELS(el->start));
881 gap_array_delete_els(el->end, 0, GAP_ARRAY_NUM_ELS(el->end));
885 static extent_list_marker_t
886 extent_list_make_marker(extent_list_t el, int pos, int endp)
888 extent_list_marker_t m;
890 #if defined HAVE_BDWGC && defined EF_USE_BDWGC
891 m = xnew(struct extent_list_marker_s);
893 if (extent_list_marker_freelist) {
894 m = extent_list_marker_freelist;
895 extent_list_marker_freelist = extent_list_marker_freelist->next;
897 m = xnew(struct extent_list_marker_s);
901 m->m = gap_array_make_marker(endp ? el->end : el->start, pos);
903 m->next = el->markers;
908 #define extent_list_move_marker(el, mkr, pos) \
909 gap_array_move_marker((mkr)->endp \
911 : (el)->start, (mkr)->m, pos)
914 extent_list_delete_marker(extent_list_t el, extent_list_marker_t m)
916 extent_list_marker_t p, prev;
918 for (prev = 0, p = el->markers; p && p != m; prev = p, p = p->next);
925 prev->next = p->next;
927 el->markers = p->next;
929 #if defined HAVE_BDWGC && defined EF_USE_BDWGC
932 m->next = extent_list_marker_freelist;
933 extent_list_marker_freelist = m;
935 gap_array_delete_marker(m->endp ? el->end : el->start, m->m);
939 #define extent_list_marker_pos(el, mkr) \
940 gap_array_marker_pos ((mkr)->endp \
942 : (el)->start, (mkr)->m)
945 allocate_extent_list(void)
947 extent_list_t el = xnew(struct extent_list_s);
948 el->start = make_gap_array(sizeof(EXTENT));
949 el->end = make_gap_array(sizeof(EXTENT));
955 free_extent_list(extent_list_t el)
957 free_gap_array(el->start);
958 free_gap_array(el->end);
963 /************************************************************************/
964 /* Auxiliary extent structure */
965 /************************************************************************/
967 static Lisp_Object mark_extent_auxiliary(Lisp_Object obj)
969 struct extent_auxiliary *data = XEXTENT_AUXILIARY(obj);
970 mark_object(data->begin_glyph);
971 mark_object(data->end_glyph);
972 mark_object(data->invisible);
973 mark_object(data->children);
974 mark_object(data->read_only);
975 mark_object(data->mouse_face);
976 mark_object(data->initial_redisplay_function);
977 mark_object(data->before_change_functions);
978 mark_object(data->after_change_functions);
982 DEFINE_LRECORD_IMPLEMENTATION("extent-auxiliary", extent_auxiliary,
983 mark_extent_auxiliary, internal_object_printer,
984 0, 0, 0, 0, struct extent_auxiliary);
986 void allocate_extent_auxiliary(EXTENT ext)
988 Lisp_Object extent_aux;
989 struct extent_auxiliary *data =
990 alloc_lcrecord_type(struct extent_auxiliary,
991 &lrecord_extent_auxiliary);
993 copy_lcrecord(data, &extent_auxiliary_defaults);
994 XSETEXTENT_AUXILIARY(extent_aux, data);
995 ext->plist = Fcons(extent_aux, ext->plist);
996 ext->flags.has_aux = 1;
1000 /************************************************************************/
1001 /* Extent info structure */
1002 /************************************************************************/
1004 /* An extent-info structure consists of a list of the buffer or string's
1005 extents and a "stack of extents" that lists all of the extents over
1006 a particular position. The stack-of-extents info is used for
1007 optimization purposes -- it basically caches some info that might
1008 be expensive to compute. Certain otherwise hard computations are easy
1009 given the stack of extents over a particular position, and if the
1010 stack of extents over a nearby position is known (because it was
1011 calculated at some prior point in time), it's easy to move the stack
1012 of extents to the proper position.
1014 Given that the stack of extents is an optimization, and given that
1015 it requires memory, a string's stack of extents is wiped out each
1016 time a garbage collection occurs. Therefore, any time you retrieve
1017 the stack of extents, it might not be there. If you need it to
1018 be there, use the _force version.
1020 Similarly, a string may or may not have an extent_info structure.
1021 (Generally it won't if there haven't been any extents added to the
1022 string.) So use the _force version if you need the extent_info
1023 structure to be there. */
1025 static extent_stack_t allocate_soe(void);
1026 static void free_soe(extent_stack_t);
1027 static void soe_invalidate(Lisp_Object obj);
1029 #if !defined HAVE_BDWGC || !defined EF_USE_BDWGC
1031 mark_extent_info(Lisp_Object obj)
1033 struct extent_info *data = (struct extent_info *)XEXTENT_INFO(obj);
1035 extent_list_t list = data->extents;
1037 /* Vbuffer_defaults and Vbuffer_local_symbols are buffer-like
1038 objects that are created specially and never have their extent
1039 list initialized (or rather, it is set to zero in
1040 nuke_all_buffer_slots()). However, these objects get
1041 garbage-collected so we have to deal.
1043 (Also the list can be zero when we're dealing with a destroyed
1047 for (i = 0; i < extent_list_num_els(list); i++) {
1048 struct extent *extent = extent_list_at(list, i, 0);
1051 XSETEXTENT(exobj, extent);
1060 finalize_extent_info(void *header, int for_disksave)
1062 struct extent_info *data = (struct extent_info *)header;
1068 free_soe(data->soe);
1071 if (data->extents) {
1072 free_extent_list(data->extents);
1077 /* just define dummies */
1079 mark_extent_info(Lisp_Object SXE_UNUSED(obj))
1085 finalize_extent_info(void *SXE_UNUSED(header), int SXE_UNUSED(for_disksave))
1091 DEFINE_LRECORD_IMPLEMENTATION("extent-info", extent_info,
1092 mark_extent_info, internal_object_printer,
1093 finalize_extent_info, 0, 0, 0,
1094 struct extent_info);
1097 allocate_extent_info(void)
1099 Lisp_Object extent_info;
1100 struct extent_info *data =
1101 alloc_lcrecord_type(struct extent_info, &lrecord_extent_info);
1103 XSETEXTENT_INFO(extent_info, data);
1104 data->extents = allocate_extent_list();
1110 flush_cached_extent_info(Lisp_Object extent_info)
1112 struct extent_info *data = XEXTENT_INFO(extent_info);
1115 free_soe(data->soe);
1120 /************************************************************************/
1121 /* Buffer/string extent primitives */
1122 /************************************************************************/
1124 /* The functions in this section are the ONLY ones that should know
1125 about the internal implementation of the extent lists. Other functions
1126 should only know that there are two orderings on extents, the "display"
1127 order (sorted by start position, basically) and the e-order (sorted
1128 by end position, basically), and that certain operations are provided
1129 to manipulate the list. */
1131 /* ------------------------------- */
1132 /* basic primitives */
1133 /* ------------------------------- */
1136 decode_buffer_or_string(Lisp_Object object)
1138 if (LIKELY(NILP(object))) {
1139 XSETBUFFER(object, current_buffer);
1140 } else if (BUFFERP(object)) {
1141 CHECK_LIVE_BUFFER(object);
1142 } else if (STRINGP(object)) {
1145 dead_wrong_type_argument(Qbuffer_or_string_p, object);
1150 EXTENT extent_ancestor_1(EXTENT e)
1152 while (e->flags.has_parent) {
1153 /* There should be no circularities except in case of a logic
1154 error somewhere in the extent code */
1155 e = XEXTENT(XEXTENT_AUXILIARY(XCAR(e->plist))->parent);
1160 /* Given an extent object (string or buffer or nil), return its extent info.
1161 This may be 0 for a string. */
1163 static struct extent_info*
1164 buffer_or_string_extent_info(Lisp_Object object)
1166 if (STRINGP(object)) {
1167 Lisp_Object plist = XSTRING(object)->plist;
1168 if (!CONSP(plist) || !EXTENT_INFOP(XCAR(plist))) {
1171 return XEXTENT_INFO(XCAR(plist));
1172 } else if (NILP(object)) {
1175 return XEXTENT_INFO(XBUFFER(object)->extent_info);
1179 /* Given a string or buffer, return its extent list. This may be
1182 static extent_list_t
1183 buffer_or_string_extent_list(Lisp_Object object)
1185 struct extent_info *info = buffer_or_string_extent_info(object);
1190 return info->extents;
1193 /* Given a string or buffer, return its extent info. If it's not there,
1196 static struct extent_info*
1197 buffer_or_string_extent_info_force(Lisp_Object object)
1199 struct extent_info *info = buffer_or_string_extent_info(object);
1202 Lisp_Object extent_info;
1204 /* should never happen for buffers --
1205 the only buffers without an extent
1206 info are those after finalization,
1207 destroyed buffers, or special
1208 Lisp-inaccessible buffer objects. */
1209 assert(STRINGP(object));
1211 extent_info = allocate_extent_info();
1212 XSTRING(object)->plist =
1213 Fcons(extent_info, XSTRING(object)->plist);
1214 return XEXTENT_INFO(extent_info);
1219 /* Detach all the extents in OBJECT. Called from redisplay. */
1222 detach_all_extents(Lisp_Object object)
1224 struct extent_info *data = buffer_or_string_extent_info(object);
1227 if (data->extents) {
1229 i < extent_list_num_els(data->extents);
1231 EXTENT e = extent_list_at(data->extents, i, 0);
1232 /* No need to do detach_extent(). Just nuke the
1233 damn things, which results in the equivalent
1235 set_extent_start(e, -1);
1236 set_extent_end(e, -1);
1238 /* But we need to clear all the lists containing extents
1239 or havoc will result. */
1240 extent_list_delete_all(data->extents);
1242 soe_invalidate(object);
1248 init_buffer_extents(struct buffer *b)
1250 b->extent_info = allocate_extent_info();
1255 uninit_buffer_extents(struct buffer *b)
1257 struct extent_info *data = XEXTENT_INFO(b->extent_info);
1259 /* Don't destroy the extents here -- there may still be children
1260 extents pointing to the extents. */
1261 detach_all_extents(make_buffer(b));
1262 finalize_extent_info(data, 0);
1266 /* Retrieve the extent list that an extent is a member of; the
1267 return value will never be 0 except in destroyed buffers (in which
1268 case the only extents that can refer to this buffer are detached
1271 #define extent_extent_list(e) buffer_or_string_extent_list (extent_object (e))
1273 /* ------------------------------- */
1274 /* stack of extents */
1275 /* ------------------------------- */
1277 #ifdef ERROR_CHECK_EXTENTS
1280 sledgehammer_extent_check(Lisp_Object object)
1282 extent_list_t el = buffer_or_string_extent_list(object);
1283 struct buffer *buf = 0;
1288 if (BUFFERP(object)) {
1289 buf = XBUFFER(object);
1291 for (int endp = 0; endp < 2; endp++) {
1292 for (int i = 1; i < extent_list_num_els(el); i++) {
1293 EXTENT e1 = extent_list_at(el, i - 1, endp);
1294 EXTENT e2 = extent_list_at(el, i, endp);
1296 assert(extent_start(e1) <= buf->text->gpt ||
1298 buf->text->gpt + buf->text->gap_size);
1299 assert(extent_end(e1) <= buf->text->gpt
1301 buf->text->gpt + buf->text->gap_size);
1303 assert(extent_start(e1) <= extent_end(e1));
1305 ? (EXTENT_E_LESS_EQUAL(e1, e2))
1306 : (EXTENT_LESS_EQUAL(e1, e2)));
1311 #endif /* ERROR_CHECK_EXTENTS */
1313 static extent_stack_t
1314 buffer_or_string_stack_of_extents(Lisp_Object object)
1316 struct extent_info *info = buffer_or_string_extent_info(object);
1323 static extent_stack_t
1324 buffer_or_string_stack_of_extents_force(Lisp_Object object)
1326 struct extent_info *info = buffer_or_string_extent_info_force(object);
1328 info->soe = allocate_soe();
1333 /* #define SOE_DEBUG */
1337 static void print_extent_1(char *buf, Lisp_Object extent);
1340 print_extent_2(EXTENT e)
1345 XSETEXTENT(extent, e);
1346 print_extent_1(buf, extent);
1351 soe_dump(Lisp_Object obj)
1354 extent_stack_t soe = buffer_or_string_stack_of_extents(obj);
1363 printf("SOE pos is %d (memind %d)\n",
1364 soe->pos < 0 ? soe->pos :
1365 buffer_or_string_memind_to_bytind(obj, soe->pos), soe->pos);
1366 for (endp = 0; endp < 2; endp++) {
1367 printf(endp ? "SOE end:" : "SOE start:");
1368 for (i = 0; i < extent_list_num_els(sel); i++) {
1369 EXTENT e = extent_list_at(sel, i, endp);
1378 #endif /* SOE_DEBUG */
1380 /* Insert EXTENT into OBJ's stack of extents, if necessary. */
1383 soe_insert(Lisp_Object obj, EXTENT extent)
1385 extent_stack_t soe = buffer_or_string_stack_of_extents(obj);
1388 printf("Inserting into SOE: ");
1389 print_extent_2(extent);
1392 if (!soe || soe->pos < extent_start(extent) ||
1393 soe->pos > extent_end(extent)) {
1395 printf("(not needed)\n\n");
1399 extent_list_insert(soe->extents, extent);
1401 puts("SOE afterwards is:");
1407 /* Delete EXTENT from OBJ's stack of extents, if necessary. */
1410 soe_delete(Lisp_Object obj, EXTENT extent)
1412 extent_stack_t soe = buffer_or_string_stack_of_extents(obj);
1415 printf("Deleting from SOE: ");
1416 print_extent_2(extent);
1419 if (!soe || soe->pos < extent_start(extent) ||
1420 soe->pos > extent_end(extent)) {
1422 puts("(not needed)\n");
1426 extent_list_delete(soe->extents, extent);
1428 puts("SOE afterwards is:");
1434 /* Move OBJ's stack of extents to lie over the specified position. */
1437 soe_move(Lisp_Object obj, Memind pos)
1439 extent_stack_t soe = buffer_or_string_stack_of_extents_force(obj);
1440 extent_list_t sel = soe->extents;
1441 int numsoe = extent_list_num_els(sel);
1442 extent_list_t bel = buffer_or_string_extent_list(obj);
1446 #ifdef ERROR_CHECK_EXTENTS
1451 printf("Moving SOE from %d (memind %d) to %d (memind %d)\n",
1452 soe->pos < 0 ? soe->pos :
1453 buffer_or_string_memind_to_bytind(obj, soe->pos), soe->pos,
1454 buffer_or_string_memind_to_bytind(obj, pos), pos);
1456 if (soe->pos < pos) {
1459 } else if (soe->pos > pos) {
1464 puts("(not needed)\n");
1469 /* For DIRECTION = 1: Any extent that overlaps POS is either in the
1470 SOE (if the extent starts at or before SOE->POS) or is greater
1471 (in the display order) than any extent in the SOE (if it starts
1474 For DIRECTION = -1: Any extent that overlaps POS is either in the
1475 SOE (if the extent ends at or after SOE->POS) or is less (in the
1476 e-order) than any extent in the SOE (if it ends before SOE->POS).
1478 We proceed in two stages:
1480 1) delete all extents in the SOE that don't overlap POS.
1481 2) insert all extents into the SOE that start (or end, when
1482 DIRECTION = -1) in (SOE->POS, POS] and that overlap
1483 POS. (Don't include SOE->POS in the range because those
1484 extents would already be in the SOE.)
1490 /* Delete all extents in the SOE that don't overlap POS.
1491 This is all extents that end before (or start after,
1492 if DIRECTION = -1) POS.
1495 /* Deleting extents from the SOE is tricky because it changes
1496 the positions of extents. If we are deleting in the forward
1497 direction we have to call extent_list_at() on the same position
1498 over and over again because positions after the deleted element
1499 get shifted back by 1. To make life simplest, we delete forward
1500 irrespective of DIRECTION.
1505 if (direction > 0) {
1507 end = extent_list_locate_from_pos(sel, pos, 1);
1509 start = extent_list_locate_from_pos(sel, pos + 1, 0);
1513 for (i = start; i < end; i++) {
1515 sel, extent_list_at(sel, start, !endp));
1524 if (direction < 0) {
1526 extent_list_locate_from_pos(
1527 bel, soe->pos, endp) - 1;
1530 extent_list_locate_from_pos(
1531 bel, soe->pos + 1, endp);
1534 for (; start_pos >= 0 && start_pos < extent_list_num_els(bel);
1535 start_pos += direction) {
1536 EXTENT e = extent_list_at(bel, start_pos, endp);
1538 ? (extent_start(e) > pos)
1539 : (extent_end(e) < pos)) {
1540 /* All further extents lie on the far side of
1541 POS and thus can't overlap. */
1545 ? (extent_end(e) >= pos)
1546 : (extent_start(e) <= pos)) {
1547 extent_list_insert(sel, e);
1554 puts("SOE afterwards is:");
1561 soe_invalidate(Lisp_Object obj)
1563 extent_stack_t soe = buffer_or_string_stack_of_extents(obj);
1566 extent_list_delete_all(soe->extents);
1572 static extent_stack_t
1575 extent_stack_t soe = xnew_and_zero(struct extent_stack_s);
1576 soe->extents = allocate_extent_list();
1582 free_soe(extent_stack_t soe)
1584 free_extent_list(soe->extents);
1589 /* ------------------------------- */
1590 /* other primitives */
1591 /* ------------------------------- */
1593 /* Return the start (endp == 0) or end (endp == 1) of an extent as
1594 a byte index. If you want the value as a memory index, use
1595 extent_endpoint(). If you want the value as a buffer position,
1596 use extent_endpoint_bufpos(). */
1598 static Bytind extent_endpoint_bytind(EXTENT extent, int endp)
1600 assert(EXTENT_LIVE_P(extent));
1601 assert(!extent_detached_p(extent));
1603 Memind i = endp ? extent_end(extent) : extent_start(extent);
1604 Lisp_Object obj = extent_object(extent);
1605 return buffer_or_string_memind_to_bytind(obj, i);
1609 static Bufpos extent_endpoint_bufpos(EXTENT extent, int endp)
1611 assert(EXTENT_LIVE_P(extent));
1612 assert(!extent_detached_p(extent));
1614 Memind i = endp ? extent_end(extent) : extent_start(extent);
1615 Lisp_Object obj = extent_object(extent);
1616 return buffer_or_string_memind_to_bufpos(obj, i);
1620 /* A change to an extent occurred that will change the display, so
1621 notify redisplay. Maybe also recurse over all the extent's
1625 extent_changed_for_redisplay(EXTENT extent, int descendants_too,
1626 int invisibility_change)
1631 /* we could easily encounter a detached extent while traversing the
1632 children, but we should never be able to encounter a dead extent. */
1633 assert(EXTENT_LIVE_P(extent));
1635 if (descendants_too) {
1636 Lisp_Object children = extent_children(extent);
1638 if (!NILP(children)) {
1639 /* first mark all of the extent's children. We will
1640 lose big-time if there are any circularities here, so
1641 we sure as hell better ensure that there aren't. */
1642 LIST_LOOP(rest, XWEAK_LIST_LIST(children)) {
1643 extent_changed_for_redisplay(
1644 XEXTENT(XCAR(rest)), 1,
1645 invisibility_change);
1650 /* now mark the extent itself. */
1652 object = extent_object(extent);
1654 if (extent_detached_p(extent)) {
1657 } else if (STRINGP(object)) {
1658 /* #### Changes to string extents can affect redisplay if they
1659 are in the modeline or in the gutters.
1661 If the extent is in some generated-modeline-string: when we
1662 change an extent in generated-modeline-string, this changes
1663 its parent, which is in `modeline-format', so we should force
1664 the modeline to be updated. But how to determine whether a
1665 string is a `generated-modeline-string'? Looping through all
1666 buffers is not very efficient. Should we add all
1667 `generated-modeline-string' strings to a hash table? Maybe
1668 efficiency is not the greatest concern here and there's no
1669 big loss in looping over the buffers.
1671 If the extent is in a gutter we mark the gutter as
1672 changed. This means (a) we can update extents in the gutters
1673 when we need it. (b) we don't have to update the gutters when
1674 only extents attached to buffers have changed. */
1676 if (!in_modeline_generation) {
1677 MARK_EXTENTS_CHANGED;
1679 gutter_extent_signal_changed_region_maybe(
1681 extent_endpoint_bufpos(extent, 0),
1682 extent_endpoint_bufpos(extent, 1));
1684 } else if (BUFFERP(object)) {
1686 b = XBUFFER(object);
1687 BUF_FACECHANGE(b)++;
1688 MARK_EXTENTS_CHANGED;
1689 if (invisibility_change) {
1692 buffer_extent_signal_changed_region(
1694 extent_endpoint_bufpos(extent, 0),
1695 extent_endpoint_bufpos(extent, 1));
1699 /* A change to an extent occurred that might affect redisplay.
1700 This is called when properties such as the endpoints, the layout,
1701 or the priority changes. Redisplay will be affected only if
1702 the extent has any displayable attributes. */
1705 extent_maybe_changed_for_redisplay(EXTENT extent, int descendants_too,
1706 int invisibility_change)
1708 /* Retrieve the ancestor for efficiency */
1709 EXTENT anc = extent_ancestor(extent);
1710 if (!NILP(extent_face(anc)) ||
1711 !NILP(extent_begin_glyph(anc)) ||
1712 !NILP(extent_end_glyph(anc)) ||
1713 !NILP(extent_mouse_face(anc)) ||
1714 !NILP(extent_invisible(anc)) ||
1715 !NILP(extent_initial_redisplay_function(anc)) ||
1716 invisibility_change)
1717 extent_changed_for_redisplay(extent, descendants_too,
1718 invisibility_change);
1722 make_extent_detached(Lisp_Object object)
1724 EXTENT extent = allocate_extent();
1726 assert(NILP(object) || STRINGP(object) ||
1727 (BUFFERP(object) && BUFFER_LIVE_P(XBUFFER(object))));
1728 extent_object(extent) = object;
1729 /* Now make sure the extent info exists. */
1730 if (!NILP(object)) {
1731 buffer_or_string_extent_info_force(object);
1736 /* A "real" extent is any extent other than the internal (not-user-visible)
1737 extents used by `map-extents'. */
1740 real_extent_at_forward(extent_list_t el, int pos, int endp)
1742 for (; pos < extent_list_num_els(el); pos++) {
1743 EXTENT e = extent_list_at(el, pos, endp);
1744 if (!extent_internal_p(e)) {
1752 real_extent_at_backward(extent_list_t el, int pos, int endp)
1754 for (; pos >= 0; pos--) {
1755 EXTENT e = extent_list_at(el, pos, endp);
1756 if (!extent_internal_p(e)) {
1764 extent_first(Lisp_Object obj)
1766 extent_list_t el = buffer_or_string_extent_list(obj);
1771 return real_extent_at_forward(el, 0, 0);
1774 #ifdef DEBUG_SXEMACS
1776 extent_e_first(Lisp_Object obj)
1778 extent_list_t el = buffer_or_string_extent_list(obj);
1783 return real_extent_at_forward(el, 0, 1);
1785 #endif /* DEBUG_SXEMACS */
1788 extent_next(EXTENT e)
1790 extent_list_t el = extent_extent_list(e);
1792 int pos = extent_list_locate(el, e, 0, &foundp);
1794 return real_extent_at_forward(el, pos + 1, 0);
1797 #ifdef DEBUG_SXEMACS
1799 extent_e_next(EXTENT e)
1801 extent_list_t el = extent_extent_list(e);
1803 int pos = extent_list_locate(el, e, 1, &foundp);
1805 return real_extent_at_forward(el, pos + 1, 1);
1807 #endif /* DEBUG_SXEMACS */
1810 extent_last(Lisp_Object obj)
1812 extent_list_t el = buffer_or_string_extent_list(obj);
1817 return real_extent_at_backward(el, extent_list_num_els(el) - 1, 0);
1820 #ifdef DEBUG_SXEMACS
1822 extent_e_last(Lisp_Object obj)
1824 extent_list_t el = buffer_or_string_extent_list(obj);
1829 return real_extent_at_backward(el, extent_list_num_els(el) - 1, 1);
1831 #endif /* DEBUG_SXEMACS */
1834 extent_previous(EXTENT e)
1836 extent_list_t el = extent_extent_list(e);
1838 int pos = extent_list_locate(el, e, 0, &foundp);
1840 return real_extent_at_backward(el, pos - 1, 0);
1843 #ifdef DEBUG_SXEMACS
1845 extent_e_previous(EXTENT e)
1847 extent_list_t el = extent_extent_list(e);
1849 int pos = extent_list_locate(el, e, 1, &foundp);
1851 return real_extent_at_backward(el, pos - 1, 1);
1853 #endif /* DEBUG_SXEMACS */
1856 extent_attach(EXTENT extent)
1858 extent_list_t el = extent_extent_list(extent);
1860 extent_list_insert(el, extent);
1861 soe_insert(extent_object(extent), extent);
1862 /* only this extent changed */
1863 extent_maybe_changed_for_redisplay(
1864 extent, 0, !NILP(extent_invisible(extent)));
1869 extent_detach(EXTENT extent)
1873 if (extent_detached_p(extent)) {
1876 el = extent_extent_list(extent);
1878 /* call this before messing with the extent. */
1879 extent_maybe_changed_for_redisplay(
1880 extent, 0, !NILP(extent_invisible(extent)));
1881 extent_list_delete(el, extent);
1882 soe_delete(extent_object(extent), extent);
1883 set_extent_start(extent, -1);
1884 set_extent_end(extent, -1);
1888 /* ------------------------------- */
1889 /* map-extents et al. */
1890 /* ------------------------------- */
1892 /* Returns true iff map_extents() would visit the given extent.
1893 See the comments at map_extents() for info on the overlap rule.
1894 Assumes that all validation on the extent and buffer positions has
1895 already been performed (see Fextent_in_region_p ()).
1898 extent_in_region_p(EXTENT extent, Bytind from, Bytind to, unsigned int flags)
1900 Lisp_Object obj = extent_object(extent);
1901 Endpoint_Index start, end, exs, exe;
1902 int start_open, end_open;
1903 unsigned int all_extents_flags = flags & ME_ALL_EXTENTS_MASK;
1904 unsigned int in_region_flags = flags & ME_IN_REGION_MASK;
1907 /* A zero-length region is treated as closed-closed. */
1909 flags |= ME_END_CLOSED;
1910 flags &= ~ME_START_OPEN;
1913 /* So is a zero-length extent. */
1914 if (extent_start(extent) == extent_end(extent)) {
1915 start_open = 0, end_open = 0;
1916 } else if (LIKELY(all_extents_flags == 0)) {
1917 /* `all_extents_flags' will almost always be zero. */
1918 start_open = extent_start_open_p(extent);
1919 end_open = extent_end_open_p(extent);
1921 switch (all_extents_flags) {
1922 case ME_ALL_EXTENTS_CLOSED:
1923 start_open = 0, end_open = 0;
1925 case ME_ALL_EXTENTS_OPEN:
1926 start_open = 1, end_open = 1;
1928 case ME_ALL_EXTENTS_CLOSED_OPEN:
1929 start_open = 0, end_open = 1;
1931 case ME_ALL_EXTENTS_OPEN_CLOSED:
1932 start_open = 1, end_open = 0;
1939 start = buffer_or_string_bytind_to_startind(obj, from,
1940 flags & ME_START_OPEN);
1941 end = buffer_or_string_bytind_to_endind(obj, to,
1942 !(flags & ME_END_CLOSED));
1943 exs = memind_to_startind(extent_start(extent), start_open);
1944 exe = memind_to_endind(extent_end(extent), end_open);
1946 /* It's easy to determine whether an extent lies *outside* the
1947 region -- just determine whether it's completely before
1948 or completely after the region. Reject all such extents, so
1949 we're now left with only the extents that overlap the region.
1952 if (exs > end || exe < start) {
1955 /* See if any further restrictions are called for. */
1956 /* in_region_flags will almost always be zero. */
1957 if (in_region_flags == 0) {
1960 switch (in_region_flags) {
1961 case ME_START_IN_REGION:
1962 retval = start <= exs && exs <= end;
1964 case ME_END_IN_REGION:
1965 retval = start <= exe && exe <= end;
1967 case ME_START_AND_END_IN_REGION:
1968 retval = start <= exs && exe <= end;
1970 case ME_START_OR_END_IN_REGION:
1971 retval = (start <= exs && exs <= end) ||
1972 (start <= exe && exe <= end);
1979 return flags & ME_NEGATE_IN_REGION ? !retval : retval;
1982 struct map_extents_struct {
1984 extent_list_marker_t mkr;
1989 map_extents_unwind(Lisp_Object obj)
1991 struct map_extents_struct *closure =
1992 (struct map_extents_struct *)get_opaque_ptr(obj);
1993 free_opaque_ptr(obj);
1994 if (closure->range) {
1995 extent_detach(closure->range);
1998 extent_list_delete_marker(closure->el, closure->mkr);
2003 /* This is the guts of `map-extents' and the other functions that
2004 map over extents. In theory the operation of this function is
2005 simple: just figure out what extents we're mapping over, and
2006 call the function on each one of them in the range. Unfortunately
2007 there are a wide variety of things that the mapping function
2008 might do, and we have to be very tricky to avoid getting messed
2009 up. Furthermore, this function needs to be very fast (it is
2010 called multiple times every time text is inserted or deleted
2011 from a buffer), and so we can't always afford the overhead of
2012 dealing with all the possible things that the mapping function
2013 might do; thus, there are many flags that can be specified
2014 indicating what the mapping function might or might not do.
2016 The result of all this is that this is the most complicated
2017 function in this file. Change it at your own risk!
2019 A potential simplification to the logic below is to determine
2020 all the extents that the mapping function should be called on
2021 before any calls are actually made and save them in an array.
2022 That introduces its own complications, however (the array
2023 needs to be marked for garbage-collection, and a static array
2024 cannot be used because map_extents() needs to be reentrant).
2025 Furthermore, the results might be a little less sensible than
2029 map_extents_bytind(Bytind from, Bytind to, map_extents_fun fn, void *arg,
2030 Lisp_Object obj, EXTENT after, unsigned int flags)
2032 Memind st, en; /* range we're mapping over */
2033 EXTENT range = 0; /* extent for this, if ME_MIGHT_MODIFY_TEXT */
2034 extent_list_t el = 0; /* extent list we're iterating over */
2035 extent_list_marker_t posm = 0; /* marker for extent list,
2036 if ME_MIGHT_MODIFY_EXTENTS */
2037 /* count and struct for unwind-protect, if ME_MIGHT_THROW */
2039 struct map_extents_struct closure;
2041 #ifdef ERROR_CHECK_EXTENTS
2043 assert(from >= buffer_or_string_absolute_begin_byte(obj) &&
2044 from <= buffer_or_string_absolute_end_byte(obj) &&
2045 to >= buffer_or_string_absolute_begin_byte(obj) &&
2046 to <= buffer_or_string_absolute_end_byte(obj));
2050 assert(EQ(obj, extent_object(after)));
2051 assert(!extent_detached_p(after));
2054 el = buffer_or_string_extent_list(obj);
2055 if (!el || !extent_list_num_els(el))
2059 st = buffer_or_string_bytind_to_memind(obj, from);
2060 en = buffer_or_string_bytind_to_memind(obj, to);
2062 if (flags & ME_MIGHT_MODIFY_TEXT) {
2063 /* The mapping function might change the text in the buffer,
2064 so make an internal extent to hold the range we're mapping
2066 range = make_extent_detached(obj);
2067 set_extent_start(range, st);
2068 set_extent_end(range, en);
2069 range->flags.start_open = flags & ME_START_OPEN;
2070 range->flags.end_open = !(flags & ME_END_CLOSED);
2071 range->flags.internal = 1;
2072 range->flags.detachable = 0;
2073 extent_attach(range);
2076 if (flags & ME_MIGHT_THROW) {
2077 /* The mapping function might throw past us so we need to use an
2078 unwind_protect() to eliminate the internal extent and range
2080 count = specpdl_depth();
2081 closure.range = range;
2083 record_unwind_protect(map_extents_unwind,
2084 make_opaque_ptr(&closure));
2087 /* ---------- Figure out where we start and what direction
2088 we move in. This is the trickiest part of this
2089 function. ---------- */
2091 /* If ME_START_IN_REGION, ME_END_IN_REGION or ME_START_AND_END_IN_REGION
2092 was specified and ME_NEGATE_IN_REGION was not specified, our job
2093 is simple because of the presence of the display order and e-order.
2094 (Note that theoretically do something similar for
2095 ME_START_OR_END_IN_REGION, but that would require more trickiness
2096 than it's worth to avoid hitting the same extent twice.)
2098 In the general case, all the extents that overlap a range can be
2099 divided into two classes: those whose start position lies within
2100 the range (including the range's end but not including the
2101 range's start), and those that overlap the start position,
2102 i.e. those in the SOE for the start position. Or equivalently,
2103 the extents can be divided into those whose end position lies
2104 within the range and those in the SOE for the end position. Note
2105 that for this purpose we treat both the range and all extents in
2106 the buffer as closed on both ends. If this is not what the ME_
2107 flags specified, then we've mapped over a few too many extents,
2108 but no big deal because extent_in_region_p() will filter them
2109 out. Ideally, we could move the SOE to the closer of the range's
2110 two ends and work forwards or backwards from there. However, in
2111 order to make the semantics of the AFTER argument work out, we
2112 have to always go in the same direction; so we choose to always
2113 move the SOE to the start position.
2115 When it comes time to do the SOE stage, we first call soe_move()
2116 so that the SOE gets set up. Note that the SOE might get
2117 changed while we are mapping over its contents. If we can
2118 guarantee that the SOE won't get moved to a new position, we
2119 simply need to put a marker in the SOE and we will track deletions
2120 and insertions of extents in the SOE. If the SOE might get moved,
2121 however (this would happen as a result of a recursive invocation
2122 of map-extents or a call to a redisplay-type function), then
2123 trying to track its changes is hopeless, so we just keep a
2124 marker to the first (or last) extent in the SOE and use that as
2127 Finally, if DONT_USE_SOE is defined, we don't use the SOE at all
2128 and instead just map from the beginning of the buffer. This is
2129 used for testing purposes and allows the SOE to be calculated
2130 using map_extents() instead of the other way around. */
2133 int range_flag; /* ME_*_IN_REGION subset of flags */
2134 int do_soe_stage = 0; /* Are we mapping over the SOE? */
2135 /* Does the range stage map over start or end positions? */
2137 /* If type == 0, we include the start position in the range
2139 If type == 1, we exclude the start position in the range
2141 If type == 2, we begin at range_start_pos, an extent-list
2144 int range_start_type = 0;
2145 int range_start_pos = 0;
2148 range_flag = flags & ME_IN_REGION_MASK;
2149 if ((range_flag == ME_START_IN_REGION ||
2150 range_flag == ME_START_AND_END_IN_REGION) &&
2151 !(flags & ME_NEGATE_IN_REGION)) {
2152 /* map over start position in [range-start, range-end].
2155 } else if (range_flag == ME_END_IN_REGION
2156 && !(flags & ME_NEGATE_IN_REGION)) {
2157 /* map over end position in [range-start, range-end].
2161 /* Need to include the SOE extents. */
2163 /* Just brute-force it: start from the beginning. */
2165 range_start_type = 2;
2166 range_start_pos = 0;
2168 extent_stack_t soe =
2169 buffer_or_string_stack_of_extents_force(obj);
2172 /* Move the SOE to the closer end of the range. This
2173 dictates whether we map over start positions or end
2177 numsoe = extent_list_num_els(soe->extents);
2179 if (flags & ME_MIGHT_MOVE_SOE) {
2181 /* Can't map over SOE, so just extend
2182 range to cover the SOE. */
2183 EXTENT e = extent_list_at(
2184 soe->extents, 0, 0);
2185 range_start_pos = extent_list_locate
2186 (buffer_or_string_extent_list
2187 (obj), e, 0, &foundp);
2189 range_start_type = 2;
2191 /* We can map over the SOE. */
2193 range_start_type = 1;
2196 /* No extents in the SOE to map over, so we act
2197 just as if ME_START_IN_REGION or
2198 ME_END_IN_REGION was specified. RANGE_ENDP
2199 already specified so no need to do anything
2205 /* ---------- Now loop over the extents. ---------- */
2207 /* We combine the code for the two stages because much of it
2209 for (stage = 0; stage < 2; stage++) {
2210 int pos = 0; /* Position in extent list */
2212 /* First set up start conditions */
2213 if (stage == 0) { /* The SOE stage */
2216 el = buffer_or_string_stack_of_extents_force
2218 /* We will always be looping over start extents
2220 assert(!range_endp);
2222 } else { /* The range stage */
2223 el = buffer_or_string_extent_list(obj);
2224 switch (range_start_type) {
2226 pos = extent_list_locate_from_pos
2227 (el, st, range_endp);
2230 pos = extent_list_locate_from_pos
2231 (el, st + 1, range_endp);
2234 pos = range_start_pos;
2241 if (flags & ME_MIGHT_MODIFY_EXTENTS) {
2242 /* Create a marker to track changes to the
2245 /* Delete the marker used in the SOE
2247 extent_list_delete_marker
2248 (buffer_or_string_stack_of_extents_force
2249 (obj)->extents, posm);
2250 posm = extent_list_make_marker(
2251 el, pos, range_endp);
2252 /* tell the unwind function about the marker. */
2262 /* ----- update position in extent list
2263 and fetch next extent ----- */
2266 /* fetch POS again to track extent
2267 insertions or deletions */
2268 pos = extent_list_marker_pos(el, posm);
2270 if (pos >= extent_list_num_els(el)) {
2273 e = extent_list_at(el, pos, range_endp);
2276 /* now point the marker to the next one
2277 we're going to process. This ensures
2278 graceful behavior if this extent is
2280 extent_list_move_marker(el, posm, pos);
2282 /* ----- deal with internal extents ----- */
2284 if (extent_internal_p(e)) {
2285 if (!(flags & ME_INCLUDE_INTERNAL)) {
2287 } else if (e == range) {
2288 /* We're processing internal
2289 extents and we've come across
2290 our own special range extent.
2291 (This happens only in
2292 adjust_extents*() and
2293 process_extents*(), which
2294 handle text insertion and
2295 deletion.) We need to omit
2296 processing of this extent;
2297 otherwise we will probably
2299 terminating this loop. */
2304 /* ----- deal with AFTER condition ----- */
2307 /* if e > after, then we can stop
2308 skipping extents. */
2309 if (EXTENT_LESS(after, e)) {
2312 /* otherwise, skip this
2318 /* ----- stop if we're completely outside the
2321 /* fetch ST and EN again to track text
2322 insertions or deletions */
2324 st = extent_start(range);
2325 en = extent_end(range);
2327 if (extent_endpoint(e, range_endp) > en) {
2328 /* Can't be mapping over SOE because all
2329 extents in there should overlap ST */
2334 /* ----- Now actually call the function ----- */
2336 obj2 = extent_object(e);
2337 if (extent_in_region_p(
2339 buffer_or_string_memind_to_bytind
2341 buffer_or_string_memind_to_bytind
2342 (obj2, en), flags)) {
2343 if ((*fn) (e, arg)) {
2344 /* Function wants us to stop
2347 /* so outer for loop will
2354 /* ---------- Finished looping. ---------- */
2357 if (flags & ME_MIGHT_THROW) {
2358 /* This deletes the range extent and frees the marker. */
2359 unbind_to(count, Qnil);
2361 /* Delete them ourselves */
2363 extent_detach(range);
2366 extent_list_delete_marker(el, posm);
2372 map_extents(Bufpos from, Bufpos to, map_extents_fun fn,
2373 void *arg, Lisp_Object obj, EXTENT after, unsigned int flags)
2375 map_extents_bytind(buffer_or_string_bufpos_to_bytind(obj, from),
2376 buffer_or_string_bufpos_to_bytind(obj, to), fn, arg,
2380 /* ------------------------------- */
2381 /* adjust_extents() */
2382 /* ------------------------------- */
2384 /* Add AMOUNT to all extent endpoints in the range (FROM, TO]. This
2385 happens whenever the gap is moved or (under Mule) a character in a
2386 string is substituted for a different-length one. The reason for
2387 this is that extent endpoints behave just like markers (all memory
2388 indices do) and this adjustment correct for markers -- see
2389 adjust_markers(). Note that it is important that we visit all
2390 extent endpoints in the range, irrespective of whether the
2391 endpoints are open or closed.
2393 We could use map_extents() for this (and in fact the function
2394 was originally written that way), but the gap is in an incoherent
2395 state when this function is called and this function plays
2396 around with extent endpoints without detaching and reattaching
2397 the extents (this is provably correct and saves lots of time),
2398 so for safety we make it just look at the extent lists directly. */
2401 adjust_extents(Lisp_Object obj, Memind from, Memind to, int amount)
2409 #ifdef ERROR_CHECK_EXTENTS
2410 sledgehammer_extent_check(obj);
2412 el = buffer_or_string_extent_list(obj);
2414 if (!el || !extent_list_num_els(el)) {
2417 /* IMPORTANT! Compute the starting positions of the extents to
2418 modify BEFORE doing any modification! Otherwise the starting
2419 position for the second time through the loop might get
2420 incorrectly calculated (I got bit by this bug real bad). */
2421 startpos[0] = extent_list_locate_from_pos(el, from + 1, 0);
2422 startpos[1] = extent_list_locate_from_pos(el, from + 1, 1);
2423 for (endp = 0; endp < 2; endp++) {
2424 for (pos = startpos[endp]; pos < extent_list_num_els(el);
2426 EXTENT e = extent_list_at(el, pos, endp);
2427 if (extent_endpoint(e, endp) > to) {
2430 set_extent_endpoint(
2432 do_marker_adjustment(
2433 extent_endpoint(e, endp),
2439 /* The index for the buffer's SOE is a memory index and thus
2440 needs to be adjusted like a marker. */
2441 soe = buffer_or_string_stack_of_extents(obj);
2442 if (soe && soe->pos >= 0) {
2443 soe->pos = do_marker_adjustment(soe->pos, from, to, amount);
2448 /* ------------------------------- */
2449 /* adjust_extents_for_deletion() */
2450 /* ------------------------------- */
2452 struct adjust_extents_for_deletion_arg {
2453 EXTENT_dynarr *list;
2456 static int adjust_extents_for_deletion_mapper(EXTENT extent, void *arg)
2458 struct adjust_extents_for_deletion_arg *closure =
2459 (struct adjust_extents_for_deletion_arg *)arg;
2461 Dynarr_add(closure->list, extent);
2462 /* continue mapping */
2466 /* For all extent endpoints in the range (FROM, TO], move them to the beginning
2467 of the new gap. Note that it is important that we visit all extent
2468 endpoints in the range, irrespective of whether the endpoints are open or
2471 This function deals with weird stuff such as the fact that extents
2474 There is no string correspondent for this because you can't
2475 delete characters from a string.
2479 adjust_extents_for_deletion(Lisp_Object object, Bytind from,
2480 Bytind to, int gapsize, int numdel, int movegapsize)
2482 struct adjust_extents_for_deletion_arg closure;
2484 Memind adjust_to = (Memind) (to + gapsize);
2485 Bytecount amount = -numdel - movegapsize;
2486 Memind oldsoe = 0, newsoe = 0;
2487 extent_stack_t soe = buffer_or_string_stack_of_extents(object);
2489 #ifdef ERROR_CHECK_EXTENTS
2490 sledgehammer_extent_check(object);
2492 closure.list = Dynarr_new(EXTENT);
2494 /* We're going to be playing weird games below with extents and the SOE
2495 and such, so compute the list now of all the extents that we're going
2496 to muck with. If we do the mapping and adjusting together, things
2497 can get all screwed up. */
2499 map_extents_bytind(from, to, adjust_extents_for_deletion_mapper,
2500 (void *)&closure, object, 0,
2501 /* extent endpoints move like markers regardless
2502 of their open/closeness. */
2503 ME_ALL_EXTENTS_CLOSED | ME_END_CLOSED |
2504 ME_START_OR_END_IN_REGION | ME_INCLUDE_INTERNAL);
2507 Old and new values for the SOE's position. (It gets adjusted
2508 like a marker, just like extent endpoints.)
2513 if (soe->pos >= 0) {
2514 newsoe = do_marker_adjustment(
2515 soe->pos, adjust_to, adjust_to, amount);
2521 for (i = 0; i < Dynarr_length(closure.list); i++) {
2522 EXTENT extent = Dynarr_at(closure.list, i);
2523 Memind new_start = extent_start(extent);
2524 Memind new_end = extent_end(extent);
2526 /* do_marker_adjustment() will not adjust values that should not
2527 be adjusted. We're passing the same funky arguments to
2528 do_marker_adjustment() as buffer_delete_range() does. */
2529 new_start = do_marker_adjustment(
2530 new_start, adjust_to, adjust_to, amount);
2531 new_end = do_marker_adjustment(
2532 new_end, adjust_to, adjust_to, amount);
2534 /* We need to be very careful here so that the SOE doesn't get
2535 corrupted. We are shrinking extents out of the deleted
2536 region and simultaneously moving the SOE's pos out of the
2537 deleted region, so the SOE should contain the same extents at
2538 the end as at the beginning. However, extents may get
2539 reordered by this process, so we have to operate by pulling
2540 the extents out of the buffer and SOE, changing their bounds,
2541 and then reinserting them. In order for the SOE not to get
2542 screwed up, we have to make sure that the SOE's pos points to
2543 its old location whenever we pull an extent out, and points
2544 to its new location whenever we put the extent back in.
2547 if (new_start != extent_start(extent) ||
2548 new_end != extent_end(extent)) {
2549 extent_detach(extent);
2550 set_extent_start(extent, new_start);
2551 set_extent_end(extent, new_end);
2555 extent_attach(extent);
2566 #ifdef ERROR_CHECK_EXTENTS
2567 sledgehammer_extent_check(object);
2569 Dynarr_free(closure.list);
2573 /* ------------------------------- */
2574 /* extent fragments */
2575 /* ------------------------------- */
2577 /* Imagine that the buffer is divided up into contiguous,
2578 nonoverlapping "runs" of text such that no extent
2579 starts or ends within a run (extents that abut the
2582 An extent fragment is a structure that holds data about
2583 the run that contains a particular buffer position (if
2584 the buffer position is at the junction of two runs, the
2585 run after the position is used) -- the beginning and
2586 end of the run, a list of all of the extents in that
2587 run, the "merged face" that results from merging all of
2588 the faces corresponding to those extents, the begin and
2589 end glyphs at the beginning of the run, etc. This is
2590 the information that redisplay needs in order to
2593 Extent fragments have to be very quick to update to
2594 a new buffer position when moving linearly through
2595 the buffer. They rely on the stack-of-extents code,
2596 which does the heavy-duty algorithmic work of determining
2597 which extents overly a particular position. */
2599 /* This function returns the position of the beginning of
2600 the first run that begins after POS, or returns POS if
2601 there are no such runs. */
2604 extent_find_end_of_run(Lisp_Object obj, Bytind pos, int outside_accessible)
2607 extent_list_t bel = buffer_or_string_extent_list(obj);
2610 Memind mempos = buffer_or_string_bytind_to_memind(obj, pos);
2611 Bytind limit = outside_accessible ?
2612 buffer_or_string_absolute_end_byte(obj) :
2613 buffer_or_string_accessible_end_byte(obj);
2615 if (!bel || !extent_list_num_els(bel)) {
2618 sel = buffer_or_string_stack_of_extents_force(obj)->extents;
2619 soe_move(obj, mempos);
2621 /* Find the first start position after POS. */
2622 elind1 = extent_list_locate_from_pos(bel, mempos + 1, 0);
2623 if (elind1 < extent_list_num_els(bel)) {
2624 pos1 = buffer_or_string_memind_to_bytind(
2625 obj, extent_start(extent_list_at(bel, elind1, 0)));
2630 /* Find the first end position after POS. The extent corresponding
2631 to this position is either in the SOE or is greater than or
2632 equal to POS1, so we just have to look in the SOE. */
2633 elind2 = extent_list_locate_from_pos(sel, mempos + 1, 1);
2634 if (elind2 < extent_list_num_els(sel)) {
2635 pos2 = buffer_or_string_memind_to_bytind(
2636 obj, extent_end(extent_list_at(sel, elind2, 1)));
2640 return min(min(pos1, pos2), limit);
2644 extent_find_beginning_of_run(Lisp_Object obj, Bytind pos,
2645 int outside_accessible)
2648 extent_list_t bel = buffer_or_string_extent_list(obj);
2651 Memind mempos = buffer_or_string_bytind_to_memind(obj, pos);
2652 Bytind limit = outside_accessible
2653 ? buffer_or_string_absolute_begin_byte(obj)
2654 : buffer_or_string_accessible_begin_byte(obj);
2656 if (!bel || !extent_list_num_els(bel)) {
2659 sel = buffer_or_string_stack_of_extents_force(obj)->extents;
2660 soe_move(obj, mempos);
2662 /* Find the first end position before POS. */
2663 elind1 = extent_list_locate_from_pos(bel, mempos, 1);
2665 pos1 = buffer_or_string_memind_to_bytind(
2666 obj, extent_end(extent_list_at(bel, elind1 - 1, 1)));
2670 /* Find the first start position before POS. The extent corresponding
2671 to this position is either in the SOE or is less than or
2672 equal to POS1, so we just have to look in the SOE. */
2673 elind2 = extent_list_locate_from_pos(sel, mempos, 0);
2675 pos2 = buffer_or_string_memind_to_bytind(
2676 obj, extent_start(extent_list_at(sel, elind2 - 1, 0)));
2680 return max(max(pos1, pos2), limit);
2683 struct extent_fragment*
2684 extent_fragment_new(Lisp_Object buffer_or_string, struct frame *frm)
2686 struct extent_fragment *ef = xnew_and_zero(struct extent_fragment);
2688 ef->object = buffer_or_string;
2690 ef->extents = Dynarr_new(EXTENT);
2691 ef->glyphs = Dynarr_new(glyph_block);
2696 void extent_fragment_delete(struct extent_fragment *ef)
2698 Dynarr_free(ef->extents);
2699 Dynarr_free(ef->glyphs);
2704 extent_priority_sort_function(const void *humpty, const void *dumpty)
2706 const EXTENT foo = *(const EXTENT *)humpty;
2707 const EXTENT bar = *(const EXTENT *)dumpty;
2708 if (extent_priority(foo) < extent_priority(bar)) {
2711 return extent_priority(foo) > extent_priority(bar);
2715 extent_fragment_sort_by_priority(EXTENT_dynarr * extarr)
2719 /* Sort our copy of the stack by extent_priority. We use a bubble
2720 sort here because it's going to be faster than qsort() for small
2721 numbers of extents (less than 10 or so), and 99.999% of the time
2722 there won't ever be more extents than this in the stack. */
2723 if (Dynarr_length(extarr) < 10) {
2724 for (i = 1; i < Dynarr_length(extarr); i++) {
2727 (extent_priority(Dynarr_at(extarr, j)) >
2728 extent_priority(Dynarr_at(extarr, j + 1)))) {
2729 EXTENT tmp = Dynarr_at(extarr, j);
2730 Dynarr_at(extarr, j) = Dynarr_at(extarr, j + 1);
2731 Dynarr_at(extarr, j + 1) = tmp;
2736 /* But some loser programs mess up and may create a large number
2737 of extents overlapping the same spot. This will result in
2738 catastrophic behavior if we use the bubble sort above. */
2739 qsort(Dynarr_atp(extarr, 0), Dynarr_length(extarr),
2740 sizeof(EXTENT), extent_priority_sort_function);
2744 /* If PROP is the `invisible' property of an extent,
2745 this is 1 if the extent should be treated as invisible. */
2747 #define EXTENT_PROP_MEANS_INVISIBLE(buf, prop) \
2748 (EQ (buf->invisibility_spec, Qt) \
2750 : invisible_p (prop, buf->invisibility_spec))
2752 /* If PROP is the `invisible' property of a extent,
2753 this is 1 if the extent should be treated as invisible
2754 and should have an ellipsis. */
2756 #define EXTENT_PROP_MEANS_INVISIBLE_WITH_ELLIPSIS(buf, prop) \
2757 (EQ (buf->invisibility_spec, Qt) \
2759 : invisible_ellipsis_p (prop, buf->invisibility_spec))
2761 /* This is like a combination of memq and assq.
2762 Return 1 if PROPVAL appears as an element of LIST
2763 or as the car of an element of LIST.
2764 If PROPVAL is a list, compare each element against LIST
2765 in that way, and return 1 if any element of PROPVAL is found in LIST.
2767 This function cannot quit. */
2770 invisible_p(REGISTER Lisp_Object propval, Lisp_Object list)
2772 REGISTER Lisp_Object tail, proptail;
2773 for (tail = list; CONSP(tail); tail = XCDR(tail)) {
2774 REGISTER Lisp_Object tem;
2776 if (EQ(propval, tem))
2778 if (CONSP(tem) && EQ(propval, XCAR(tem)))
2781 if (CONSP(propval)) {
2782 for (proptail = propval; CONSP(proptail);
2783 proptail = XCDR(proptail)) {
2784 Lisp_Object propelt;
2785 propelt = XCAR(proptail);
2786 for (tail = list; CONSP(tail); tail = XCDR(tail)) {
2787 REGISTER Lisp_Object tem;
2789 if (EQ(propelt, tem)) {
2792 if (CONSP(tem) && EQ(propelt, XCAR(tem))) {
2801 /* Return 1 if PROPVAL appears as the car of an element of LIST
2802 and the cdr of that element is non-nil.
2803 If PROPVAL is a list, check each element of PROPVAL in that way,
2804 and the first time some element is found,
2805 return 1 if the cdr of that element is non-nil.
2807 This function cannot quit. */
2810 invisible_ellipsis_p(REGISTER Lisp_Object propval, Lisp_Object list)
2812 REGISTER Lisp_Object tail, proptail;
2814 for (tail = list; CONSP(tail); tail = XCDR(tail)) {
2815 REGISTER Lisp_Object tem;
2817 if (CONSP(tem) && EQ(propval, XCAR(tem))) {
2818 return !NILP(XCDR(tem));
2821 if (CONSP(propval)) {
2822 for (proptail = propval; CONSP(proptail);
2823 proptail = XCDR(proptail)) {
2824 Lisp_Object propelt;
2825 propelt = XCAR(proptail);
2826 for (tail = list; CONSP(tail); tail = XCDR(tail)) {
2827 REGISTER Lisp_Object tem;
2829 if (CONSP(tem) && EQ(propelt, XCAR(tem))) {
2830 return !NILP(XCDR(tem));
2839 extent_fragment_update(struct window * w, struct extent_fragment * ef,
2840 Bytind pos, Lisp_Object last_glyph)
2843 int seen_glyph = NILP(last_glyph) ? 1 : 0;
2845 buffer_or_string_stack_of_extents_force(ef->object)->extents;
2847 struct extent dummy_lhe_extent;
2848 Memind mempos = buffer_or_string_bytind_to_memind(ef->object, pos);
2849 glyph_block_dynarr *glyphs; /* List of glyphs to post process */
2850 int invis_before = 0; /* Exiting an invisible extent. */
2851 int invis_after = 0; /* Entering an invisible extent. */
2852 int insert_empty = 0; /* Position to insert empty extent glyphs */
2853 int queuing_begin = 0; /* Queuing begin glyphs. */
2855 #ifdef ERROR_CHECK_EXTENTS
2856 assert(pos >= buffer_or_string_accessible_begin_byte(ef->object)
2857 && pos <= buffer_or_string_accessible_end_byte(ef->object));
2860 Dynarr_reset(ef->extents);
2861 Dynarr_reset(ef->glyphs);
2863 ef->previously_invisible = ef->invisible;
2864 if (ef->invisible) {
2865 if (ef->invisible_ellipses)
2866 ef->invisible_ellipses_already_displayed = 1;
2868 ef->invisible_ellipses_already_displayed = 0;
2871 ef->invisible_ellipses = 0;
2873 /* Set up the begin and end positions. */
2875 ef->end = extent_find_end_of_run(ef->object, pos, 0);
2877 /* Note that extent_find_end_of_run() already moved the SOE for us. */
2878 /* soe_move (ef->object, mempos); */
2880 /* We tried determining all the charsets used in the run here,
2881 but that fails even if we only do the current line -- display
2882 tables or non-printable characters might cause other charsets
2885 /* Determine whether the last-highlighted-extent is present. */
2886 if (EXTENTP(Vlast_highlighted_extent))
2887 lhe = XEXTENT(Vlast_highlighted_extent);
2889 /* Now add all extents that overlap the character after POS and
2890 have a non-nil face. Also check if the character is
2891 invisible. We also queue begin and end glyphs of extents
2892 that being/end at just before POS. These are ordered as
2893 follows. 1) end glyphs of non-empty extents in reverse
2894 display order. 2) begin glyphs of empty extents. 3) end
2895 glyphs of empty extents. 4) begin glyphs of non-empty
2896 extents in display order. Empty extents are shown nested,
2897 but the invisibility property of an empty extent is
2898 ignored and not used to determine whether an 'interior'
2899 empty extent's glyphs should be shown or not. */
2900 glyphs = Dynarr_new(glyph_block);
2901 for (i = 0; i < extent_list_num_els(sel); i++) {
2902 EXTENT e = extent_list_at(sel, i, 0);
2903 int zero_width = extent_start(e) == extent_end(e);
2904 Lisp_Object invis_prop = extent_invisible(e);
2907 if (extent_start(e) == mempos) {
2908 /* The extent starts here. If we are queuing
2909 end glyphs, we should display all the end
2910 glyphs we've pushed. */
2912 if (!queuing_begin) {
2913 /* Append any already seen end glyphs */
2914 for (j = Dynarr_length(glyphs); j--;) {
2915 struct glyph_block *gbp
2916 = Dynarr_atp(glyphs, j);
2919 Dynarr_add(ef->glyphs, *gbp);
2920 else if (EQ(gbp->glyph, last_glyph))
2924 /* Pop the end glyphs just displayed. */
2925 Dynarr_set_size(glyphs, 0);
2926 /* We are now queuing begin glyphs. */
2928 /* And will insert empty extent glyphs
2930 insert_empty = Dynarr_length (ef->glyphs);
2933 glyph = extent_begin_glyph(e);
2936 struct glyph_block gb;
2938 memset(&gb,0,sizeof(gb));
2941 gb.active = 0; /* BEGIN_GLYPH */
2943 XSETEXTENT(gb.extent, e);
2947 == Dynarr_length (ef->glyphs))
2948 Dynarr_add (ef->glyphs, gb);
2953 } else if (!invis_after)
2954 Dynarr_add (glyphs, gb);
2958 if (extent_end(e) == mempos) {
2959 /* The extend ends here. Push the end glyph. */
2960 glyph = extent_end_glyph(e);
2962 if (!NILP (glyph)) {
2963 struct glyph_block gb;
2965 gb.width = gb.findex = 0; /* just init */
2967 gb.active = 1; /* END_GLYPH */
2968 XSETEXTENT(gb.extent, e);
2971 Dynarr_add (ef->glyphs, gb);
2972 else if (!invis_before)
2973 Dynarr_add(glyphs, gb);
2975 /* If this extent is not empty, any inner
2976 extents ending here will not be visible. */
2977 if (extent_start (e) < mempos && !NILP (invis_prop))
2981 if (extent_end(e) > mempos) {
2982 /* This extent covers POS. */
2983 if (!NILP(invis_prop)) {
2985 /* If this extend spans POS, all
2986 glyphs are invisible. */
2987 if (extent_start (e) < mempos)
2988 Dynarr_set_size (glyphs, 0);
2990 if (!BUFFERP(ef->object))
2991 /* #### no `string-invisibility-spec' */
2995 invisible_ellipses_already_displayed
2997 EXTENT_PROP_MEANS_INVISIBLE_WITH_ELLIPSIS
2998 (XBUFFER(ef->object), invis_prop)) {
3000 ef->invisible_ellipses = 1;
3001 } else if (EXTENT_PROP_MEANS_INVISIBLE
3002 (XBUFFER(ef->object),
3008 /* Remember that one of the extents in the list might be
3009 our dummy extent representing the highlighting that
3010 is attached to some other extent that is currently
3011 mouse-highlighted. When an extent is
3012 mouse-highlighted, it is as if there are two extents
3013 there, of potentially different priorities: the
3014 extent being highlighted, with whatever face and
3015 priority it has; and an ephemeral extent in the
3016 `mouse-face' face with `mouse-highlight-priority'.
3019 if (!NILP(extent_face(e)))
3020 Dynarr_add(ef->extents, e);
3023 /* zeroing isn't really necessary; we only deref
3024 `priority' and `face' */
3025 xzero(dummy_lhe_extent);
3026 set_extent_priority(&dummy_lhe_extent,
3027 mouse_highlight_priority);
3028 /* Need to break up the following expression,
3030 /* error in the Digital UNIX 3.2g C compiler
3032 /* UNIX Compiler Driver 3.11). */
3033 f = extent_mouse_face(lhe);
3034 extent_face(&dummy_lhe_extent) = f;
3035 Dynarr_add(ef->extents, &dummy_lhe_extent);
3037 /* since we are looping anyway, we might as well do this
3039 if ((!NILP(extent_initial_redisplay_function(e))) &&
3040 !extent_in_red_event_p(e)) {
3041 Lisp_Object function =
3042 extent_initial_redisplay_function(e);
3045 /* print_extent_2 (e);
3048 /* FIXME: One should probably inhibit the
3049 displaying of this extent to reduce
3051 extent_in_red_event_p(e) = 1;
3053 /* call the function */
3055 if (!NILP(function)) {
3056 Fenqueue_eval_event(function, obj);
3062 if (!queuing_begin) {
3063 /* Append end glyphs in reverse order */
3064 for (j = Dynarr_length(glyphs); j--;) {
3065 struct glyph_block *gbp = Dynarr_atp(glyphs, j);
3068 Dynarr_add(ef->glyphs, *gbp);
3069 else if (EQ(gbp->glyph, last_glyph))
3074 /* Scan the zero length glyphs and see where we
3075 start a glyph that has not been displayed yet. */
3076 for (j = insert_empty;
3077 j != Dynarr_length (ef->glyphs); j++) {
3078 struct glyph_block *gbp
3079 = Dynarr_atp(ef->glyphs, j);
3081 if (EQ(gbp->glyph, last_glyph)) {
3087 Dynarr_delete_many (ef->glyphs, insert_empty,
3091 /* Now copy the begin glyphs. */
3092 for (j = 0; j != Dynarr_length (glyphs); j++) {
3093 struct glyph_block *gbp = Dynarr_atp(glyphs, j);
3096 Dynarr_add(ef->glyphs, *gbp);
3097 else if (EQ(gbp->glyph, last_glyph))
3102 Dynarr_free(glyphs);
3104 extent_fragment_sort_by_priority(ef->extents);
3106 /* Now merge the faces together into a single face. The code to
3107 do this is in faces.c because it involves manipulating faces. */
3108 return get_extent_fragment_face_cache_index(w, ef);
3111 /************************************************************************/
3112 /* extent-object methods */
3113 /************************************************************************/
3115 /* These are the basic helper functions for handling the allocation of
3116 extent objects. They are similar to the functions for other
3117 lrecord objects. allocate_extent() is in alloc.c, not here. */
3119 static Lisp_Object mark_extent(Lisp_Object obj)
3121 struct extent *extent = XEXTENT(obj);
3123 mark_object(extent_object(extent));
3124 mark_object(extent_no_chase_normal_field(extent, face));
3125 return extent->plist;
3129 print_extent_1(Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
3131 EXTENT ext = XEXTENT(obj);
3132 EXTENT anc = extent_ancestor(ext);
3134 char buf[100], *bp = buf;
3137 /* Retrieve the ancestor and use it, for faster retrieval of properties */
3139 if (!NILP(extent_begin_glyph(anc)))
3141 *bp++ = (extent_start_open_p(anc) ? '(' : '[');
3142 if (extent_detached_p(ext))
3143 strncpy(bp, "detached", sizeof(buf)-1);
3145 sz=snprintf(bp, sizeof(buf)-2, "%ld, %ld",
3146 XINT(Fextent_start_position(obj)),
3147 XINT(Fextent_end_position(obj)));
3148 assert(sz>=0 && (size_t)sz<(sizeof(buf)-2));
3151 *bp++ = (extent_end_open_p(anc) ? ')' : ']');
3152 if (!NILP(extent_end_glyph(anc)))
3156 if (!NILP(extent_read_only(anc)))
3158 if (!NILP(extent_mouse_face(anc)))
3160 if (extent_unique_p(anc))
3162 else if (extent_duplicable_p(anc))
3164 if (!NILP(extent_invisible(anc)))
3167 if (!NILP(extent_read_only(anc)) || !NILP(extent_mouse_face(anc)) ||
3168 extent_unique_p(anc) ||
3169 extent_duplicable_p(anc) || !NILP(extent_invisible(anc)))
3172 write_c_string(buf, printcharfun);
3174 tail = extent_plist_slot(anc);
3176 for (; !NILP(tail); tail = Fcdr(Fcdr(tail))) {
3177 Lisp_Object v = XCAR(XCDR(tail));
3180 print_internal(XCAR(tail), printcharfun, escapeflag);
3181 write_c_string(" ", printcharfun);
3184 write_fmt_str(printcharfun, "0x%lx", (long)ext);
3188 print_extent(Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
3191 const char *title = "";
3192 const char *name = "";
3193 const char *posttitle = "";
3194 Lisp_Object obj2 = Qnil;
3196 /* Destroyed extents have 't' in the object field, causing
3197 extent_object() to abort (maybe). */
3198 if (EXTENT_LIVE_P(XEXTENT(obj)))
3199 obj2 = extent_object(XEXTENT(obj));
3202 title = "no buffer";
3203 else if (BUFFERP(obj2)) {
3204 if (BUFFER_LIVE_P(XBUFFER(obj2))) {
3207 (char *)XSTRING_DATA(XBUFFER(obj2)->name);
3209 title = "Killed Buffer";
3213 assert(STRINGP(obj2));
3214 title = "string \"";
3216 name = (char *)XSTRING_DATA(obj2);
3219 if (print_readably) {
3220 if (!EXTENT_LIVE_P(XEXTENT(obj))) {
3221 error("printing unreadable object "
3222 "#<destroyed extent>");
3224 error("printing unreadable object "
3225 "#<extent %p>", XEXTENT(obj));
3229 if (!EXTENT_LIVE_P(XEXTENT(obj))) {
3230 write_c_string("#<destroyed extent", printcharfun);
3232 write_c_string("#<extent ", printcharfun);
3233 print_extent_1(obj, printcharfun, escapeflag);
3234 write_c_string(extent_detached_p(XEXTENT(obj))
3235 ? " from " : " in ", printcharfun);
3236 write_fmt_string(printcharfun, "%s%s%s", title, name, posttitle);
3240 error("printing unreadable object #<extent>");
3241 write_c_string("#<extent", printcharfun);
3243 write_c_string(">", printcharfun);
3246 static int properties_equal(EXTENT e1, EXTENT e2, int depth)
3248 /* When this function is called, all indirections have been followed.
3249 Thus, the indirection checks in the various macros below will not
3250 amount to anything, and could be removed. However, the time
3251 savings would probably not be significant. */
3252 if (!(EQ(extent_face(e1), extent_face(e2)) &&
3253 extent_priority(e1) == extent_priority(e2) &&
3254 internal_equal(extent_begin_glyph(e1), extent_begin_glyph(e2),
3256 internal_equal(extent_end_glyph(e1), extent_end_glyph(e2),
3260 /* compare the bit flags. */
3262 /* The has_aux field should not be relevant. */
3263 int e1_has_aux = e1->flags.has_aux;
3264 int e2_has_aux = e2->flags.has_aux;
3267 e1->flags.has_aux = e2->flags.has_aux = 0;
3268 value = memcmp(&e1->flags, &e2->flags, sizeof(e1->flags));
3269 e1->flags.has_aux = e1_has_aux;
3270 e2->flags.has_aux = e2_has_aux;
3275 /* compare the random elements of the plists. */
3276 return !plists_differ(extent_no_chase_plist(e1),
3277 extent_no_chase_plist(e2), 0, 0, depth + 1);
3280 static int extent_equal(Lisp_Object obj1, Lisp_Object obj2, int depth)
3282 struct extent *e1 = XEXTENT(obj1);
3283 struct extent *e2 = XEXTENT(obj2);
3285 (extent_start(e1) == extent_start(e2) &&
3286 extent_end(e1) == extent_end(e2) &&
3287 internal_equal(extent_object(e1), extent_object(e2), depth + 1) &&
3288 properties_equal(extent_ancestor(e1), extent_ancestor(e2), depth));
3291 static unsigned long extent_hash(Lisp_Object obj, int depth)
3293 struct extent *e = XEXTENT(obj);
3294 /* No need to hash all of the elements; that would take too long.
3295 Just hash the most common ones. */
3296 return HASH3(extent_start(e), extent_end(e),
3297 internal_hash(extent_object(e), depth + 1));
3300 static const struct lrecord_description extent_description[] = {
3301 {XD_LISP_OBJECT, offsetof(struct extent, object)},
3302 {XD_LISP_OBJECT, offsetof(struct extent, flags.face)},
3303 {XD_LISP_OBJECT, offsetof(struct extent, plist)},
3307 static Lisp_Object extent_getprop(Lisp_Object obj, Lisp_Object prop)
3309 return Fextent_property(obj, prop, Qunbound);
3312 static int extent_putprop(Lisp_Object obj, Lisp_Object prop, Lisp_Object value)
3314 Fset_extent_property(obj, prop, value);
3318 static int extent_remprop(Lisp_Object obj, Lisp_Object prop)
3320 EXTENT ext = XEXTENT(obj);
3322 /* This list is taken from Fset_extent_property, and should be kept
3324 if (EQ(prop, Qread_only)
3325 || EQ(prop, Qunique)
3326 || EQ(prop, Qduplicable)
3327 || EQ(prop, Qinvisible)
3328 || EQ(prop, Qdetachable)
3329 || EQ(prop, Qdetached)
3330 || EQ(prop, Qdestroyed)
3331 || EQ(prop, Qpriority)
3333 || EQ(prop, Qinitial_redisplay_function)
3334 || EQ(prop, Qafter_change_functions)
3335 || EQ(prop, Qbefore_change_functions)
3336 || EQ(prop, Qmouse_face)
3337 || EQ(prop, Qhighlight)
3338 || EQ(prop, Qbegin_glyph_layout)
3339 || EQ(prop, Qend_glyph_layout)
3340 || EQ(prop, Qglyph_layout)
3341 || EQ(prop, Qbegin_glyph)
3342 || EQ(prop, Qend_glyph)
3343 || EQ(prop, Qstart_open)
3344 || EQ(prop, Qend_open)
3345 || EQ(prop, Qstart_closed)
3346 || EQ(prop, Qend_closed)
3347 || EQ(prop, Qkeymap)) {
3348 /* #### Is this correct, anyway? */
3352 return external_remprop(extent_plist_addr(ext), prop, 0, ERROR_ME);
3355 static Lisp_Object extent_plist(Lisp_Object obj)
3357 return Fextent_properties(obj);
3360 DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS("extent", extent,
3361 mark_extent, print_extent,
3362 /* NOTE: If you declare a
3363 finalization method here,
3364 it will NOT be called.
3367 extent_equal, extent_hash,
3369 extent_getprop, extent_putprop,
3370 extent_remprop, extent_plist,
3373 /************************************************************************/
3374 /* basic extent accessors */
3375 /************************************************************************/
3377 /* These functions are for checking externally-passed extent objects
3378 and returning an extent's basic properties, which include the
3379 buffer the extent is associated with, the endpoints of the extent's
3380 range, the open/closed-ness of those endpoints, and whether the
3381 extent is detached. Manipulating these properties requires
3382 manipulating the ordered lists that hold extents; thus, functions
3383 to do that are in a later section. */
3385 /* Given a Lisp_Object that is supposed to be an extent, make sure it
3386 is OK and return an extent pointer. Extents can be in one of four
3390 2) detached and not associated with a buffer
3391 3) detached and associated with a buffer
3392 4) attached to a buffer
3394 If FLAGS is 0, types 2-4 are allowed. If FLAGS is DE_MUST_HAVE_BUFFER,
3395 types 3-4 are allowed. If FLAGS is DE_MUST_BE_ATTACHED, only type 4
3399 static EXTENT decode_extent(Lisp_Object extent_obj, unsigned int flags)
3404 CHECK_LIVE_EXTENT(extent_obj);
3405 extent = XEXTENT(extent_obj);
3406 obj = extent_object(extent);
3408 /* the following condition will fail if we're dealing with a freed extent */
3409 assert(NILP(obj) || BUFFERP(obj) || STRINGP(obj));
3411 if (flags & DE_MUST_BE_ATTACHED)
3412 flags |= DE_MUST_HAVE_BUFFER;
3414 /* if buffer is dead, then convert extent to have no buffer. */
3415 if (BUFFERP(obj) && !BUFFER_LIVE_P(XBUFFER(obj)))
3416 obj = extent_object(extent) = Qnil;
3418 assert(!NILP(obj) || extent_detached_p(extent));
3420 if ((NILP(obj) && (flags & DE_MUST_HAVE_BUFFER))
3421 || (extent_detached_p(extent) && (flags & DE_MUST_BE_ATTACHED))) {
3422 invalid_argument("extent doesn't belong to a buffer or string",
3429 /* Note that the returned value is a buffer position, not a byte index. */
3431 static Lisp_Object extent_endpoint_external(Lisp_Object extent_obj, int endp)
3433 EXTENT extent = decode_extent(extent_obj, 0);
3435 if (extent_detached_p(extent))
3438 return make_int(extent_endpoint_bufpos(extent, endp));
3441 DEFUN("extentp", Fextentp, 1, 1, 0, /*
3442 Return t if OBJECT is an extent.
3446 return EXTENTP(object) ? Qt : Qnil;
3449 DEFUN("extent-live-p", Fextent_live_p, 1, 1, 0, /*
3450 Return t if OBJECT is an extent that has not been destroyed.
3454 return EXTENTP(object) && EXTENT_LIVE_P(XEXTENT(object)) ? Qt : Qnil;
3457 DEFUN("extent-detached-p", Fextent_detached_p, 1, 1, 0, /*
3458 Return t if EXTENT is detached.
3462 return extent_detached_p(decode_extent(extent, 0)) ? Qt : Qnil;
3465 DEFUN("extent-object", Fextent_object, 1, 1, 0, /*
3466 Return object (buffer or string) that EXTENT refers to.
3470 return extent_object(decode_extent(extent, 0));
3473 DEFUN("extent-start-position", Fextent_start_position, 1, 1, 0, /*
3474 Return start position of EXTENT, or nil if EXTENT is detached.
3478 return extent_endpoint_external(extent, 0);
3481 DEFUN("extent-end-position", Fextent_end_position, 1, 1, 0, /*
3482 Return end position of EXTENT, or nil if EXTENT is detached.
3486 return extent_endpoint_external(extent, 1);
3489 DEFUN("extent-length", Fextent_length, 1, 1, 0, /*
3490 Return length of EXTENT in characters.
3494 EXTENT e = decode_extent(extent, DE_MUST_BE_ATTACHED);
3495 return make_int(extent_endpoint_bufpos(e, 1)
3496 - extent_endpoint_bufpos(e, 0));
3499 DEFUN("next-extent", Fnext_extent, 1, 1, 0, /*
3500 Find next extent after EXTENT.
3501 If EXTENT is a buffer return the first extent in the buffer; likewise
3503 Extents in a buffer are ordered in what is called the "display"
3504 order, which sorts by increasing start positions and then by *decreasing*
3506 If you want to perform an operation on a series of extents, use
3507 `map-extents' instead of this function; it is much more efficient.
3508 The primary use of this function should be to enumerate all the
3509 extents in a buffer.
3510 Note: The display order is not necessarily the order that `map-extents'
3511 processes extents in!
3518 if (EXTENTP(extent))
3519 next = extent_next(decode_extent(extent, DE_MUST_BE_ATTACHED));
3521 next = extent_first(decode_buffer_or_string(extent));
3525 XSETEXTENT(val, next);
3529 DEFUN("previous-extent", Fprevious_extent, 1, 1, 0, /*
3530 Find last extent before EXTENT.
3531 If EXTENT is a buffer return the last extent in the buffer; likewise
3533 This function is analogous to `next-extent'.
3540 if (EXTENTP(extent))
3542 extent_previous(decode_extent(extent, DE_MUST_BE_ATTACHED));
3544 prev = extent_last(decode_buffer_or_string(extent));
3548 XSETEXTENT(val, prev);
3552 #ifdef DEBUG_SXEMACS
3554 DEFUN("next-e-extent", Fnext_e_extent, 1, 1, 0, /*
3555 Find next extent after EXTENT using the "e" order.
3556 If EXTENT is a buffer return the first extent in the buffer; likewise
3564 if (EXTENTP(extent))
3566 extent_e_next(decode_extent(extent, DE_MUST_BE_ATTACHED));
3568 next = extent_e_first(decode_buffer_or_string(extent));
3572 XSETEXTENT(val, next);
3576 DEFUN("previous-e-extent", Fprevious_e_extent, 1, 1, 0, /*
3577 Find last extent before EXTENT using the "e" order.
3578 If EXTENT is a buffer return the last extent in the buffer; likewise
3580 This function is analogous to `next-e-extent'.
3587 if (EXTENTP(extent))
3589 extent_e_previous(decode_extent
3590 (extent, DE_MUST_BE_ATTACHED));
3592 prev = extent_e_last(decode_buffer_or_string(extent));
3596 XSETEXTENT(val, prev);
3602 DEFUN("next-extent-change", Fnext_extent_change, 1, 2, 0, /*
3603 Return the next position after POS where an extent begins or ends.
3604 If POS is at the end of the buffer or string, POS will be returned;
3605 otherwise a position greater than POS will always be returned.
3606 If OBJECT is nil, the current buffer is assumed.
3610 Lisp_Object obj = decode_buffer_or_string(object);
3614 get_buffer_or_string_pos_byte(obj, pos, GB_ALLOW_PAST_ACCESSIBLE);
3615 bpos = extent_find_end_of_run(obj, bpos, 1);
3616 return make_int(buffer_or_string_bytind_to_bufpos(obj, bpos));
3619 DEFUN("previous-extent-change", Fprevious_extent_change, 1, 2, 0, /*
3620 Return the last position before POS where an extent begins or ends.
3621 If POS is at the beginning of the buffer or string, POS will be returned;
3622 otherwise a position less than POS will always be returned.
3623 If OBJECT is nil, the current buffer is assumed.
3627 Lisp_Object obj = decode_buffer_or_string(object);
3631 get_buffer_or_string_pos_byte(obj, pos, GB_ALLOW_PAST_ACCESSIBLE);
3632 bpos = extent_find_beginning_of_run(obj, bpos, 1);
3633 return make_int(buffer_or_string_bytind_to_bufpos(obj, bpos));
3636 /************************************************************************/
3637 /* parent and children stuff */
3638 /************************************************************************/
3640 DEFUN("extent-parent", Fextent_parent, 1, 1, 0, /*
3641 Return the parent (if any) of EXTENT.
3642 If an extent has a parent, it derives all its properties from that extent
3643 and has no properties of its own. (The only "properties" that the
3644 extent keeps are the buffer/string it refers to and the start and end
3645 points.) It is possible for an extent's parent to itself have a parent.
3648 /* do I win the prize for the strangest split infinitive? */
3650 EXTENT e = decode_extent(extent, 0);
3651 return extent_parent(e);
3654 DEFUN("extent-children", Fextent_children, 1, 1, 0, /*
3655 Return a list of the children (if any) of EXTENT.
3656 The children of an extent are all those extents whose parent is that extent.
3657 This function does not recursively trace children of children.
3658 \(To do that, use `extent-descendants'.)
3662 EXTENT e = decode_extent(extent, 0);
3663 Lisp_Object children = extent_children(e);
3665 if (!NILP(children))
3666 return Fcopy_sequence(XWEAK_LIST_LIST(children));
3671 static void remove_extent_from_children_list(EXTENT e, Lisp_Object child)
3673 Lisp_Object children = extent_children(e);
3675 #ifdef ERROR_CHECK_EXTENTS
3676 assert(!NILP(memq_no_quit(child, XWEAK_LIST_LIST(children))));
3678 XWEAK_LIST_LIST(children) =
3679 delq_no_quit(child, XWEAK_LIST_LIST(children));
3682 static void add_extent_to_children_list(EXTENT e, Lisp_Object child)
3684 Lisp_Object children = extent_children(e);
3686 if (NILP(children)) {
3687 children = make_weak_list(WEAK_LIST_SIMPLE);
3688 set_extent_no_chase_aux_field(e, children, children);
3690 #ifdef ERROR_CHECK_EXTENTS
3691 assert(NILP(memq_no_quit(child, XWEAK_LIST_LIST(children))));
3693 XWEAK_LIST_LIST(children) = Fcons(child, XWEAK_LIST_LIST(children));
3696 DEFUN("set-extent-parent", Fset_extent_parent, 2, 2, 0, /*
3697 Set the parent of EXTENT to PARENT (may be nil).
3698 See `extent-parent'.
3702 EXTENT e = decode_extent(extent, 0);
3703 Lisp_Object cur_parent = extent_parent(e);
3706 XSETEXTENT(extent, e);
3708 CHECK_LIVE_EXTENT(parent);
3709 if (EQ(parent, cur_parent))
3711 for (rest = parent; !NILP(rest); rest = extent_parent(XEXTENT(rest)))
3712 if (EQ(rest, extent))
3713 signal_type_error(Qinvalid_change,
3714 "Circular parent chain would result",
3717 remove_extent_from_children_list(XEXTENT(cur_parent), extent);
3718 set_extent_no_chase_aux_field(e, parent, Qnil);
3719 e->flags.has_parent = 0;
3721 add_extent_to_children_list(XEXTENT(parent), extent);
3722 set_extent_no_chase_aux_field(e, parent, parent);
3723 e->flags.has_parent = 1;
3725 /* changing the parent also changes the properties of all children. */
3727 int old_invis = (!NILP(cur_parent) &&
3728 !NILP(extent_invisible(XEXTENT(cur_parent))));
3729 int new_invis = (!NILP(parent) &&
3730 !NILP(extent_invisible(XEXTENT(parent))));
3732 extent_maybe_changed_for_redisplay(e, 1,
3733 new_invis != old_invis);
3739 /************************************************************************/
3740 /* basic extent mutators */
3741 /************************************************************************/
3743 /* Note: If you track non-duplicable extents by undo, you'll get bogus
3744 undo records for transient extents via update-extent.
3745 For example, query-replace will do this.
3748 static void set_extent_endpoints_1(EXTENT extent, Memind start, Memind end)
3750 #ifdef ERROR_CHECK_EXTENTS
3751 Lisp_Object obj = extent_object(extent);
3753 assert(start <= end);
3755 assert(valid_memind_p(XBUFFER(obj), start));
3756 assert(valid_memind_p(XBUFFER(obj), end));
3760 /* Optimization: if the extent is already where we want it to be,
3762 if (!extent_detached_p(extent) && extent_start(extent) == start &&
3763 extent_end(extent) == end)
3766 if (extent_detached_p(extent)) {
3767 if (extent_duplicable_p(extent)) {
3768 Lisp_Object extent_obj;
3769 XSETEXTENT(extent_obj, extent);
3770 record_extent(extent_obj, 1);
3773 extent_detach(extent);
3775 set_extent_start(extent, start);
3776 set_extent_end(extent, end);
3777 extent_attach(extent);
3780 /* Set extent's endpoints to S and E, and put extent in buffer or string
3781 OBJECT. (If OBJECT is nil, do not change the extent's object.) */
3783 void set_extent_endpoints(EXTENT extent, Bytind s, Bytind e, Lisp_Object object)
3788 object = extent_object(extent);
3789 assert(!NILP(object));
3790 } else if (!EQ(object, extent_object(extent))) {
3791 extent_detach(extent);
3792 extent_object(extent) = object;
3795 start = s < 0 ? extent_start(extent) :
3796 buffer_or_string_bytind_to_memind(object, s);
3797 end = e < 0 ? extent_end(extent) :
3798 buffer_or_string_bytind_to_memind(object, e);
3799 set_extent_endpoints_1(extent, start, end);
3802 static void set_extent_openness(EXTENT extent, int start_open, int end_open)
3804 if (start_open != -1)
3805 extent_start_open_p(extent) = start_open;
3807 extent_end_open_p(extent) = end_open;
3808 /* changing the open/closedness of an extent does not affect
3812 static EXTENT make_extent_internal(Lisp_Object object, Bytind from, Bytind to)
3816 extent = make_extent_detached(object);
3817 set_extent_endpoints(extent, from, to, Qnil);
3822 copy_extent(EXTENT original, Bytind from, Bytind to, Lisp_Object object)
3826 e = make_extent_detached(object);
3828 set_extent_endpoints(e, from, to, Qnil);
3830 e->plist = Fcopy_sequence(original->plist);
3831 memcpy(&e->flags, &original->flags, sizeof(e->flags));
3832 if (e->flags.has_aux) {
3833 /* also need to copy the aux struct. It won't work for
3834 this extent to share the same aux struct as the original
3836 struct extent_auxiliary *data =
3837 alloc_lcrecord_type(struct extent_auxiliary,
3838 &lrecord_extent_auxiliary);
3840 copy_lcrecord(data, XEXTENT_AUXILIARY(XCAR(original->plist)));
3841 XSETEXTENT_AUXILIARY(XCAR(e->plist), data);
3845 /* we may have just added another child to the parent extent. */
3846 Lisp_Object parent = extent_parent(e);
3847 if (!NILP(parent)) {
3849 XSETEXTENT(extent, e);
3850 add_extent_to_children_list(XEXTENT(parent), extent);
3857 static void destroy_extent(EXTENT extent)
3859 Lisp_Object rest, nextrest, children;
3860 Lisp_Object extent_obj;
3862 if (!extent_detached_p(extent))
3863 extent_detach(extent);
3864 /* disassociate the extent from its children and parent */
3865 children = extent_children(extent);
3866 if (!NILP(children)) {
3867 LIST_LOOP_DELETING(rest, nextrest, XWEAK_LIST_LIST(children))
3868 Fset_extent_parent(XCAR(rest), Qnil);
3870 XSETEXTENT(extent_obj, extent);
3871 Fset_extent_parent(extent_obj, Qnil);
3872 /* mark the extent as destroyed */
3873 extent_object(extent) = Qt;
3876 DEFUN("make-extent", Fmake_extent, 2, 3, 0, /*
3877 Make an extent for the range [FROM, TO) in BUFFER-OR-STRING.
3878 BUFFER-OR-STRING defaults to the current buffer. Insertions at point
3879 TO will be outside of the extent; insertions at FROM will be inside the
3880 extent, causing the extent to grow. (This is the same way that markers
3881 behave.) You can change the behavior of insertions at the endpoints
3882 using `set-extent-property'. The extent is initially detached if both
3883 FROM and TO are nil, and in this case BUFFER-OR-STRING defaults to nil,
3884 meaning the extent is in no buffer and no string.
3886 (from, to, buffer_or_string))
3888 Lisp_Object extent_obj;
3891 obj = decode_buffer_or_string(buffer_or_string);
3892 if (NILP(from) && NILP(to)) {
3893 if (NILP(buffer_or_string))
3895 XSETEXTENT(extent_obj, make_extent_detached(obj));
3899 get_buffer_or_string_range_byte(obj, from, to, &start, &end,
3900 GB_ALLOW_PAST_ACCESSIBLE);
3901 XSETEXTENT(extent_obj, make_extent_internal(obj, start, end));
3906 DEFUN("copy-extent", Fcopy_extent, 1, 2, 0, /*
3907 Make a copy of EXTENT. It is initially detached.
3908 Optional argument BUFFER-OR-STRING defaults to EXTENT's buffer or string.
3910 (extent, buffer_or_string))
3912 EXTENT ext = decode_extent(extent, 0);
3914 if (NILP(buffer_or_string))
3915 buffer_or_string = extent_object(ext);
3917 buffer_or_string = decode_buffer_or_string(buffer_or_string);
3919 XSETEXTENT(extent, copy_extent(ext, -1, -1, buffer_or_string));
3923 DEFUN("delete-extent", Fdelete_extent, 1, 1, 0, /*
3924 Remove EXTENT from its buffer and destroy it.
3925 This does not modify the buffer's text, only its display properties.
3926 The extent cannot be used thereafter.
3932 /* We do not call decode_extent() here because already-destroyed
3934 CHECK_EXTENT(extent);
3935 ext = XEXTENT(extent);
3937 if (!EXTENT_LIVE_P(ext))
3939 destroy_extent(ext);
3943 DEFUN("detach-extent", Fdetach_extent, 1, 1, 0, /*
3944 Remove EXTENT from its buffer in such a way that it can be re-inserted.
3945 An extent is also detached when all of its characters are all killed by a
3946 deletion, unless its `detachable' property has been unset.
3948 Extents which have the `duplicable' attribute are tracked by the undo
3949 mechanism. Detachment via `detach-extent' and string deletion is recorded,
3950 as is attachment via `insert-extent' and string insertion. Extent motion,
3951 face changes, and attachment via `make-extent' and `set-extent-endpoints'
3952 are not recorded. This means that extent changes which are to be undo-able
3953 must be performed by character editing, or by insertion and detachment of
3958 EXTENT ext = decode_extent(extent, 0);
3960 if (extent_detached_p(ext))
3962 if (extent_duplicable_p(ext))
3963 record_extent(extent, 0);
3969 DEFUN("set-extent-endpoints", Fset_extent_endpoints, 3, 4, 0, /*
3970 Set the endpoints of EXTENT to START, END.
3971 If START and END are null, call detach-extent on EXTENT.
3972 BUFFER-OR-STRING specifies the new buffer or string that the extent should
3973 be in, and defaults to EXTENT's buffer or string. (If nil, and EXTENT
3974 is in no buffer and no string, it defaults to the current buffer.)
3975 See documentation on `detach-extent' for a discussion of undo recording.
3977 (extent, start, end, buffer_or_string))
3982 ext = decode_extent(extent, 0);
3984 if (NILP(buffer_or_string)) {
3985 buffer_or_string = extent_object(ext);
3986 if (NILP(buffer_or_string))
3987 buffer_or_string = Fcurrent_buffer();
3989 buffer_or_string = decode_buffer_or_string(buffer_or_string);
3991 if (NILP(start) && NILP(end))
3992 return Fdetach_extent(extent);
3994 get_buffer_or_string_range_byte(buffer_or_string, start, end, &s, &e,
3995 GB_ALLOW_PAST_ACCESSIBLE);
3997 buffer_or_string_extent_info_force(buffer_or_string);
3998 set_extent_endpoints(ext, s, e, buffer_or_string);
4002 /************************************************************************/
4003 /* mapping over extents */
4004 /************************************************************************/
4006 static unsigned int decode_map_extents_flags(Lisp_Object flags)
4008 unsigned int retval = 0;
4009 unsigned int all_extents_specified = 0;
4010 unsigned int in_region_specified = 0;
4012 if (EQ(flags, Qt)) /* obsoleteness compatibility */
4013 return ME_END_CLOSED;
4017 flags = Fcons(flags, Qnil);
4018 while (!NILP(flags)) {
4023 if (EQ(sym, Qall_extents_closed) || EQ(sym, Qall_extents_open)
4024 || EQ(sym, Qall_extents_closed_open)
4025 || EQ(sym, Qall_extents_open_closed)) {
4026 if (all_extents_specified)
4028 ("Only one `all-extents-*' flag may be specified");
4029 all_extents_specified = 1;
4031 if (EQ(sym, Qstart_in_region) || EQ(sym, Qend_in_region) ||
4032 EQ(sym, Qstart_and_end_in_region) ||
4033 EQ(sym, Qstart_or_end_in_region)) {
4034 if (in_region_specified)
4036 ("Only one `*-in-region' flag may be specified");
4037 in_region_specified = 1;
4040 /* I do so love that conditional operator ... */
4042 EQ(sym, Qend_closed) ? ME_END_CLOSED :
4043 EQ(sym, Qstart_open) ? ME_START_OPEN :
4044 EQ(sym, Qall_extents_closed) ? ME_ALL_EXTENTS_CLOSED :
4045 EQ(sym, Qall_extents_open) ? ME_ALL_EXTENTS_OPEN :
4047 Qall_extents_closed_open) ? ME_ALL_EXTENTS_CLOSED_OPEN :
4049 Qall_extents_open_closed) ? ME_ALL_EXTENTS_OPEN_CLOSED :
4050 EQ(sym, Qstart_in_region) ? ME_START_IN_REGION : EQ(sym,
4052 ? ME_END_IN_REGION : EQ(sym,
4053 Qstart_and_end_in_region) ?
4054 ME_START_AND_END_IN_REGION : EQ(sym,
4055 Qstart_or_end_in_region) ?
4056 ME_START_OR_END_IN_REGION : EQ(sym,
4057 Qnegate_in_region) ?
4059 : (invalid_argument("Invalid `map-extents' flag", sym), 0);
4061 flags = XCDR(flags);
4066 DEFUN("extent-in-region-p", Fextent_in_region_p, 1, 4, 0, /*
4067 Return whether EXTENT overlaps a specified region.
4068 This is equivalent to whether `map-extents' would visit EXTENT when called
4071 (extent, from, to, flags))
4074 EXTENT ext = decode_extent(extent, DE_MUST_BE_ATTACHED);
4075 Lisp_Object obj = extent_object(ext);
4077 get_buffer_or_string_range_byte(obj, from, to, &start, &end,
4079 GB_ALLOW_PAST_ACCESSIBLE);
4081 return extent_in_region_p(ext, start, end,
4082 decode_map_extents_flags(flags)) ? Qt : Qnil;
4085 struct slow_map_extents_arg {
4086 Lisp_Object map_arg;
4087 Lisp_Object map_routine;
4089 Lisp_Object property;
4093 static int slow_map_extents_function(EXTENT extent, void *arg)
4095 /* This function can GC */
4096 struct slow_map_extents_arg *closure =
4097 (struct slow_map_extents_arg *)arg;
4098 Lisp_Object extent_obj;
4100 XSETEXTENT(extent_obj, extent);
4102 /* make sure this extent qualifies according to the PROPERTY
4105 if (!NILP(closure->property)) {
4107 Fextent_property(extent_obj, closure->property,
4109 if ((NILP(closure->value) && NILP(value)) ||
4110 (!NILP(closure->value) && !EQ(value, closure->value)))
4114 closure->result = call2(closure->map_routine, extent_obj,
4116 return !NILP(closure->result);
4119 DEFUN("map-extents", Fmap_extents, 1, 8, 0, /*
4120 Map FUNCTION over the extents which overlap a region in OBJECT.
4121 OBJECT is normally a buffer or string but could be an extent (see below).
4122 The region is normally bounded by [FROM, TO) (i.e. the beginning of the
4123 region is closed and the end of the region is open), but this can be
4124 changed with the FLAGS argument (see below for a complete discussion).
4126 FUNCTION is called with the arguments (extent, MAPARG). The arguments
4127 OBJECT, FROM, TO, MAPARG, and FLAGS are all optional and default to
4128 the current buffer, the beginning of OBJECT, the end of OBJECT, nil,
4129 and nil, respectively. `map-extents' returns the first non-nil result
4130 produced by FUNCTION, and no more calls to FUNCTION are made after it
4133 If OBJECT is an extent, FROM and TO default to the extent's endpoints,
4134 and the mapping omits that extent and its predecessors. This feature
4135 supports restarting a loop based on `map-extents'. Note: OBJECT must
4136 be attached to a buffer or string, and the mapping is done over that
4139 An extent overlaps the region if there is any point in the extent that is
4140 also in the region. (For the purpose of overlap, zero-length extents and
4141 regions are treated as closed on both ends regardless of their endpoints'
4142 specified open/closedness.) Note that the endpoints of an extent or region
4143 are considered to be in that extent or region if and only if the
4144 corresponding end is closed. For example, the extent [5,7] overlaps the
4145 region [2,5] because 5 is in both the extent and the region. However, (5,7]
4146 does not overlap [2,5] because 5 is not in the extent, and neither [5,7] nor
4147 \(5,7] overlaps the region [2,5) because 5 is not in the region.
4149 The optional FLAGS can be a symbol or a list of one or more symbols,
4150 modifying the behavior of `map-extents'. Allowed symbols are:
4152 end-closed The region's end is closed.
4154 start-open The region's start is open.
4156 all-extents-closed Treat all extents as closed on both ends for the
4157 purpose of determining whether they overlap the
4158 region, irrespective of their actual open- or
4160 all-extents-open Treat all extents as open on both ends.
4161 all-extents-closed-open Treat all extents as start-closed, end-open.
4162 all-extents-open-closed Treat all extents as start-open, end-closed.
4164 start-in-region In addition to the above conditions for extent
4165 overlap, the extent's start position must lie within
4166 the specified region. Note that, for this
4167 condition, open start positions are treated as if
4168 0.5 was added to the endpoint's value, and open
4169 end positions are treated as if 0.5 was subtracted
4170 from the endpoint's value.
4171 end-in-region The extent's end position must lie within the
4173 start-and-end-in-region Both the extent's start and end positions must lie
4175 start-or-end-in-region Either the extent's start or end position must lie
4178 negate-in-region The condition specified by a `*-in-region' flag
4179 must NOT hold for the extent to be considered.
4181 At most one of `all-extents-closed', `all-extents-open',
4182 `all-extents-closed-open', and `all-extents-open-closed' may be specified.
4184 At most one of `start-in-region', `end-in-region',
4185 `start-and-end-in-region', and `start-or-end-in-region' may be specified.
4187 If optional arg PROPERTY is non-nil, only extents with that property set
4188 on them will be visited. If optional arg VALUE is non-nil, only extents
4189 whose value for that property is `eq' to VALUE will be visited.
4191 (function, object, from, to, maparg, flags, property, value))
4193 /* This function can GC */
4194 struct slow_map_extents_arg closure;
4195 unsigned int me_flags;
4197 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
4200 if (EXTENTP(object)) {
4201 after = decode_extent(object, DE_MUST_BE_ATTACHED);
4203 from = Fextent_start_position(object);
4205 to = Fextent_end_position(object);
4206 object = extent_object(after);
4208 object = decode_buffer_or_string(object);
4210 get_buffer_or_string_range_byte(object, from, to, &start, &end,
4212 GB_ALLOW_PAST_ACCESSIBLE);
4214 me_flags = decode_map_extents_flags(flags);
4216 if (!NILP(property)) {
4218 value = canonicalize_extent_property(property, value);
4221 GCPRO5(function, maparg, object, property, value);
4223 closure.map_arg = maparg;
4224 closure.map_routine = function;
4225 closure.result = Qnil;
4226 closure.property = property;
4227 closure.value = value;
4229 map_extents_bytind(start, end, slow_map_extents_function,
4230 (void *)&closure, object, after,
4231 /* You never know what the user might do ... */
4232 me_flags | ME_MIGHT_CALL_ELISP);
4235 return closure.result;
4238 /************************************************************************/
4239 /* mapping over extents -- other functions */
4240 /************************************************************************/
4242 /* ------------------------------- */
4243 /* map-extent-children */
4244 /* ------------------------------- */
4246 struct slow_map_extent_children_arg {
4247 Lisp_Object map_arg;
4248 Lisp_Object map_routine;
4250 Lisp_Object property;
4257 static int slow_map_extent_children_function(EXTENT extent, void *arg)
4259 /* This function can GC */
4260 struct slow_map_extent_children_arg *closure =
4261 (struct slow_map_extent_children_arg *)arg;
4262 Lisp_Object extent_obj;
4263 Bytind start = extent_endpoint_bytind(extent, 0);
4264 Bytind end = extent_endpoint_bytind(extent, 1);
4265 /* Make sure the extent starts inside the region of interest,
4266 rather than just overlaps it.
4268 if (start < closure->start_min)
4270 /* Make sure the extent is not a child of a previous visited one.
4271 We know already, because of extent ordering,
4272 that start >= prev_start, and that if
4273 start == prev_start, then end <= prev_end.
4275 if (start == closure->prev_start) {
4276 if (end < closure->prev_end)
4278 } else { /* start > prev_start */
4280 if (start < closure->prev_end)
4282 /* corner case: prev_end can be -1 if there is no prev */
4284 XSETEXTENT(extent_obj, extent);
4286 /* make sure this extent qualifies according to the PROPERTY
4289 if (!NILP(closure->property)) {
4291 Fextent_property(extent_obj, closure->property,
4293 if ((NILP(closure->value) && NILP(value)) ||
4294 (!NILP(closure->value) && !EQ(value, closure->value)))
4298 closure->result = call2(closure->map_routine, extent_obj,
4301 /* Since the callback may change the buffer, compute all stored
4302 buffer positions here.
4304 closure->start_min = -1; /* no need for this any more */
4305 closure->prev_start = extent_endpoint_bytind(extent, 0);
4306 closure->prev_end = extent_endpoint_bytind(extent, 1);
4308 return !NILP(closure->result);
4311 DEFUN("map-extent-children", Fmap_extent_children, 1, 8, 0, /*
4312 Map FUNCTION over the extents in the region from FROM to TO.
4313 FUNCTION is called with arguments (extent, MAPARG). See `map-extents'
4314 for a full discussion of the arguments FROM, TO, and FLAGS.
4316 The arguments are the same as for `map-extents', but this function differs
4317 in that it only visits extents which start in the given region, and also
4318 in that, after visiting an extent E, it skips all other extents which start
4319 inside E but end before E's end.
4321 Thus, this function may be used to walk a tree of extents in a buffer:
4322 (defun walk-extents (buffer &optional ignore)
4323 (map-extent-children 'walk-extents buffer))
4325 (function, object, from, to, maparg, flags, property, value))
4327 /* This function can GC */
4328 struct slow_map_extent_children_arg closure;
4329 unsigned int me_flags;
4331 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
4334 if (EXTENTP(object)) {
4335 after = decode_extent(object, DE_MUST_BE_ATTACHED);
4337 from = Fextent_start_position(object);
4339 to = Fextent_end_position(object);
4340 object = extent_object(after);
4342 object = decode_buffer_or_string(object);
4344 get_buffer_or_string_range_byte(object, from, to, &start, &end,
4346 GB_ALLOW_PAST_ACCESSIBLE);
4348 me_flags = decode_map_extents_flags(flags);
4350 if (!NILP(property)) {
4352 value = canonicalize_extent_property(property, value);
4355 GCPRO5(function, maparg, object, property, value);
4357 closure.map_arg = maparg;
4358 closure.map_routine = function;
4359 closure.result = Qnil;
4360 closure.property = property;
4361 closure.value = value;
4362 closure.start_min = start;
4363 closure.prev_start = -1;
4364 closure.prev_end = -1;
4365 map_extents_bytind(start, end, slow_map_extent_children_function,
4366 (void *)&closure, object, after,
4367 /* You never know what the user might do ... */
4368 me_flags | ME_MIGHT_CALL_ELISP);
4371 return closure.result;
4374 /* ------------------------------- */
4376 /* ------------------------------- */
4378 /* find "smallest" matching extent containing pos -- (flag == 0) means
4379 all extents match, else (EXTENT_FLAGS (extent) & flag) must be true;
4380 for more than one matching extent with precisely the same endpoints,
4381 we choose the last extent in the extents_list.
4382 The search stops just before "before", if that is non-null.
4385 struct extent_at_arg {
4386 Lisp_Object best_match; /* or list of extents */
4394 enum extent_at_flag {
4400 static enum extent_at_flag decode_extent_at_flag(Lisp_Object at_flag)
4403 return EXTENT_AT_AFTER;
4405 CHECK_SYMBOL(at_flag);
4406 if (EQ(at_flag, Qafter))
4407 return EXTENT_AT_AFTER;
4408 if (EQ(at_flag, Qbefore))
4409 return EXTENT_AT_BEFORE;
4410 if (EQ(at_flag, Qat))
4411 return EXTENT_AT_AT;
4413 invalid_argument("Invalid AT-FLAG in `extent-at'", at_flag);
4414 return EXTENT_AT_AFTER; /* unreached */
4417 static int extent_at_mapper(EXTENT e, void *arg)
4419 struct extent_at_arg *closure = (struct extent_at_arg *)arg;
4421 if (e == closure->before)
4424 /* If closure->prop is non-nil, then the extent is only acceptable
4425 if it has a non-nil value for that property. */
4426 if (!NILP(closure->prop)) {
4428 XSETEXTENT(extent, e);
4429 if (NILP(Fextent_property(extent, closure->prop, Qnil)))
4433 if (!closure->all_extents) {
4436 if (NILP(closure->best_match))
4438 current = XEXTENT(closure->best_match);
4439 /* redundant but quick test */
4440 if (extent_start(current) > extent_start(e))
4443 /* we return the "last" best fit, instead of the first --
4444 this is because then the glyph closest to two equivalent
4445 extents corresponds to the "extent-at" the text just past
4447 else if (!EXTENT_LESS_VALS(e, closure->best_start,
4453 XSETEXTENT(closure->best_match, e);
4454 closure->best_start = extent_start(e);
4455 closure->best_end = extent_end(e);
4459 XSETEXTENT(extent, e);
4460 closure->best_match = Fcons(extent, closure->best_match);
4467 extent_at_bytind(Bytind position, Lisp_Object object, Lisp_Object property,
4468 EXTENT before, enum extent_at_flag at_flag, int all_extents)
4470 struct extent_at_arg closure;
4471 struct gcpro gcpro1;
4473 /* it might be argued that invalid positions should cause
4474 errors, but the principle of least surprise dictates that
4475 nil should be returned (extent-at is often used in
4476 response to a mouse event, and in many cases previous events
4477 have changed the buffer contents).
4479 Also, the openness stuff in the text-property code currently
4480 does not check its limits and might go off the end. */
4481 if ((at_flag == EXTENT_AT_BEFORE
4482 ? position <= buffer_or_string_absolute_begin_byte(object)
4483 : position < buffer_or_string_absolute_begin_byte(object))
4484 || (at_flag == EXTENT_AT_AFTER
4485 ? position >= buffer_or_string_absolute_end_byte(object)
4486 : position > buffer_or_string_absolute_end_byte(object)))
4489 closure.best_match = Qnil;
4490 closure.prop = property;
4491 closure.before = before;
4492 closure.all_extents = all_extents;
4494 GCPRO1(closure.best_match);
4495 map_extents_bytind(at_flag ==
4496 EXTENT_AT_BEFORE ? position - 1 : position,
4497 at_flag == EXTENT_AT_AFTER ? position + 1 : position,
4498 extent_at_mapper, (void *)&closure, object, 0,
4499 ME_START_OPEN | ME_ALL_EXTENTS_CLOSED);
4501 closure.best_match = Fnreverse(closure.best_match);
4504 return closure.best_match;
4507 DEFUN("extent-at", Fextent_at, 1, 5, 0, /*
4508 Find "smallest" extent at POS in OBJECT having PROPERTY set.
4509 Normally, an extent is "at" POS if it overlaps the region (POS, POS+1);
4510 i.e. if it covers the character after POS. (However, see the definition
4511 of AT-FLAG.) "Smallest" means the extent that comes last in the display
4512 order; this normally means the extent whose start position is closest to
4513 POS. See `next-extent' for more information.
4514 OBJECT specifies a buffer or string and defaults to the current buffer.
4515 PROPERTY defaults to nil, meaning that any extent will do.
4516 Properties are attached to extents with `set-extent-property', which see.
4517 Returns nil if POS is invalid or there is no matching extent at POS.
4518 If the fourth argument BEFORE is not nil, it must be an extent; any returned
4519 extent will precede that extent. This feature allows `extent-at' to be
4520 used by a loop over extents.
4521 AT-FLAG controls how end cases are handled, and should be one of:
4523 nil or `after' An extent is at POS if it covers the character
4524 after POS. This is consistent with the way
4525 that text properties work.
4526 `before' An extent is at POS if it covers the character
4528 `at' An extent is at POS if it overlaps or abuts POS.
4529 This includes all zero-length extents at POS.
4531 Note that in all cases, the start-openness and end-openness of the extents
4532 considered is ignored. If you want to pay attention to those properties,
4533 you should use `map-extents', which gives you more control.
4535 (pos, object, property, before, at_flag))
4538 EXTENT before_extent;
4539 enum extent_at_flag fl;
4541 object = decode_buffer_or_string(object);
4543 get_buffer_or_string_pos_byte(object, pos, GB_NO_ERROR_IF_BAD);
4547 before_extent = decode_extent(before, DE_MUST_BE_ATTACHED);
4548 if (before_extent && !EQ(object, extent_object(before_extent)))
4549 invalid_argument("extent not in specified buffer or string",
4551 fl = decode_extent_at_flag(at_flag);
4553 return extent_at_bytind(position, object, property, before_extent, fl,
4557 DEFUN("extents-at", Fextents_at, 1, 5, 0, /*
4558 Find all extents at POS in OBJECT having PROPERTY set.
4559 Normally, an extent is "at" POS if it overlaps the region (POS, POS+1);
4560 i.e. if it covers the character after POS. (However, see the definition
4562 This provides similar functionality to `extent-list', but does so in a way
4563 that is compatible with `extent-at'. (For example, errors due to POS out of
4564 range are ignored; this makes it safer to use this function in response to
4565 a mouse event, because in many cases previous events have changed the buffer
4567 OBJECT specifies a buffer or string and defaults to the current buffer.
4568 PROPERTY defaults to nil, meaning that any extent will do.
4569 Properties are attached to extents with `set-extent-property', which see.
4570 Returns nil if POS is invalid or there is no matching extent at POS.
4571 If the fourth argument BEFORE is not nil, it must be an extent; any returned
4572 extent will precede that extent. This feature allows `extents-at' to be
4573 used by a loop over extents.
4574 AT-FLAG controls how end cases are handled, and should be one of:
4576 nil or `after' An extent is at POS if it covers the character
4577 after POS. This is consistent with the way
4578 that text properties work.
4579 `before' An extent is at POS if it covers the character
4581 `at' An extent is at POS if it overlaps or abuts POS.
4582 This includes all zero-length extents at POS.
4584 Note that in all cases, the start-openness and end-openness of the extents
4585 considered is ignored. If you want to pay attention to those properties,
4586 you should use `map-extents', which gives you more control.
4588 (pos, object, property, before, at_flag))
4591 EXTENT before_extent;
4592 enum extent_at_flag fl;
4594 object = decode_buffer_or_string(object);
4596 get_buffer_or_string_pos_byte(object, pos, GB_NO_ERROR_IF_BAD);
4600 before_extent = decode_extent(before, DE_MUST_BE_ATTACHED);
4601 if (before_extent && !EQ(object, extent_object(before_extent)))
4602 invalid_argument("extent not in specified buffer or string",
4604 fl = decode_extent_at_flag(at_flag);
4606 return extent_at_bytind(position, object, property, before_extent, fl,
4610 /* ------------------------------- */
4611 /* verify_extent_modification() */
4612 /* ------------------------------- */
4614 /* verify_extent_modification() is called when a buffer or string is
4615 modified to check whether the modification is occuring inside a
4619 struct verify_extents_arg {
4623 Lisp_Object iro; /* value of inhibit-read-only */
4626 static int verify_extent_mapper(EXTENT extent, void *arg)
4628 struct verify_extents_arg *closure = (struct verify_extents_arg *)arg;
4629 Lisp_Object prop = extent_read_only(extent);
4634 if (CONSP(closure->iro) && !NILP(Fmemq(prop, closure->iro)))
4637 #if 0 /* Nobody seems to care for this any more -sb */
4638 /* Allow deletion if the extent is completely contained in
4639 the region being deleted.
4640 This is important for supporting tokens which are internally
4641 write-protected, but which can be killed and yanked as a whole.
4642 Ignore open/closed distinctions at this point.
4645 if (closure->start != closure->end &&
4646 extent_start(extent) >= closure->start &&
4647 extent_end(extent) <= closure->end)
4652 Fsignal(Qbuffer_read_only, (list1(closure->object)));
4654 RETURN_NOT_REACHED(0)
4657 /* Value of Vinhibit_read_only is precomputed and passed in for
4661 verify_extent_modification(Lisp_Object object, Bytind from, Bytind to,
4662 Lisp_Object inhibit_read_only_value)
4665 struct verify_extents_arg closure;
4667 /* If insertion, visit closed-endpoint extents touching the insertion
4668 point because the text would go inside those extents. If deletion,
4669 treat the range as open on both ends so that touching extents are not
4670 visited. Note that we assume that an insertion is occurring if the
4671 changed range has zero length, and a deletion otherwise. This
4672 fails if a change (i.e. non-insertion, non-deletion) is happening.
4673 As far as I know, this doesn't currently occur in XEmacs. --ben */
4674 closed = (from == to);
4675 closure.object = object;
4676 closure.start = buffer_or_string_bytind_to_memind(object, from);
4677 closure.end = buffer_or_string_bytind_to_memind(object, to);
4678 closure.iro = inhibit_read_only_value;
4680 map_extents_bytind(from, to, verify_extent_mapper, (void *)&closure,
4681 object, 0, closed ? ME_END_CLOSED : ME_START_OPEN);
4684 /* ------------------------------------ */
4685 /* process_extents_for_insertion() */
4686 /* ------------------------------------ */
4688 struct process_extents_for_insertion_arg {
4694 /* A region of length LENGTH was just inserted at OPOINT. Modify all
4695 of the extents as required for the insertion, based on their
4696 start-open/end-open properties.
4699 static int process_extents_for_insertion_mapper(EXTENT extent, void *arg)
4701 struct process_extents_for_insertion_arg *closure =
4702 (struct process_extents_for_insertion_arg *)arg;
4703 Memind indice = buffer_or_string_bytind_to_memind(closure->object,
4706 /* When this function is called, one end of the newly-inserted text should
4707 be adjacent to some endpoint of the extent, or disjoint from it. If
4708 the insertion overlaps any existing extent, something is wrong.
4710 #ifdef ERROR_CHECK_EXTENTS
4711 if (extent_start(extent) > indice &&
4712 extent_start(extent) < indice + closure->length)
4714 if (extent_end(extent) > indice &&
4715 extent_end(extent) < indice + closure->length)
4719 /* The extent-adjustment code adjusted the extent's endpoints as if
4720 all extents were closed-open -- endpoints at the insertion point
4721 remain unchanged. We need to fix the other kinds of extents:
4723 1. Start position of start-open extents needs to be moved.
4725 2. End position of end-closed extents needs to be moved.
4727 Note that both conditions hold for zero-length (] extents at the
4728 insertion point. But under these rules, zero-length () extents
4729 would get adjusted such that their start is greater than their
4730 end; instead of allowing that, we treat them as [) extents by
4731 modifying condition #1 to not fire nothing when dealing with a
4732 zero-length open-open extent.
4734 Existence of zero-length open-open extents is unfortunately an
4735 inelegant part of the extent model, but there is no way around
4739 Memind new_start = extent_start(extent);
4740 Memind new_end = extent_end(extent);
4742 if (indice == extent_start(extent)
4743 && extent_start_open_p(extent)
4744 /* zero-length () extents are exempt; see comment above. */
4745 && !(new_start == new_end && extent_end_open_p(extent))
4747 new_start += closure->length;
4748 if (indice == extent_end(extent) && !extent_end_open_p(extent))
4749 new_end += closure->length;
4751 set_extent_endpoints_1(extent, new_start, new_end);
4758 process_extents_for_insertion(Lisp_Object object, Bytind opoint,
4761 struct process_extents_for_insertion_arg closure;
4763 closure.opoint = opoint;
4764 closure.length = length;
4765 closure.object = object;
4767 map_extents_bytind(opoint, opoint + length,
4768 process_extents_for_insertion_mapper,
4769 (void *)&closure, object, 0,
4770 ME_END_CLOSED | ME_MIGHT_MODIFY_EXTENTS |
4771 ME_INCLUDE_INTERNAL);
4774 /* ------------------------------------ */
4775 /* process_extents_for_deletion() */
4776 /* ------------------------------------ */
4778 struct process_extents_for_deletion_arg {
4780 int destroy_included_extents;
4783 /* This function is called when we're about to delete the range [from, to].
4784 Detach all of the extents that are completely inside the range [from, to],
4785 if they're detachable or open-open. */
4787 static int process_extents_for_deletion_mapper(EXTENT extent, void *arg)
4789 struct process_extents_for_deletion_arg *closure =
4790 (struct process_extents_for_deletion_arg *)arg;
4792 /* If the extent lies completely within the range that
4793 is being deleted, then nuke the extent if it's detachable
4794 (otherwise, it will become a zero-length extent). */
4796 if (closure->start <= extent_start(extent) &&
4797 extent_end(extent) <= closure->end) {
4798 if (extent_detachable_p(extent)) {
4799 if (closure->destroy_included_extents)
4800 destroy_extent(extent);
4802 extent_detach(extent);
4809 /* DESTROY_THEM means destroy the extents instead of just deleting them.
4810 It is unused currently, but perhaps might be used (there used to
4811 be a function process_extents_for_destruction(), #if 0'd out,
4812 that did the equivalent). */
4814 process_extents_for_deletion(Lisp_Object object, Bytind from,
4815 Bytind to, int destroy_them)
4817 struct process_extents_for_deletion_arg closure;
4819 closure.start = buffer_or_string_bytind_to_memind(object, from);
4820 closure.end = buffer_or_string_bytind_to_memind(object, to);
4821 closure.destroy_included_extents = destroy_them;
4823 map_extents_bytind(from, to, process_extents_for_deletion_mapper,
4824 (void *)&closure, object, 0,
4825 ME_END_CLOSED | ME_MIGHT_MODIFY_EXTENTS);
4828 /* ------------------------------- */
4829 /* report_extent_modification() */
4830 /* ------------------------------- */
4831 struct report_extent_modification_closure {
4838 static Lisp_Object report_extent_modification_restore(Lisp_Object buffer)
4840 if (current_buffer != XBUFFER(buffer))
4841 Fset_buffer(buffer);
4845 static int report_extent_modification_mapper(EXTENT extent, void *arg)
4847 struct report_extent_modification_closure *closure =
4848 (struct report_extent_modification_closure *)arg;
4849 Lisp_Object exobj, startobj, endobj;
4850 Lisp_Object hook = (closure->afterp
4851 ? extent_after_change_functions(extent)
4852 : extent_before_change_functions(extent));
4856 XSETEXTENT(exobj, extent);
4857 XSETINT(startobj, closure->start);
4858 XSETINT(endobj, closure->end);
4860 /* Now that we are sure to call elisp, set up an unwind-protect so
4861 inside_change_hook gets restored in case we throw. Also record
4862 the current buffer, in case we change it. Do the recording only
4865 One confusing thing here is that our caller never actually calls
4866 unbind_to (closure.speccount, Qnil). This is because
4867 map_extents_bytind() unbinds before, and with a smaller
4868 speccount. The additional unbind_to() in
4869 report_extent_modification() would cause XEmacs to abort. */
4870 if (closure->speccount == -1) {
4871 closure->speccount = specpdl_depth();
4872 record_unwind_protect(report_extent_modification_restore,
4876 /* The functions will expect closure->buffer to be the current
4877 buffer, so change it if it isn't. */
4878 if (current_buffer != XBUFFER(closure->buffer))
4879 Fset_buffer(closure->buffer);
4881 /* #### It's a shame that we can't use any of the existing run_hook*
4882 functions here. This is so because all of them work with
4883 symbols, to be able to retrieve default values of local hooks.
4886 #### Idea: we could set up a dummy symbol, and call the hook
4887 functions on *that*. */
4889 if (!CONSP(hook) || EQ(XCAR(hook), Qlambda))
4890 call3(hook, exobj, startobj, endobj);
4893 EXTERNAL_LIST_LOOP(tail, hook)
4894 /* #### Shouldn't this perform the same Fset_buffer() check as
4896 call3(XCAR(tail), exobj, startobj, endobj);
4902 report_extent_modification(Lisp_Object buffer, Bufpos start, Bufpos end,
4905 struct report_extent_modification_closure closure;
4907 closure.buffer = buffer;
4908 closure.start = start;
4910 closure.afterp = afterp;
4911 closure.speccount = -1;
4913 map_extents(start, end, report_extent_modification_mapper,
4914 (void *)&closure, buffer, NULL, ME_MIGHT_CALL_ELISP);
4917 /************************************************************************/
4918 /* extent properties */
4919 /************************************************************************/
4921 static void set_extent_invisible(EXTENT extent, Lisp_Object value)
4923 if (!EQ(extent_invisible(extent), value)) {
4924 set_extent_invisible_1(extent, value);
4925 extent_changed_for_redisplay(extent, 1, 1);
4929 /* This function does "memoization" -- similar to the interning
4930 that happens with symbols. Given a list of faces, an equivalent
4931 list is returned such that if this function is called twice with
4932 input that is `equal', the resulting outputs will be `eq'.
4934 Note that the inputs and outputs are in general *not* `equal' --
4935 faces in symbol form become actual face objects in the output.
4936 This is necessary so that temporary faces stay around. */
4938 static Lisp_Object memoize_extent_face_internal(Lisp_Object list)
4942 Lisp_Object cons, thecons;
4943 Lisp_Object oldtail, tail;
4944 struct gcpro gcpro1;
4949 return Fget_face(list);
4951 /* To do the memoization, we use a hash table mapping from
4952 external lists to internal lists. We do `equal' comparisons
4953 on the keys so the memoization works correctly.
4955 Note that we canonicalize things so that the keys in the
4956 hash table (the external lists) always contain symbols and
4957 the values (the internal lists) always contain face objects.
4959 We also maintain a "reverse" table that maps from the internal
4960 lists to the external equivalents. The idea here is twofold:
4962 1) `extent-face' wants to return a list containing face symbols
4963 rather than face objects.
4964 2) We don't want things to get quite so messed up if the user
4965 maliciously side-effects the returned lists.
4968 len = XINT(Flength(list));
4969 thelen = XINT(Flength(Vextent_face_reusable_list));
4974 /* We canonicalize the given list into another list.
4975 We try to avoid consing except when necessary, so we have
4980 cons = Vextent_face_reusable_list;
4981 while (!NILP(XCDR(cons)))
4983 XCDR(cons) = Fmake_list(make_int(len - thelen), Qnil);
4984 } else if (thelen > len) {
4987 /* Truncate the list temporarily so it's the right length;
4988 remember the old tail. */
4989 cons = Vextent_face_reusable_list;
4990 for (i = 0; i < len - 1; i++)
4993 oldtail = XCDR(cons);
4997 thecons = Vextent_face_reusable_list;
4998 EXTERNAL_LIST_LOOP(cons, list) {
4999 Lisp_Object face = Fget_face(XCAR(cons));
5001 XCAR(thecons) = Fface_name(face);
5002 thecons = XCDR(thecons);
5006 Fgethash(Vextent_face_reusable_list,
5007 Vextent_face_memoize_hash_table, Qnil);
5009 Lisp_Object symlist =
5010 Fcopy_sequence(Vextent_face_reusable_list);
5011 Lisp_Object facelist =
5012 Fcopy_sequence(Vextent_face_reusable_list);
5014 LIST_LOOP(cons, facelist) {
5015 XCAR(cons) = Fget_face(XCAR(cons));
5017 Fputhash(symlist, facelist, Vextent_face_memoize_hash_table);
5018 Fputhash(facelist, symlist,
5019 Vextent_face_reverse_memoize_hash_table);
5023 /* Now restore the truncated tail of the reusable list, if necessary. */
5025 XCDR(tail) = oldtail;
5031 static Lisp_Object external_of_internal_memoized_face(Lisp_Object face)
5035 else if (!CONSP(face))
5036 return XFACE(face)->name;
5038 face = Fgethash(face, Vextent_face_reverse_memoize_hash_table,
5040 assert(!UNBOUNDP(face));
5046 canonicalize_extent_property(Lisp_Object prop, Lisp_Object value)
5048 if (EQ(prop, Qface) || EQ(prop, Qmouse_face))
5049 value = (external_of_internal_memoized_face
5050 (memoize_extent_face_internal(value)));
5054 /* Do we need a lisp-level function ? */
5055 DEFUN("set-extent-initial-redisplay-function", Fset_extent_initial_redisplay_function, 2, 2, 0, /*
5056 Note: This feature is experimental!
5058 Set initial-redisplay-function of EXTENT to the function
5061 The first time the EXTENT is (re)displayed, an eval event will be
5062 dispatched calling FUNCTION with EXTENT as its only argument.
5066 EXTENT e = decode_extent(extent, DE_MUST_BE_ATTACHED);
5068 e = extent_ancestor(e); /* Is this needed? Macro also does chasing! */
5069 set_extent_initial_redisplay_function(e, function);
5070 extent_in_red_event_p(e) = 0; /* If the function changed we can spawn
5072 extent_changed_for_redisplay(e, 1, 0); /* Do we need to mark children too ? */
5077 DEFUN("extent-face", Fextent_face, 1, 1, 0, /*
5078 Return the name of the face in which EXTENT is displayed, or nil
5079 if the extent's face is unspecified. This might also return a list
5086 CHECK_EXTENT(extent);
5087 face = extent_face(XEXTENT(extent));
5089 return external_of_internal_memoized_face(face);
5092 DEFUN("set-extent-face", Fset_extent_face, 2, 2, 0, /*
5093 Make the given EXTENT have the graphic attributes specified by FACE.
5094 FACE can also be a list of faces, and all faces listed will apply,
5095 with faces earlier in the list taking priority over those later in the
5100 EXTENT e = decode_extent(extent, 0);
5101 Lisp_Object orig_face = face;
5103 /* retrieve the ancestor for efficiency and proper redisplay noting. */
5104 e = extent_ancestor(e);
5106 face = memoize_extent_face_internal(face);
5108 extent_face(e) = face;
5109 extent_changed_for_redisplay(e, 1, 0);
5114 DEFUN("extent-mouse-face", Fextent_mouse_face, 1, 1, 0, /*
5115 Return the face used to highlight EXTENT when the mouse passes over it.
5116 The return value will be a face name, a list of face names, or nil
5117 if the extent's mouse face is unspecified.
5123 CHECK_EXTENT(extent);
5124 face = extent_mouse_face(XEXTENT(extent));
5126 return external_of_internal_memoized_face(face);
5129 DEFUN("set-extent-mouse-face", Fset_extent_mouse_face, 2, 2, 0, /*
5130 Set the face used to highlight EXTENT when the mouse passes over it.
5131 FACE can also be a list of faces, and all faces listed will apply,
5132 with faces earlier in the list taking priority over those later in the
5138 Lisp_Object orig_face = face;
5140 CHECK_EXTENT(extent);
5141 e = XEXTENT(extent);
5142 /* retrieve the ancestor for efficiency and proper redisplay noting. */
5143 e = extent_ancestor(e);
5145 face = memoize_extent_face_internal(face);
5147 set_extent_mouse_face(e, face);
5148 extent_changed_for_redisplay(e, 1, 0);
5154 set_extent_glyph(EXTENT extent, Lisp_Object glyph, int endp,
5155 glyph_layout layout)
5157 extent = extent_ancestor(extent);
5160 set_extent_begin_glyph(extent, glyph);
5161 extent_begin_glyph_layout(extent) = layout;
5163 set_extent_end_glyph(extent, glyph);
5164 extent_end_glyph_layout(extent) = layout;
5167 extent_changed_for_redisplay(extent, 1, 0);
5170 static Lisp_Object glyph_layout_to_symbol(glyph_layout layout)
5175 case GL_OUTSIDE_MARGIN:
5176 return Qoutside_margin;
5177 case GL_INSIDE_MARGIN:
5178 return Qinside_margin;
5183 return Qnil; /* unreached */
5187 static glyph_layout symbol_to_glyph_layout(Lisp_Object layout_obj)
5189 if (NILP(layout_obj))
5192 CHECK_SYMBOL(layout_obj);
5193 if (EQ(layout_obj, Qoutside_margin))
5194 return GL_OUTSIDE_MARGIN;
5195 if (EQ(layout_obj, Qinside_margin))
5196 return GL_INSIDE_MARGIN;
5197 if (EQ(layout_obj, Qwhitespace))
5198 return GL_WHITESPACE;
5199 if (EQ(layout_obj, Qtext))
5202 invalid_argument("Unknown glyph layout type", layout_obj);
5203 return GL_TEXT; /* unreached */
5207 set_extent_glyph_1(Lisp_Object extent_obj, Lisp_Object glyph, int endp,
5208 Lisp_Object layout_obj)
5210 EXTENT extent = decode_extent(extent_obj, 0);
5211 glyph_layout layout = symbol_to_glyph_layout(layout_obj);
5213 /* Make sure we've actually been given a valid glyph or it's nil
5214 (meaning we're deleting a glyph from an extent). */
5216 CHECK_BUFFER_GLYPH(glyph);
5218 set_extent_glyph(extent, glyph, endp, layout);
5222 DEFUN("set-extent-begin-glyph", Fset_extent_begin_glyph, 2, 3, 0, /*
5223 Display a bitmap, subwindow or string at the beginning of EXTENT.
5224 BEGIN-GLYPH must be a glyph object. The layout policy defaults to `text'.
5226 (extent, begin_glyph, layout))
5228 return set_extent_glyph_1(extent, begin_glyph, 0, layout);
5231 DEFUN("set-extent-end-glyph", Fset_extent_end_glyph, 2, 3, 0, /*
5232 Display a bitmap, subwindow or string at the end of EXTENT.
5233 END-GLYPH must be a glyph object. The layout policy defaults to `text'.
5235 (extent, end_glyph, layout))
5237 return set_extent_glyph_1(extent, end_glyph, 1, layout);
5240 DEFUN("extent-begin-glyph", Fextent_begin_glyph, 1, 1, 0, /*
5241 Return the glyph object displayed at the beginning of EXTENT.
5242 If there is none, nil is returned.
5246 return extent_begin_glyph(decode_extent(extent, 0));
5249 DEFUN("extent-end-glyph", Fextent_end_glyph, 1, 1, 0, /*
5250 Return the glyph object displayed at the end of EXTENT.
5251 If there is none, nil is returned.
5255 return extent_end_glyph(decode_extent(extent, 0));
5258 DEFUN("set-extent-begin-glyph-layout", Fset_extent_begin_glyph_layout, 2, 2, 0, /*
5259 Set the layout policy of EXTENT's begin glyph.
5260 Access this using the `extent-begin-glyph-layout' function.
5264 EXTENT e = decode_extent(extent, 0);
5265 e = extent_ancestor(e);
5266 extent_begin_glyph_layout(e) = symbol_to_glyph_layout(layout);
5267 extent_maybe_changed_for_redisplay(e, 1, 0);
5271 DEFUN("set-extent-end-glyph-layout", Fset_extent_end_glyph_layout, 2, 2, 0, /*
5272 Set the layout policy of EXTENT's end glyph.
5273 Access this using the `extent-end-glyph-layout' function.
5277 EXTENT e = decode_extent(extent, 0);
5278 e = extent_ancestor(e);
5279 extent_end_glyph_layout(e) = symbol_to_glyph_layout(layout);
5280 extent_maybe_changed_for_redisplay(e, 1, 0);
5284 DEFUN("extent-begin-glyph-layout", Fextent_begin_glyph_layout, 1, 1, 0, /*
5285 Return the layout policy associated with EXTENT's begin glyph.
5286 Set this using the `set-extent-begin-glyph-layout' function.
5290 EXTENT e = decode_extent(extent, 0);
5291 return glyph_layout_to_symbol((glyph_layout)
5292 extent_begin_glyph_layout(e));
5295 DEFUN("extent-end-glyph-layout", Fextent_end_glyph_layout, 1, 1, 0, /*
5296 Return the layout policy associated with EXTENT's end glyph.
5297 Set this using the `set-extent-end-glyph-layout' function.
5301 EXTENT e = decode_extent(extent, 0);
5302 return glyph_layout_to_symbol((glyph_layout)
5303 extent_end_glyph_layout(e));
5306 DEFUN("set-extent-priority", Fset_extent_priority, 2, 2, 0, /*
5307 Set the display priority of EXTENT to PRIORITY (an integer).
5308 When the extent attributes are being merged for display, the priority
5309 is used to determine which extent takes precedence in the event of a
5310 conflict (two extents whose faces both specify font, for example: the
5311 font of the extent with the higher priority will be used).
5312 Extents are created with priority 0; priorities may be negative.
5316 EXTENT e = decode_extent(extent, 0);
5318 CHECK_INT(priority);
5319 e = extent_ancestor(e);
5320 set_extent_priority(e, XINT(priority));
5321 extent_maybe_changed_for_redisplay(e, 1, 0);
5325 DEFUN("extent-priority", Fextent_priority, 1, 1, 0, /*
5326 Return the display priority of EXTENT; see `set-extent-priority'.
5330 EXTENT e = decode_extent(extent, 0);
5331 return make_int(extent_priority(e));
5334 DEFUN("set-extent-property", Fset_extent_property, 3, 3, 0, /*
5335 Change a property of an extent.
5336 PROPERTY may be any symbol; the value stored may be accessed with
5337 the `extent-property' function.
5338 The following symbols have predefined meanings:
5340 detached Removes the extent from its buffer; setting this is
5341 the same as calling `detach-extent'.
5343 destroyed Removes the extent from its buffer, and makes it
5344 unusable in the future; this is the same calling
5347 priority Change redisplay priority; same as `set-extent-priority'.
5349 start-open Whether the set of characters within the extent is
5350 treated being open on the left, that is, whether
5351 the start position is an exclusive, rather than
5352 inclusive, boundary. If true, then characters
5353 inserted exactly at the beginning of the extent
5354 will remain outside of the extent; otherwise they
5355 will go into the extent, extending it.
5357 end-open Whether the set of characters within the extent is
5358 treated being open on the right, that is, whether
5359 the end position is an exclusive, rather than
5360 inclusive, boundary. If true, then characters
5361 inserted exactly at the end of the extent will
5362 remain outside of the extent; otherwise they will
5363 go into the extent, extending it.
5365 By default, extents have the `end-open' but not the
5366 `start-open' property set.
5368 read-only Text within this extent will be unmodifiable.
5370 initial-redisplay-function (EXPERIMENTAL)
5371 function to be called the first time (part of) the extent
5372 is redisplayed. It will be called with the extent as its
5374 Note: The function will not be called immediately
5375 during redisplay, an eval event will be dispatched.
5377 detachable Whether the extent gets detached (as with
5378 `detach-extent') when all the text within the
5379 extent is deleted. This is true by default. If
5380 this property is not set, the extent becomes a
5381 zero-length extent when its text is deleted. (In
5382 such a case, the `start-open' property is
5383 automatically removed if both the `start-open' and
5384 `end-open' properties are set, since zero-length
5385 extents open on both ends are not allowed.)
5387 face The face in which to display the text. Setting
5388 this is the same as calling `set-extent-face'.
5390 mouse-face If non-nil, the extent will be highlighted in this
5391 face when the mouse moves over it.
5393 pointer If non-nil, and a valid pointer glyph, this specifies
5394 the shape of the mouse pointer while over the extent.
5396 highlight Obsolete: Setting this property is equivalent to
5397 setting a `mouse-face' property of `highlight'.
5398 Reading this property returns non-nil if
5399 the extent has a non-nil `mouse-face' property.
5401 duplicable Whether this extent should be copied into strings,
5402 so that kill, yank, and undo commands will restore
5403 or copy it. `duplicable' extents are copied from
5404 an extent into a string when `buffer-substring' or
5405 a similar function creates a string. The extents
5406 in a string are copied into other strings created
5407 from the string using `concat' or `substring'.
5408 When `insert' or a similar function inserts the
5409 string into a buffer, the extents are copied back
5412 unique Meaningful only in conjunction with `duplicable'.
5413 When this is set, there may be only one instance
5414 of this extent attached at a time: if it is copied
5415 to the kill ring and then yanked, the extent is
5416 not copied. If, however, it is killed (removed
5417 from the buffer) and then yanked, it will be
5418 re-attached at the new position.
5420 invisible If the value is non-nil, text under this extent
5421 may be treated as not present for the purpose of
5422 redisplay, or may be displayed using an ellipsis
5423 or other marker; see `buffer-invisibility-spec'
5424 and `invisible-text-glyph'. In all cases,
5425 however, the text is still visible to other
5426 functions that examine a buffer's text.
5428 keymap This keymap is consulted for mouse clicks on this
5429 extent, or keypresses made while point is within the
5432 copy-function This is a hook that is run when a duplicable extent
5433 is about to be copied from a buffer to a string (or
5434 the kill ring). It is called with three arguments,
5435 the extent, and the buffer-positions within it
5436 which are being copied. If this function returns
5437 nil, then the extent will not be copied; otherwise
5440 paste-function This is a hook that is run when a duplicable extent is
5441 about to be copied from a string (or the kill ring)
5442 into a buffer. It is called with three arguments,
5443 the original extent, and the buffer positions which
5444 the copied extent will occupy. (This hook is run
5445 after the corresponding text has already been
5446 inserted into the buffer.) Note that the extent
5447 argument may be detached when this function is run.
5448 If this function returns nil, no extent will be
5449 inserted. Otherwise, there will be an extent
5450 covering the range in question.
5452 If the original extent is not attached to a buffer,
5453 then it will be re-attached at this range.
5454 Otherwise, a copy will be made, and that copy
5457 The copy-function and paste-function are meaningful
5458 only for extents with the `duplicable' flag set,
5459 and if they are not specified, behave as if `t' was
5460 the returned value. When these hooks are invoked,
5461 the current buffer is the buffer which the extent
5462 is being copied from/to, respectively.
5464 begin-glyph A glyph to be displayed at the beginning of the extent,
5467 end-glyph A glyph to be displayed at the end of the extent,
5470 begin-glyph-layout The layout policy (one of `text', `whitespace',
5471 `inside-margin', or `outside-margin') of the extent's
5474 end-glyph-layout The layout policy of the extent's end glyph.
5476 syntax-table A cons or a syntax table object. If a cons, the car must
5477 be an integer (interpreted as a syntax code, applicable to
5478 all characters in the extent). Otherwise, syntax of
5479 characters in the extent is looked up in the syntax table.
5480 You should use the text property API to manipulate this
5481 property. (This may be required in the future.)
5483 (extent, property, value))
5485 /* This function can GC if property is `keymap' */
5486 EXTENT e = decode_extent(extent, 0);
5488 if (EQ(property, Qread_only))
5489 set_extent_read_only(e, value);
5490 else if (EQ(property, Qunique))
5491 extent_unique_p(e) = !NILP(value);
5492 else if (EQ(property, Qduplicable))
5493 extent_duplicable_p(e) = !NILP(value);
5494 else if (EQ(property, Qinvisible))
5495 set_extent_invisible(e, value);
5496 else if (EQ(property, Qdetachable))
5497 extent_detachable_p(e) = !NILP(value);
5499 else if (EQ(property, Qdetached)) {
5501 error("can only set `detached' to t");
5502 Fdetach_extent(extent);
5503 } else if (EQ(property, Qdestroyed)) {
5505 error("can only set `destroyed' to t");
5506 Fdelete_extent(extent);
5507 } else if (EQ(property, Qpriority))
5508 Fset_extent_priority(extent, value);
5509 else if (EQ(property, Qface))
5510 Fset_extent_face(extent, value);
5511 else if (EQ(property, Qinitial_redisplay_function))
5512 Fset_extent_initial_redisplay_function(extent, value);
5513 else if (EQ(property, Qbefore_change_functions))
5514 set_extent_before_change_functions(e, value);
5515 else if (EQ(property, Qafter_change_functions))
5516 set_extent_after_change_functions(e, value);
5517 else if (EQ(property, Qmouse_face))
5518 Fset_extent_mouse_face(extent, value);
5520 else if (EQ(property, Qhighlight))
5521 Fset_extent_mouse_face(extent, Qhighlight);
5522 else if (EQ(property, Qbegin_glyph_layout))
5523 Fset_extent_begin_glyph_layout(extent, value);
5524 else if (EQ(property, Qend_glyph_layout))
5525 Fset_extent_end_glyph_layout(extent, value);
5526 /* For backwards compatibility. We use begin glyph because it is by
5527 far the more used of the two. */
5528 else if (EQ(property, Qglyph_layout))
5529 Fset_extent_begin_glyph_layout(extent, value);
5530 else if (EQ(property, Qbegin_glyph))
5531 Fset_extent_begin_glyph(extent, value, Qnil);
5532 else if (EQ(property, Qend_glyph))
5533 Fset_extent_end_glyph(extent, value, Qnil);
5534 else if (EQ(property, Qstart_open))
5535 set_extent_openness(e, !NILP(value), -1);
5536 else if (EQ(property, Qend_open))
5537 set_extent_openness(e, -1, !NILP(value));
5538 /* Support (but don't document...) the obvious *_closed antonyms. */
5539 else if (EQ(property, Qstart_closed))
5540 set_extent_openness(e, NILP(value), -1);
5541 else if (EQ(property, Qend_closed))
5542 set_extent_openness(e, -1, NILP(value));
5544 if (EQ(property, Qkeymap))
5545 while (!NILP(value) && NILP(Fkeymapp(value)))
5546 value = wrong_type_argument(Qkeymapp, value);
5548 external_plist_put(extent_plist_addr(e), property, value, 0,
5555 DEFUN("set-extent-properties", Fset_extent_properties, 2, 2, 0, /*
5556 Change some properties of EXTENT.
5557 PLIST is a property list.
5558 For a list of built-in properties, see `set-extent-property'.
5562 /* This function can GC, if one of the properties is `keymap' */
5563 Lisp_Object property, value;
5564 struct gcpro gcpro1;
5567 plist = Fcopy_sequence(plist);
5568 Fcanonicalize_plist(plist, Qnil);
5570 while (!NILP(plist)) {
5571 property = Fcar(plist);
5572 plist = Fcdr(plist);
5573 value = Fcar(plist);
5574 plist = Fcdr(plist);
5575 Fset_extent_property(extent, property, value);
5581 DEFUN("extent-property", Fextent_property, 2, 3, 0, /*
5582 Return EXTENT's value for property PROPERTY.
5583 If no such property exists, DEFAULT is returned.
5584 See `set-extent-property' for the built-in property names.
5586 (extent, property, default_))
5588 EXTENT e = decode_extent(extent, 0);
5590 if (EQ(property, Qdetached))
5591 return extent_detached_p(e) ? Qt : Qnil;
5592 else if (EQ(property, Qdestroyed))
5593 return !EXTENT_LIVE_P(e) ? Qt : Qnil;
5594 else if (EQ(property, Qstart_open))
5595 return extent_normal_field(e, start_open) ? Qt : Qnil;
5596 else if (EQ(property, Qend_open))
5597 return extent_normal_field(e, end_open) ? Qt : Qnil;
5598 else if (EQ(property, Qunique))
5599 return extent_normal_field(e, unique) ? Qt : Qnil;
5600 else if (EQ(property, Qduplicable))
5601 return extent_normal_field(e, duplicable) ? Qt : Qnil;
5602 else if (EQ(property, Qdetachable))
5603 return extent_normal_field(e, detachable) ? Qt : Qnil;
5604 /* Support (but don't document...) the obvious *_closed antonyms. */
5605 else if (EQ(property, Qstart_closed))
5606 return extent_start_open_p(e) ? Qnil : Qt;
5607 else if (EQ(property, Qend_closed))
5608 return extent_end_open_p(e) ? Qnil : Qt;
5609 else if (EQ(property, Qpriority))
5610 return make_int(extent_priority(e));
5611 else if (EQ(property, Qread_only))
5612 return extent_read_only(e);
5613 else if (EQ(property, Qinvisible))
5614 return extent_invisible(e);
5615 else if (EQ(property, Qface))
5616 return Fextent_face(extent);
5617 else if (EQ(property, Qinitial_redisplay_function))
5618 return extent_initial_redisplay_function(e);
5619 else if (EQ(property, Qbefore_change_functions))
5620 return extent_before_change_functions(e);
5621 else if (EQ(property, Qafter_change_functions))
5622 return extent_after_change_functions(e);
5623 else if (EQ(property, Qmouse_face))
5624 return Fextent_mouse_face(extent);
5626 else if (EQ(property, Qhighlight))
5627 return !NILP(Fextent_mouse_face(extent)) ? Qt : Qnil;
5628 else if (EQ(property, Qbegin_glyph_layout))
5629 return Fextent_begin_glyph_layout(extent);
5630 else if (EQ(property, Qend_glyph_layout))
5631 return Fextent_end_glyph_layout(extent);
5632 /* For backwards compatibility. We use begin glyph because it is by
5633 far the more used of the two. */
5634 else if (EQ(property, Qglyph_layout))
5635 return Fextent_begin_glyph_layout(extent);
5636 else if (EQ(property, Qbegin_glyph))
5637 return extent_begin_glyph(e);
5638 else if (EQ(property, Qend_glyph))
5639 return extent_end_glyph(e);
5641 Lisp_Object value = external_plist_get(extent_plist_addr(e),
5642 property, 0, ERROR_ME);
5643 return UNBOUNDP(value) ? default_ : value;
5647 DEFUN("extent-properties", Fextent_properties, 1, 1, 0, /*
5648 Return a property list of the attributes of EXTENT.
5649 Do not modify this list; use `set-extent-property' instead.
5654 Lisp_Object result, face, anc_obj;
5655 glyph_layout layout;
5657 CHECK_EXTENT(extent);
5658 e = XEXTENT(extent);
5659 if (!EXTENT_LIVE_P(e))
5660 return cons3(Qdestroyed, Qt, Qnil);
5662 anc = extent_ancestor(e);
5663 XSETEXTENT(anc_obj, anc);
5665 /* For efficiency, use the ancestor for all properties except detached */
5667 result = extent_plist_slot(anc);
5669 if (!NILP(face = Fextent_face(anc_obj)))
5670 result = cons3(Qface, face, result);
5672 if (!NILP(face = Fextent_mouse_face(anc_obj)))
5673 result = cons3(Qmouse_face, face, result);
5675 if ((layout = (glyph_layout) extent_begin_glyph_layout(anc)) != GL_TEXT) {
5676 Lisp_Object sym = glyph_layout_to_symbol(layout);
5677 result = cons3(Qglyph_layout, sym, result); /* compatibility */
5678 result = cons3(Qbegin_glyph_layout, sym, result);
5681 if ((layout = (glyph_layout) extent_end_glyph_layout(anc)) != GL_TEXT)
5683 cons3(Qend_glyph_layout, glyph_layout_to_symbol(layout),
5686 if (!NILP(extent_end_glyph(anc)))
5687 result = cons3(Qend_glyph, extent_end_glyph(anc), result);
5689 if (!NILP(extent_begin_glyph(anc)))
5690 result = cons3(Qbegin_glyph, extent_begin_glyph(anc), result);
5692 if (extent_priority(anc) != 0)
5694 cons3(Qpriority, make_int(extent_priority(anc)), result);
5696 if (!NILP(extent_initial_redisplay_function(anc)))
5697 result = cons3(Qinitial_redisplay_function,
5698 extent_initial_redisplay_function(anc), result);
5700 if (!NILP(extent_before_change_functions(anc)))
5701 result = cons3(Qbefore_change_functions,
5702 extent_before_change_functions(anc), result);
5704 if (!NILP(extent_after_change_functions(anc)))
5705 result = cons3(Qafter_change_functions,
5706 extent_after_change_functions(anc), result);
5708 if (!NILP(extent_invisible(anc)))
5709 result = cons3(Qinvisible, extent_invisible(anc), result);
5711 if (!NILP(extent_read_only(anc)))
5712 result = cons3(Qread_only, extent_read_only(anc), result);
5714 if (extent_normal_field(anc, end_open))
5715 result = cons3(Qend_open, Qt, result);
5717 if (extent_normal_field(anc, start_open))
5718 result = cons3(Qstart_open, Qt, result);
5720 if (extent_normal_field(anc, detachable))
5721 result = cons3(Qdetachable, Qt, result);
5723 if (extent_normal_field(anc, duplicable))
5724 result = cons3(Qduplicable, Qt, result);
5726 if (extent_normal_field(anc, unique))
5727 result = cons3(Qunique, Qt, result);
5729 /* detached is not an inherited property */
5730 if (extent_detached_p(e))
5731 result = cons3(Qdetached, Qt, result);
5736 /************************************************************************/
5738 /************************************************************************/
5740 /* The display code looks into the Vlast_highlighted_extent variable to
5741 correctly display highlighted extents. This updates that variable,
5742 and marks the appropriate buffers as needing some redisplay.
5744 static void do_highlight(Lisp_Object extent_obj, int highlight_p)
5746 if ((highlight_p && (EQ(Vlast_highlighted_extent, extent_obj))) ||
5747 (!highlight_p && (EQ(Vlast_highlighted_extent, Qnil))))
5749 if (EXTENTP(Vlast_highlighted_extent) &&
5750 EXTENT_LIVE_P(XEXTENT(Vlast_highlighted_extent))) {
5751 /* do not recurse on descendants. Only one extent is highlighted
5753 extent_changed_for_redisplay(XEXTENT(Vlast_highlighted_extent),
5756 Vlast_highlighted_extent = Qnil;
5757 if (!NILP(extent_obj)
5758 && BUFFERP(extent_object(XEXTENT(extent_obj)))
5760 extent_changed_for_redisplay(XEXTENT(extent_obj), 0, 0);
5761 Vlast_highlighted_extent = extent_obj;
5765 DEFUN("force-highlight-extent", Fforce_highlight_extent, 1, 2, 0, /*
5766 Highlight or unhighlight the given extent.
5767 If the second arg is non-nil, it will be highlighted, else dehighlighted.
5768 This is the same as `highlight-extent', except that it will work even
5769 on extents without the `mouse-face' property.
5771 (extent, highlight_p))
5776 XSETEXTENT(extent, decode_extent(extent, DE_MUST_BE_ATTACHED));
5777 do_highlight(extent, !NILP(highlight_p));
5781 DEFUN("highlight-extent", Fhighlight_extent, 1, 2, 0, /*
5782 Highlight EXTENT, if it is highlightable.
5783 \(that is, if it has the `mouse-face' property).
5784 If the second arg is non-nil, it will be highlighted, else dehighlighted.
5785 Highlighted extents are displayed as if they were merged with the face
5786 or faces specified by the `mouse-face' property.
5788 (extent, highlight_p))
5790 if (EXTENTP(extent) && NILP(extent_mouse_face(XEXTENT(extent))))
5793 return Fforce_highlight_extent(extent, highlight_p);
5796 /************************************************************************/
5797 /* strings and extents */
5798 /************************************************************************/
5800 /* copy/paste hooks */
5803 run_extent_copy_paste_internal(EXTENT e, Bufpos from, Bufpos to,
5804 Lisp_Object object, Lisp_Object prop)
5806 /* This function can GC */
5808 Lisp_Object copy_fn;
5809 XSETEXTENT(extent, e);
5810 copy_fn = Fextent_property(extent, prop, Qnil);
5811 if (!NILP(copy_fn)) {
5813 struct gcpro gcpro1, gcpro2, gcpro3;
5814 GCPRO3(extent, copy_fn, object);
5815 if (BUFFERP(object))
5816 flag = call3_in_buffer(XBUFFER(object), copy_fn, extent,
5817 make_int(from), make_int(to));
5820 call3(copy_fn, extent, make_int(from),
5823 if (NILP(flag) || !EXTENT_LIVE_P(XEXTENT(extent)))
5829 static int run_extent_copy_function(EXTENT e, Bytind from, Bytind to)
5831 Lisp_Object object = extent_object(e);
5832 /* This function can GC */
5833 return run_extent_copy_paste_internal
5834 (e, buffer_or_string_bytind_to_bufpos(object, from),
5835 buffer_or_string_bytind_to_bufpos(object, to), object,
5840 run_extent_paste_function(EXTENT e, Bytind from, Bytind to, Lisp_Object object)
5842 /* This function can GC */
5843 return run_extent_copy_paste_internal
5844 (e, buffer_or_string_bytind_to_bufpos(object, from),
5845 buffer_or_string_bytind_to_bufpos(object, to), object,
5849 static void update_extent(EXTENT extent, Bytind from, Bytind to)
5851 set_extent_endpoints(extent, from, to, Qnil);
5854 /* Insert an extent, usually from the dup_list of a string which
5855 has just been inserted.
5856 This code does not handle the case of undo.
5859 insert_extent(EXTENT extent, Bytind new_start, Bytind new_end,
5860 Lisp_Object object, int run_hooks)
5862 /* This function can GC */
5865 if (!EQ(extent_object(extent), object))
5868 if (extent_detached_p(extent)) {
5870 !run_extent_paste_function(extent, new_start, new_end,
5872 /* The paste-function said don't re-attach this extent here. */
5875 update_extent(extent, new_start, new_end);
5877 Bytind exstart = extent_endpoint_bytind(extent, 0);
5878 Bytind exend = extent_endpoint_bytind(extent, 1);
5880 if (exend < new_start || exstart > new_end)
5883 new_start = min(exstart, new_start);
5884 new_end = max(exend, new_end);
5885 if (exstart != new_start || exend != new_end)
5886 update_extent(extent, new_start, new_end);
5890 XSETEXTENT(tmp, extent);
5895 !run_extent_paste_function(extent, new_start, new_end, object))
5896 /* The paste-function said don't attach a copy of the extent here. */
5900 copy_extent(extent, new_start, new_end, object));
5905 DEFUN("insert-extent", Finsert_extent, 1, 5, 0, /*
5906 Insert EXTENT from START to END in BUFFER-OR-STRING.
5907 BUFFER-OR-STRING defaults to the current buffer if omitted.
5908 This operation does not insert any characters,
5909 but otherwise acts as if there were a replicating extent whose
5910 parent is EXTENT in some string that was just inserted.
5911 Returns the newly-inserted extent.
5912 The fourth arg, NO-HOOKS, can be used to inhibit the running of the
5913 extent's `paste-function' property if it has one.
5914 See documentation on `detach-extent' for a discussion of undo recording.
5916 (extent, start, end, no_hooks, buffer_or_string))
5918 EXTENT ext = decode_extent(extent, 0);
5922 buffer_or_string = decode_buffer_or_string(buffer_or_string);
5923 get_buffer_or_string_range_byte(buffer_or_string, start, end, &s, &e,
5924 GB_ALLOW_PAST_ACCESSIBLE);
5926 copy = insert_extent(ext, s, e, buffer_or_string, NILP(no_hooks));
5927 if (EXTENTP(copy)) {
5928 if (extent_duplicable_p(XEXTENT(copy)))
5929 record_extent(copy, 1);
5934 /* adding buffer extents to a string */
5936 struct add_string_extents_arg {
5942 static int add_string_extents_mapper(EXTENT extent, void *arg)
5944 /* This function can GC */
5945 struct add_string_extents_arg *closure =
5946 (struct add_string_extents_arg *)arg;
5947 Bytecount start = extent_endpoint_bytind(extent, 0) - closure->from;
5948 Bytecount end = extent_endpoint_bytind(extent, 1) - closure->from;
5950 if (extent_duplicable_p(extent)) {
5951 start = max(start, 0);
5952 end = min(end, closure->length);
5954 /* Run the copy-function to give an extent the option of
5955 not being copied into the string (or kill ring).
5957 if (extent_duplicable_p(extent) &&
5958 !run_extent_copy_function(extent, start + closure->from,
5959 end + closure->from))
5961 copy_extent(extent, start, end, closure->string);
5967 /* Add the extents in buffer BUF from OPOINT to OPOINT+LENGTH to
5968 the string STRING. */
5970 add_string_extents(Lisp_Object string, struct buffer *buf, Bytind opoint,
5973 /* This function can GC */
5974 struct add_string_extents_arg closure;
5975 struct gcpro gcpro1, gcpro2;
5978 closure.from = opoint;
5979 closure.length = length;
5980 closure.string = string;
5981 buffer = make_buffer(buf);
5982 GCPRO2(buffer, string);
5983 map_extents_bytind(opoint, opoint + length, add_string_extents_mapper,
5984 (void *)&closure, buffer, 0,
5985 /* ignore extents that just abut the region */
5986 ME_END_CLOSED | ME_ALL_EXTENTS_OPEN |
5987 /* we are calling E-Lisp (the extent's copy function)
5988 so anything might happen */
5989 ME_MIGHT_CALL_ELISP);
5993 struct splice_in_string_extents_arg {
6000 static int splice_in_string_extents_mapper(EXTENT extent, void *arg)
6002 /* This function can GC */
6003 struct splice_in_string_extents_arg *closure =
6004 (struct splice_in_string_extents_arg *)arg;
6005 /* BASE_START and BASE_END are the limits in the buffer of the string
6006 that was just inserted.
6008 NEW_START and NEW_END are the prospective buffer positions of the
6009 extent that is going into the buffer. */
6010 Bytind base_start = closure->opoint;
6011 Bytind base_end = base_start + closure->length;
6012 Bytind new_start = (base_start + extent_endpoint_bytind(extent, 0) -
6014 Bytind new_end = (base_start + extent_endpoint_bytind(extent, 1) -
6017 if (new_start < base_start)
6018 new_start = base_start;
6019 if (new_end > base_end)
6021 if (new_end <= new_start)
6024 if (!extent_duplicable_p(extent))
6028 !run_extent_paste_function(extent, new_start, new_end,
6031 copy_extent(extent, new_start, new_end, closure->buffer);
6036 /* We have just inserted a section of STRING (starting at POS, of
6037 length LENGTH) into buffer BUF at OPOINT. Do whatever is necessary
6038 to get the string's extents into the buffer. */
6041 splice_in_string_extents(Lisp_Object string, struct buffer *buf,
6042 Bytind opoint, Bytecount length, Bytecount pos)
6044 struct splice_in_string_extents_arg closure;
6045 struct gcpro gcpro1, gcpro2;
6048 buffer = make_buffer(buf);
6049 closure.opoint = opoint;
6051 closure.length = length;
6052 closure.buffer = buffer;
6053 GCPRO2(buffer, string);
6054 map_extents_bytind(pos, pos + length,
6055 splice_in_string_extents_mapper,
6056 (void *)&closure, string, 0,
6057 /* ignore extents that just abut the region */
6058 ME_END_CLOSED | ME_ALL_EXTENTS_OPEN |
6059 /* we are calling E-Lisp (the extent's copy function)
6060 so anything might happen */
6061 ME_MIGHT_CALL_ELISP);
6065 struct copy_string_extents_arg {
6069 Lisp_Object new_string;
6072 struct copy_string_extents_1_arg {
6073 Lisp_Object parent_in_question;
6074 EXTENT found_extent;
6077 static int copy_string_extents_mapper(EXTENT extent, void *arg)
6079 struct copy_string_extents_arg *closure =
6080 (struct copy_string_extents_arg *)arg;
6081 Bytecount old_start, old_end, new_start, new_end;
6083 old_start = extent_endpoint_bytind(extent, 0);
6084 old_end = extent_endpoint_bytind(extent, 1);
6086 old_start = max(closure->old_pos, old_start);
6087 old_end = min(closure->old_pos + closure->length, old_end);
6089 if (old_start >= old_end)
6092 new_start = old_start + closure->new_pos - closure->old_pos;
6093 new_end = old_end + closure->new_pos - closure->old_pos;
6095 copy_extent(extent, new_start, new_end, closure->new_string);
6099 /* The string NEW_STRING was partially constructed from OLD_STRING.
6100 In particular, the section of length LEN starting at NEW_POS in
6101 NEW_STRING came from the section of the same length starting at
6102 OLD_POS in OLD_STRING. Copy the extents as appropriate. */
6105 copy_string_extents(Lisp_Object new_string, Lisp_Object old_string,
6106 Bytecount new_pos, Bytecount old_pos, Bytecount length)
6108 struct copy_string_extents_arg closure;
6109 struct gcpro gcpro1, gcpro2;
6111 closure.new_pos = new_pos;
6112 closure.old_pos = old_pos;
6113 closure.new_string = new_string;
6114 closure.length = length;
6115 GCPRO2(new_string, old_string);
6116 map_extents_bytind(old_pos, old_pos + length,
6117 copy_string_extents_mapper,
6118 (void *)&closure, old_string, 0,
6119 /* ignore extents that just abut the region */
6120 ME_END_CLOSED | ME_ALL_EXTENTS_OPEN |
6121 /* we are calling E-Lisp (the extent's copy function)
6122 so anything might happen */
6123 ME_MIGHT_CALL_ELISP);
6127 /* Checklist for sanity checking:
6128 - {kill, yank, copy} at {open, closed} {start, end} of {writable, read-only} extent
6129 - {kill, copy} & yank {once, repeatedly} duplicable extent in {same, different} buffer
6132 /************************************************************************/
6133 /* text properties */
6134 /************************************************************************/
6137 Originally this stuff was implemented in lisp (all of the functionality
6138 exists to make that possible) but speed was a problem.
6141 Lisp_Object Qtext_prop;
6142 Lisp_Object Qtext_prop_extent_paste_function;
6145 get_text_property_bytind(Bytind position, Lisp_Object prop,
6146 Lisp_Object object, enum extent_at_flag fl,
6147 int text_props_only)
6151 /* text_props_only specifies whether we only consider text-property
6152 extents (those with the 'text-prop property set) or all extents. */
6153 if (!text_props_only)
6154 extent = extent_at_bytind(position, object, prop, 0, fl, 0);
6159 extent_at_bytind(position, object, Qtext_prop,
6164 (prop, Fextent_property(extent, Qtext_prop, Qnil)))
6166 prior = XEXTENT(extent);
6171 return Fextent_property(extent, prop, Qnil);
6172 if (!NILP(Vdefault_text_properties))
6173 return Fplist_get(Vdefault_text_properties, prop, Qnil);
6178 get_text_property_1(Lisp_Object pos, Lisp_Object prop, Lisp_Object object,
6179 Lisp_Object at_flag, int text_props_only)
6184 object = decode_buffer_or_string(object);
6186 get_buffer_or_string_pos_byte(object, pos, GB_NO_ERROR_IF_BAD);
6188 /* We canonicalize the start/end-open/closed properties to the
6189 non-default version -- "adding" the default property really
6190 needs to remove the non-default one. See below for more
6192 if (EQ(prop, Qstart_closed)) {
6197 if (EQ(prop, Qend_open)) {
6204 get_text_property_bytind(position, prop, object,
6205 decode_extent_at_flag(at_flag),
6208 val = NILP(val) ? Qt : Qnil;
6213 DEFUN("get-text-property", Fget_text_property, 2, 4, 0, /*
6214 Return the value of the PROP property at the given position.
6215 Optional arg OBJECT specifies the buffer or string to look in, and
6216 defaults to the current buffer.
6217 Optional arg AT-FLAG controls what it means for a property to be "at"
6218 a position, and has the same meaning as in `extent-at'.
6219 This examines only those properties added with `put-text-property'.
6220 See also `get-char-property'.
6222 (pos, prop, object, at_flag))
6224 return get_text_property_1(pos, prop, object, at_flag, 1);
6227 DEFUN("get-char-property", Fget_char_property, 2, 4, 0, /*
6228 Return the value of the PROP property at the given position.
6229 Optional arg OBJECT specifies the buffer or string to look in, and
6230 defaults to the current buffer.
6231 Optional arg AT-FLAG controls what it means for a property to be "at"
6232 a position, and has the same meaning as in `extent-at'.
6233 This examines properties on all extents.
6234 See also `get-text-property'.
6236 (pos, prop, object, at_flag))
6238 return get_text_property_1(pos, prop, object, at_flag, 0);
6241 /* About start/end-open/closed:
6243 These properties have to be handled specially because of their
6244 strange behavior. If I put the "start-open" property on a region,
6245 then *all* text-property extents in the region have to have their
6246 start be open. This is unlike all other properties, which don't
6247 affect the extents of text properties other than their own.
6251 1) We have to map start-closed to (not start-open) and end-open
6252 to (not end-closed) -- i.e. adding the default is really the
6253 same as remove the non-default property. It won't work, for
6254 example, to have both "start-open" and "start-closed" on
6256 2) Whenever we add one of these properties, we go through all
6257 text-property extents in the region and set the appropriate
6258 open/closedness on them.
6259 3) Whenever we change a text-property extent for a property,
6260 we have to make sure we set the open/closedness properly.
6262 (2) and (3) together rely on, and maintain, the invariant
6263 that the open/closedness of text-property extents is correct
6264 at the beginning and end of each operation.
6267 struct put_text_prop_arg {
6268 Lisp_Object prop, value; /* The property and value we are storing */
6269 Bytind start, end; /* The region into which we are storing it */
6271 Lisp_Object the_extent; /* Our chosen extent; this is used for
6272 communication between subsequent passes. */
6273 int changed_p; /* Output: whether we have modified anything */
6276 static int put_text_prop_mapper(EXTENT e, void *arg)
6278 struct put_text_prop_arg *closure = (struct put_text_prop_arg *)arg;
6280 Lisp_Object object = closure->object;
6281 Lisp_Object value = closure->value;
6282 Bytind e_start, e_end;
6283 Bytind start = closure->start;
6284 Bytind end = closure->end;
6285 Lisp_Object extent, e_val;
6288 XSETEXTENT(extent, e);
6290 /* Note: in some cases when the property itself is 'start-open
6291 or 'end-closed, the checks to set the openness may do a bit
6292 of extra work; but it won't hurt because we then fix up the
6293 openness later on in put_text_prop_openness_mapper(). */
6294 if (!EQ(Fextent_property(extent, Qtext_prop, Qnil), closure->prop))
6295 /* It's not for this property; do nothing. */
6298 e_start = extent_endpoint_bytind(e, 0);
6299 e_end = extent_endpoint_bytind(e, 1);
6300 e_val = Fextent_property(extent, closure->prop, Qnil);
6301 is_eq = EQ(value, e_val);
6303 if (!NILP(value) && NILP(closure->the_extent) && is_eq) {
6304 /* We want there to be an extent here at the end, and we haven't picked
6305 one yet, so use this one. Extend it as necessary. We only reuse an
6306 extent which has an EQ value for the prop in question to avoid
6307 side-effecting the kill ring (that is, we never change the property
6308 on an extent after it has been created.)
6310 if (e_start != start || e_end != end) {
6311 Bytind new_start = min(e_start, start);
6312 Bytind new_end = max(e_end, end);
6313 set_extent_endpoints(e, new_start, new_end, Qnil);
6314 /* If we changed the endpoint, then we need to set its
6316 set_extent_openness(e, new_start != e_start
6317 ? !NILP(get_text_property_bytind
6318 (start, Qstart_open, object,
6319 EXTENT_AT_AFTER, 1)) : -1,
6321 ? NILP(get_text_property_bytind
6322 (end - 1, Qend_closed,
6323 object, EXTENT_AT_AFTER, 1))
6325 closure->changed_p = 1;
6327 closure->the_extent = extent;
6330 /* Even if we're adding a prop, at this point, we want all other extents of
6331 this prop to go away (as now they overlap). So the theory here is that,
6332 when we are adding a prop to a region that has multiple (disjoint)
6333 occurrences of that prop in it already, we pick one of those and extend
6334 it, and remove the others.
6337 else if (EQ(extent, closure->the_extent)) {
6338 /* just in case map-extents hits it again (does that happen?) */
6340 } else if (e_start >= start && e_end <= end) {
6341 /* Extent is contained in region; remove it. Don't destroy or modify
6342 it, because we don't want to change the attributes pointed to by the
6343 duplicates in the kill ring.
6346 closure->changed_p = 1;
6347 } else if (!NILP(closure->the_extent) &&
6348 is_eq && e_start <= end && e_end >= start) {
6349 EXTENT te = XEXTENT(closure->the_extent);
6350 /* This extent overlaps, and has the same prop/value as the extent we've
6351 decided to reuse, so we can remove this existing extent as well (the
6352 whole thing, even the part outside of the region) and extend
6353 the-extent to cover it, resulting in the minimum number of extents in
6356 Bytind the_start = extent_endpoint_bytind(te, 0);
6357 Bytind the_end = extent_endpoint_bytind(te, 1);
6358 if (e_start != the_start && /* note AND not OR -- hmm, why is this
6359 the case? I think it's because the
6360 assumption that the text-property
6361 extents don't overlap makes it
6362 OK; changing it to an OR would
6363 result in changed_p sometimes getting
6364 falsely marked. Is this bad? */
6366 Bytind new_start = min(e_start, the_start);
6367 Bytind new_end = max(e_end, the_end);
6368 set_extent_endpoints(te, new_start, new_end, Qnil);
6369 /* If we changed the endpoint, then we need to set its
6370 openness. We are setting the endpoint to be the same as
6371 that of the extent we're about to remove, and we assume
6372 (the invariant mentioned above) that extent has the
6373 proper endpoint setting, so we just use it. */
6374 set_extent_openness(te, new_start != e_start ?
6375 (int)extent_start_open_p(e) : -1,
6377 (int)extent_end_open_p(e) : -1);
6378 closure->changed_p = 1;
6381 } else if (e_end <= end) {
6382 /* Extent begins before start but ends before end, so we can just
6383 decrease its end position.
6385 if (e_end != start) {
6386 set_extent_endpoints(e, e_start, start, Qnil);
6387 set_extent_openness(e, -1, NILP(get_text_property_bytind
6388 (start - 1, Qend_closed,
6390 EXTENT_AT_AFTER, 1)));
6391 closure->changed_p = 1;
6393 } else if (e_start >= start) {
6394 /* Extent ends after end but begins after start, so we can just
6395 increase its start position.
6397 if (e_start != end) {
6398 set_extent_endpoints(e, end, e_end, Qnil);
6399 set_extent_openness(e, !NILP(get_text_property_bytind
6400 (end, Qstart_open, object,
6401 EXTENT_AT_AFTER, 1)), -1);
6402 closure->changed_p = 1;
6405 /* Otherwise, `extent' straddles the region. We need to split it.
6407 set_extent_endpoints(e, e_start, start, Qnil);
6408 set_extent_openness(e, -1, NILP(get_text_property_bytind
6409 (start - 1, Qend_closed, object,
6410 EXTENT_AT_AFTER, 1)));
6411 set_extent_openness(copy_extent
6412 (e, end, e_end, extent_object(e)),
6413 !NILP(get_text_property_bytind
6414 (end, Qstart_open, object,
6415 EXTENT_AT_AFTER, 1)), -1);
6416 closure->changed_p = 1;
6419 return 0; /* to continue mapping. */
6422 static int put_text_prop_openness_mapper(EXTENT e, void *arg)
6424 struct put_text_prop_arg *closure = (struct put_text_prop_arg *)arg;
6425 Bytind e_start, e_end;
6426 Bytind start = closure->start;
6427 Bytind end = closure->end;
6429 XSETEXTENT(extent, e);
6430 e_start = extent_endpoint_bytind(e, 0);
6431 e_end = extent_endpoint_bytind(e, 1);
6433 if (NILP(Fextent_property(extent, Qtext_prop, Qnil))) {
6434 /* It's not a text-property extent; do nothing. */
6437 /* Note end conditions and NILP/!NILP's carefully. */
6438 else if (EQ(closure->prop, Qstart_open)
6439 && e_start >= start && e_start < end)
6440 set_extent_openness(e, !NILP(closure->value), -1);
6441 else if (EQ(closure->prop, Qend_closed)
6442 && e_end > start && e_end <= end)
6443 set_extent_openness(e, -1, NILP(closure->value));
6445 return 0; /* to continue mapping. */
6449 put_text_prop(Bytind start, Bytind end, Lisp_Object object,
6450 Lisp_Object prop, Lisp_Object value, int duplicable_p)
6452 /* This function can GC */
6453 struct put_text_prop_arg closure;
6455 if (start == end) /* There are no characters in the region. */
6458 /* convert to the non-default versions, since a nil property is
6459 the same as it not being present. */
6460 if (EQ(prop, Qstart_closed)) {
6462 value = NILP(value) ? Qt : Qnil;
6463 } else if (EQ(prop, Qend_open)) {
6465 value = NILP(value) ? Qt : Qnil;
6468 value = canonicalize_extent_property(prop, value);
6470 closure.prop = prop;
6471 closure.value = value;
6472 closure.start = start;
6474 closure.object = object;
6475 closure.changed_p = 0;
6476 closure.the_extent = Qnil;
6478 map_extents_bytind(start, end,
6479 put_text_prop_mapper, (void *)&closure, object, 0,
6480 /* get all extents that abut the region */
6481 ME_ALL_EXTENTS_CLOSED | ME_END_CLOSED |
6482 /* it might QUIT or error if the user has
6483 fucked with the extent plist. */
6484 /* #### dmoore - I think this should include
6485 ME_MIGHT_MOVE_SOE, since the callback function
6486 might recurse back into map_extents_bytind. */
6487 ME_MIGHT_THROW | ME_MIGHT_MODIFY_EXTENTS);
6489 /* If we made it through the loop without reusing an extent
6490 (and we want there to be one) make it now.
6492 if (!NILP(value) && NILP(closure.the_extent)) {
6495 XSETEXTENT(extent, make_extent_internal(object, start, end));
6496 closure.changed_p = 1;
6497 Fset_extent_property(extent, Qtext_prop, prop);
6498 Fset_extent_property(extent, prop, value);
6500 extent_duplicable_p(XEXTENT(extent)) = 1;
6501 Fset_extent_property(extent, Qpaste_function,
6502 Qtext_prop_extent_paste_function);
6504 set_extent_openness(XEXTENT(extent),
6505 !NILP(get_text_property_bytind
6506 (start, Qstart_open, object,
6507 EXTENT_AT_AFTER, 1)),
6508 NILP(get_text_property_bytind
6509 (end - 1, Qend_closed, object,
6510 EXTENT_AT_AFTER, 1)));
6513 if (EQ(prop, Qstart_open) || EQ(prop, Qend_closed)) {
6514 map_extents_bytind(start, end,
6515 put_text_prop_openness_mapper,
6516 (void *)&closure, object, 0,
6517 /* get all extents that abut the region */
6518 ME_ALL_EXTENTS_CLOSED | ME_END_CLOSED |
6519 ME_MIGHT_MODIFY_EXTENTS);
6522 return closure.changed_p;
6525 DEFUN("put-text-property", Fput_text_property, 4, 5, 0, /*
6526 Adds the given property/value to all characters in the specified region.
6527 The property is conceptually attached to the characters rather than the
6528 region. The properties are copied when the characters are copied/pasted.
6529 Fifth argument OBJECT is the buffer or string containing the text, and
6530 defaults to the current buffer.
6532 (start, end, prop, value, object))
6534 /* This function can GC */
6537 object = decode_buffer_or_string(object);
6538 get_buffer_or_string_range_byte(object, start, end, &s, &e, 0);
6539 put_text_prop(s, e, object, prop, value, 1);
6543 DEFUN("put-nonduplicable-text-property", Fput_nonduplicable_text_property, 4, 5, 0, /*
6544 Adds the given property/value to all characters in the specified region.
6545 The property is conceptually attached to the characters rather than the
6546 region, however the properties will not be copied when the characters
6548 Fifth argument OBJECT is the buffer or string containing the text, and
6549 defaults to the current buffer.
6551 (start, end, prop, value, object))
6553 /* This function can GC */
6556 object = decode_buffer_or_string(object);
6557 get_buffer_or_string_range_byte(object, start, end, &s, &e, 0);
6558 put_text_prop(s, e, object, prop, value, 0);
6562 DEFUN("add-text-properties", Fadd_text_properties, 3, 4, 0, /*
6563 Add properties to the characters from START to END.
6564 The third argument PROPS is a property list specifying the property values
6565 to add. The optional fourth argument, OBJECT, is the buffer or string
6566 containing the text and defaults to the current buffer. Returns t if
6567 any property was changed, nil otherwise.
6569 (start, end, props, object))
6571 /* This function can GC */
6575 object = decode_buffer_or_string(object);
6576 get_buffer_or_string_range_byte(object, start, end, &s, &e, 0);
6578 for (; !NILP(props); props = Fcdr(Fcdr(props))) {
6579 Lisp_Object prop = XCAR(props);
6580 Lisp_Object value = Fcar(XCDR(props));
6581 changed |= put_text_prop(s, e, object, prop, value, 1);
6583 return changed ? Qt : Qnil;
6586 DEFUN("add-nonduplicable-text-properties", Fadd_nonduplicable_text_properties, 3, 4, 0, /*
6587 Add nonduplicable properties to the characters from START to END.
6588 \(The properties will not be copied when the characters are copied.)
6589 The third argument PROPS is a property list specifying the property values
6590 to add. The optional fourth argument, OBJECT, is the buffer or string
6591 containing the text and defaults to the current buffer. Returns t if
6592 any property was changed, nil otherwise.
6594 (start, end, props, object))
6596 /* This function can GC */
6600 object = decode_buffer_or_string(object);
6601 get_buffer_or_string_range_byte(object, start, end, &s, &e, 0);
6603 for (; !NILP(props); props = Fcdr(Fcdr(props))) {
6604 Lisp_Object prop = XCAR(props);
6605 Lisp_Object value = Fcar(XCDR(props));
6606 changed |= put_text_prop(s, e, object, prop, value, 0);
6608 return changed ? Qt : Qnil;
6611 DEFUN("remove-text-properties", Fremove_text_properties, 3, 4, 0, /*
6612 Remove the given properties from all characters in the specified region.
6613 PROPS should be a plist, but the values in that plist are ignored (treated
6614 as nil). Returns t if any property was changed, nil otherwise.
6615 Fourth argument OBJECT is the buffer or string containing the text, and
6616 defaults to the current buffer.
6618 (start, end, props, object))
6620 /* This function can GC */
6624 object = decode_buffer_or_string(object);
6625 get_buffer_or_string_range_byte(object, start, end, &s, &e, 0);
6627 for (; !NILP(props); props = Fcdr(Fcdr(props))) {
6628 Lisp_Object prop = XCAR(props);
6629 changed |= put_text_prop(s, e, object, prop, Qnil, 1);
6631 return changed ? Qt : Qnil;
6634 /* Whenever a text-prop extent is pasted into a buffer (via `yank' or `insert'
6635 or whatever) we attach the properties to the buffer by calling
6636 `put-text-property' instead of by simply allowing the extent to be copied or
6637 re-attached. Then we return nil, telling the extents code not to attach it
6638 again. By handing the insertion hackery in this way, we make kill/yank
6639 behave consistently with put-text-property and not fragment the extents
6640 (since text-prop extents must partition, not overlap).
6642 The lisp implementation of this was probably fast enough, but since I moved
6643 the rest of the put-text-prop code here, I moved this as well for
6646 DEFUN("text-prop-extent-paste-function", Ftext_prop_extent_paste_function, 3, 3, 0, /*
6647 Used as the `paste-function' property of `text-prop' extents.
6651 /* This function can GC */
6652 Lisp_Object prop, val;
6654 prop = Fextent_property(extent, Qtext_prop, Qnil);
6656 signal_type_error(Qinternal_error,
6657 "Internal error: no text-prop", extent);
6658 val = Fextent_property(extent, prop, Qnil);
6660 /* removed by bill perry, 2/9/97
6661 ** This little bit of code would not allow you to have a text property
6662 ** with a value of Qnil. This is bad bad bad.
6665 signal_type_error_2(Qinternal_error,
6666 "Internal error: no text-prop",
6669 Fput_text_property(from, to, prop, val, Qnil);
6670 return Qnil; /* important! */
6673 /* This function could easily be written in Lisp but the C code wants
6674 to use it in connection with invisible extents (at least currently).
6675 If this changes, consider moving this back into Lisp. */
6677 DEFUN("next-single-property-change", Fnext_single_property_change, 2, 4, 0, /*
6678 Return the position of next property change for a specific property.
6679 Scans characters forward from POS till it finds a change in the PROP
6680 property, then returns the position of the change. The optional third
6681 argument OBJECT is the buffer or string to scan (defaults to the current
6683 The property values are compared with `eq'.
6684 Return nil if the property is constant all the way to the end of OBJECT.
6685 If the value is non-nil, it is a position greater than POS, never equal.
6687 If the optional fourth argument LIMIT is non-nil, don't search
6688 past position LIMIT; return LIMIT if nothing is found before LIMIT.
6689 If two or more extents with conflicting non-nil values for PROP overlap
6690 a particular character, it is undefined which value is considered to be
6691 the value of PROP. (Note that this situation will not happen if you always
6692 use the text-property primitives.)
6694 (pos, prop, object, limit))
6698 Lisp_Object extent, value;
6701 object = decode_buffer_or_string(object);
6702 bpos = get_buffer_or_string_pos_char(object, pos, 0);
6704 blim = buffer_or_string_accessible_end_char(object);
6707 blim = get_buffer_or_string_pos_char(object, limit, 0);
6711 extent = Fextent_at(make_int(bpos), object, prop, Qnil, Qnil);
6713 value = Fextent_property(extent, prop, Qnil);
6718 bpos = XINT(Fnext_extent_change(make_int(bpos), object));
6720 break; /* property is the same all the way to the end */
6721 extent = Fextent_at(make_int(bpos), object, prop, Qnil, Qnil);
6722 if ((NILP(extent) && !NILP(value)) ||
6723 (!NILP(extent) && !EQ(value,
6724 Fextent_property(extent, prop,
6726 return make_int(bpos);
6729 /* I think it's more sensible for this function to return nil always
6730 in this situation and it used to do it this way, but it's been changed
6731 for FSF compatibility. */
6735 return make_int(blim);
6738 /* See comment on previous function about why this is written in C. */
6740 DEFUN("previous-single-property-change", Fprevious_single_property_change, 2, 4, 0, /*
6741 Return the position of next property change for a specific property.
6742 Scans characters backward from POS till it finds a change in the PROP
6743 property, then returns the position of the change. The optional third
6744 argument OBJECT is the buffer or string to scan (defaults to the current
6746 The property values are compared with `eq'.
6747 Return nil if the property is constant all the way to the start of OBJECT.
6748 If the value is non-nil, it is a position less than POS, never equal.
6750 If the optional fourth argument LIMIT is non-nil, don't search back
6751 past position LIMIT; return LIMIT if nothing is found until LIMIT.
6752 If two or more extents with conflicting non-nil values for PROP overlap
6753 a particular character, it is undefined which value is considered to be
6754 the value of PROP. (Note that this situation will not happen if you always
6755 use the text-property primitives.)
6757 (pos, prop, object, limit))
6761 Lisp_Object extent, value;
6764 object = decode_buffer_or_string(object);
6765 bpos = get_buffer_or_string_pos_char(object, pos, 0);
6767 blim = buffer_or_string_accessible_begin_char(object);
6770 blim = get_buffer_or_string_pos_char(object, limit, 0);
6774 /* extent-at refers to the character AFTER bpos, but we want the
6775 character before bpos. Thus the - 1. extent-at simply
6776 returns nil on bogus positions, so not to worry. */
6777 extent = Fextent_at(make_int(bpos - 1), object, prop, Qnil, Qnil);
6779 value = Fextent_property(extent, prop, Qnil);
6784 bpos = XINT(Fprevious_extent_change(make_int(bpos), object));
6786 break; /* property is the same all the way to the beginning */
6788 Fextent_at(make_int(bpos - 1), object, prop, Qnil, Qnil);
6789 if ((NILP(extent) && !NILP(value))
6791 && !EQ(value, Fextent_property(extent, prop, Qnil))))
6792 return make_int(bpos);
6795 /* I think it's more sensible for this function to return nil always
6796 in this situation and it used to do it this way, but it's been changed
6797 for FSF compatibility. */
6801 return make_int(blim);
6804 #ifdef MEMORY_USAGE_STATS
6807 compute_buffer_extent_usage(struct buffer *b, struct overhead_stats *ovstats)
6809 /* #### not yet written */
6813 #endif /* MEMORY_USAGE_STATS */
6815 /************************************************************************/
6816 /* initialization */
6817 /************************************************************************/
6819 void syms_of_extents(void)
6821 INIT_LRECORD_IMPLEMENTATION(extent);
6822 INIT_LRECORD_IMPLEMENTATION(extent_info);
6823 INIT_LRECORD_IMPLEMENTATION(extent_auxiliary);
6825 defsymbol(&Qextentp, "extentp");
6826 defsymbol(&Qextent_live_p, "extent-live-p");
6828 defsymbol(&Qall_extents_closed, "all-extents-closed");
6829 defsymbol(&Qall_extents_open, "all-extents-open");
6830 defsymbol(&Qall_extents_closed_open, "all-extents-closed-open");
6831 defsymbol(&Qall_extents_open_closed, "all-extents-open-closed");
6832 defsymbol(&Qstart_in_region, "start-in-region");
6833 defsymbol(&Qend_in_region, "end-in-region");
6834 defsymbol(&Qstart_and_end_in_region, "start-and-end-in-region");
6835 defsymbol(&Qstart_or_end_in_region, "start-or-end-in-region");
6836 defsymbol(&Qnegate_in_region, "negate-in-region");
6838 defsymbol(&Qdetached, "detached");
6839 defsymbol(&Qdestroyed, "destroyed");
6840 defsymbol(&Qbegin_glyph, "begin-glyph");
6841 defsymbol(&Qend_glyph, "end-glyph");
6842 defsymbol(&Qstart_open, "start-open");
6843 defsymbol(&Qend_open, "end-open");
6844 defsymbol(&Qstart_closed, "start-closed");
6845 defsymbol(&Qend_closed, "end-closed");
6846 defsymbol(&Qread_only, "read-only");
6847 /* defsymbol (&Qhighlight, "highlight"); in faces.c */
6848 defsymbol(&Qunique, "unique");
6849 defsymbol(&Qduplicable, "duplicable");
6850 defsymbol(&Qdetachable, "detachable");
6851 defsymbol(&Qpriority, "priority");
6852 defsymbol(&Qmouse_face, "mouse-face");
6853 defsymbol(&Qinitial_redisplay_function, "initial-redisplay-function");
6855 defsymbol(&Qglyph_layout, "glyph-layout"); /* backwards compatibility */
6856 defsymbol(&Qbegin_glyph_layout, "begin-glyph-layout");
6857 defsymbol(&Qend_glyph_layout, "end-glyph-layout");
6858 defsymbol(&Qoutside_margin, "outside-margin");
6859 defsymbol(&Qinside_margin, "inside-margin");
6860 defsymbol(&Qwhitespace, "whitespace");
6861 /* Qtext defined in general.c */
6863 defsymbol(&Qpaste_function, "paste-function");
6864 defsymbol(&Qcopy_function, "copy-function");
6866 defsymbol(&Qtext_prop, "text-prop");
6867 defsymbol(&Qtext_prop_extent_paste_function,
6868 "text-prop-extent-paste-function");
6871 DEFSUBR(Fextent_live_p);
6872 DEFSUBR(Fextent_detached_p);
6873 DEFSUBR(Fextent_start_position);
6874 DEFSUBR(Fextent_end_position);
6875 DEFSUBR(Fextent_object);
6876 DEFSUBR(Fextent_length);
6878 DEFSUBR(Fmake_extent);
6879 DEFSUBR(Fcopy_extent);
6880 DEFSUBR(Fdelete_extent);
6881 DEFSUBR(Fdetach_extent);
6882 DEFSUBR(Fset_extent_endpoints);
6883 DEFSUBR(Fnext_extent);
6884 DEFSUBR(Fprevious_extent);
6886 DEFSUBR(Fnext_e_extent);
6887 DEFSUBR(Fprevious_e_extent);
6889 DEFSUBR(Fnext_extent_change);
6890 DEFSUBR(Fprevious_extent_change);
6892 DEFSUBR(Fextent_parent);
6893 DEFSUBR(Fextent_children);
6894 DEFSUBR(Fset_extent_parent);
6896 DEFSUBR(Fextent_in_region_p);
6897 DEFSUBR(Fmap_extents);
6898 DEFSUBR(Fmap_extent_children);
6899 DEFSUBR(Fextent_at);
6900 DEFSUBR(Fextents_at);
6902 DEFSUBR(Fset_extent_initial_redisplay_function);
6903 DEFSUBR(Fextent_face);
6904 DEFSUBR(Fset_extent_face);
6905 DEFSUBR(Fextent_mouse_face);
6906 DEFSUBR(Fset_extent_mouse_face);
6907 DEFSUBR(Fset_extent_begin_glyph);
6908 DEFSUBR(Fset_extent_end_glyph);
6909 DEFSUBR(Fextent_begin_glyph);
6910 DEFSUBR(Fextent_end_glyph);
6911 DEFSUBR(Fset_extent_begin_glyph_layout);
6912 DEFSUBR(Fset_extent_end_glyph_layout);
6913 DEFSUBR(Fextent_begin_glyph_layout);
6914 DEFSUBR(Fextent_end_glyph_layout);
6915 DEFSUBR(Fset_extent_priority);
6916 DEFSUBR(Fextent_priority);
6917 DEFSUBR(Fset_extent_property);
6918 DEFSUBR(Fset_extent_properties);
6919 DEFSUBR(Fextent_property);
6920 DEFSUBR(Fextent_properties);
6922 DEFSUBR(Fhighlight_extent);
6923 DEFSUBR(Fforce_highlight_extent);
6925 DEFSUBR(Finsert_extent);
6927 DEFSUBR(Fget_text_property);
6928 DEFSUBR(Fget_char_property);
6929 DEFSUBR(Fput_text_property);
6930 DEFSUBR(Fput_nonduplicable_text_property);
6931 DEFSUBR(Fadd_text_properties);
6932 DEFSUBR(Fadd_nonduplicable_text_properties);
6933 DEFSUBR(Fremove_text_properties);
6934 DEFSUBR(Ftext_prop_extent_paste_function);
6935 DEFSUBR(Fnext_single_property_change);
6936 DEFSUBR(Fprevious_single_property_change);
6939 void reinit_vars_of_extents(void)
6941 extent_auxiliary_defaults.begin_glyph = Qnil;
6942 extent_auxiliary_defaults.end_glyph = Qnil;
6943 extent_auxiliary_defaults.parent = Qnil;
6944 extent_auxiliary_defaults.children = Qnil;
6945 extent_auxiliary_defaults.priority = 0;
6946 extent_auxiliary_defaults.invisible = Qnil;
6947 extent_auxiliary_defaults.read_only = Qnil;
6948 extent_auxiliary_defaults.mouse_face = Qnil;
6949 extent_auxiliary_defaults.initial_redisplay_function = Qnil;
6950 extent_auxiliary_defaults.before_change_functions = Qnil;
6951 extent_auxiliary_defaults.after_change_functions = Qnil;
6954 void vars_of_extents(void)
6956 reinit_vars_of_extents();
6958 DEFVAR_INT("mouse-highlight-priority", &mouse_highlight_priority /*
6959 The priority to use for the mouse-highlighting pseudo-extent
6960 that is used to highlight extents with the `mouse-face' attribute set.
6961 See `set-extent-priority'.
6963 /* Set mouse-highlight-priority (which ends up being used both for the
6964 mouse-highlighting pseudo-extent and the primary selection extent)
6965 to a very high value because very few extents should override it.
6966 1000 gives lots of room below it for different-prioritized extents.
6967 10 doesn't. ediff, for example, likes to use priorities around 100.
6969 mouse_highlight_priority = /* 10 */ 1000;
6971 DEFVAR_LISP("default-text-properties", &Vdefault_text_properties /*
6972 Property list giving default values for text properties.
6973 Whenever a character does not specify a value for a property, the value
6974 stored in this list is used instead. This only applies when the
6975 functions `get-text-property' or `get-char-property' are called.
6977 Vdefault_text_properties = Qnil;
6979 staticpro(&Vlast_highlighted_extent);
6980 Vlast_highlighted_extent = Qnil;
6982 Vextent_face_reusable_list = Fcons(Qnil, Qnil);
6983 staticpro(&Vextent_face_reusable_list);
6986 void complex_vars_of_extents(void)
6988 staticpro(&Vextent_face_memoize_hash_table);
6989 /* The memoize hash table maps from lists of symbols to lists of
6990 faces. It needs to be `equal' to implement the memoization.
6991 The reverse table maps in the other direction and just needs
6992 to do `eq' comparison because the lists of faces are already
6994 Vextent_face_memoize_hash_table =
6995 make_lisp_hash_table(100, HASH_TABLE_VALUE_WEAK, HASH_TABLE_EQUAL);
6996 staticpro(&Vextent_face_reverse_memoize_hash_table);
6997 Vextent_face_reverse_memoize_hash_table =
6998 make_lisp_hash_table(100, HASH_TABLE_KEY_WEAK, HASH_TABLE_EQ);