Mercurial > hg > xemacs-beta
annotate src/extents.c @ 5050:6f2158fa75ed
Fix quick-build, use asserts() in place of ABORT()
-------------------- ChangeLog entries follow: --------------------
ChangeLog addition:
2010-02-20 Ben Wing <ben@xemacs.org>
* configure.ac (XE_COMPLEX_ARG):
Correct doc of --quick-build: It also doesn't check for Lisp shadows.
src/ChangeLog addition:
2010-02-20 Ben Wing <ben@xemacs.org>
* EmacsFrame.c:
* EmacsFrame.c (EmacsFrameRecomputeCellSize):
* alloca.c (i00afunc):
* buffer.c:
* buffer.c (MARKED_SLOT):
* buffer.c (complex_vars_of_buffer):
* cm.c:
* cm.c (cmcheckmagic):
* console.c:
* console.c (MARKED_SLOT):
* device-x.c:
* device-x.c (x_get_visual_depth):
* emacs.c (sort_args):
* eval.c (throw_or_bomb_out):
* event-stream.c:
* event-stream.c (Fadd_timeout):
* event-stream.c (Fadd_async_timeout):
* event-stream.c (Frecent_keys):
* events.c:
* events.c (Fdeallocate_event):
* events.c (event_pixel_translation):
* extents.c:
* extents.c (process_extents_for_insertion_mapper):
* fns.c (Fbase64_encode_region):
* fns.c (Fbase64_encode_string):
* fns.c (Fbase64_decode_region):
* fns.c (Fbase64_decode_string):
* font-lock.c:
* font-lock.c (find_context):
* frame-x.c:
* frame-x.c (x_wm_mark_shell_size_user_specified):
* frame-x.c (x_wm_mark_shell_position_user_specified):
* frame-x.c (x_wm_set_shell_iconic_p):
* frame-x.c (x_wm_set_cell_size):
* frame-x.c (x_wm_set_variable_size):
* frame-x.c (x_wm_store_class_hints):
* frame-x.c (x_wm_maybe_store_wm_command):
* frame-x.c (x_initialize_frame_size):
* frame.c (delete_frame_internal):
* frame.c (change_frame_size_1):
* free-hook.c (check_free):
* free-hook.c (note_block_input):
* free-hook.c (log_gcpro):
* gccache-gtk.c (gc_cache_lookup):
* gccache-x.c:
* gccache-x.c (gc_cache_lookup):
* glyphs-gtk.c:
* glyphs-gtk.c (init_image_instance_from_gdk_pixmap):
* glyphs-x.c:
* glyphs-x.c (extract_xpm_color_names):
* insdel.c:
* insdel.c (move_gap):
* keymap.c:
* keymap.c (keymap_lookup_directly):
* keymap.c (keymap_delete_inverse_internal):
* keymap.c (accessible_keymaps_mapper_1):
* keymap.c (where_is_recursive_mapper):
* lisp.h:
* lstream.c (make_lisp_buffer_stream_1):
* macros.c:
* macros.c (pop_kbd_macro_event):
* mc-alloc.c (remove_page_from_used_list):
* menubar-x.c:
* menubar-x.c (set_frame_menubar):
* ralloc.c:
* ralloc.c (obtain):
* ralloc.c (relinquish):
* ralloc.c (relocate_blocs):
* ralloc.c (resize_bloc):
* ralloc.c (r_alloc_free):
* ralloc.c (r_re_alloc):
* ralloc.c (r_alloc_thaw):
* ralloc.c (init_ralloc):
* ralloc.c (Free_Addr_Block):
* scrollbar-x.c:
* scrollbar-x.c (x_update_scrollbar_instance_status):
* sunplay.c (init_device):
* unexnt.c:
* unexnt.c (read_in_bss):
* unexnt.c (map_in_heap):
* window.c:
* window.c (real_window):
* window.c (window_display_lines):
* window.c (window_display_buffer):
* window.c (set_window_display_buffer):
* window.c (unshow_buffer):
* window.c (Fget_lru_window):
if (...) ABORT(); ---> assert();
More specifically:
if (x == y) ABORT (); --> assert (x != y);
if (x != y) ABORT (); --> assert (x == y);
if (x > y) ABORT (); --> assert (x <= y);
etc.
if (!x) ABORT (); --> assert (x);
if (x) ABORT (); --> assert (!x);
DeMorgan's Law's applied and manually simplified:
if (x && !y) ABORT (); --> assert (!x || y);
if (!x || y >= z) ABORT (); --> assert (x && y < z);
Checked to make sure that assert() of an expression with side
effects ensures that the side effects get executed even when
asserts are disabled, and add a comment about this being a
requirement of any "disabled assert" expression.
* depend:
* make-src-depend:
* make-src-depend (PrintDeps):
Fix broken code in make-src-depend so it does what it was always
supposed to do, which was separate out config.h and lisp.h and
all the files they include into separate variables in the
depend part of Makefile so that quick-build can turn off the
lisp.h/config.h/text.h/etc. dependencies of the source files, to
speed up recompilation.
| author | Ben Wing <ben@xemacs.org> |
|---|---|
| date | Sat, 20 Feb 2010 05:05:54 -0600 |
| parents | 16112448d484 |
| children | 0e803dc6f096 |
| rev | line source |
|---|---|
| 428 | 1 /* Copyright (c) 1994, 1995 Free Software Foundation, Inc. |
| 2 Copyright (c) 1995 Sun Microsystems, Inc. | |
|
5050
6f2158fa75ed
Fix quick-build, use asserts() in place of ABORT()
Ben Wing <ben@xemacs.org>
parents:
4976
diff
changeset
|
3 Copyright (c) 1995, 1996, 2000, 2002, 2003, 2004, 2005, 2010 Ben Wing. |
| 428 | 4 |
| 5 This file is part of XEmacs. | |
| 6 | |
| 7 XEmacs is free software; you can redistribute it and/or modify it | |
| 8 under the terms of the GNU General Public License as published by the | |
| 9 Free Software Foundation; either version 2, or (at your option) any | |
| 10 later version. | |
| 11 | |
| 12 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
| 13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
| 14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
| 15 for more details. | |
| 16 | |
| 17 You should have received a copy of the GNU General Public License | |
| 18 along with XEmacs; see the file COPYING. If not, write to | |
| 19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
| 20 Boston, MA 02111-1307, USA. */ | |
| 21 | |
| 22 /* Synched up with: Not in FSF. */ | |
| 23 | |
| 24 /* This file has been Mule-ized. */ | |
| 25 | |
| 26 /* Written by Ben Wing <ben@xemacs.org>. | |
| 27 | |
| 28 [Originally written by some people at Lucid. | |
| 29 Hacked on by jwz. | |
| 30 Start/end-open stuff added by John Rose (john.rose@eng.sun.com). | |
| 31 Rewritten from scratch by Ben Wing, December 1994.] */ | |
| 32 | |
| 33 /* Commentary: | |
| 34 | |
| 35 Extents are regions over a buffer, with a start and an end position | |
| 36 denoting the region of the buffer included in the extent. In | |
| 37 addition, either end can be closed or open, meaning that the endpoint | |
| 38 is or is not logically included in the extent. Insertion of a character | |
| 39 at a closed endpoint causes the character to go inside the extent; | |
| 40 insertion at an open endpoint causes the character to go outside. | |
| 41 | |
| 42 Extent endpoints are stored using memory indices (see insdel.c), | |
| 43 to minimize the amount of adjusting that needs to be done when | |
| 44 characters are inserted or deleted. | |
| 45 | |
| 46 (Formerly, extent endpoints at the gap could be either before or | |
| 47 after the gap, depending on the open/closedness of the endpoint. | |
| 48 The intent of this was to make it so that insertions would | |
| 49 automatically go inside or out of extents as necessary with no | |
| 50 further work needing to be done. It didn't work out that way, | |
| 51 however, and just ended up complexifying and buggifying all the | |
| 52 rest of the code.) | |
| 53 | |
| 54 Extents are compared using memory indices. There are two orderings | |
| 55 for extents and both orders are kept current at all times. The normal | |
| 56 or "display" order is as follows: | |
| 57 | |
| 58 Extent A is "less than" extent B, that is, earlier in the display order, | |
| 59 if: A-start < B-start, | |
| 60 or if: A-start = B-start, and A-end > B-end | |
| 61 | |
| 62 So if two extents begin at the same position, the larger of them is the | |
| 63 earlier one in the display order (EXTENT_LESS is true). | |
| 64 | |
| 65 For the e-order, the same thing holds: Extent A is "less than" extent B | |
| 66 in e-order, that is, later in the buffer, | |
| 67 if: A-end < B-end, | |
| 68 or if: A-end = B-end, and A-start > B-start | |
| 69 | |
| 70 So if two extents end at the same position, the smaller of them is the | |
| 71 earlier one in the e-order (EXTENT_E_LESS is true). | |
| 72 | |
| 73 The display order and the e-order are complementary orders: any | |
| 74 theorem about the display order also applies to the e-order if you | |
| 75 swap all occurrences of "display order" and "e-order", "less than" | |
| 76 and "greater than", and "extent start" and "extent end". | |
| 77 | |
| 78 Extents can be zero-length, and will end up that way if their endpoints | |
| 79 are explicitly set that way or if their detachable property is nil | |
| 80 and all the text in the extent is deleted. (The exception is open-open | |
| 81 zero-length extents, which are barred from existing because there is | |
| 82 no sensible way to define their properties. Deletion of the text in | |
| 83 an open-open extent causes it to be converted into a closed-open | |
| 84 extent.) Zero-length extents are primarily used to represent | |
| 85 annotations, and behave as follows: | |
| 86 | |
| 87 1) Insertion at the position of a zero-length extent expands the extent | |
| 88 if both endpoints are closed; goes after the extent if it is closed-open; | |
| 89 and goes before the extent if it is open-closed. | |
| 90 | |
| 91 2) Deletion of a character on a side of a zero-length extent whose | |
| 92 corresponding endpoint is closed causes the extent to be detached if | |
| 93 it is detachable; if the extent is not detachable or the corresponding | |
| 94 endpoint is open, the extent remains in the buffer, moving as necessary. | |
| 95 | |
| 96 Note that closed-open, non-detachable zero-length extents behave exactly | |
| 97 like markers and that open-closed, non-detachable zero-length extents | |
| 98 behave like the "point-type" marker in Mule. | |
| 99 | |
| 100 | |
| 101 #### The following information is wrong in places. | |
| 102 | |
| 103 More about the different orders: | |
| 104 -------------------------------- | |
| 105 | |
| 106 The extents in a buffer are ordered by "display order" because that | |
| 107 is that order that the redisplay mechanism needs to process them in. | |
| 108 The e-order is an auxiliary ordering used to facilitate operations | |
| 109 over extents. The operations that can be performed on the ordered | |
| 110 list of extents in a buffer are | |
| 111 | |
| 112 1) Locate where an extent would go if inserted into the list. | |
| 113 2) Insert an extent into the list. | |
| 114 3) Remove an extent from the list. | |
| 115 4) Map over all the extents that overlap a range. | |
| 116 | |
| 117 (4) requires being able to determine the first and last extents | |
| 118 that overlap a range. | |
| 119 | |
| 120 NOTE: "overlap" is used as follows: | |
| 121 | |
| 122 -- two ranges overlap if they have at least one point in common. | |
| 123 Whether the endpoints are open or closed makes a difference here. | |
| 124 -- a point overlaps a range if the point is contained within the | |
| 125 range; this is equivalent to treating a point P as the range | |
| 126 [P, P]. | |
| 127 -- In the case of an *extent* overlapping a point or range, the | |
| 128 extent is normally treated as having closed endpoints. This | |
| 129 applies consistently in the discussion of stacks of extents | |
| 130 and such below. Note that this definition of overlap is not | |
| 131 necessarily consistent with the extents that `map-extents' | |
| 132 maps over, since `map-extents' sometimes pays attention to | |
| 133 whether the endpoints of an extents are open or closed. | |
| 134 But for our purposes, it greatly simplifies things to treat | |
| 135 all extents as having closed endpoints. | |
| 136 | |
| 137 First, define >, <, <=, etc. as applied to extents to mean | |
| 138 comparison according to the display order. Comparison between an | |
| 139 extent E and an index I means comparison between E and the range | |
| 140 [I, I]. | |
| 141 Also define e>, e<, e<=, etc. to mean comparison according to the | |
| 142 e-order. | |
| 143 For any range R, define R(0) to be the starting index of the range | |
| 144 and R(1) to be the ending index of the range. | |
| 145 For any extent E, define E(next) to be the extent directly following | |
| 146 E, and E(prev) to be the extent directly preceding E. Assume | |
| 147 E(next) and E(prev) can be determined from E in constant time. | |
| 148 (This is because we store the extent list as a doubly linked | |
| 149 list.) | |
| 150 Similarly, define E(e-next) and E(e-prev) to be the extents | |
| 151 directly following and preceding E in the e-order. | |
| 152 | |
| 153 Now: | |
| 154 | |
| 155 Let R be a range. | |
| 156 Let F be the first extent overlapping R. | |
| 157 Let L be the last extent overlapping R. | |
| 158 | |
| 159 Theorem 1: R(1) lies between L and L(next), i.e. L <= R(1) < L(next). | |
| 160 | |
| 161 This follows easily from the definition of display order. The | |
| 162 basic reason that this theorem applies is that the display order | |
| 163 sorts by increasing starting index. | |
| 164 | |
| 165 Therefore, we can determine L just by looking at where we would | |
| 166 insert R(1) into the list, and if we know F and are moving forward | |
| 167 over extents, we can easily determine when we've hit L by comparing | |
| 168 the extent we're at to R(1). | |
| 169 | |
| 170 Theorem 2: F(e-prev) e< [1, R(0)] e<= F. | |
| 171 | |
| 172 This is the analog of Theorem 1, and applies because the e-order | |
| 173 sorts by increasing ending index. | |
| 174 | |
| 175 Therefore, F can be found in the same amount of time as operation (1), | |
| 176 i.e. the time that it takes to locate where an extent would go if | |
| 177 inserted into the e-order list. | |
| 178 | |
| 179 If the lists were stored as balanced binary trees, then operation (1) | |
| 180 would take logarithmic time, which is usually quite fast. However, | |
| 181 currently they're stored as simple doubly-linked lists, and instead | |
| 182 we do some caching to try to speed things up. | |
| 183 | |
| 184 Define a "stack of extents" (or "SOE") as the set of extents | |
| 185 (ordered in the display order) that overlap an index I, together with | |
| 186 the SOE's "previous" extent, which is an extent that precedes I in | |
| 187 the e-order. (Hopefully there will not be very many extents between | |
| 188 I and the previous extent.) | |
| 189 | |
| 190 Now: | |
| 191 | |
| 192 Let I be an index, let S be the stack of extents on I, let F be | |
| 193 the first extent in S, and let P be S's previous extent. | |
| 194 | |
| 195 Theorem 3: The first extent in S is the first extent that overlaps | |
| 196 any range [I, J]. | |
| 197 | |
| 198 Proof: Any extent that overlaps [I, J] but does not include I must | |
| 199 have a start index > I, and thus be greater than any extent in S. | |
| 200 | |
| 201 Therefore, finding the first extent that overlaps a range R is the | |
| 202 same as finding the first extent that overlaps R(0). | |
| 203 | |
| 204 Theorem 4: Let I2 be an index such that I2 > I, and let F2 be the | |
| 205 first extent that overlaps I2. Then, either F2 is in S or F2 is | |
| 206 greater than any extent in S. | |
| 207 | |
| 208 Proof: If F2 does not include I then its start index is greater | |
| 209 than I and thus it is greater than any extent in S, including F. | |
| 210 Otherwise, F2 includes I and thus is in S, and thus F2 >= F. | |
| 211 | |
| 212 */ | |
| 213 | |
| 214 #include <config.h> | |
| 215 #include "lisp.h" | |
| 216 | |
| 217 #include "buffer.h" | |
| 218 #include "debug.h" | |
| 219 #include "device.h" | |
| 220 #include "elhash.h" | |
| 872 | 221 #include "extents-impl.h" |
| 428 | 222 #include "faces.h" |
| 223 #include "frame.h" | |
| 224 #include "glyphs.h" | |
| 225 #include "insdel.h" | |
| 226 #include "keymap.h" | |
| 227 #include "opaque.h" | |
| 228 #include "process.h" | |
| 1292 | 229 #include "profile.h" |
| 428 | 230 #include "redisplay.h" |
| 442 | 231 #include "gutter.h" |
| 428 | 232 |
| 233 /* ------------------------------- */ | |
| 234 /* gap array */ | |
| 235 /* ------------------------------- */ | |
| 236 | |
| 237 /* Note that this object is not extent-specific and should perhaps be | |
| 238 moved into another file. */ | |
| 239 | |
| 240 /* Holds a marker that moves as elements in the array are inserted and | |
| 241 deleted, similar to standard markers. */ | |
| 242 | |
| 243 typedef struct gap_array_marker | |
| 244 { | |
| 3092 | 245 #ifdef NEW_GC |
| 246 struct lrecord_header header; | |
| 247 #endif /* NEW_GC */ | |
| 428 | 248 int pos; |
| 249 struct gap_array_marker *next; | |
| 250 } Gap_Array_Marker; | |
| 251 | |
| 1204 | 252 |
| 428 | 253 /* Holds a "gap array", which is an array of elements with a gap located |
| 254 in it. Insertions and deletions with a high degree of locality | |
| 255 are very fast, essentially in constant time. Array positions as | |
| 256 used and returned in the gap array functions are independent of | |
| 257 the gap. */ | |
| 258 | |
| 1204 | 259 /* Layout of gap array: |
| 260 | |
| 261 <------ gap ------><---- gapsize ----><----- numels - gap ----> | |
| 262 <---------------------- numels + gapsize ---------------------> | |
| 263 | |
| 264 For marking purposes, we use two extra variables computed from | |
| 265 the others -- the offset to the data past the gap, plus the number | |
| 266 of elements in that data: | |
| 267 | |
| 268 offset_past_gap = elsize * (gap + gapsize) | |
| 269 els_past_gap = numels - gap | |
| 270 */ | |
| 271 | |
| 272 | |
| 428 | 273 typedef struct gap_array |
| 274 { | |
| 3092 | 275 #ifdef NEW_GC |
| 276 struct lrecord_header header; | |
| 277 #endif /* NEW_GC */ | |
| 1204 | 278 Elemcount gap; |
| 279 Elemcount gapsize; | |
| 280 Elemcount numels; | |
| 281 Bytecount elsize; | |
| 282 /* Redundant numbers computed from the others, for marking purposes */ | |
| 283 Bytecount offset_past_gap; | |
| 284 Elemcount els_past_gap; | |
| 428 | 285 Gap_Array_Marker *markers; |
| 1204 | 286 /* this is a stretchy array */ |
| 287 char array[1]; | |
| 428 | 288 } Gap_Array; |
| 289 | |
| 3092 | 290 #ifndef NEW_GC |
| 428 | 291 static Gap_Array_Marker *gap_array_marker_freelist; |
| 3092 | 292 #endif /* not NEW_GC */ |
| 428 | 293 |
| 294 /* Convert a "memory position" (i.e. taking the gap into account) into | |
| 295 the address of the element at (i.e. after) that position. "Memory | |
| 826 | 296 positions" are only used internally and are of type Memxpos. |
| 428 | 297 "Array positions" are used externally and are of type int. */ |
| 298 #define GAP_ARRAY_MEMEL_ADDR(ga, memel) ((ga)->array + (ga)->elsize*(memel)) | |
| 299 | |
| 300 /* Number of elements currently in a gap array */ | |
| 301 #define GAP_ARRAY_NUM_ELS(ga) ((ga)->numels) | |
| 302 | |
| 303 #define GAP_ARRAY_ARRAY_TO_MEMORY_POS(ga, pos) \ | |
| 304 ((pos) <= (ga)->gap ? (pos) : (pos) + (ga)->gapsize) | |
| 305 | |
| 306 #define GAP_ARRAY_MEMORY_TO_ARRAY_POS(ga, pos) \ | |
| 307 ((pos) <= (ga)->gap ? (pos) : (pos) - (ga)->gapsize) | |
| 308 | |
| 309 /* Convert an array position into the address of the element at | |
| 310 (i.e. after) that position. */ | |
| 311 #define GAP_ARRAY_EL_ADDR(ga, pos) ((pos) < (ga)->gap ? \ | |
| 312 GAP_ARRAY_MEMEL_ADDR(ga, pos) : \ | |
| 313 GAP_ARRAY_MEMEL_ADDR(ga, (pos) + (ga)->gapsize)) | |
| 314 | |
| 315 /* ------------------------------- */ | |
| 316 /* extent list */ | |
| 317 /* ------------------------------- */ | |
| 318 | |
| 319 typedef struct extent_list_marker | |
| 320 { | |
| 3092 | 321 #ifdef NEW_GC |
| 322 struct lrecord_header header; | |
| 323 #endif /* NEW_GC */ | |
| 428 | 324 Gap_Array_Marker *m; |
| 325 int endp; | |
| 326 struct extent_list_marker *next; | |
| 327 } Extent_List_Marker; | |
| 328 | |
| 329 typedef struct extent_list | |
| 330 { | |
| 3092 | 331 #ifdef NEW_GC |
| 332 struct lrecord_header header; | |
| 333 #endif /* NEW_GC */ | |
| 428 | 334 Gap_Array *start; |
| 335 Gap_Array *end; | |
| 336 Extent_List_Marker *markers; | |
| 337 } Extent_List; | |
| 338 | |
| 3092 | 339 #ifndef NEW_GC |
| 428 | 340 static Extent_List_Marker *extent_list_marker_freelist; |
| 3092 | 341 #endif /* not NEW_GC */ |
| 428 | 342 |
| 343 #define EXTENT_LESS_VALS(e,st,nd) ((extent_start (e) < (st)) || \ | |
| 344 ((extent_start (e) == (st)) && \ | |
| 345 (extent_end (e) > (nd)))) | |
| 346 | |
| 347 #define EXTENT_EQUAL_VALS(e,st,nd) ((extent_start (e) == (st)) && \ | |
| 348 (extent_end (e) == (nd))) | |
| 349 | |
| 350 #define EXTENT_LESS_EQUAL_VALS(e,st,nd) ((extent_start (e) < (st)) || \ | |
| 351 ((extent_start (e) == (st)) && \ | |
| 352 (extent_end (e) >= (nd)))) | |
| 353 | |
| 354 /* Is extent E1 less than extent E2 in the display order? */ | |
| 355 #define EXTENT_LESS(e1,e2) \ | |
| 356 EXTENT_LESS_VALS (e1, extent_start (e2), extent_end (e2)) | |
| 357 | |
| 358 /* Is extent E1 equal to extent E2? */ | |
| 359 #define EXTENT_EQUAL(e1,e2) \ | |
| 360 EXTENT_EQUAL_VALS (e1, extent_start (e2), extent_end (e2)) | |
| 361 | |
| 362 /* Is extent E1 less than or equal to extent E2 in the display order? */ | |
| 363 #define EXTENT_LESS_EQUAL(e1,e2) \ | |
| 364 EXTENT_LESS_EQUAL_VALS (e1, extent_start (e2), extent_end (e2)) | |
| 365 | |
| 366 #define EXTENT_E_LESS_VALS(e,st,nd) ((extent_end (e) < (nd)) || \ | |
| 367 ((extent_end (e) == (nd)) && \ | |
| 368 (extent_start (e) > (st)))) | |
| 369 | |
| 370 #define EXTENT_E_LESS_EQUAL_VALS(e,st,nd) ((extent_end (e) < (nd)) || \ | |
| 371 ((extent_end (e) == (nd)) && \ | |
| 372 (extent_start (e) >= (st)))) | |
| 373 | |
| 374 /* Is extent E1 less than extent E2 in the e-order? */ | |
| 375 #define EXTENT_E_LESS(e1,e2) \ | |
| 376 EXTENT_E_LESS_VALS(e1, extent_start (e2), extent_end (e2)) | |
| 377 | |
| 378 /* Is extent E1 less than or equal to extent E2 in the e-order? */ | |
| 379 #define EXTENT_E_LESS_EQUAL(e1,e2) \ | |
| 380 EXTENT_E_LESS_EQUAL_VALS (e1, extent_start (e2), extent_end (e2)) | |
| 381 | |
| 382 #define EXTENT_GAP_ARRAY_AT(ga, pos) (* (EXTENT *) GAP_ARRAY_EL_ADDR(ga, pos)) | |
| 383 | |
| 384 /* ------------------------------- */ | |
| 385 /* auxiliary extent structure */ | |
| 386 /* ------------------------------- */ | |
| 387 | |
| 388 struct extent_auxiliary extent_auxiliary_defaults; | |
| 389 | |
| 390 /* ------------------------------- */ | |
| 391 /* buffer-extent primitives */ | |
| 392 /* ------------------------------- */ | |
| 393 | |
| 394 typedef struct stack_of_extents | |
| 395 { | |
| 3092 | 396 #ifdef NEW_GC |
| 397 struct lrecord_header header; | |
| 398 #endif /* NEW_GC */ | |
| 428 | 399 Extent_List *extents; |
| 826 | 400 Memxpos pos; /* Position of stack of extents. EXTENTS is the list of |
| 428 | 401 all extents that overlap this position. This position |
| 402 can be -1 if the stack of extents is invalid (this | |
| 403 happens when a buffer is first created or a string's | |
| 404 stack of extents is created [a string's stack of extents | |
| 405 is nuked when a GC occurs, to conserve memory]). */ | |
| 406 } Stack_Of_Extents; | |
| 407 | |
| 408 /* ------------------------------- */ | |
| 409 /* map-extents */ | |
| 410 /* ------------------------------- */ | |
| 411 | |
| 826 | 412 typedef int (*map_extents_fun) (EXTENT extent, void *arg); |
| 413 | |
| 428 | 414 typedef int Endpoint_Index; |
| 415 | |
| 826 | 416 #define memxpos_to_startind(x, start_open) \ |
| 428 | 417 ((Endpoint_Index) (((x) << 1) + !!(start_open))) |
| 826 | 418 #define memxpos_to_endind(x, end_open) \ |
| 428 | 419 ((Endpoint_Index) (((x) << 1) - !!(end_open))) |
| 420 | |
| 421 /* ------------------------------- */ | |
| 422 /* buffer-or-string primitives */ | |
| 423 /* ------------------------------- */ | |
| 424 | |
| 826 | 425 /* Similar for Bytebpos's and start/end indices. */ |
| 426 | |
| 427 #define buffer_or_string_bytexpos_to_startind(obj, ind, start_open) \ | |
| 428 memxpos_to_startind (buffer_or_string_bytexpos_to_memxpos (obj, ind), \ | |
| 428 | 429 start_open) |
| 430 | |
| 826 | 431 #define buffer_or_string_bytexpos_to_endind(obj, ind, end_open) \ |
| 432 memxpos_to_endind (buffer_or_string_bytexpos_to_memxpos (obj, ind), \ | |
| 428 | 433 end_open) |
| 434 | |
| 435 /* ------------------------------- */ | |
| 436 /* Lisp-level functions */ | |
| 437 /* ------------------------------- */ | |
| 438 | |
| 439 /* flags for decode_extent() */ | |
| 440 #define DE_MUST_HAVE_BUFFER 1 | |
| 441 #define DE_MUST_BE_ATTACHED 2 | |
| 442 | |
| 443 Lisp_Object Vlast_highlighted_extent; | |
| 1292 | 444 |
| 445 Lisp_Object QSin_map_extents_internal; | |
| 446 | |
| 458 | 447 Fixnum mouse_highlight_priority; |
| 428 | 448 |
| 449 Lisp_Object Qextentp; | |
| 450 Lisp_Object Qextent_live_p; | |
| 451 | |
| 452 Lisp_Object Qall_extents_closed; | |
| 453 Lisp_Object Qall_extents_open; | |
| 454 Lisp_Object Qall_extents_closed_open; | |
| 455 Lisp_Object Qall_extents_open_closed; | |
| 456 Lisp_Object Qstart_in_region; | |
| 457 Lisp_Object Qend_in_region; | |
| 458 Lisp_Object Qstart_and_end_in_region; | |
| 459 Lisp_Object Qstart_or_end_in_region; | |
| 460 Lisp_Object Qnegate_in_region; | |
| 461 | |
| 462 Lisp_Object Qdetached; | |
| 463 Lisp_Object Qdestroyed; | |
| 464 Lisp_Object Qbegin_glyph; | |
| 465 Lisp_Object Qend_glyph; | |
| 466 Lisp_Object Qstart_open; | |
| 467 Lisp_Object Qend_open; | |
| 468 Lisp_Object Qstart_closed; | |
| 469 Lisp_Object Qend_closed; | |
| 470 Lisp_Object Qread_only; | |
| 471 /* Qhighlight defined in general.c */ | |
| 472 Lisp_Object Qunique; | |
| 473 Lisp_Object Qduplicable; | |
| 474 Lisp_Object Qdetachable; | |
| 475 Lisp_Object Qpriority; | |
| 476 Lisp_Object Qmouse_face; | |
| 477 Lisp_Object Qinitial_redisplay_function; | |
| 478 | |
| 479 Lisp_Object Qglyph_layout; /* This exists only for backwards compatibility. */ | |
| 480 Lisp_Object Qbegin_glyph_layout, Qend_glyph_layout; | |
| 481 Lisp_Object Qoutside_margin; | |
| 482 Lisp_Object Qinside_margin; | |
| 483 Lisp_Object Qwhitespace; | |
| 484 /* Qtext defined in general.c */ | |
| 485 | |
| 486 Lisp_Object Qcopy_function; | |
| 487 Lisp_Object Qpaste_function; | |
| 488 | |
| 489 static Lisp_Object canonicalize_extent_property (Lisp_Object prop, | |
| 490 Lisp_Object value); | |
| 826 | 491 |
| 492 typedef struct | |
| 493 { | |
| 494 Lisp_Object key, value; | |
| 495 } Lisp_Object_pair; | |
| 496 typedef struct | |
| 497 { | |
| 498 Dynarr_declare (Lisp_Object_pair); | |
| 499 } Lisp_Object_pair_dynarr; | |
| 500 | |
| 501 static void extent_properties (EXTENT e, Lisp_Object_pair_dynarr *props); | |
| 502 | |
| 428 | 503 Lisp_Object Vextent_face_memoize_hash_table; |
| 504 Lisp_Object Vextent_face_reverse_memoize_hash_table; | |
| 505 Lisp_Object Vextent_face_reusable_list; | |
| 506 /* FSFmacs bogosity */ | |
| 507 Lisp_Object Vdefault_text_properties; | |
| 508 | |
| 442 | 509 /* if true, we don't want to set any redisplay flags on modeline extent |
| 510 changes */ | |
| 511 int in_modeline_generation; | |
| 512 | |
| 428 | 513 |
| 514 /************************************************************************/ | |
| 515 /* Generalized gap array */ | |
| 516 /************************************************************************/ | |
| 517 | |
| 518 /* This generalizes the "array with a gap" model used to store buffer | |
| 519 characters. This is based on the stuff in insdel.c and should | |
| 520 probably be merged with it. This is not extent-specific and should | |
| 521 perhaps be moved into a separate file. */ | |
| 522 | |
| 523 /* ------------------------------- */ | |
| 524 /* internal functions */ | |
| 525 /* ------------------------------- */ | |
| 526 | |
| 527 /* Adjust the gap array markers in the range (FROM, TO]. Parallel to | |
| 528 adjust_markers() in insdel.c. */ | |
| 529 | |
| 530 static void | |
| 826 | 531 gap_array_adjust_markers (Gap_Array *ga, Memxpos from, |
| 1204 | 532 Memxpos to, Elemcount amount) |
| 428 | 533 { |
| 534 Gap_Array_Marker *m; | |
| 535 | |
| 536 for (m = ga->markers; m; m = m->next) | |
| 537 m->pos = do_marker_adjustment (m->pos, from, to, amount); | |
| 538 } | |
| 539 | |
| 1204 | 540 static void |
| 541 gap_array_recompute_derived_values (Gap_Array *ga) | |
| 542 { | |
| 543 ga->offset_past_gap = ga->elsize * (ga->gap + ga->gapsize); | |
| 544 ga->els_past_gap = ga->numels - ga->gap; | |
| 545 } | |
| 546 | |
| 428 | 547 /* Move the gap to array position POS. Parallel to move_gap() in |
| 548 insdel.c but somewhat simplified. */ | |
| 549 | |
| 550 static void | |
| 1204 | 551 gap_array_move_gap (Gap_Array *ga, Elemcount pos) |
| 552 { | |
| 553 Elemcount gap = ga->gap; | |
| 554 Elemcount gapsize = ga->gapsize; | |
| 555 | |
| 428 | 556 if (pos < gap) |
| 557 { | |
| 558 memmove (GAP_ARRAY_MEMEL_ADDR (ga, pos + gapsize), | |
| 559 GAP_ARRAY_MEMEL_ADDR (ga, pos), | |
| 560 (gap - pos)*ga->elsize); | |
| 826 | 561 gap_array_adjust_markers (ga, (Memxpos) pos, (Memxpos) gap, |
| 428 | 562 gapsize); |
| 563 } | |
| 564 else if (pos > gap) | |
| 565 { | |
| 566 memmove (GAP_ARRAY_MEMEL_ADDR (ga, gap), | |
| 567 GAP_ARRAY_MEMEL_ADDR (ga, gap + gapsize), | |
| 568 (pos - gap)*ga->elsize); | |
| 826 | 569 gap_array_adjust_markers (ga, (Memxpos) (gap + gapsize), |
| 570 (Memxpos) (pos + gapsize), - gapsize); | |
| 428 | 571 } |
| 572 ga->gap = pos; | |
| 1204 | 573 |
| 574 gap_array_recompute_derived_values (ga); | |
| 428 | 575 } |
| 576 | |
| 577 /* Make the gap INCREMENT characters longer. Parallel to make_gap() in | |
| 1204 | 578 insdel.c. The gap array may be moved, so assign the return value back |
| 579 to the array pointer. */ | |
| 580 | |
| 581 static Gap_Array * | |
| 582 gap_array_make_gap (Gap_Array *ga, Elemcount increment) | |
| 583 { | |
| 584 Elemcount real_gap_loc; | |
| 585 Elemcount old_gap_size; | |
| 428 | 586 |
| 587 /* If we have to get more space, get enough to last a while. We use | |
| 588 a geometric progression that saves on realloc space. */ | |
| 589 increment += 100 + ga->numels / 8; | |
| 590 | |
| 3092 | 591 #ifdef NEW_GC |
| 592 ga = (Gap_Array *) mc_realloc (ga, | |
| 593 offsetof (Gap_Array, array) + | |
| 594 (ga->numels + ga->gapsize + increment) * | |
| 595 ga->elsize); | |
| 596 #else /* not NEW_GC */ | |
| 1204 | 597 ga = (Gap_Array *) xrealloc (ga, |
| 598 offsetof (Gap_Array, array) + | |
| 599 (ga->numels + ga->gapsize + increment) * | |
| 600 ga->elsize); | |
| 3092 | 601 #endif /* not NEW_GC */ |
| 1204 | 602 if (ga == 0) |
| 428 | 603 memory_full (); |
| 604 | |
| 605 real_gap_loc = ga->gap; | |
| 606 old_gap_size = ga->gapsize; | |
| 607 | |
| 608 /* Call the newly allocated space a gap at the end of the whole space. */ | |
| 609 ga->gap = ga->numels + ga->gapsize; | |
| 610 ga->gapsize = increment; | |
| 611 | |
| 612 /* Move the new gap down to be consecutive with the end of the old one. | |
| 613 This adjusts the markers properly too. */ | |
| 614 gap_array_move_gap (ga, real_gap_loc + old_gap_size); | |
| 615 | |
| 616 /* Now combine the two into one large gap. */ | |
| 617 ga->gapsize += old_gap_size; | |
| 618 ga->gap = real_gap_loc; | |
| 1204 | 619 |
| 620 gap_array_recompute_derived_values (ga); | |
| 621 | |
| 622 return ga; | |
| 428 | 623 } |
| 624 | |
| 625 /* ------------------------------- */ | |
| 626 /* external functions */ | |
| 627 /* ------------------------------- */ | |
| 628 | |
| 629 /* Insert NUMELS elements (pointed to by ELPTR) into the specified | |
| 1204 | 630 gap array at POS. The gap array may be moved, so assign the |
| 631 return value back to the array pointer. */ | |
| 632 | |
| 633 static Gap_Array * | |
| 634 gap_array_insert_els (Gap_Array *ga, Elemcount pos, void *elptr, | |
| 635 Elemcount numels) | |
| 428 | 636 { |
| 637 assert (pos >= 0 && pos <= ga->numels); | |
| 638 if (ga->gapsize < numels) | |
| 1204 | 639 ga = gap_array_make_gap (ga, numels - ga->gapsize); |
| 428 | 640 if (pos != ga->gap) |
| 641 gap_array_move_gap (ga, pos); | |
| 642 | |
| 643 memcpy (GAP_ARRAY_MEMEL_ADDR (ga, ga->gap), (char *) elptr, | |
| 644 numels*ga->elsize); | |
| 645 ga->gapsize -= numels; | |
| 646 ga->gap += numels; | |
| 647 ga->numels += numels; | |
| 1204 | 648 gap_array_recompute_derived_values (ga); |
| 428 | 649 /* This is the equivalent of insert-before-markers. |
| 650 | |
| 651 #### Should only happen if marker is "moves forward at insert" type. | |
| 652 */ | |
| 653 | |
| 654 gap_array_adjust_markers (ga, pos - 1, pos, numels); | |
| 1204 | 655 return ga; |
| 428 | 656 } |
| 657 | |
| 658 /* Delete NUMELS elements from the specified gap array, starting at FROM. */ | |
| 659 | |
| 660 static void | |
| 1204 | 661 gap_array_delete_els (Gap_Array *ga, Elemcount from, Elemcount numdel) |
| 662 { | |
| 663 Elemcount to = from + numdel; | |
| 664 Elemcount gapsize = ga->gapsize; | |
| 428 | 665 |
| 666 assert (from >= 0); | |
| 667 assert (numdel >= 0); | |
| 668 assert (to <= ga->numels); | |
| 669 | |
| 670 /* Make sure the gap is somewhere in or next to what we are deleting. */ | |
| 671 if (to < ga->gap) | |
| 672 gap_array_move_gap (ga, to); | |
| 673 if (from > ga->gap) | |
| 674 gap_array_move_gap (ga, from); | |
| 675 | |
| 676 /* Relocate all markers pointing into the new, larger gap | |
| 677 to point at the end of the text before the gap. */ | |
| 678 gap_array_adjust_markers (ga, to + gapsize, to + gapsize, | |
| 679 - numdel - gapsize); | |
| 680 | |
| 681 ga->gapsize += numdel; | |
| 682 ga->numels -= numdel; | |
| 683 ga->gap = from; | |
| 1204 | 684 gap_array_recompute_derived_values (ga); |
| 428 | 685 } |
| 686 | |
| 687 static Gap_Array_Marker * | |
| 1204 | 688 gap_array_make_marker (Gap_Array *ga, Elemcount pos) |
| 428 | 689 { |
| 690 Gap_Array_Marker *m; | |
| 691 | |
| 692 assert (pos >= 0 && pos <= ga->numels); | |
| 3092 | 693 #ifdef NEW_GC |
| 694 m = alloc_lrecord_type (Gap_Array_Marker, &lrecord_gap_array_marker); | |
| 695 #else /* not NEW_GC */ | |
| 428 | 696 if (gap_array_marker_freelist) |
| 697 { | |
| 698 m = gap_array_marker_freelist; | |
| 699 gap_array_marker_freelist = gap_array_marker_freelist->next; | |
| 700 } | |
| 701 else | |
| 702 m = xnew (Gap_Array_Marker); | |
| 3092 | 703 #endif /* not NEW_GC */ |
| 428 | 704 |
| 705 m->pos = GAP_ARRAY_ARRAY_TO_MEMORY_POS (ga, pos); | |
| 706 m->next = ga->markers; | |
| 707 ga->markers = m; | |
| 708 return m; | |
| 709 } | |
| 710 | |
| 711 static void | |
| 712 gap_array_delete_marker (Gap_Array *ga, Gap_Array_Marker *m) | |
| 713 { | |
| 714 Gap_Array_Marker *p, *prev; | |
| 715 | |
| 716 for (prev = 0, p = ga->markers; p && p != m; prev = p, p = p->next) | |
| 717 ; | |
| 718 assert (p); | |
| 719 if (prev) | |
| 720 prev->next = p->next; | |
| 721 else | |
| 722 ga->markers = p->next; | |
| 4117 | 723 #ifndef NEW_GC |
| 428 | 724 m->next = gap_array_marker_freelist; |
| 1204 | 725 m->pos = 0xDEADBEEF; /* -559038737 base 10 */ |
| 428 | 726 gap_array_marker_freelist = m; |
| 3092 | 727 #endif /* not NEW_GC */ |
| 728 } | |
| 729 | |
| 730 #ifndef NEW_GC | |
| 428 | 731 static void |
| 732 gap_array_delete_all_markers (Gap_Array *ga) | |
| 733 { | |
| 734 Gap_Array_Marker *p, *next; | |
| 735 | |
| 736 for (p = ga->markers; p; p = next) | |
| 737 { | |
| 738 next = p->next; | |
| 739 p->next = gap_array_marker_freelist; | |
| 740 p->pos = 0xDEADBEEF; /* -559038737 as an int */ | |
| 741 gap_array_marker_freelist = p; | |
| 742 } | |
| 743 } | |
| 3092 | 744 #endif /* not NEW_GC */ |
| 428 | 745 |
| 746 static void | |
| 1204 | 747 gap_array_move_marker (Gap_Array *ga, Gap_Array_Marker *m, Elemcount pos) |
| 428 | 748 { |
| 749 assert (pos >= 0 && pos <= ga->numels); | |
| 750 m->pos = GAP_ARRAY_ARRAY_TO_MEMORY_POS (ga, pos); | |
| 751 } | |
| 752 | |
| 753 #define gap_array_marker_pos(ga, m) \ | |
| 754 GAP_ARRAY_MEMORY_TO_ARRAY_POS (ga, (m)->pos) | |
| 755 | |
| 756 static Gap_Array * | |
| 1204 | 757 make_gap_array (Elemcount elsize) |
| 428 | 758 { |
| 3092 | 759 #ifdef NEW_GC |
| 760 Gap_Array *ga = alloc_lrecord_type (Gap_Array, &lrecord_gap_array); | |
| 761 #else /* not NEW_GC */ | |
| 428 | 762 Gap_Array *ga = xnew_and_zero (Gap_Array); |
| 3092 | 763 #endif /* not NEW_GC */ |
| 428 | 764 ga->elsize = elsize; |
| 765 return ga; | |
| 766 } | |
| 767 | |
| 3092 | 768 #ifndef NEW_GC |
| 428 | 769 static void |
| 770 free_gap_array (Gap_Array *ga) | |
| 771 { | |
| 772 gap_array_delete_all_markers (ga); | |
|
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4967
diff
changeset
|
773 xfree (ga); |
| 428 | 774 } |
| 3092 | 775 #endif /* not NEW_GC */ |
| 428 | 776 |
| 777 | |
| 778 /************************************************************************/ | |
| 779 /* Extent list primitives */ | |
| 780 /************************************************************************/ | |
| 781 | |
| 782 /* A list of extents is maintained as a double gap array: one gap array | |
| 783 is ordered by start index (the "display order") and the other is | |
| 784 ordered by end index (the "e-order"). Note that positions in an | |
| 785 extent list should logically be conceived of as referring *to* | |
| 786 a particular extent (as is the norm in programs) rather than | |
| 787 sitting between two extents. Note also that callers of these | |
| 788 functions should not be aware of the fact that the extent list is | |
| 789 implemented as an array, except for the fact that positions are | |
| 790 integers (this should be generalized to handle integers and linked | |
| 791 list equally well). | |
| 792 */ | |
| 793 | |
| 794 /* Number of elements in an extent list */ | |
| 1204 | 795 #define extent_list_num_els(el) GAP_ARRAY_NUM_ELS (el->start) |
| 428 | 796 |
| 797 /* Return the position at which EXTENT is located in the specified extent | |
| 798 list (in the display order if ENDP is 0, in the e-order otherwise). | |
| 799 If the extent is not found, the position where the extent would | |
| 800 be inserted is returned. If ENDP is 0, the insertion would go after | |
| 801 all other equal extents. If ENDP is not 0, the insertion would go | |
| 802 before all other equal extents. If FOUNDP is not 0, then whether | |
| 803 the extent was found will get written into it. */ | |
| 804 | |
| 805 static int | |
| 806 extent_list_locate (Extent_List *el, EXTENT extent, int endp, int *foundp) | |
| 807 { | |
| 808 Gap_Array *ga = endp ? el->end : el->start; | |
| 809 int left = 0, right = GAP_ARRAY_NUM_ELS (ga); | |
| 810 int oldfoundpos, foundpos; | |
| 811 int found; | |
| 812 | |
| 813 while (left != right) | |
| 814 { | |
| 815 /* RIGHT might not point to a valid extent (i.e. it's at the end | |
| 816 of the list), so NEWPOS must round down. */ | |
| 647 | 817 int newpos = (left + right) >> 1; |
| 428 | 818 EXTENT e = EXTENT_GAP_ARRAY_AT (ga, (int) newpos); |
| 819 | |
| 820 if (endp ? EXTENT_E_LESS (e, extent) : EXTENT_LESS (e, extent)) | |
| 647 | 821 left = newpos + 1; |
| 428 | 822 else |
| 823 right = newpos; | |
| 824 } | |
| 825 | |
| 826 /* Now we're at the beginning of all equal extents. */ | |
| 827 found = 0; | |
| 828 oldfoundpos = foundpos = left; | |
| 829 while (foundpos < GAP_ARRAY_NUM_ELS (ga)) | |
| 830 { | |
| 831 EXTENT e = EXTENT_GAP_ARRAY_AT (ga, foundpos); | |
| 832 if (e == extent) | |
| 833 { | |
| 834 found = 1; | |
| 835 break; | |
| 836 } | |
| 837 if (!EXTENT_EQUAL (e, extent)) | |
| 838 break; | |
| 839 foundpos++; | |
| 840 } | |
| 841 if (foundp) | |
| 842 *foundp = found; | |
| 843 if (found || !endp) | |
| 844 return foundpos; | |
| 845 else | |
| 846 return oldfoundpos; | |
| 847 } | |
| 848 | |
| 849 /* Return the position of the first extent that begins at or after POS | |
| 850 (or ends at or after POS, if ENDP is not 0). | |
| 851 | |
| 852 An out-of-range value for POS is allowed, and guarantees that the | |
| 853 position at the beginning or end of the extent list is returned. */ | |
| 854 | |
| 855 static int | |
| 826 | 856 extent_list_locate_from_pos (Extent_List *el, Memxpos pos, int endp) |
| 428 | 857 { |
| 858 struct extent fake_extent; | |
| 859 /* | |
| 860 | |
| 861 Note that if we search for [POS, POS], then we get the following: | |
| 862 | |
| 863 -- if ENDP is 0, then all extents whose start position is <= POS | |
| 864 lie before the returned position, and all extents whose start | |
| 865 position is > POS lie at or after the returned position. | |
| 866 | |
| 867 -- if ENDP is not 0, then all extents whose end position is < POS | |
| 868 lie before the returned position, and all extents whose end | |
| 869 position is >= POS lie at or after the returned position. | |
| 870 | |
| 871 */ | |
| 872 set_extent_start (&fake_extent, endp ? pos : pos-1); | |
| 873 set_extent_end (&fake_extent, endp ? pos : pos-1); | |
| 874 return extent_list_locate (el, &fake_extent, endp, 0); | |
| 875 } | |
| 876 | |
| 877 /* Return the extent at POS. */ | |
| 878 | |
| 879 static EXTENT | |
| 826 | 880 extent_list_at (Extent_List *el, Memxpos pos, int endp) |
| 428 | 881 { |
| 882 Gap_Array *ga = endp ? el->end : el->start; | |
| 883 | |
| 884 assert (pos >= 0 && pos < GAP_ARRAY_NUM_ELS (ga)); | |
| 885 return EXTENT_GAP_ARRAY_AT (ga, pos); | |
| 886 } | |
| 887 | |
| 888 /* Insert an extent into an extent list. */ | |
| 889 | |
| 890 static void | |
| 891 extent_list_insert (Extent_List *el, EXTENT extent) | |
| 892 { | |
| 893 int pos, foundp; | |
| 894 | |
| 895 pos = extent_list_locate (el, extent, 0, &foundp); | |
| 896 assert (!foundp); | |
| 1204 | 897 el->start = gap_array_insert_els (el->start, pos, &extent, 1); |
| 428 | 898 pos = extent_list_locate (el, extent, 1, &foundp); |
| 899 assert (!foundp); | |
| 1204 | 900 el->end = gap_array_insert_els (el->end, pos, &extent, 1); |
| 428 | 901 } |
| 902 | |
| 903 /* Delete an extent from an extent list. */ | |
| 904 | |
| 905 static void | |
| 906 extent_list_delete (Extent_List *el, EXTENT extent) | |
| 907 { | |
| 908 int pos, foundp; | |
| 909 | |
| 910 pos = extent_list_locate (el, extent, 0, &foundp); | |
| 911 assert (foundp); | |
| 912 gap_array_delete_els (el->start, pos, 1); | |
| 913 pos = extent_list_locate (el, extent, 1, &foundp); | |
| 914 assert (foundp); | |
| 915 gap_array_delete_els (el->end, pos, 1); | |
| 916 } | |
| 917 | |
| 918 static void | |
| 919 extent_list_delete_all (Extent_List *el) | |
| 920 { | |
| 921 gap_array_delete_els (el->start, 0, GAP_ARRAY_NUM_ELS (el->start)); | |
| 922 gap_array_delete_els (el->end, 0, GAP_ARRAY_NUM_ELS (el->end)); | |
| 923 } | |
| 924 | |
| 925 static Extent_List_Marker * | |
| 926 extent_list_make_marker (Extent_List *el, int pos, int endp) | |
| 927 { | |
| 928 Extent_List_Marker *m; | |
| 929 | |
| 3092 | 930 #ifdef NEW_GC |
| 931 m = alloc_lrecord_type (Extent_List_Marker, &lrecord_extent_list_marker); | |
| 932 #else /* not NEW_GC */ | |
| 428 | 933 if (extent_list_marker_freelist) |
| 934 { | |
| 935 m = extent_list_marker_freelist; | |
| 936 extent_list_marker_freelist = extent_list_marker_freelist->next; | |
| 937 } | |
| 938 else | |
| 939 m = xnew (Extent_List_Marker); | |
| 3092 | 940 #endif /* not NEW_GC */ |
| 428 | 941 |
| 942 m->m = gap_array_make_marker (endp ? el->end : el->start, pos); | |
| 943 m->endp = endp; | |
| 944 m->next = el->markers; | |
| 945 el->markers = m; | |
| 946 return m; | |
| 947 } | |
| 948 | |
| 949 #define extent_list_move_marker(el, mkr, pos) \ | |
| 950 gap_array_move_marker((mkr)->endp ? (el)->end : (el)->start, (mkr)->m, pos) | |
| 951 | |
| 952 static void | |
| 953 extent_list_delete_marker (Extent_List *el, Extent_List_Marker *m) | |
| 954 { | |
| 955 Extent_List_Marker *p, *prev; | |
| 956 | |
| 957 for (prev = 0, p = el->markers; p && p != m; prev = p, p = p->next) | |
| 958 ; | |
| 959 assert (p); | |
| 960 if (prev) | |
| 961 prev->next = p->next; | |
| 962 else | |
| 963 el->markers = p->next; | |
| 3092 | 964 #ifdef NEW_GC |
| 965 gap_array_delete_marker (m->endp ? el->end : el->start, m->m); | |
| 966 #else /* not NEW_GC */ | |
| 428 | 967 m->next = extent_list_marker_freelist; |
| 968 extent_list_marker_freelist = m; | |
| 969 gap_array_delete_marker (m->endp ? el->end : el->start, m->m); | |
| 3092 | 970 #endif /* not NEW_GC */ |
| 428 | 971 } |
| 972 | |
| 973 #define extent_list_marker_pos(el, mkr) \ | |
| 974 gap_array_marker_pos ((mkr)->endp ? (el)->end : (el)->start, (mkr)->m) | |
| 975 | |
| 976 static Extent_List * | |
| 977 allocate_extent_list (void) | |
| 978 { | |
| 3092 | 979 #ifdef NEW_GC |
| 980 Extent_List *el = alloc_lrecord_type (Extent_List, &lrecord_extent_list); | |
| 981 #else /* not NEW_GC */ | |
| 428 | 982 Extent_List *el = xnew (Extent_List); |
| 3092 | 983 #endif /* not NEW_GC */ |
| 440 | 984 el->start = make_gap_array (sizeof (EXTENT)); |
| 985 el->end = make_gap_array (sizeof (EXTENT)); | |
| 428 | 986 el->markers = 0; |
| 987 return el; | |
| 988 } | |
| 989 | |
| 3092 | 990 #ifndef NEW_GC |
| 428 | 991 static void |
| 992 free_extent_list (Extent_List *el) | |
| 993 { | |
| 994 free_gap_array (el->start); | |
| 995 free_gap_array (el->end); | |
|
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4967
diff
changeset
|
996 xfree (el); |
| 428 | 997 } |
| 3092 | 998 #endif /* not NEW_GC */ |
| 428 | 999 |
| 1000 | |
| 1001 /************************************************************************/ | |
| 1002 /* Auxiliary extent structure */ | |
| 1003 /************************************************************************/ | |
| 1004 | |
| 1204 | 1005 static const struct memory_description extent_auxiliary_description[] ={ |
| 934 | 1006 { XD_LISP_OBJECT, offsetof (struct extent_auxiliary, begin_glyph) }, |
| 1007 { XD_LISP_OBJECT, offsetof (struct extent_auxiliary, end_glyph) }, | |
| 1008 { XD_LISP_OBJECT, offsetof (struct extent_auxiliary, parent) }, | |
| 1009 { XD_LISP_OBJECT, offsetof (struct extent_auxiliary, children) }, | |
| 1010 { XD_LISP_OBJECT, offsetof (struct extent_auxiliary, invisible) }, | |
| 1011 { XD_LISP_OBJECT, offsetof (struct extent_auxiliary, read_only) }, | |
| 1012 { XD_LISP_OBJECT, offsetof (struct extent_auxiliary, mouse_face) }, | |
| 1013 { XD_LISP_OBJECT, offsetof (struct extent_auxiliary, initial_redisplay_function) }, | |
| 1014 { XD_LISP_OBJECT, offsetof (struct extent_auxiliary, before_change_functions) }, | |
| 1015 { XD_LISP_OBJECT, offsetof (struct extent_auxiliary, after_change_functions) }, | |
| 1016 { XD_END } | |
| 1017 }; | |
| 428 | 1018 static Lisp_Object |
| 1019 mark_extent_auxiliary (Lisp_Object obj) | |
| 1020 { | |
| 1021 struct extent_auxiliary *data = XEXTENT_AUXILIARY (obj); | |
| 1022 mark_object (data->begin_glyph); | |
| 1023 mark_object (data->end_glyph); | |
| 1024 mark_object (data->invisible); | |
| 1025 mark_object (data->children); | |
| 1026 mark_object (data->read_only); | |
| 1027 mark_object (data->mouse_face); | |
| 1028 mark_object (data->initial_redisplay_function); | |
| 1029 mark_object (data->before_change_functions); | |
| 1030 mark_object (data->after_change_functions); | |
| 1031 return data->parent; | |
| 1032 } | |
| 1033 | |
| 934 | 1034 DEFINE_LRECORD_IMPLEMENTATION ("extent-auxiliary", extent_auxiliary, |
| 1035 0, /*dumpable-flag*/ | |
| 1036 mark_extent_auxiliary, internal_object_printer, | |
| 1204 | 1037 0, 0, 0, extent_auxiliary_description, |
| 1038 struct extent_auxiliary); | |
| 428 | 1039 void |
| 1040 allocate_extent_auxiliary (EXTENT ext) | |
| 1041 { | |
| 1042 Lisp_Object extent_aux; | |
| 2720 | 1043 struct extent_auxiliary *data = |
| 3017 | 1044 ALLOC_LCRECORD_TYPE (struct extent_auxiliary, &lrecord_extent_auxiliary); |
| 1045 COPY_LCRECORD (data, &extent_auxiliary_defaults); | |
| 793 | 1046 extent_aux = wrap_extent_auxiliary (data); |
| 428 | 1047 ext->plist = Fcons (extent_aux, ext->plist); |
| 1048 ext->flags.has_aux = 1; | |
| 1049 } | |
| 1050 | |
| 1051 | |
| 1052 /************************************************************************/ | |
| 1053 /* Extent info structure */ | |
| 1054 /************************************************************************/ | |
| 1055 | |
| 1056 /* An extent-info structure consists of a list of the buffer or string's | |
| 1057 extents and a "stack of extents" that lists all of the extents over | |
| 1058 a particular position. The stack-of-extents info is used for | |
| 1059 optimization purposes -- it basically caches some info that might | |
| 1060 be expensive to compute. Certain otherwise hard computations are easy | |
| 1061 given the stack of extents over a particular position, and if the | |
| 1062 stack of extents over a nearby position is known (because it was | |
| 1063 calculated at some prior point in time), it's easy to move the stack | |
| 1064 of extents to the proper position. | |
| 1065 | |
| 1066 Given that the stack of extents is an optimization, and given that | |
| 1067 it requires memory, a string's stack of extents is wiped out each | |
| 1068 time a garbage collection occurs. Therefore, any time you retrieve | |
| 1069 the stack of extents, it might not be there. If you need it to | |
| 1070 be there, use the _force version. | |
| 1071 | |
| 1072 Similarly, a string may or may not have an extent_info structure. | |
| 1073 (Generally it won't if there haven't been any extents added to the | |
| 1074 string.) So use the _force version if you need the extent_info | |
| 1075 structure to be there. */ | |
| 1076 | |
| 1077 static struct stack_of_extents *allocate_soe (void); | |
| 3092 | 1078 #ifndef NEW_GC |
| 428 | 1079 static void free_soe (struct stack_of_extents *soe); |
| 3092 | 1080 #endif /* not NEW_GC */ |
| 428 | 1081 static void soe_invalidate (Lisp_Object obj); |
| 1082 | |
| 1204 | 1083 extern const struct sized_memory_description gap_array_marker_description; |
| 1084 | |
| 1085 static const struct memory_description gap_array_marker_description_1[] = { | |
| 3092 | 1086 #ifdef NEW_GC |
| 1087 { XD_LISP_OBJECT, offsetof (Gap_Array_Marker, next) }, | |
| 1088 #else /* not NEW_GC */ | |
| 2367 | 1089 { XD_BLOCK_PTR, offsetof (Gap_Array_Marker, next), 1, |
| 2551 | 1090 { &gap_array_marker_description } }, |
| 3092 | 1091 #endif /* not NEW_GC */ |
| 1204 | 1092 { XD_END } |
| 1093 }; | |
| 1094 | |
| 3092 | 1095 #ifdef NEW_GC |
| 1096 DEFINE_LRECORD_IMPLEMENTATION ("gap-array-marker", gap_array_marker, | |
| 1097 0, /*dumpable-flag*/ | |
| 1098 0, 0, 0, 0, 0, | |
| 1099 gap_array_marker_description_1, | |
| 1100 struct gap_array_marker); | |
| 1101 #else /* not NEW_GC */ | |
| 1204 | 1102 const struct sized_memory_description gap_array_marker_description = { |
| 1103 sizeof (Gap_Array_Marker), | |
| 1104 gap_array_marker_description_1 | |
| 934 | 1105 }; |
| 3092 | 1106 #endif /* not NEW_GC */ |
| 934 | 1107 |
| 1204 | 1108 static const struct memory_description lispobj_gap_array_description_1[] = { |
| 2881 | 1109 { XD_ELEMCOUNT, offsetof (Gap_Array, gap) }, |
| 1110 { XD_BYTECOUNT, offsetof (Gap_Array, offset_past_gap) }, | |
| 1111 { XD_ELEMCOUNT, offsetof (Gap_Array, els_past_gap) }, | |
| 3092 | 1112 #ifdef NEW_GC |
| 1113 { XD_LISP_OBJECT, offsetof (Gap_Array, markers) }, | |
| 1114 #else /* not NEW_GC */ | |
| 2367 | 1115 { XD_BLOCK_PTR, offsetof (Gap_Array, markers), 1, |
| 2551 | 1116 { &gap_array_marker_description }, XD_FLAG_NO_KKCC }, |
| 3092 | 1117 #endif /* not NEW_GC */ |
| 2367 | 1118 { XD_BLOCK_ARRAY, offsetof (Gap_Array, array), XD_INDIRECT (0, 0), |
| 2551 | 1119 { &lisp_object_description } }, |
| 2367 | 1120 { XD_BLOCK_ARRAY, XD_INDIRECT (1, offsetof (Gap_Array, array)), |
| 2551 | 1121 XD_INDIRECT (2, 0), { &lisp_object_description } }, |
| 934 | 1122 { XD_END } |
| 1123 }; | |
| 1204 | 1124 |
| 3092 | 1125 #ifdef NEW_GC |
| 1126 | |
| 1127 static Bytecount | |
| 1128 size_gap_array (const void *lheader) | |
| 1129 { | |
| 1130 Gap_Array *ga = (Gap_Array *) lheader; | |
| 1131 return offsetof (Gap_Array, array) + (ga->numels + ga->gapsize) * ga->elsize; | |
| 1132 } | |
| 1133 | |
| 1134 DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION ("gap-array", gap_array, | |
| 1135 0, /*dumpable-flag*/ | |
| 1136 0, 0, 0, 0, 0, | |
| 1137 lispobj_gap_array_description_1, | |
| 1138 size_gap_array, | |
| 1139 struct gap_array); | |
| 1140 #else /* not NEW_GC */ | |
| 1204 | 1141 static const struct sized_memory_description lispobj_gap_array_description = { |
| 1142 sizeof (Gap_Array), | |
| 1143 lispobj_gap_array_description_1 | |
| 1144 }; | |
| 1145 | |
| 1146 extern const struct sized_memory_description extent_list_marker_description; | |
| 3092 | 1147 #endif /* not NEW_GC */ |
| 1204 | 1148 |
| 1149 static const struct memory_description extent_list_marker_description_1[] = { | |
| 3092 | 1150 #ifdef NEW_GC |
| 1151 { XD_LISP_OBJECT, offsetof (Extent_List_Marker, m) }, | |
| 1152 { XD_LISP_OBJECT, offsetof (Extent_List_Marker, next) }, | |
| 1153 #else /* not NEW_GC */ | |
| 2367 | 1154 { XD_BLOCK_PTR, offsetof (Extent_List_Marker, m), 1, |
| 2551 | 1155 { &gap_array_marker_description } }, |
| 2367 | 1156 { XD_BLOCK_PTR, offsetof (Extent_List_Marker, next), 1, |
| 2551 | 1157 { &extent_list_marker_description } }, |
| 3092 | 1158 #endif /* not NEW_GC */ |
| 1204 | 1159 { XD_END } |
| 1160 }; | |
| 1161 | |
| 3092 | 1162 #ifdef NEW_GC |
| 1163 DEFINE_LRECORD_IMPLEMENTATION ("extent-list-marker", extent_list_marker, | |
| 1164 0, /*dumpable-flag*/ | |
| 1165 0, 0, 0, 0, 0, | |
| 1166 extent_list_marker_description_1, | |
| 1167 struct extent_list_marker); | |
| 1168 #else /* not NEW_GC */ | |
| 1204 | 1169 const struct sized_memory_description extent_list_marker_description = { |
| 1170 sizeof (Extent_List_Marker), | |
| 1171 extent_list_marker_description_1 | |
| 1172 }; | |
| 3092 | 1173 #endif /* not NEW_GC */ |
| 1204 | 1174 |
| 1175 static const struct memory_description extent_list_description_1[] = { | |
| 3092 | 1176 #ifdef NEW_GC |
| 1177 { XD_LISP_OBJECT, offsetof (Extent_List, start) }, | |
| 1178 { XD_LISP_OBJECT, offsetof (Extent_List, end) }, | |
| 1179 { XD_LISP_OBJECT, offsetof (Extent_List, markers) }, | |
| 1180 #else /* not NEW_GC */ | |
| 2551 | 1181 { XD_BLOCK_PTR, offsetof (Extent_List, start), 1, |
| 1182 { &lispobj_gap_array_description } }, | |
| 1183 { XD_BLOCK_PTR, offsetof (Extent_List, end), 1, | |
| 1184 { &lispobj_gap_array_description }, XD_FLAG_NO_KKCC }, | |
| 1185 { XD_BLOCK_PTR, offsetof (Extent_List, markers), 1, | |
| 1186 { &extent_list_marker_description }, XD_FLAG_NO_KKCC }, | |
| 3092 | 1187 #endif /* not NEW_GC */ |
| 1204 | 1188 { XD_END } |
| 1189 }; | |
| 1190 | |
| 3092 | 1191 #ifdef NEW_GC |
| 1192 DEFINE_LRECORD_IMPLEMENTATION ("extent-list", extent_list, | |
| 1193 0, /*dumpable-flag*/ | |
| 1194 0, 0, 0, 0, 0, | |
| 1195 extent_list_description_1, | |
| 1196 struct extent_list); | |
| 1197 #else /* not NEW_GC */ | |
| 1204 | 1198 static const struct sized_memory_description extent_list_description = { |
| 1199 sizeof (Extent_List), | |
| 1200 extent_list_description_1 | |
| 1201 }; | |
| 3092 | 1202 #endif /* not NEW_GC */ |
| 1204 | 1203 |
| 1204 static const struct memory_description stack_of_extents_description_1[] = { | |
| 3092 | 1205 #ifdef NEW_GC |
| 1206 { XD_LISP_OBJECT, offsetof (Stack_Of_Extents, extents) }, | |
| 1207 #else /* not NEW_GC */ | |
| 2551 | 1208 { XD_BLOCK_PTR, offsetof (Stack_Of_Extents, extents), 1, |
| 1209 { &extent_list_description } }, | |
| 3092 | 1210 #endif /* not NEW_GC */ |
| 1204 | 1211 { XD_END } |
| 1212 }; | |
| 1213 | |
| 3092 | 1214 #ifdef NEW_GC |
| 1215 DEFINE_LRECORD_IMPLEMENTATION ("stack-of-extents", stack_of_extents, | |
| 1216 0, /*dumpable-flag*/ | |
| 1217 0, 0, 0, 0, 0, | |
| 1218 stack_of_extents_description_1, | |
| 1219 struct stack_of_extents); | |
| 1220 #else /* not NEW_GC */ | |
| 1204 | 1221 static const struct sized_memory_description stack_of_extents_description = { |
| 1222 sizeof (Stack_Of_Extents), | |
| 1223 stack_of_extents_description_1 | |
| 1224 }; | |
| 3092 | 1225 #endif /* not NEW_GC */ |
| 1204 | 1226 |
| 1227 static const struct memory_description extent_info_description [] = { | |
| 3092 | 1228 #ifdef NEW_GC |
| 1229 { XD_LISP_OBJECT, offsetof (struct extent_info, extents) }, | |
| 1230 { XD_LISP_OBJECT, offsetof (struct extent_info, soe) }, | |
| 1231 #else /* not NEW_GC */ | |
| 2367 | 1232 { XD_BLOCK_PTR, offsetof (struct extent_info, extents), 1, |
| 2551 | 1233 { &extent_list_description } }, |
| 2367 | 1234 { XD_BLOCK_PTR, offsetof (struct extent_info, soe), 1, |
| 2551 | 1235 { &stack_of_extents_description }, XD_FLAG_NO_KKCC }, |
| 3092 | 1236 #endif /* not NEW_GC */ |
| 1204 | 1237 { XD_END } |
| 1238 }; | |
| 934 | 1239 |
| 428 | 1240 static Lisp_Object |
| 1241 mark_extent_info (Lisp_Object obj) | |
| 1242 { | |
| 1243 struct extent_info *data = (struct extent_info *) XEXTENT_INFO (obj); | |
| 1244 int i; | |
| 1245 Extent_List *list = data->extents; | |
| 1246 | |
| 1247 /* Vbuffer_defaults and Vbuffer_local_symbols are buffer-like | |
| 1248 objects that are created specially and never have their extent | |
| 1249 list initialized (or rather, it is set to zero in | |
| 1250 nuke_all_buffer_slots()). However, these objects get | |
| 1251 garbage-collected so we have to deal. | |
| 1252 | |
| 1253 (Also the list can be zero when we're dealing with a destroyed | |
| 1254 buffer.) */ | |
| 1255 | |
| 1256 if (list) | |
| 1257 { | |
| 1258 for (i = 0; i < extent_list_num_els (list); i++) | |
| 1259 { | |
| 1260 struct extent *extent = extent_list_at (list, i, 0); | |
| 793 | 1261 Lisp_Object exobj = wrap_extent (extent); |
| 1262 | |
| 428 | 1263 mark_object (exobj); |
| 1264 } | |
| 1265 } | |
| 1266 | |
| 1267 return Qnil; | |
| 1268 } | |
| 1269 | |
| 3263 | 1270 #ifdef NEW_GC |
| 1271 DEFINE_LRECORD_IMPLEMENTATION ("extent-info", extent_info, | |
| 1272 0, /*dumpable-flag*/ | |
| 1273 mark_extent_info, internal_object_printer, | |
| 1274 0, 0, 0, | |
| 1275 extent_info_description, | |
| 1276 struct extent_info); | |
| 1277 #else /* not NEW_GC */ | |
| 428 | 1278 static void |
| 1279 finalize_extent_info (void *header, int for_disksave) | |
| 1280 { | |
| 1281 struct extent_info *data = (struct extent_info *) header; | |
| 1282 | |
| 1283 if (for_disksave) | |
| 1284 return; | |
| 1285 | |
| 3092 | 1286 data->soe = 0; |
| 1287 data->extents = 0; | |
| 428 | 1288 if (data->soe) |
| 1289 { | |
| 1290 free_soe (data->soe); | |
| 1291 data->soe = 0; | |
| 1292 } | |
| 1293 if (data->extents) | |
| 1294 { | |
| 1295 free_extent_list (data->extents); | |
| 1296 data->extents = 0; | |
| 1297 } | |
| 1298 } | |
| 1299 | |
| 934 | 1300 DEFINE_LRECORD_IMPLEMENTATION ("extent-info", extent_info, |
| 1301 0, /*dumpable-flag*/ | |
| 1302 mark_extent_info, internal_object_printer, | |
| 1303 finalize_extent_info, 0, 0, | |
| 1204 | 1304 extent_info_description, |
| 934 | 1305 struct extent_info); |
| 3263 | 1306 #endif /* not NEW_GC */ |
| 428 | 1307 |
| 1308 static Lisp_Object | |
| 1309 allocate_extent_info (void) | |
| 1310 { | |
| 1311 Lisp_Object extent_info; | |
| 1312 struct extent_info *data = | |
| 3017 | 1313 ALLOC_LCRECORD_TYPE (struct extent_info, &lrecord_extent_info); |
| 428 | 1314 |
| 793 | 1315 extent_info = wrap_extent_info (data); |
| 428 | 1316 data->extents = allocate_extent_list (); |
| 1317 data->soe = 0; | |
| 1318 return extent_info; | |
| 1319 } | |
| 1320 | |
| 1321 void | |
| 1322 flush_cached_extent_info (Lisp_Object extent_info) | |
| 1323 { | |
| 1324 struct extent_info *data = XEXTENT_INFO (extent_info); | |
| 1325 | |
| 1326 if (data->soe) | |
| 1327 { | |
| 3092 | 1328 #ifndef NEW_GC |
| 428 | 1329 free_soe (data->soe); |
| 3092 | 1330 #endif /* not NEW_GC */ |
| 428 | 1331 data->soe = 0; |
| 1332 } | |
| 1333 } | |
| 1334 | |
| 1335 | |
| 1336 /************************************************************************/ | |
| 1337 /* Buffer/string extent primitives */ | |
| 1338 /************************************************************************/ | |
| 1339 | |
| 1340 /* The functions in this section are the ONLY ones that should know | |
| 1341 about the internal implementation of the extent lists. Other functions | |
| 1342 should only know that there are two orderings on extents, the "display" | |
| 1343 order (sorted by start position, basically) and the e-order (sorted | |
| 1344 by end position, basically), and that certain operations are provided | |
| 1345 to manipulate the list. */ | |
| 1346 | |
| 1347 /* ------------------------------- */ | |
| 1348 /* basic primitives */ | |
| 1349 /* ------------------------------- */ | |
| 1350 | |
| 1351 static Lisp_Object | |
| 1352 decode_buffer_or_string (Lisp_Object object) | |
| 1353 { | |
| 1354 if (NILP (object)) | |
| 793 | 1355 object = wrap_buffer (current_buffer); |
| 428 | 1356 else if (BUFFERP (object)) |
| 1357 CHECK_LIVE_BUFFER (object); | |
| 1358 else if (STRINGP (object)) | |
| 1359 ; | |
| 1360 else | |
| 1361 dead_wrong_type_argument (Qbuffer_or_string_p, object); | |
| 1362 | |
| 1363 return object; | |
| 1364 } | |
| 1365 | |
| 1366 EXTENT | |
| 1367 extent_ancestor_1 (EXTENT e) | |
| 1368 { | |
| 1369 while (e->flags.has_parent) | |
| 1370 { | |
| 1371 /* There should be no circularities except in case of a logic | |
| 1372 error somewhere in the extent code */ | |
| 1373 e = XEXTENT (XEXTENT_AUXILIARY (XCAR (e->plist))->parent); | |
| 1374 } | |
| 1375 return e; | |
| 1376 } | |
| 1377 | |
| 1378 /* Given an extent object (string or buffer or nil), return its extent info. | |
| 1379 This may be 0 for a string. */ | |
| 1380 | |
| 1381 static struct extent_info * | |
| 1382 buffer_or_string_extent_info (Lisp_Object object) | |
| 1383 { | |
| 1384 if (STRINGP (object)) | |
| 1385 { | |
| 793 | 1386 Lisp_Object plist = XSTRING_PLIST (object); |
| 428 | 1387 if (!CONSP (plist) || !EXTENT_INFOP (XCAR (plist))) |
| 1388 return 0; | |
| 1389 return XEXTENT_INFO (XCAR (plist)); | |
| 1390 } | |
| 1391 else if (NILP (object)) | |
| 1392 return 0; | |
| 1393 else | |
| 1394 return XEXTENT_INFO (XBUFFER (object)->extent_info); | |
| 1395 } | |
| 1396 | |
| 1397 /* Given a string or buffer, return its extent list. This may be | |
| 1398 0 for a string. */ | |
| 1399 | |
| 1400 static Extent_List * | |
| 1401 buffer_or_string_extent_list (Lisp_Object object) | |
| 1402 { | |
| 1403 struct extent_info *info = buffer_or_string_extent_info (object); | |
| 1404 | |
| 1405 if (!info) | |
| 1406 return 0; | |
| 1407 return info->extents; | |
| 1408 } | |
| 1409 | |
| 1410 /* Given a string or buffer, return its extent info. If it's not there, | |
| 1411 create it. */ | |
| 1412 | |
| 1413 static struct extent_info * | |
| 1414 buffer_or_string_extent_info_force (Lisp_Object object) | |
| 1415 { | |
| 1416 struct extent_info *info = buffer_or_string_extent_info (object); | |
| 1417 | |
| 1418 if (!info) | |
| 1419 { | |
| 1420 Lisp_Object extent_info; | |
| 1421 | |
| 1422 assert (STRINGP (object)); /* should never happen for buffers -- | |
| 1423 the only buffers without an extent | |
| 1424 info are those after finalization, | |
| 1425 destroyed buffers, or special | |
| 1426 Lisp-inaccessible buffer objects. */ | |
| 1427 extent_info = allocate_extent_info (); | |
| 793 | 1428 XSTRING_PLIST (object) = Fcons (extent_info, XSTRING_PLIST (object)); |
| 428 | 1429 return XEXTENT_INFO (extent_info); |
| 1430 } | |
| 1431 | |
| 1432 return info; | |
| 1433 } | |
| 1434 | |
| 1435 /* Detach all the extents in OBJECT. Called from redisplay. */ | |
| 1436 | |
| 1437 void | |
| 1438 detach_all_extents (Lisp_Object object) | |
| 1439 { | |
| 1440 struct extent_info *data = buffer_or_string_extent_info (object); | |
| 1441 | |
| 1442 if (data) | |
| 1443 { | |
| 1444 if (data->extents) | |
| 1445 { | |
| 1446 int i; | |
| 1447 | |
| 1448 for (i = 0; i < extent_list_num_els (data->extents); i++) | |
| 1449 { | |
| 1450 EXTENT e = extent_list_at (data->extents, i, 0); | |
| 1451 /* No need to do detach_extent(). Just nuke the damn things, | |
| 1452 which results in the equivalent but faster. */ | |
| 1453 set_extent_start (e, -1); | |
| 1454 set_extent_end (e, -1); | |
| 1455 } | |
| 3466 | 1456 |
| 1457 /* But we need to clear all the lists containing extents or | |
| 1458 havoc will result. */ | |
| 1459 extent_list_delete_all (data->extents); | |
| 428 | 1460 } |
| 1461 soe_invalidate (object); | |
| 1462 } | |
| 1463 } | |
| 1464 | |
| 1465 | |
| 1466 void | |
| 1467 init_buffer_extents (struct buffer *b) | |
| 1468 { | |
| 1469 b->extent_info = allocate_extent_info (); | |
| 1470 } | |
| 1471 | |
| 1472 void | |
| 1473 uninit_buffer_extents (struct buffer *b) | |
| 1474 { | |
| 3092 | 1475 #ifndef NEW_GC |
| 428 | 1476 struct extent_info *data = XEXTENT_INFO (b->extent_info); |
| 3092 | 1477 #endif /* not NEW_GC */ |
| 428 | 1478 |
| 1479 /* Don't destroy the extents here -- there may still be children | |
| 1480 extents pointing to the extents. */ | |
| 771 | 1481 detach_all_extents (wrap_buffer (b)); |
| 3092 | 1482 #ifndef NEW_GC |
| 428 | 1483 finalize_extent_info (data, 0); |
| 3092 | 1484 #endif /* not NEW_GC */ |
| 428 | 1485 } |
| 1486 | |
| 1487 /* Retrieve the extent list that an extent is a member of; the | |
| 1488 return value will never be 0 except in destroyed buffers (in which | |
| 1489 case the only extents that can refer to this buffer are detached | |
| 1490 ones). */ | |
| 1491 | |
| 1492 #define extent_extent_list(e) buffer_or_string_extent_list (extent_object (e)) | |
| 1493 | |
| 1494 /* ------------------------------- */ | |
| 1495 /* stack of extents */ | |
| 1496 /* ------------------------------- */ | |
| 1497 | |
| 1498 #ifdef ERROR_CHECK_EXTENTS | |
| 1499 | |
| 771 | 1500 /* See unicode.c for more about sledgehammer checks */ |
| 1501 | |
| 428 | 1502 void |
| 1503 sledgehammer_extent_check (Lisp_Object object) | |
| 1504 { | |
| 1505 int i; | |
| 1506 int endp; | |
| 1507 Extent_List *el = buffer_or_string_extent_list (object); | |
| 1508 struct buffer *buf = 0; | |
| 1509 | |
| 1510 if (!el) | |
| 1511 return; | |
| 1512 | |
| 1513 if (BUFFERP (object)) | |
| 1514 buf = XBUFFER (object); | |
| 1515 | |
| 1516 for (endp = 0; endp < 2; endp++) | |
| 1517 for (i = 1; i < extent_list_num_els (el); i++) | |
| 1518 { | |
| 1519 EXTENT e1 = extent_list_at (el, i-1, endp); | |
| 1520 EXTENT e2 = extent_list_at (el, i, endp); | |
| 1521 if (buf) | |
| 1522 { | |
| 1523 assert (extent_start (e1) <= buf->text->gpt || | |
| 1524 extent_start (e1) > buf->text->gpt + buf->text->gap_size); | |
| 1525 assert (extent_end (e1) <= buf->text->gpt || | |
| 1526 extent_end (e1) > buf->text->gpt + buf->text->gap_size); | |
| 1527 } | |
| 1528 assert (extent_start (e1) <= extent_end (e1)); | |
| 1529 assert (endp ? (EXTENT_E_LESS_EQUAL (e1, e2)) : | |
| 1530 (EXTENT_LESS_EQUAL (e1, e2))); | |
| 1531 } | |
| 1532 } | |
| 1533 | |
| 1534 #endif | |
| 1535 | |
| 1536 static Stack_Of_Extents * | |
| 1537 buffer_or_string_stack_of_extents (Lisp_Object object) | |
| 1538 { | |
| 1539 struct extent_info *info = buffer_or_string_extent_info (object); | |
| 1540 if (!info) | |
| 1541 return 0; | |
| 1542 return info->soe; | |
| 1543 } | |
| 1544 | |
| 1545 static Stack_Of_Extents * | |
| 1546 buffer_or_string_stack_of_extents_force (Lisp_Object object) | |
| 1547 { | |
| 1548 struct extent_info *info = buffer_or_string_extent_info_force (object); | |
| 1549 if (!info->soe) | |
| 1550 info->soe = allocate_soe (); | |
| 1551 return info->soe; | |
| 1552 } | |
| 1553 | |
| 983 | 1554 /* #### don't even think of #define'ing this, the prototype of |
| 1555 print_extent_1 has changed! */ | |
| 428 | 1556 /* #define SOE_DEBUG */ |
| 1557 | |
| 1558 #ifdef SOE_DEBUG | |
| 1559 | |
| 1560 static void print_extent_1 (char *buf, Lisp_Object extent); | |
| 1561 | |
| 1562 static void | |
| 1563 print_extent_2 (EXTENT e) | |
| 1564 { | |
| 1565 Lisp_Object extent; | |
| 1566 char buf[200]; | |
| 1567 | |
| 793 | 1568 extent = wrap_extent (e); |
| 428 | 1569 print_extent_1 (buf, extent); |
| 1570 fputs (buf, stdout); | |
| 1571 } | |
| 1572 | |
| 1573 static void | |
| 1574 soe_dump (Lisp_Object obj) | |
| 1575 { | |
| 1576 int i; | |
| 1577 Stack_Of_Extents *soe = buffer_or_string_stack_of_extents (obj); | |
| 1578 Extent_List *sel; | |
| 1579 int endp; | |
| 1580 | |
| 1581 if (!soe) | |
| 1582 { | |
| 1583 printf ("No SOE"); | |
| 1584 return; | |
| 1585 } | |
| 1586 sel = soe->extents; | |
| 826 | 1587 printf ("SOE pos is %d (memxpos %d)\n", |
| 428 | 1588 soe->pos < 0 ? soe->pos : |
| 826 | 1589 buffer_or_string_memxpos_to_bytexpos (obj, soe->pos), |
| 428 | 1590 soe->pos); |
| 1591 for (endp = 0; endp < 2; endp++) | |
| 1592 { | |
| 1593 printf (endp ? "SOE end:" : "SOE start:"); | |
| 1594 for (i = 0; i < extent_list_num_els (sel); i++) | |
| 1595 { | |
| 1596 EXTENT e = extent_list_at (sel, i, endp); | |
| 1597 putchar ('\t'); | |
| 1598 print_extent_2 (e); | |
| 1599 } | |
| 1600 putchar ('\n'); | |
| 1601 } | |
| 1602 putchar ('\n'); | |
| 1603 } | |
| 1604 | |
| 1605 #endif | |
| 1606 | |
| 1607 /* Insert EXTENT into OBJ's stack of extents, if necessary. */ | |
| 1608 | |
| 1609 static void | |
| 1610 soe_insert (Lisp_Object obj, EXTENT extent) | |
| 1611 { | |
| 1612 Stack_Of_Extents *soe = buffer_or_string_stack_of_extents (obj); | |
| 1613 | |
| 1614 #ifdef SOE_DEBUG | |
| 1615 printf ("Inserting into SOE: "); | |
| 1616 print_extent_2 (extent); | |
| 1617 putchar ('\n'); | |
| 1618 #endif | |
| 1619 if (!soe || soe->pos < extent_start (extent) || | |
| 1620 soe->pos > extent_end (extent)) | |
| 1621 { | |
| 1622 #ifdef SOE_DEBUG | |
| 1623 printf ("(not needed)\n\n"); | |
| 1624 #endif | |
| 1625 return; | |
| 1626 } | |
| 1627 extent_list_insert (soe->extents, extent); | |
| 1628 #ifdef SOE_DEBUG | |
| 1629 puts ("SOE afterwards is:"); | |
| 1630 soe_dump (obj); | |
| 1631 #endif | |
| 1632 } | |
| 1633 | |
| 1634 /* Delete EXTENT from OBJ's stack of extents, if necessary. */ | |
| 1635 | |
| 1636 static void | |
| 1637 soe_delete (Lisp_Object obj, EXTENT extent) | |
| 1638 { | |
| 1639 Stack_Of_Extents *soe = buffer_or_string_stack_of_extents (obj); | |
| 1640 | |
| 1641 #ifdef SOE_DEBUG | |
| 1642 printf ("Deleting from SOE: "); | |
| 1643 print_extent_2 (extent); | |
| 1644 putchar ('\n'); | |
| 1645 #endif | |
| 1646 if (!soe || soe->pos < extent_start (extent) || | |
| 1647 soe->pos > extent_end (extent)) | |
| 1648 { | |
| 1649 #ifdef SOE_DEBUG | |
| 1650 puts ("(not needed)\n"); | |
| 1651 #endif | |
| 1652 return; | |
| 1653 } | |
| 1654 extent_list_delete (soe->extents, extent); | |
| 1655 #ifdef SOE_DEBUG | |
| 1656 puts ("SOE afterwards is:"); | |
| 1657 soe_dump (obj); | |
| 1658 #endif | |
| 1659 } | |
| 1660 | |
| 1661 /* Move OBJ's stack of extents to lie over the specified position. */ | |
| 1662 | |
| 1663 static void | |
| 826 | 1664 soe_move (Lisp_Object obj, Memxpos pos) |
| 428 | 1665 { |
| 1666 Stack_Of_Extents *soe = buffer_or_string_stack_of_extents_force (obj); | |
| 1667 Extent_List *sel = soe->extents; | |
| 1668 int numsoe = extent_list_num_els (sel); | |
| 1669 Extent_List *bel = buffer_or_string_extent_list (obj); | |
| 1670 int direction; | |
| 1671 int endp; | |
| 1672 | |
| 1673 #ifdef ERROR_CHECK_EXTENTS | |
| 1674 assert (bel); | |
| 1675 #endif | |
| 1676 | |
| 1677 #ifdef SOE_DEBUG | |
| 826 | 1678 printf ("Moving SOE from %d (memxpos %d) to %d (memxpos %d)\n", |
| 428 | 1679 soe->pos < 0 ? soe->pos : |
| 826 | 1680 buffer_or_string_memxpos_to_bytexpos (obj, soe->pos), soe->pos, |
| 1681 buffer_or_string_memxpos_to_bytexpos (obj, pos), pos); | |
| 428 | 1682 #endif |
| 1683 if (soe->pos < pos) | |
| 1684 { | |
| 1685 direction = 1; | |
| 1686 endp = 0; | |
| 1687 } | |
| 1688 else if (soe->pos > pos) | |
| 1689 { | |
| 1690 direction = -1; | |
| 1691 endp = 1; | |
| 1692 } | |
| 1693 else | |
| 1694 { | |
| 1695 #ifdef SOE_DEBUG | |
| 1696 puts ("(not needed)\n"); | |
| 1697 #endif | |
| 1698 return; | |
| 1699 } | |
| 1700 | |
| 1701 /* For DIRECTION = 1: Any extent that overlaps POS is either in the | |
| 1702 SOE (if the extent starts at or before SOE->POS) or is greater | |
| 1703 (in the display order) than any extent in the SOE (if it starts | |
| 1704 after SOE->POS). | |
| 1705 | |
| 1706 For DIRECTION = -1: Any extent that overlaps POS is either in the | |
| 1707 SOE (if the extent ends at or after SOE->POS) or is less (in the | |
| 1708 e-order) than any extent in the SOE (if it ends before SOE->POS). | |
| 1709 | |
| 1710 We proceed in two stages: | |
| 1711 | |
| 1712 1) delete all extents in the SOE that don't overlap POS. | |
| 1713 2) insert all extents into the SOE that start (or end, when | |
| 1714 DIRECTION = -1) in (SOE->POS, POS] and that overlap | |
| 1715 POS. (Don't include SOE->POS in the range because those | |
| 1716 extents would already be in the SOE.) | |
| 1717 */ | |
| 1718 | |
| 1719 /* STAGE 1. */ | |
| 1720 | |
| 1721 if (numsoe > 0) | |
| 1722 { | |
| 1723 /* Delete all extents in the SOE that don't overlap POS. | |
| 1724 This is all extents that end before (or start after, | |
| 1725 if DIRECTION = -1) POS. | |
| 1726 */ | |
| 1727 | |
| 1728 /* Deleting extents from the SOE is tricky because it changes | |
| 1729 the positions of extents. If we are deleting in the forward | |
| 1730 direction we have to call extent_list_at() on the same position | |
| 1731 over and over again because positions after the deleted element | |
| 1732 get shifted back by 1. To make life simplest, we delete forward | |
| 1733 irrespective of DIRECTION. | |
| 1734 */ | |
| 1735 int start, end; | |
| 1736 int i; | |
| 1737 | |
| 1738 if (direction > 0) | |
| 1739 { | |
| 1740 start = 0; | |
| 1741 end = extent_list_locate_from_pos (sel, pos, 1); | |
| 1742 } | |
| 1743 else | |
| 1744 { | |
| 1745 start = extent_list_locate_from_pos (sel, pos+1, 0); | |
| 1746 end = numsoe; | |
| 1747 } | |
| 1748 | |
| 1749 for (i = start; i < end; i++) | |
| 1750 extent_list_delete (sel, extent_list_at (sel, start /* see above */, | |
| 1751 !endp)); | |
| 1752 } | |
| 1753 | |
| 1754 /* STAGE 2. */ | |
| 1755 | |
| 1756 { | |
| 1757 int start_pos; | |
| 1758 | |
| 1759 if (direction < 0) | |
| 1760 start_pos = extent_list_locate_from_pos (bel, soe->pos, endp) - 1; | |
| 1761 else | |
| 1762 start_pos = extent_list_locate_from_pos (bel, soe->pos + 1, endp); | |
| 1763 | |
| 1764 for (; start_pos >= 0 && start_pos < extent_list_num_els (bel); | |
| 1765 start_pos += direction) | |
| 1766 { | |
| 1767 EXTENT e = extent_list_at (bel, start_pos, endp); | |
| 1768 if ((direction > 0) ? | |
| 1769 (extent_start (e) > pos) : | |
| 1770 (extent_end (e) < pos)) | |
| 1771 break; /* All further extents lie on the far side of POS | |
| 1772 and thus can't overlap. */ | |
| 1773 if ((direction > 0) ? | |
| 1774 (extent_end (e) >= pos) : | |
| 1775 (extent_start (e) <= pos)) | |
| 1776 extent_list_insert (sel, e); | |
| 1777 } | |
| 1778 } | |
| 1779 | |
| 1780 soe->pos = pos; | |
| 1781 #ifdef SOE_DEBUG | |
| 1782 puts ("SOE afterwards is:"); | |
| 1783 soe_dump (obj); | |
| 1784 #endif | |
| 1785 } | |
| 1786 | |
| 1787 static void | |
| 1788 soe_invalidate (Lisp_Object obj) | |
| 1789 { | |
| 1790 Stack_Of_Extents *soe = buffer_or_string_stack_of_extents (obj); | |
| 1791 | |
| 1792 if (soe) | |
| 1793 { | |
| 1794 extent_list_delete_all (soe->extents); | |
| 1795 soe->pos = -1; | |
| 1796 } | |
| 1797 } | |
| 1798 | |
| 1799 static struct stack_of_extents * | |
| 1800 allocate_soe (void) | |
| 1801 { | |
| 3092 | 1802 #ifdef NEW_GC |
| 1803 struct stack_of_extents *soe = | |
| 1804 alloc_lrecord_type (struct stack_of_extents, &lrecord_stack_of_extents); | |
| 1805 #else /* not NEW_GC */ | |
| 428 | 1806 struct stack_of_extents *soe = xnew_and_zero (struct stack_of_extents); |
| 3092 | 1807 #endif /* not NEW_GC */ |
| 428 | 1808 soe->extents = allocate_extent_list (); |
| 1809 soe->pos = -1; | |
| 1810 return soe; | |
| 1811 } | |
| 1812 | |
| 3092 | 1813 #ifndef NEW_GC |
| 428 | 1814 static void |
| 1815 free_soe (struct stack_of_extents *soe) | |
| 1816 { | |
| 1817 free_extent_list (soe->extents); | |
|
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4967
diff
changeset
|
1818 xfree (soe); |
| 428 | 1819 } |
| 3092 | 1820 #endif /* not NEW_GC */ |
| 428 | 1821 |
| 1822 /* ------------------------------- */ | |
| 1823 /* other primitives */ | |
| 1824 /* ------------------------------- */ | |
| 1825 | |
| 1826 /* Return the start (endp == 0) or end (endp == 1) of an extent as | |
| 1827 a byte index. If you want the value as a memory index, use | |
| 1828 extent_endpoint(). If you want the value as a buffer position, | |
| 826 | 1829 use extent_endpoint_char(). */ |
| 1830 | |
| 1831 Bytexpos | |
| 1832 extent_endpoint_byte (EXTENT extent, int endp) | |
| 1833 { | |
| 1834 assert (EXTENT_LIVE_P (extent)); | |
| 1835 assert (!extent_detached_p (extent)); | |
| 1836 { | |
| 1837 Memxpos i = endp ? extent_end (extent) : extent_start (extent); | |
| 1838 Lisp_Object obj = extent_object (extent); | |
| 1839 return buffer_or_string_memxpos_to_bytexpos (obj, i); | |
| 1840 } | |
| 1841 } | |
| 1842 | |
| 1843 Charxpos | |
| 1844 extent_endpoint_char (EXTENT extent, int endp) | |
| 428 | 1845 { |
| 1846 assert (EXTENT_LIVE_P (extent)); | |
| 1847 assert (!extent_detached_p (extent)); | |
| 1848 { | |
| 826 | 1849 Memxpos i = endp ? extent_end (extent) : extent_start (extent); |
| 428 | 1850 Lisp_Object obj = extent_object (extent); |
| 826 | 1851 return buffer_or_string_memxpos_to_charxpos (obj, i); |
| 428 | 1852 } |
| 1853 } | |
| 1854 | |
| 1855 static void | |
| 826 | 1856 signal_single_extent_changed (EXTENT extent, Lisp_Object property, |
| 2286 | 1857 Bytexpos UNUSED (old_start), |
| 1858 Bytexpos UNUSED (old_end)) | |
| 826 | 1859 { |
| 1860 EXTENT anc = extent_ancestor (extent); | |
| 1861 /* Redisplay checks */ | |
| 1862 if (NILP (property) ? | |
| 1863 (!NILP (extent_face (anc)) || | |
| 1864 !NILP (extent_begin_glyph (anc)) || | |
| 1865 !NILP (extent_end_glyph (anc)) || | |
| 1866 !NILP (extent_mouse_face (anc)) || | |
| 1867 !NILP (extent_invisible (anc)) || | |
| 1868 !NILP (extent_initial_redisplay_function (anc))) : | |
| 1869 EQ (property, Qface) || | |
| 1870 EQ (property, Qmouse_face) || | |
| 1871 EQ (property, Qbegin_glyph) || | |
| 1872 EQ (property, Qend_glyph) || | |
| 1873 EQ (property, Qbegin_glyph_layout) || | |
| 1874 EQ (property, Qend_glyph_layout) || | |
| 1875 EQ (property, Qinvisible) || | |
| 1876 EQ (property, Qinitial_redisplay_function) || | |
| 1877 EQ (property, Qpriority)) | |
| 1878 { | |
| 1879 Lisp_Object object = extent_object (extent); | |
| 1880 | |
| 1881 if (extent_detached_p (extent)) | |
| 1882 return; | |
| 1883 | |
| 1884 else if (STRINGP (object)) | |
| 1885 { | |
| 1886 /* #### Changes to string extents can affect redisplay if they are | |
| 1887 in the modeline or in the gutters. | |
| 1888 | |
| 1889 If the extent is in some generated-modeline-string: when we | |
| 1890 change an extent in generated-modeline-string, this changes its | |
| 1891 parent, which is in `modeline-format', so we should force the | |
| 1892 modeline to be updated. But how to determine whether a string | |
| 1893 is a `generated-modeline-string'? Looping through all buffers | |
| 1894 is not very efficient. Should we add all | |
| 1895 `generated-modeline-string' strings to a hash table? Maybe | |
| 1896 efficiency is not the greatest concern here and there's no big | |
| 1897 loss in looping over the buffers. | |
| 1898 | |
| 1899 If the extent is in a gutter we mark the gutter as | |
| 1900 changed. This means (a) we can update extents in the gutters | |
| 1901 when we need it. (b) we don't have to update the gutters when | |
| 1902 only extents attached to buffers have changed. */ | |
| 1903 | |
| 1904 if (!in_modeline_generation) | |
| 1905 MARK_EXTENTS_CHANGED; | |
| 1906 gutter_extent_signal_changed_region_maybe | |
| 1907 (object, extent_endpoint_char (extent, 0), | |
| 1908 extent_endpoint_char (extent, 1)); | |
| 1909 } | |
| 1910 else if (BUFFERP (object)) | |
| 1911 { | |
| 1912 struct buffer *b; | |
| 1913 b = XBUFFER (object); | |
| 1914 BUF_FACECHANGE (b)++; | |
| 1915 MARK_EXTENTS_CHANGED; | |
| 1916 if (NILP (property) ? !NILP (extent_invisible (anc)) : | |
| 1917 EQ (property, Qinvisible)) | |
| 1918 MARK_CLIP_CHANGED; | |
| 1919 buffer_extent_signal_changed_region | |
| 1920 (b, extent_endpoint_char (extent, 0), | |
| 1921 extent_endpoint_char (extent, 1)); | |
| 1922 } | |
| 1923 } | |
| 1924 | |
| 1925 /* Check for syntax table property change */ | |
| 1926 if (NILP (property) ? !NILP (Fextent_property (wrap_extent (extent), | |
| 1927 Qsyntax_table, Qnil)) : | |
| 1928 EQ (property, Qsyntax_table)) | |
| 3250 | 1929 signal_syntax_cache_extent_changed (extent); |
| 826 | 1930 } |
| 1931 | |
| 1932 /* Make note that a change has happened in EXTENT. The change was either | |
| 1933 to a property or to the endpoints (but not both at once). If PROPERTY | |
| 1934 is non-nil, the change happened to that property; otherwise, the change | |
| 1935 happened to the endpoints, and the old ones are given. Currently, all | |
| 1936 endpoints changes are in the form of two signals, a detach followed by | |
| 1937 an attach, and when detaching, we are signalled before the extent is | |
| 1938 detached. (You can distinguish a detach from an attach because the | |
| 1939 latter has old_start == -1 and old_end == -1.) (#### We don't currently | |
| 1940 give the old property. If someone needs that, this will have to | |
| 1941 change.) KLUDGE: If PROPERTY is Qt, all properties may have changed | |
| 1942 because the parent was changed. #### We need to handle this properly, by | |
| 1943 mapping over properties. */ | |
| 1944 | |
| 1945 static void | |
| 1946 signal_extent_changed (EXTENT extent, Lisp_Object property, | |
| 1947 Bytexpos old_start, Bytexpos old_end, | |
| 1948 int descendants_too) | |
| 1949 { | |
| 428 | 1950 /* we could easily encounter a detached extent while traversing the |
| 1951 children, but we should never be able to encounter a dead extent. */ | |
| 1952 assert (EXTENT_LIVE_P (extent)); | |
| 1953 | |
| 1954 if (descendants_too) | |
| 1955 { | |
| 1956 Lisp_Object children = extent_children (extent); | |
| 1957 | |
| 1958 if (!NILP (children)) | |
| 1959 { | |
| 826 | 1960 /* first process all of the extent's children. We will lose |
| 1961 big-time if there are any circularities here, so we sure as | |
| 1962 hell better ensure that there aren't. */ | |
| 831 | 1963 LIST_LOOP_2 (child, XWEAK_LIST_LIST (children)) |
| 1964 signal_extent_changed (XEXTENT (child), property, old_start, | |
| 840 | 1965 old_end, descendants_too); |
| 428 | 1966 } |
| 1967 } | |
| 1968 | |
| 826 | 1969 /* now process the extent itself. */ |
| 1970 signal_single_extent_changed (extent, property, old_start, old_end); | |
| 1971 } | |
| 428 | 1972 |
| 1973 static void | |
| 826 | 1974 signal_extent_property_changed (EXTENT extent, Lisp_Object property, |
| 1975 int descendants_too) | |
| 1976 { | |
| 1977 signal_extent_changed (extent, property, 0, 0, descendants_too); | |
| 428 | 1978 } |
| 1979 | |
| 1980 static EXTENT | |
| 1981 make_extent_detached (Lisp_Object object) | |
| 1982 { | |
| 1983 EXTENT extent = allocate_extent (); | |
| 1984 | |
| 1985 assert (NILP (object) || STRINGP (object) || | |
| 1986 (BUFFERP (object) && BUFFER_LIVE_P (XBUFFER (object)))); | |
| 1987 extent_object (extent) = object; | |
| 1988 /* Now make sure the extent info exists. */ | |
| 1989 if (!NILP (object)) | |
| 1990 buffer_or_string_extent_info_force (object); | |
| 1991 return extent; | |
| 1992 } | |
| 1993 | |
| 1994 /* A "real" extent is any extent other than the internal (not-user-visible) | |
| 1995 extents used by `map-extents'. */ | |
| 1996 | |
| 1997 static EXTENT | |
| 1998 real_extent_at_forward (Extent_List *el, int pos, int endp) | |
| 1999 { | |
| 2000 for (; pos < extent_list_num_els (el); pos++) | |
| 2001 { | |
| 2002 EXTENT e = extent_list_at (el, pos, endp); | |
| 2003 if (!extent_internal_p (e)) | |
| 2004 return e; | |
| 2005 } | |
| 2006 return 0; | |
| 2007 } | |
| 2008 | |
| 2009 static EXTENT | |
| 2010 real_extent_at_backward (Extent_List *el, int pos, int endp) | |
| 2011 { | |
| 2012 for (; pos >= 0; pos--) | |
| 2013 { | |
| 2014 EXTENT e = extent_list_at (el, pos, endp); | |
| 2015 if (!extent_internal_p (e)) | |
| 2016 return e; | |
| 2017 } | |
| 2018 return 0; | |
| 2019 } | |
| 2020 | |
| 2021 static EXTENT | |
| 2022 extent_first (Lisp_Object obj) | |
| 2023 { | |
| 2024 Extent_List *el = buffer_or_string_extent_list (obj); | |
| 2025 | |
| 2026 if (!el) | |
| 2027 return 0; | |
| 2028 return real_extent_at_forward (el, 0, 0); | |
| 2029 } | |
| 2030 | |
| 2031 #ifdef DEBUG_XEMACS | |
| 2032 static EXTENT | |
| 2033 extent_e_first (Lisp_Object obj) | |
| 2034 { | |
| 2035 Extent_List *el = buffer_or_string_extent_list (obj); | |
| 2036 | |
| 2037 if (!el) | |
| 2038 return 0; | |
| 2039 return real_extent_at_forward (el, 0, 1); | |
| 2040 } | |
| 2041 #endif | |
| 2042 | |
| 2043 static EXTENT | |
| 2044 extent_next (EXTENT e) | |
| 2045 { | |
| 2046 Extent_List *el = extent_extent_list (e); | |
| 2047 int foundp; | |
| 2048 int pos = extent_list_locate (el, e, 0, &foundp); | |
| 2049 assert (foundp); | |
| 2050 return real_extent_at_forward (el, pos+1, 0); | |
| 2051 } | |
| 2052 | |
| 2053 #ifdef DEBUG_XEMACS | |
| 2054 static EXTENT | |
| 2055 extent_e_next (EXTENT e) | |
| 2056 { | |
| 2057 Extent_List *el = extent_extent_list (e); | |
| 2058 int foundp; | |
| 2059 int pos = extent_list_locate (el, e, 1, &foundp); | |
| 2060 assert (foundp); | |
| 2061 return real_extent_at_forward (el, pos+1, 1); | |
| 2062 } | |
| 2063 #endif | |
| 2064 | |
| 2065 static EXTENT | |
| 2066 extent_last (Lisp_Object obj) | |
| 2067 { | |
| 2068 Extent_List *el = buffer_or_string_extent_list (obj); | |
| 2069 | |
| 2070 if (!el) | |
| 2071 return 0; | |
| 2072 return real_extent_at_backward (el, extent_list_num_els (el) - 1, 0); | |
| 2073 } | |
| 2074 | |
| 2075 #ifdef DEBUG_XEMACS | |
| 2076 static EXTENT | |
| 2077 extent_e_last (Lisp_Object obj) | |
| 2078 { | |
| 2079 Extent_List *el = buffer_or_string_extent_list (obj); | |
| 2080 | |
| 2081 if (!el) | |
| 2082 return 0; | |
| 2083 return real_extent_at_backward (el, extent_list_num_els (el) - 1, 1); | |
| 2084 } | |
| 2085 #endif | |
| 2086 | |
| 2087 static EXTENT | |
| 2088 extent_previous (EXTENT e) | |
| 2089 { | |
| 2090 Extent_List *el = extent_extent_list (e); | |
| 2091 int foundp; | |
| 2092 int pos = extent_list_locate (el, e, 0, &foundp); | |
| 2093 assert (foundp); | |
| 2094 return real_extent_at_backward (el, pos-1, 0); | |
| 2095 } | |
| 2096 | |
| 2097 #ifdef DEBUG_XEMACS | |
| 2098 static EXTENT | |
| 2099 extent_e_previous (EXTENT e) | |
| 2100 { | |
| 2101 Extent_List *el = extent_extent_list (e); | |
| 2102 int foundp; | |
| 2103 int pos = extent_list_locate (el, e, 1, &foundp); | |
| 2104 assert (foundp); | |
| 2105 return real_extent_at_backward (el, pos-1, 1); | |
| 2106 } | |
| 2107 #endif | |
| 2108 | |
| 2109 static void | |
| 2110 extent_attach (EXTENT extent) | |
| 2111 { | |
| 2112 Extent_List *el = extent_extent_list (extent); | |
| 2113 | |
| 2114 extent_list_insert (el, extent); | |
| 2115 soe_insert (extent_object (extent), extent); | |
| 2116 /* only this extent changed */ | |
| 826 | 2117 signal_extent_changed (extent, Qnil, -1, -1, 0); |
| 428 | 2118 } |
| 2119 | |
| 2120 static void | |
| 2121 extent_detach (EXTENT extent) | |
| 2122 { | |
| 2123 Extent_List *el; | |
| 2124 | |
| 2125 if (extent_detached_p (extent)) | |
| 2126 return; | |
| 2127 el = extent_extent_list (extent); | |
| 2128 | |
| 2129 /* call this before messing with the extent. */ | |
| 826 | 2130 signal_extent_changed (extent, Qnil, |
| 2131 extent_endpoint_byte (extent, 0), | |
| 2132 extent_endpoint_char (extent, 0), | |
| 2133 0); | |
| 428 | 2134 extent_list_delete (el, extent); |
| 2135 soe_delete (extent_object (extent), extent); | |
| 2136 set_extent_start (extent, -1); | |
| 2137 set_extent_end (extent, -1); | |
| 2138 } | |
| 2139 | |
| 2140 /* ------------------------------- */ | |
| 2141 /* map-extents et al. */ | |
| 2142 /* ------------------------------- */ | |
| 2143 | |
| 2144 /* Returns true iff map_extents() would visit the given extent. | |
| 2145 See the comments at map_extents() for info on the overlap rule. | |
| 2146 Assumes that all validation on the extent and buffer positions has | |
| 2147 already been performed (see Fextent_in_region_p ()). | |
| 2148 */ | |
| 2149 static int | |
| 826 | 2150 extent_in_region_p (EXTENT extent, Bytexpos from, Bytexpos to, |
| 428 | 2151 unsigned int flags) |
| 2152 { | |
| 2153 Lisp_Object obj = extent_object (extent); | |
| 2154 Endpoint_Index start, end, exs, exe; | |
| 2155 int start_open, end_open; | |
| 2156 unsigned int all_extents_flags = flags & ME_ALL_EXTENTS_MASK; | |
| 2157 unsigned int in_region_flags = flags & ME_IN_REGION_MASK; | |
| 2158 int retval; | |
| 2159 | |
| 2160 /* A zero-length region is treated as closed-closed. */ | |
| 2161 if (from == to) | |
| 2162 { | |
| 2163 flags |= ME_END_CLOSED; | |
| 2164 flags &= ~ME_START_OPEN; | |
| 2165 } | |
| 2166 | |
| 2167 /* So is a zero-length extent. */ | |
| 2168 if (extent_start (extent) == extent_end (extent)) | |
| 2169 start_open = 0, end_open = 0; | |
| 2170 /* `all_extents_flags' will almost always be zero. */ | |
| 2171 else if (all_extents_flags == 0) | |
| 2172 { | |
| 2173 start_open = extent_start_open_p (extent); | |
| 2174 end_open = extent_end_open_p (extent); | |
| 2175 } | |
| 2176 else | |
| 2177 switch (all_extents_flags) | |
| 2178 { | |
| 2179 case ME_ALL_EXTENTS_CLOSED: start_open = 0, end_open = 0; break; | |
| 2180 case ME_ALL_EXTENTS_OPEN: start_open = 1, end_open = 1; break; | |
| 2181 case ME_ALL_EXTENTS_CLOSED_OPEN: start_open = 0, end_open = 1; break; | |
| 2182 case ME_ALL_EXTENTS_OPEN_CLOSED: start_open = 1, end_open = 0; break; | |
| 2500 | 2183 default: ABORT(); return 0; |
| 428 | 2184 } |
| 2185 | |
| 826 | 2186 start = buffer_or_string_bytexpos_to_startind (obj, from, |
| 428 | 2187 flags & ME_START_OPEN); |
| 826 | 2188 end = buffer_or_string_bytexpos_to_endind (obj, to, |
| 2189 ! (flags & ME_END_CLOSED)); | |
| 2190 exs = memxpos_to_startind (extent_start (extent), start_open); | |
| 2191 exe = memxpos_to_endind (extent_end (extent), end_open); | |
| 428 | 2192 |
| 2193 /* It's easy to determine whether an extent lies *outside* the | |
| 2194 region -- just determine whether it's completely before | |
| 2195 or completely after the region. Reject all such extents, so | |
| 2196 we're now left with only the extents that overlap the region. | |
| 2197 */ | |
| 2198 | |
| 2199 if (exs > end || exe < start) | |
| 2200 return 0; | |
| 2201 | |
| 2202 /* See if any further restrictions are called for. */ | |
| 2203 /* in_region_flags will almost always be zero. */ | |
| 2204 if (in_region_flags == 0) | |
| 2205 retval = 1; | |
| 2206 else | |
| 2207 switch (in_region_flags) | |
| 2208 { | |
| 2209 case ME_START_IN_REGION: | |
| 2210 retval = start <= exs && exs <= end; break; | |
| 2211 case ME_END_IN_REGION: | |
| 2212 retval = start <= exe && exe <= end; break; | |
| 2213 case ME_START_AND_END_IN_REGION: | |
| 2214 retval = start <= exs && exe <= end; break; | |
| 2215 case ME_START_OR_END_IN_REGION: | |
| 2216 retval = (start <= exs && exs <= end) || (start <= exe && exe <= end); | |
| 2217 break; | |
| 2218 default: | |
| 2500 | 2219 ABORT(); return 0; |
| 428 | 2220 } |
| 2221 return flags & ME_NEGATE_IN_REGION ? !retval : retval; | |
| 2222 } | |
| 2223 | |
| 2224 struct map_extents_struct | |
| 2225 { | |
| 2226 Extent_List *el; | |
| 2227 Extent_List_Marker *mkr; | |
| 2228 EXTENT range; | |
| 2229 }; | |
| 2230 | |
| 2231 static Lisp_Object | |
| 2232 map_extents_unwind (Lisp_Object obj) | |
| 2233 { | |
| 2234 struct map_extents_struct *closure = | |
| 2235 (struct map_extents_struct *) get_opaque_ptr (obj); | |
| 2236 free_opaque_ptr (obj); | |
| 2237 if (closure->range) | |
| 2238 extent_detach (closure->range); | |
| 2239 if (closure->mkr) | |
| 2240 extent_list_delete_marker (closure->el, closure->mkr); | |
| 2241 return Qnil; | |
| 2242 } | |
| 2243 | |
| 2244 /* This is the guts of `map-extents' and the other functions that | |
| 2245 map over extents. In theory the operation of this function is | |
| 2246 simple: just figure out what extents we're mapping over, and | |
| 2247 call the function on each one of them in the range. Unfortunately | |
| 2248 there are a wide variety of things that the mapping function | |
| 2249 might do, and we have to be very tricky to avoid getting messed | |
| 2250 up. Furthermore, this function needs to be very fast (it is | |
| 2251 called multiple times every time text is inserted or deleted | |
| 2252 from a buffer), and so we can't always afford the overhead of | |
| 2253 dealing with all the possible things that the mapping function | |
| 2254 might do; thus, there are many flags that can be specified | |
| 2255 indicating what the mapping function might or might not do. | |
| 2256 | |
| 2257 The result of all this is that this is the most complicated | |
| 2258 function in this file. Change it at your own risk! | |
| 2259 | |
| 2260 A potential simplification to the logic below is to determine | |
| 2261 all the extents that the mapping function should be called on | |
| 2262 before any calls are actually made and save them in an array. | |
| 2263 That introduces its own complications, however (the array | |
| 2264 needs to be marked for garbage-collection, and a static array | |
| 2265 cannot be used because map_extents() needs to be reentrant). | |
| 2266 Furthermore, the results might be a little less sensible than | |
| 2267 the logic below. */ | |
| 2268 | |
| 2269 | |
| 2270 static void | |
| 826 | 2271 map_extents (Bytexpos from, Bytexpos to, map_extents_fun fn, |
| 2272 void *arg, Lisp_Object obj, EXTENT after, | |
| 2273 unsigned int flags) | |
| 2274 { | |
| 2275 Memxpos st, en; /* range we're mapping over */ | |
| 428 | 2276 EXTENT range = 0; /* extent for this, if ME_MIGHT_MODIFY_TEXT */ |
| 2277 Extent_List *el = 0; /* extent list we're iterating over */ | |
| 2278 Extent_List_Marker *posm = 0; /* marker for extent list, | |
| 2279 if ME_MIGHT_MODIFY_EXTENTS */ | |
| 2280 /* count and struct for unwind-protect, if ME_MIGHT_THROW */ | |
| 1292 | 2281 int count = specpdl_depth (); |
| 428 | 2282 struct map_extents_struct closure; |
| 1292 | 2283 PROFILE_DECLARE (); |
| 428 | 2284 |
| 2285 #ifdef ERROR_CHECK_EXTENTS | |
| 2286 assert (from <= to); | |
| 2287 assert (from >= buffer_or_string_absolute_begin_byte (obj) && | |
| 2288 from <= buffer_or_string_absolute_end_byte (obj) && | |
| 2289 to >= buffer_or_string_absolute_begin_byte (obj) && | |
| 2290 to <= buffer_or_string_absolute_end_byte (obj)); | |
| 2291 #endif | |
| 2292 | |
| 2293 if (after) | |
| 2294 { | |
| 2295 assert (EQ (obj, extent_object (after))); | |
| 2296 assert (!extent_detached_p (after)); | |
| 2297 } | |
| 2298 | |
| 2299 el = buffer_or_string_extent_list (obj); | |
| 1292 | 2300 if (!el || !extent_list_num_els (el)) |
| 428 | 2301 return; |
| 2302 el = 0; | |
| 2303 | |
| 1292 | 2304 PROFILE_RECORD_ENTERING_SECTION (QSin_map_extents_internal); |
| 2305 | |
| 826 | 2306 st = buffer_or_string_bytexpos_to_memxpos (obj, from); |
| 2307 en = buffer_or_string_bytexpos_to_memxpos (obj, to); | |
| 428 | 2308 |
| 2309 if (flags & ME_MIGHT_MODIFY_TEXT) | |
| 2310 { | |
| 2311 /* The mapping function might change the text in the buffer, | |
| 2312 so make an internal extent to hold the range we're mapping | |
| 2313 over. */ | |
| 2314 range = make_extent_detached (obj); | |
| 2315 set_extent_start (range, st); | |
| 2316 set_extent_end (range, en); | |
| 2317 range->flags.start_open = flags & ME_START_OPEN; | |
| 2318 range->flags.end_open = !(flags & ME_END_CLOSED); | |
| 2319 range->flags.internal = 1; | |
| 2320 range->flags.detachable = 0; | |
| 2321 extent_attach (range); | |
| 2322 } | |
| 2323 | |
| 2324 if (flags & ME_MIGHT_THROW) | |
| 2325 { | |
| 2326 /* The mapping function might throw past us so we need to use an | |
| 2327 unwind_protect() to eliminate the internal extent and range | |
| 2328 that we use. */ | |
| 2329 closure.range = range; | |
| 2330 closure.mkr = 0; | |
| 2331 record_unwind_protect (map_extents_unwind, | |
| 2332 make_opaque_ptr (&closure)); | |
| 2333 } | |
| 2334 | |
| 2335 /* ---------- Figure out where we start and what direction | |
| 2336 we move in. This is the trickiest part of this | |
| 2337 function. ---------- */ | |
| 2338 | |
| 2339 /* If ME_START_IN_REGION, ME_END_IN_REGION or ME_START_AND_END_IN_REGION | |
| 2340 was specified and ME_NEGATE_IN_REGION was not specified, our job | |
| 2341 is simple because of the presence of the display order and e-order. | |
| 2342 (Note that theoretically do something similar for | |
| 2343 ME_START_OR_END_IN_REGION, but that would require more trickiness | |
| 2344 than it's worth to avoid hitting the same extent twice.) | |
| 2345 | |
| 2346 In the general case, all the extents that overlap a range can be | |
| 2347 divided into two classes: those whose start position lies within | |
| 2348 the range (including the range's end but not including the | |
| 2349 range's start), and those that overlap the start position, | |
| 2350 i.e. those in the SOE for the start position. Or equivalently, | |
| 2351 the extents can be divided into those whose end position lies | |
| 2352 within the range and those in the SOE for the end position. Note | |
| 2353 that for this purpose we treat both the range and all extents in | |
| 2354 the buffer as closed on both ends. If this is not what the ME_ | |
| 2355 flags specified, then we've mapped over a few too many extents, | |
| 2356 but no big deal because extent_in_region_p() will filter them | |
| 2357 out. Ideally, we could move the SOE to the closer of the range's | |
| 2358 two ends and work forwards or backwards from there. However, in | |
| 2359 order to make the semantics of the AFTER argument work out, we | |
| 2360 have to always go in the same direction; so we choose to always | |
| 2361 move the SOE to the start position. | |
| 2362 | |
| 2363 When it comes time to do the SOE stage, we first call soe_move() | |
| 2364 so that the SOE gets set up. Note that the SOE might get | |
| 2365 changed while we are mapping over its contents. If we can | |
| 2366 guarantee that the SOE won't get moved to a new position, we | |
| 2367 simply need to put a marker in the SOE and we will track deletions | |
| 2368 and insertions of extents in the SOE. If the SOE might get moved, | |
| 2369 however (this would happen as a result of a recursive invocation | |
| 2370 of map-extents or a call to a redisplay-type function), then | |
| 2371 trying to track its changes is hopeless, so we just keep a | |
| 2372 marker to the first (or last) extent in the SOE and use that as | |
| 2373 our bound. | |
| 2374 | |
| 2375 Finally, if DONT_USE_SOE is defined, we don't use the SOE at all | |
| 2376 and instead just map from the beginning of the buffer. This is | |
| 2377 used for testing purposes and allows the SOE to be calculated | |
| 2378 using map_extents() instead of the other way around. */ | |
| 2379 | |
| 2380 { | |
| 2381 int range_flag; /* ME_*_IN_REGION subset of flags */ | |
| 2382 int do_soe_stage = 0; /* Are we mapping over the SOE? */ | |
| 2383 /* Does the range stage map over start or end positions? */ | |
| 2384 int range_endp; | |
| 2385 /* If type == 0, we include the start position in the range stage mapping. | |
| 2386 If type == 1, we exclude the start position in the range stage mapping. | |
| 2387 If type == 2, we begin at range_start_pos, an extent-list position. | |
| 2388 */ | |
| 2389 int range_start_type = 0; | |
| 2390 int range_start_pos = 0; | |
| 2391 int stage; | |
| 2392 | |
| 2393 range_flag = flags & ME_IN_REGION_MASK; | |
| 2394 if ((range_flag == ME_START_IN_REGION || | |
| 2395 range_flag == ME_START_AND_END_IN_REGION) && | |
| 2396 !(flags & ME_NEGATE_IN_REGION)) | |
| 2397 { | |
| 2398 /* map over start position in [range-start, range-end]. No SOE | |
| 2399 stage. */ | |
| 2400 range_endp = 0; | |
| 2401 } | |
| 2402 else if (range_flag == ME_END_IN_REGION && !(flags & ME_NEGATE_IN_REGION)) | |
| 2403 { | |
| 2404 /* map over end position in [range-start, range-end]. No SOE | |
| 2405 stage. */ | |
| 2406 range_endp = 1; | |
| 2407 } | |
| 2408 else | |
| 2409 { | |
| 2410 /* Need to include the SOE extents. */ | |
| 2411 #ifdef DONT_USE_SOE | |
| 2412 /* Just brute-force it: start from the beginning. */ | |
| 2413 range_endp = 0; | |
| 2414 range_start_type = 2; | |
| 2415 range_start_pos = 0; | |
| 2416 #else | |
| 2417 Stack_Of_Extents *soe = buffer_or_string_stack_of_extents_force (obj); | |
| 2418 int numsoe; | |
| 2419 | |
| 2420 /* Move the SOE to the closer end of the range. This dictates | |
| 2421 whether we map over start positions or end positions. */ | |
| 2422 range_endp = 0; | |
| 2423 soe_move (obj, st); | |
| 2424 numsoe = extent_list_num_els (soe->extents); | |
| 2425 if (numsoe) | |
| 2426 { | |
| 2427 if (flags & ME_MIGHT_MOVE_SOE) | |
| 2428 { | |
| 2429 int foundp; | |
| 2430 /* Can't map over SOE, so just extend range to cover the | |
| 2431 SOE. */ | |
| 2432 EXTENT e = extent_list_at (soe->extents, 0, 0); | |
| 2433 range_start_pos = | |
| 2434 extent_list_locate (buffer_or_string_extent_list (obj), e, 0, | |
| 2435 &foundp); | |
| 2436 assert (foundp); | |
| 2437 range_start_type = 2; | |
| 2438 } | |
| 2439 else | |
| 2440 { | |
| 2441 /* We can map over the SOE. */ | |
| 2442 do_soe_stage = 1; | |
| 2443 range_start_type = 1; | |
| 2444 } | |
| 2445 } | |
| 2446 else | |
| 2447 { | |
| 2448 /* No extents in the SOE to map over, so we act just as if | |
| 2449 ME_START_IN_REGION or ME_END_IN_REGION was specified. | |
| 2450 RANGE_ENDP already specified so no need to do anything else. */ | |
| 2451 } | |
| 2452 } | |
| 2453 #endif | |
| 2454 | |
| 2455 /* ---------- Now loop over the extents. ---------- */ | |
| 2456 | |
| 2457 /* We combine the code for the two stages because much of it | |
| 2458 overlaps. */ | |
| 2459 for (stage = 0; stage < 2; stage++) | |
| 2460 { | |
| 2461 int pos = 0; /* Position in extent list */ | |
| 2462 | |
| 2463 /* First set up start conditions */ | |
| 2464 if (stage == 0) | |
| 2465 { /* The SOE stage */ | |
| 2466 if (!do_soe_stage) | |
| 2467 continue; | |
| 2468 el = buffer_or_string_stack_of_extents_force (obj)->extents; | |
| 2469 /* We will always be looping over start extents here. */ | |
| 2470 assert (!range_endp); | |
| 2471 pos = 0; | |
| 2472 } | |
| 2473 else | |
| 2474 { /* The range stage */ | |
| 2475 el = buffer_or_string_extent_list (obj); | |
| 2476 switch (range_start_type) | |
| 2477 { | |
| 2478 case 0: | |
| 2479 pos = extent_list_locate_from_pos (el, st, range_endp); | |
| 2480 break; | |
| 2481 case 1: | |
| 2482 pos = extent_list_locate_from_pos (el, st + 1, range_endp); | |
| 2483 break; | |
| 2484 case 2: | |
| 2485 pos = range_start_pos; | |
| 2486 break; | |
| 2487 } | |
| 2488 } | |
| 2489 | |
| 2490 if (flags & ME_MIGHT_MODIFY_EXTENTS) | |
| 2491 { | |
| 2492 /* Create a marker to track changes to the extent list */ | |
| 2493 if (posm) | |
| 2494 /* Delete the marker used in the SOE stage. */ | |
| 2495 extent_list_delete_marker | |
| 2496 (buffer_or_string_stack_of_extents_force (obj)->extents, posm); | |
| 2497 posm = extent_list_make_marker (el, pos, range_endp); | |
| 2498 /* tell the unwind function about the marker. */ | |
| 2499 closure.el = el; | |
| 2500 closure.mkr = posm; | |
| 2501 } | |
| 2502 | |
| 2503 /* Now loop! */ | |
| 2504 for (;;) | |
| 2505 { | |
| 2506 EXTENT e; | |
| 2507 Lisp_Object obj2; | |
| 2508 | |
| 2509 /* ----- update position in extent list | |
| 2510 and fetch next extent ----- */ | |
| 2511 | |
| 2512 if (posm) | |
| 2513 /* fetch POS again to track extent insertions or deletions */ | |
| 2514 pos = extent_list_marker_pos (el, posm); | |
| 2515 if (pos >= extent_list_num_els (el)) | |
| 2516 break; | |
| 2517 e = extent_list_at (el, pos, range_endp); | |
| 2518 pos++; | |
| 2519 if (posm) | |
| 2520 /* now point the marker to the next one we're going to process. | |
| 2521 This ensures graceful behavior if this extent is deleted. */ | |
| 2522 extent_list_move_marker (el, posm, pos); | |
| 2523 | |
| 2524 /* ----- deal with internal extents ----- */ | |
| 2525 | |
| 2526 if (extent_internal_p (e)) | |
| 2527 { | |
| 2528 if (!(flags & ME_INCLUDE_INTERNAL)) | |
| 2529 continue; | |
| 2530 else if (e == range) | |
| 2531 { | |
| 2532 /* We're processing internal extents and we've | |
| 2533 come across our own special range extent. | |
| 2534 (This happens only in adjust_extents*() and | |
| 2535 process_extents*(), which handle text | |
| 2536 insertion and deletion.) We need to omit | |
| 2537 processing of this extent; otherwise | |
| 2538 we will probably end up prematurely | |
| 2539 terminating this loop. */ | |
| 2540 continue; | |
| 2541 } | |
| 2542 } | |
| 2543 | |
| 2544 /* ----- deal with AFTER condition ----- */ | |
| 2545 | |
| 2546 if (after) | |
| 2547 { | |
| 2548 /* if e > after, then we can stop skipping extents. */ | |
| 2549 if (EXTENT_LESS (after, e)) | |
| 2550 after = 0; | |
| 2551 else /* otherwise, skip this extent. */ | |
| 2552 continue; | |
| 2553 } | |
| 2554 | |
| 2555 /* ----- stop if we're completely outside the range ----- */ | |
| 2556 | |
| 2557 /* fetch ST and EN again to track text insertions or deletions */ | |
| 2558 if (range) | |
| 2559 { | |
| 2560 st = extent_start (range); | |
| 2561 en = extent_end (range); | |
| 2562 } | |
| 2563 if (extent_endpoint (e, range_endp) > en) | |
| 2564 { | |
| 2565 /* Can't be mapping over SOE because all extents in | |
| 2566 there should overlap ST */ | |
| 2567 assert (stage == 1); | |
| 2568 break; | |
| 2569 } | |
| 2570 | |
| 2571 /* ----- Now actually call the function ----- */ | |
| 2572 | |
| 2573 obj2 = extent_object (e); | |
| 2574 if (extent_in_region_p (e, | |
| 826 | 2575 buffer_or_string_memxpos_to_bytexpos (obj2, |
| 2576 st), | |
| 2577 buffer_or_string_memxpos_to_bytexpos (obj2, | |
| 2578 en), | |
| 428 | 2579 flags)) |
| 2580 { | |
| 2581 if ((*fn)(e, arg)) | |
| 2582 { | |
| 2583 /* Function wants us to stop mapping. */ | |
| 2584 stage = 1; /* so outer for loop will terminate */ | |
| 2585 break; | |
| 2586 } | |
| 2587 } | |
| 2588 } | |
| 2589 } | |
| 2590 /* ---------- Finished looping. ---------- */ | |
| 2591 } | |
| 2592 | |
| 1292 | 2593 if (!(flags & ME_MIGHT_THROW)) |
| 428 | 2594 { |
| 2595 /* Delete them ourselves */ | |
| 2596 if (range) | |
| 2597 extent_detach (range); | |
| 2598 if (posm) | |
| 2599 extent_list_delete_marker (el, posm); | |
| 2600 } | |
| 1292 | 2601 |
| 2602 /* This deletes the range extent and frees the marker, if ME_MIGHT_THROW. */ | |
| 2603 unbind_to (count); | |
| 2604 | |
| 2605 PROFILE_RECORD_EXITING_SECTION (QSin_map_extents_internal); | |
| 428 | 2606 } |
| 2607 | |
| 2608 /* ------------------------------- */ | |
| 2609 /* adjust_extents() */ | |
| 2610 /* ------------------------------- */ | |
| 2611 | |
| 2612 /* Add AMOUNT to all extent endpoints in the range (FROM, TO]. This | |
| 2613 happens whenever the gap is moved or (under Mule) a character in a | |
| 2614 string is substituted for a different-length one. The reason for | |
| 2615 this is that extent endpoints behave just like markers (all memory | |
| 2616 indices do) and this adjustment correct for markers -- see | |
| 2617 adjust_markers(). Note that it is important that we visit all | |
| 2618 extent endpoints in the range, irrespective of whether the | |
| 2619 endpoints are open or closed. | |
| 2620 | |
| 2621 We could use map_extents() for this (and in fact the function | |
| 2622 was originally written that way), but the gap is in an incoherent | |
| 2623 state when this function is called and this function plays | |
| 2624 around with extent endpoints without detaching and reattaching | |
| 2625 the extents (this is provably correct and saves lots of time), | |
| 2626 so for safety we make it just look at the extent lists directly. */ | |
| 2627 | |
| 2628 void | |
| 826 | 2629 adjust_extents (Lisp_Object obj, Memxpos from, Memxpos to, int amount) |
| 428 | 2630 { |
| 2631 int endp; | |
| 2632 int pos; | |
| 2633 int startpos[2]; | |
| 2634 Extent_List *el; | |
| 2635 Stack_Of_Extents *soe; | |
| 2636 | |
| 2637 #ifdef ERROR_CHECK_EXTENTS | |
| 2638 sledgehammer_extent_check (obj); | |
| 2639 #endif | |
| 2640 el = buffer_or_string_extent_list (obj); | |
| 2641 | |
| 2642 if (!el || !extent_list_num_els(el)) | |
| 2643 return; | |
| 2644 | |
| 2645 /* IMPORTANT! Compute the starting positions of the extents to | |
| 2646 modify BEFORE doing any modification! Otherwise the starting | |
| 2647 position for the second time through the loop might get | |
| 2648 incorrectly calculated (I got bit by this bug real bad). */ | |
| 2649 startpos[0] = extent_list_locate_from_pos (el, from+1, 0); | |
| 2650 startpos[1] = extent_list_locate_from_pos (el, from+1, 1); | |
| 2651 for (endp = 0; endp < 2; endp++) | |
| 2652 { | |
| 2653 for (pos = startpos[endp]; pos < extent_list_num_els (el); | |
| 2654 pos++) | |
| 2655 { | |
| 2656 EXTENT e = extent_list_at (el, pos, endp); | |
| 2657 if (extent_endpoint (e, endp) > to) | |
| 2658 break; | |
| 2659 set_extent_endpoint (e, | |
| 2660 do_marker_adjustment (extent_endpoint (e, endp), | |
| 2661 from, to, amount), | |
| 2662 endp); | |
| 2663 } | |
| 2664 } | |
| 2665 | |
| 2666 /* The index for the buffer's SOE is a memory index and thus | |
| 2667 needs to be adjusted like a marker. */ | |
| 2668 soe = buffer_or_string_stack_of_extents (obj); | |
| 2669 if (soe && soe->pos >= 0) | |
| 2670 soe->pos = do_marker_adjustment (soe->pos, from, to, amount); | |
| 2671 } | |
| 2672 | |
| 2673 /* ------------------------------- */ | |
| 2674 /* adjust_extents_for_deletion() */ | |
| 2675 /* ------------------------------- */ | |
| 2676 | |
| 2677 struct adjust_extents_for_deletion_arg | |
| 2678 { | |
| 2679 EXTENT_dynarr *list; | |
| 2680 }; | |
| 2681 | |
| 2682 static int | |
| 2683 adjust_extents_for_deletion_mapper (EXTENT extent, void *arg) | |
| 2684 { | |
| 2685 struct adjust_extents_for_deletion_arg *closure = | |
| 2686 (struct adjust_extents_for_deletion_arg *) arg; | |
| 2687 | |
| 2688 Dynarr_add (closure->list, extent); | |
| 2689 return 0; /* continue mapping */ | |
| 2690 } | |
| 2691 | |
| 2692 /* For all extent endpoints in the range (FROM, TO], move them to the beginning | |
| 2693 of the new gap. Note that it is important that we visit all extent | |
| 2694 endpoints in the range, irrespective of whether the endpoints are open or | |
| 2695 closed. | |
| 2696 | |
| 2697 This function deals with weird stuff such as the fact that extents | |
| 2698 may get reordered. | |
| 2699 | |
| 2700 There is no string correspondent for this because you can't | |
| 2701 delete characters from a string. | |
| 2702 */ | |
| 2703 | |
| 2704 void | |
| 826 | 2705 adjust_extents_for_deletion (Lisp_Object object, Bytexpos from, |
| 2706 Bytexpos to, int gapsize, int numdel, | |
| 428 | 2707 int movegapsize) |
| 2708 { | |
| 2709 struct adjust_extents_for_deletion_arg closure; | |
| 2710 int i; | |
| 826 | 2711 Memxpos adjust_to = (Memxpos) (to + gapsize); |
| 428 | 2712 Bytecount amount = - numdel - movegapsize; |
| 826 | 2713 Memxpos oldsoe = 0, newsoe = 0; |
| 428 | 2714 Stack_Of_Extents *soe = buffer_or_string_stack_of_extents (object); |
| 2715 | |
| 2716 #ifdef ERROR_CHECK_EXTENTS | |
| 2717 sledgehammer_extent_check (object); | |
| 2718 #endif | |
| 2719 closure.list = Dynarr_new (EXTENT); | |
| 2720 | |
| 2721 /* We're going to be playing weird games below with extents and the SOE | |
| 2722 and such, so compute the list now of all the extents that we're going | |
| 2723 to muck with. If we do the mapping and adjusting together, things can | |
| 2724 get all screwed up. */ | |
| 2725 | |
| 826 | 2726 map_extents (from, to, adjust_extents_for_deletion_mapper, |
| 2727 (void *) &closure, object, 0, | |
| 2728 /* extent endpoints move like markers regardless | |
| 2729 of their open/closeness. */ | |
| 2730 ME_ALL_EXTENTS_CLOSED | ME_END_CLOSED | | |
| 2731 ME_START_OR_END_IN_REGION | ME_INCLUDE_INTERNAL); | |
| 428 | 2732 |
| 2733 /* | |
| 2734 Old and new values for the SOE's position. (It gets adjusted | |
| 2735 like a marker, just like extent endpoints.) | |
| 2736 */ | |
| 2737 | |
| 2738 if (soe) | |
| 2739 { | |
| 2740 oldsoe = soe->pos; | |
| 2741 if (soe->pos >= 0) | |
| 2742 newsoe = do_marker_adjustment (soe->pos, | |
| 2743 adjust_to, adjust_to, | |
| 2744 amount); | |
| 2745 else | |
| 2746 newsoe = soe->pos; | |
| 2747 } | |
| 2748 | |
| 2749 for (i = 0; i < Dynarr_length (closure.list); i++) | |
| 2750 { | |
| 2751 EXTENT extent = Dynarr_at (closure.list, i); | |
| 826 | 2752 Memxpos new_start = extent_start (extent); |
| 2753 Memxpos new_end = extent_end (extent); | |
| 428 | 2754 |
| 2755 /* do_marker_adjustment() will not adjust values that should not be | |
| 2756 adjusted. We're passing the same funky arguments to | |
| 2757 do_marker_adjustment() as buffer_delete_range() does. */ | |
| 2758 new_start = | |
| 2759 do_marker_adjustment (new_start, | |
| 2760 adjust_to, adjust_to, | |
| 2761 amount); | |
| 2762 new_end = | |
| 2763 do_marker_adjustment (new_end, | |
| 2764 adjust_to, adjust_to, | |
| 2765 amount); | |
| 2766 | |
| 2767 /* We need to be very careful here so that the SOE doesn't get | |
| 2768 corrupted. We are shrinking extents out of the deleted region | |
| 2769 and simultaneously moving the SOE's pos out of the deleted | |
| 2770 region, so the SOE should contain the same extents at the end | |
| 2771 as at the beginning. However, extents may get reordered | |
| 2772 by this process, so we have to operate by pulling the extents | |
| 2773 out of the buffer and SOE, changing their bounds, and then | |
| 2774 reinserting them. In order for the SOE not to get screwed up, | |
| 2775 we have to make sure that the SOE's pos points to its old | |
| 2776 location whenever we pull an extent out, and points to its | |
| 2777 new location whenever we put the extent back in. | |
| 2778 */ | |
| 2779 | |
| 2780 if (new_start != extent_start (extent) || | |
| 2781 new_end != extent_end (extent)) | |
| 2782 { | |
| 2783 extent_detach (extent); | |
| 2784 set_extent_start (extent, new_start); | |
| 2785 set_extent_end (extent, new_end); | |
| 2786 if (soe) | |
| 2787 soe->pos = newsoe; | |
| 2788 extent_attach (extent); | |
| 2789 if (soe) | |
| 2790 soe->pos = oldsoe; | |
| 2791 } | |
| 2792 } | |
| 2793 | |
| 2794 if (soe) | |
| 2795 soe->pos = newsoe; | |
| 2796 | |
| 2797 #ifdef ERROR_CHECK_EXTENTS | |
| 2798 sledgehammer_extent_check (object); | |
| 2799 #endif | |
| 2800 Dynarr_free (closure.list); | |
| 2801 } | |
| 2802 | |
| 2803 /* ------------------------------- */ | |
| 2804 /* extent fragments */ | |
| 2805 /* ------------------------------- */ | |
| 2806 | |
| 2807 /* Imagine that the buffer is divided up into contiguous, | |
| 2808 nonoverlapping "runs" of text such that no extent | |
| 2809 starts or ends within a run (extents that abut the | |
| 2810 run don't count). | |
| 2811 | |
| 2812 An extent fragment is a structure that holds data about | |
| 2813 the run that contains a particular buffer position (if | |
| 2814 the buffer position is at the junction of two runs, the | |
| 2815 run after the position is used) -- the beginning and | |
| 2816 end of the run, a list of all of the extents in that | |
| 2817 run, the "merged face" that results from merging all of | |
| 2818 the faces corresponding to those extents, the begin and | |
| 2819 end glyphs at the beginning of the run, etc. This is | |
| 2820 the information that redisplay needs in order to | |
| 2821 display this run. | |
| 2822 | |
| 2823 Extent fragments have to be very quick to update to | |
| 2824 a new buffer position when moving linearly through | |
| 2825 the buffer. They rely on the stack-of-extents code, | |
| 2826 which does the heavy-duty algorithmic work of determining | |
| 2827 which extents overly a particular position. */ | |
| 2828 | |
| 2829 /* This function returns the position of the beginning of | |
| 2830 the first run that begins after POS, or returns POS if | |
| 2831 there are no such runs. */ | |
| 2832 | |
| 826 | 2833 static Bytexpos |
| 2834 extent_find_end_of_run (Lisp_Object obj, Bytexpos pos, int outside_accessible) | |
| 428 | 2835 { |
| 2836 Extent_List *sel; | |
| 2837 Extent_List *bel = buffer_or_string_extent_list (obj); | |
| 826 | 2838 Bytexpos pos1, pos2; |
| 428 | 2839 int elind1, elind2; |
| 826 | 2840 Memxpos mempos = buffer_or_string_bytexpos_to_memxpos (obj, pos); |
| 2841 Bytexpos limit = outside_accessible ? | |
| 428 | 2842 buffer_or_string_absolute_end_byte (obj) : |
| 826 | 2843 buffer_or_string_accessible_end_byte (obj); |
| 2844 | |
| 2845 if (!bel || !extent_list_num_els (bel)) | |
| 428 | 2846 return limit; |
| 2847 | |
| 2848 sel = buffer_or_string_stack_of_extents_force (obj)->extents; | |
| 2849 soe_move (obj, mempos); | |
| 2850 | |
| 2851 /* Find the first start position after POS. */ | |
| 2852 elind1 = extent_list_locate_from_pos (bel, mempos+1, 0); | |
| 2853 if (elind1 < extent_list_num_els (bel)) | |
| 826 | 2854 pos1 = buffer_or_string_memxpos_to_bytexpos |
| 428 | 2855 (obj, extent_start (extent_list_at (bel, elind1, 0))); |
| 2856 else | |
| 2857 pos1 = limit; | |
| 2858 | |
| 2859 /* Find the first end position after POS. The extent corresponding | |
| 2860 to this position is either in the SOE or is greater than or | |
| 2861 equal to POS1, so we just have to look in the SOE. */ | |
| 2862 elind2 = extent_list_locate_from_pos (sel, mempos+1, 1); | |
| 2863 if (elind2 < extent_list_num_els (sel)) | |
| 826 | 2864 pos2 = buffer_or_string_memxpos_to_bytexpos |
| 428 | 2865 (obj, extent_end (extent_list_at (sel, elind2, 1))); |
| 2866 else | |
| 2867 pos2 = limit; | |
| 2868 | |
| 2869 return min (min (pos1, pos2), limit); | |
| 2870 } | |
| 2871 | |
| 826 | 2872 static Bytexpos |
| 2873 extent_find_beginning_of_run (Lisp_Object obj, Bytexpos pos, | |
| 428 | 2874 int outside_accessible) |
| 2875 { | |
| 2876 Extent_List *sel; | |
| 2877 Extent_List *bel = buffer_or_string_extent_list (obj); | |
| 826 | 2878 Bytexpos pos1, pos2; |
| 428 | 2879 int elind1, elind2; |
| 826 | 2880 Memxpos mempos = buffer_or_string_bytexpos_to_memxpos (obj, pos); |
| 2881 Bytexpos limit = outside_accessible ? | |
| 428 | 2882 buffer_or_string_absolute_begin_byte (obj) : |
| 826 | 2883 buffer_or_string_accessible_begin_byte (obj); |
| 428 | 2884 |
| 2885 if (!bel || !extent_list_num_els(bel)) | |
| 2886 return limit; | |
| 2887 | |
| 2888 sel = buffer_or_string_stack_of_extents_force (obj)->extents; | |
| 2889 soe_move (obj, mempos); | |
| 2890 | |
| 2891 /* Find the first end position before POS. */ | |
| 2892 elind1 = extent_list_locate_from_pos (bel, mempos, 1); | |
| 2893 if (elind1 > 0) | |
| 826 | 2894 pos1 = buffer_or_string_memxpos_to_bytexpos |
| 428 | 2895 (obj, extent_end (extent_list_at (bel, elind1 - 1, 1))); |
| 2896 else | |
| 2897 pos1 = limit; | |
| 2898 | |
| 2899 /* Find the first start position before POS. The extent corresponding | |
| 2900 to this position is either in the SOE or is less than or | |
| 2901 equal to POS1, so we just have to look in the SOE. */ | |
| 2902 elind2 = extent_list_locate_from_pos (sel, mempos, 0); | |
| 2903 if (elind2 > 0) | |
| 826 | 2904 pos2 = buffer_or_string_memxpos_to_bytexpos |
| 428 | 2905 (obj, extent_start (extent_list_at (sel, elind2 - 1, 0))); |
| 2906 else | |
| 2907 pos2 = limit; | |
| 2908 | |
| 2909 return max (max (pos1, pos2), limit); | |
| 2910 } | |
| 2911 | |
| 2912 struct extent_fragment * | |
| 2913 extent_fragment_new (Lisp_Object buffer_or_string, struct frame *frm) | |
| 2914 { | |
| 2915 struct extent_fragment *ef = xnew_and_zero (struct extent_fragment); | |
| 2916 | |
| 2917 ef->object = buffer_or_string; | |
| 2918 ef->frm = frm; | |
| 2919 ef->extents = Dynarr_new (EXTENT); | |
| 2920 ef->begin_glyphs = Dynarr_new (glyph_block); | |
| 2921 ef->end_glyphs = Dynarr_new (glyph_block); | |
| 2922 | |
| 2923 return ef; | |
| 2924 } | |
| 2925 | |
| 2926 void | |
| 2927 extent_fragment_delete (struct extent_fragment *ef) | |
| 2928 { | |
| 2929 Dynarr_free (ef->extents); | |
| 2930 Dynarr_free (ef->begin_glyphs); | |
| 2931 Dynarr_free (ef->end_glyphs); | |
|
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4967
diff
changeset
|
2932 xfree (ef); |
| 428 | 2933 } |
| 2934 | |
| 2935 static int | |
| 2936 extent_priority_sort_function (const void *humpty, const void *dumpty) | |
| 2937 { | |
| 442 | 2938 const EXTENT foo = * (const EXTENT *) humpty; |
| 2939 const EXTENT bar = * (const EXTENT *) dumpty; | |
| 428 | 2940 if (extent_priority (foo) < extent_priority (bar)) |
| 2941 return -1; | |
| 2942 return extent_priority (foo) > extent_priority (bar); | |
| 2943 } | |
| 2944 | |
| 2945 static void | |
| 2946 extent_fragment_sort_by_priority (EXTENT_dynarr *extarr) | |
| 2947 { | |
| 2948 int i; | |
| 2949 | |
| 2950 /* Sort our copy of the stack by extent_priority. We use a bubble | |
| 2951 sort here because it's going to be faster than qsort() for small | |
| 2952 numbers of extents (less than 10 or so), and 99.999% of the time | |
| 2953 there won't ever be more extents than this in the stack. */ | |
| 2954 if (Dynarr_length (extarr) < 10) | |
| 2955 { | |
| 2956 for (i = 1; i < Dynarr_length (extarr); i++) | |
| 2957 { | |
| 2958 int j = i - 1; | |
| 2959 while (j >= 0 && | |
| 2960 (extent_priority (Dynarr_at (extarr, j)) > | |
| 2961 extent_priority (Dynarr_at (extarr, j+1)))) | |
| 2962 { | |
| 2963 EXTENT tmp = Dynarr_at (extarr, j); | |
| 2964 Dynarr_at (extarr, j) = Dynarr_at (extarr, j+1); | |
| 2965 Dynarr_at (extarr, j+1) = tmp; | |
| 2966 j--; | |
| 2967 } | |
| 2968 } | |
| 2969 } | |
| 2970 else | |
| 2971 /* But some loser programs mess up and may create a large number | |
| 2972 of extents overlapping the same spot. This will result in | |
| 2973 catastrophic behavior if we use the bubble sort above. */ | |
| 4967 | 2974 qsort (Dynarr_begin (extarr), Dynarr_length (extarr), |
| 428 | 2975 sizeof (EXTENT), extent_priority_sort_function); |
| 2976 } | |
| 2977 | |
| 2978 /* If PROP is the `invisible' property of an extent, | |
| 2979 this is 1 if the extent should be treated as invisible. */ | |
| 2980 | |
| 2981 #define EXTENT_PROP_MEANS_INVISIBLE(buf, prop) \ | |
| 2982 (EQ (buf->invisibility_spec, Qt) \ | |
| 2983 ? ! NILP (prop) \ | |
| 2984 : invisible_p (prop, buf->invisibility_spec)) | |
| 2985 | |
| 2986 /* If PROP is the `invisible' property of a extent, | |
| 2987 this is 1 if the extent should be treated as invisible | |
| 2988 and should have an ellipsis. */ | |
| 2989 | |
| 2990 #define EXTENT_PROP_MEANS_INVISIBLE_WITH_ELLIPSIS(buf, prop) \ | |
| 2991 (EQ (buf->invisibility_spec, Qt) \ | |
| 2992 ? 0 \ | |
| 2993 : invisible_ellipsis_p (prop, buf->invisibility_spec)) | |
| 2994 | |
| 2995 /* This is like a combination of memq and assq. | |
| 2996 Return 1 if PROPVAL appears as an element of LIST | |
| 2997 or as the car of an element of LIST. | |
| 2998 If PROPVAL is a list, compare each element against LIST | |
| 2999 in that way, and return 1 if any element of PROPVAL is found in LIST. | |
| 3000 Otherwise return 0. | |
| 3001 This function cannot quit. */ | |
| 3002 | |
| 3003 static int | |
| 3004 invisible_p (REGISTER Lisp_Object propval, Lisp_Object list) | |
| 3005 { | |
| 3006 REGISTER Lisp_Object tail, proptail; | |
| 3007 for (tail = list; CONSP (tail); tail = XCDR (tail)) | |
| 3008 { | |
| 3009 REGISTER Lisp_Object tem; | |
| 3010 tem = XCAR (tail); | |
| 3011 if (EQ (propval, tem)) | |
| 3012 return 1; | |
| 3013 if (CONSP (tem) && EQ (propval, XCAR (tem))) | |
| 3014 return 1; | |
| 3015 } | |
| 3016 if (CONSP (propval)) | |
| 3017 for (proptail = propval; CONSP (proptail); | |
| 3018 proptail = XCDR (proptail)) | |
| 3019 { | |
| 3020 Lisp_Object propelt; | |
| 3021 propelt = XCAR (proptail); | |
| 3022 for (tail = list; CONSP (tail); tail = XCDR (tail)) | |
| 3023 { | |
| 3024 REGISTER Lisp_Object tem; | |
| 3025 tem = XCAR (tail); | |
| 3026 if (EQ (propelt, tem)) | |
| 3027 return 1; | |
| 3028 if (CONSP (tem) && EQ (propelt, XCAR (tem))) | |
| 3029 return 1; | |
| 3030 } | |
| 3031 } | |
| 3032 return 0; | |
| 3033 } | |
| 3034 | |
| 3035 /* Return 1 if PROPVAL appears as the car of an element of LIST | |
| 3036 and the cdr of that element is non-nil. | |
| 3037 If PROPVAL is a list, check each element of PROPVAL in that way, | |
| 3038 and the first time some element is found, | |
| 3039 return 1 if the cdr of that element is non-nil. | |
| 3040 Otherwise return 0. | |
| 3041 This function cannot quit. */ | |
| 3042 | |
| 3043 static int | |
| 3044 invisible_ellipsis_p (REGISTER Lisp_Object propval, Lisp_Object list) | |
| 3045 { | |
| 3046 REGISTER Lisp_Object tail, proptail; | |
| 3047 for (tail = list; CONSP (tail); tail = XCDR (tail)) | |
| 3048 { | |
| 3049 REGISTER Lisp_Object tem; | |
| 3050 tem = XCAR (tail); | |
| 3051 if (CONSP (tem) && EQ (propval, XCAR (tem))) | |
| 3052 return ! NILP (XCDR (tem)); | |
| 3053 } | |
| 3054 if (CONSP (propval)) | |
| 3055 for (proptail = propval; CONSP (proptail); | |
| 3056 proptail = XCDR (proptail)) | |
| 3057 { | |
| 3058 Lisp_Object propelt; | |
| 3059 propelt = XCAR (proptail); | |
| 3060 for (tail = list; CONSP (tail); tail = XCDR (tail)) | |
| 3061 { | |
| 3062 REGISTER Lisp_Object tem; | |
| 3063 tem = XCAR (tail); | |
| 3064 if (CONSP (tem) && EQ (propelt, XCAR (tem))) | |
| 3065 return ! NILP (XCDR (tem)); | |
| 3066 } | |
| 3067 } | |
| 3068 return 0; | |
| 3069 } | |
| 3070 | |
| 3071 face_index | |
| 3072 extent_fragment_update (struct window *w, struct extent_fragment *ef, | |
| 826 | 3073 Bytexpos pos, Lisp_Object last_glyph) |
| 428 | 3074 { |
| 3075 int i; | |
| 819 | 3076 int seen_glyph = NILP (last_glyph) ? 1 : 0; |
| 428 | 3077 Extent_List *sel = |
| 3078 buffer_or_string_stack_of_extents_force (ef->object)->extents; | |
| 3079 EXTENT lhe = 0; | |
| 3080 struct extent dummy_lhe_extent; | |
| 826 | 3081 Memxpos mempos = buffer_or_string_bytexpos_to_memxpos (ef->object, pos); |
| 428 | 3082 |
| 3083 #ifdef ERROR_CHECK_EXTENTS | |
| 3084 assert (pos >= buffer_or_string_accessible_begin_byte (ef->object) | |
| 3085 && pos <= buffer_or_string_accessible_end_byte (ef->object)); | |
| 3086 #endif | |
| 3087 | |
| 3088 Dynarr_reset (ef->extents); | |
| 3089 Dynarr_reset (ef->begin_glyphs); | |
| 3090 Dynarr_reset (ef->end_glyphs); | |
| 3091 | |
| 3092 ef->previously_invisible = ef->invisible; | |
| 3093 if (ef->invisible) | |
| 3094 { | |
| 3095 if (ef->invisible_ellipses) | |
| 3096 ef->invisible_ellipses_already_displayed = 1; | |
| 3097 } | |
| 3098 else | |
| 3099 ef->invisible_ellipses_already_displayed = 0; | |
| 3100 ef->invisible = 0; | |
| 3101 ef->invisible_ellipses = 0; | |
| 3102 | |
| 3103 /* Set up the begin and end positions. */ | |
| 3104 ef->pos = pos; | |
| 3105 ef->end = extent_find_end_of_run (ef->object, pos, 0); | |
| 3106 | |
| 3107 /* Note that extent_find_end_of_run() already moved the SOE for us. */ | |
| 3108 /* soe_move (ef->object, mempos); */ | |
| 3109 | |
| 3110 /* Determine the begin glyphs at POS. */ | |
| 3111 for (i = 0; i < extent_list_num_els (sel); i++) | |
| 3112 { | |
| 3113 EXTENT e = extent_list_at (sel, i, 0); | |
| 3114 if (extent_start (e) == mempos && !NILP (extent_begin_glyph (e))) | |
| 3115 { | |
| 3116 Lisp_Object glyph = extent_begin_glyph (e); | |
| 4932 | 3117 if (seen_glyph) |
| 3118 { | |
| 3119 struct glyph_block gb; | |
| 3120 | |
| 3121 xzero (gb); | |
| 3122 gb.glyph = glyph; | |
| 3123 gb.extent = wrap_extent (e); | |
| 3124 Dynarr_add (ef->begin_glyphs, gb); | |
| 3125 } | |
| 819 | 3126 else if (EQ (glyph, last_glyph)) |
| 3127 seen_glyph = 1; | |
| 428 | 3128 } |
| 3129 } | |
| 3130 | |
| 3131 /* Determine the end glyphs at POS. */ | |
| 3132 for (i = 0; i < extent_list_num_els (sel); i++) | |
| 3133 { | |
| 3134 EXTENT e = extent_list_at (sel, i, 1); | |
| 3135 if (extent_end (e) == mempos && !NILP (extent_end_glyph (e))) | |
| 3136 { | |
| 3137 Lisp_Object glyph = extent_end_glyph (e); | |
| 4932 | 3138 if (seen_glyph) |
| 3139 { | |
| 3140 struct glyph_block gb; | |
| 3141 | |
| 3142 xzero (gb); | |
| 3143 gb.glyph = glyph; | |
| 3144 gb.extent = wrap_extent (e); | |
| 3145 Dynarr_add (ef->end_glyphs, gb); | |
| 3146 } | |
| 819 | 3147 else if (EQ (glyph, last_glyph)) |
| 3148 seen_glyph = 1; | |
| 428 | 3149 } |
| 3150 } | |
| 3151 | |
| 3152 /* We tried determining all the charsets used in the run here, | |
| 3153 but that fails even if we only do the current line -- display | |
| 3154 tables or non-printable characters might cause other charsets | |
| 3155 to be used. */ | |
| 3156 | |
| 3157 /* Determine whether the last-highlighted-extent is present. */ | |
| 3158 if (EXTENTP (Vlast_highlighted_extent)) | |
| 3159 lhe = XEXTENT (Vlast_highlighted_extent); | |
| 3160 | |
| 3161 /* Now add all extents that overlap the character after POS and | |
| 3162 have a non-nil face. Also check if the character is invisible. */ | |
| 3163 for (i = 0; i < extent_list_num_els (sel); i++) | |
| 3164 { | |
| 3165 EXTENT e = extent_list_at (sel, i, 0); | |
| 3166 if (extent_end (e) > mempos) | |
| 3167 { | |
| 3168 Lisp_Object invis_prop = extent_invisible (e); | |
| 3169 | |
| 3170 if (!NILP (invis_prop)) | |
| 3171 { | |
| 3172 if (!BUFFERP (ef->object)) | |
| 3173 /* #### no `string-invisibility-spec' */ | |
| 3174 ef->invisible = 1; | |
| 3175 else | |
| 3176 { | |
| 3177 if (!ef->invisible_ellipses_already_displayed && | |
| 3178 EXTENT_PROP_MEANS_INVISIBLE_WITH_ELLIPSIS | |
| 3179 (XBUFFER (ef->object), invis_prop)) | |
| 3180 { | |
| 3181 ef->invisible = 1; | |
| 3182 ef->invisible_ellipses = 1; | |
| 3183 } | |
| 3184 else if (EXTENT_PROP_MEANS_INVISIBLE | |
| 3185 (XBUFFER (ef->object), invis_prop)) | |
| 3186 ef->invisible = 1; | |
| 3187 } | |
| 3188 } | |
| 3189 | |
| 3190 /* Remember that one of the extents in the list might be our | |
| 3191 dummy extent representing the highlighting that is | |
| 3192 attached to some other extent that is currently | |
| 3193 mouse-highlighted. When an extent is mouse-highlighted, | |
| 3194 it is as if there are two extents there, of potentially | |
| 3195 different priorities: the extent being highlighted, with | |
| 3196 whatever face and priority it has; and an ephemeral | |
| 3197 extent in the `mouse-face' face with | |
| 3198 `mouse-highlight-priority'. | |
| 3199 */ | |
| 3200 | |
| 3201 if (!NILP (extent_face (e))) | |
| 3202 Dynarr_add (ef->extents, e); | |
| 3203 if (e == lhe) | |
| 3204 { | |
| 3205 Lisp_Object f; | |
| 3206 /* zeroing isn't really necessary; we only deref `priority' | |
| 3207 and `face' */ | |
| 3208 xzero (dummy_lhe_extent); | |
| 3209 set_extent_priority (&dummy_lhe_extent, | |
| 3210 mouse_highlight_priority); | |
| 3211 /* Need to break up the following expression, due to an */ | |
| 3212 /* error in the Digital UNIX 3.2g C compiler (Digital */ | |
| 3213 /* UNIX Compiler Driver 3.11). */ | |
| 3214 f = extent_mouse_face (lhe); | |
| 3215 extent_face (&dummy_lhe_extent) = f; | |
| 3216 Dynarr_add (ef->extents, &dummy_lhe_extent); | |
| 3217 } | |
| 3218 /* since we are looping anyway, we might as well do this here */ | |
| 3219 if ((!NILP(extent_initial_redisplay_function (e))) && | |
| 3220 !extent_in_red_event_p(e)) | |
| 3221 { | |
| 3222 Lisp_Object function = extent_initial_redisplay_function (e); | |
| 3223 Lisp_Object obj; | |
| 3224 | |
| 3225 /* printf ("initial redisplay function called!\n "); */ | |
| 3226 | |
| 3227 /* print_extent_2 (e); | |
| 3228 printf ("\n"); */ | |
| 3229 | |
| 3230 /* FIXME: One should probably inhibit the displaying of | |
| 3231 this extent to reduce flicker */ | |
| 793 | 3232 extent_in_red_event_p (e) = 1; |
| 428 | 3233 |
| 3234 /* call the function */ | |
| 793 | 3235 obj = wrap_extent (e); |
| 3236 if (!NILP (function)) | |
| 3237 Fenqueue_eval_event (function, obj); | |
| 428 | 3238 } |
| 3239 } | |
| 3240 } | |
| 3241 | |
| 3242 extent_fragment_sort_by_priority (ef->extents); | |
| 3243 | |
| 3244 /* Now merge the faces together into a single face. The code to | |
| 3245 do this is in faces.c because it involves manipulating faces. */ | |
| 3246 return get_extent_fragment_face_cache_index (w, ef); | |
| 3247 } | |
| 3248 | |
| 3249 | |
| 3250 /************************************************************************/ | |
| 3251 /* extent-object methods */ | |
| 3252 /************************************************************************/ | |
| 3253 | |
| 3254 /* These are the basic helper functions for handling the allocation of | |
| 3255 extent objects. They are similar to the functions for other | |
| 3256 lrecord objects. allocate_extent() is in alloc.c, not here. */ | |
| 3257 | |
| 3258 static Lisp_Object | |
| 3259 mark_extent (Lisp_Object obj) | |
| 3260 { | |
| 3261 struct extent *extent = XEXTENT (obj); | |
| 3262 | |
| 3263 mark_object (extent_object (extent)); | |
| 3264 mark_object (extent_no_chase_normal_field (extent, face)); | |
| 3265 return extent->plist; | |
| 3266 } | |
| 3267 | |
| 3268 static void | |
| 2286 | 3269 print_extent_1 (Lisp_Object obj, Lisp_Object printcharfun, |
| 3270 int UNUSED (escapeflag)) | |
| 428 | 3271 { |
| 3272 EXTENT ext = XEXTENT (obj); | |
| 3273 EXTENT anc = extent_ancestor (ext); | |
| 3274 Lisp_Object tail; | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
3275 Ascbyte buf[64], *bp = buf; |
| 428 | 3276 |
| 3277 /* Retrieve the ancestor and use it, for faster retrieval of properties */ | |
| 3278 | |
| 3279 if (!NILP (extent_begin_glyph (anc))) *bp++ = '*'; | |
| 3280 *bp++ = (extent_start_open_p (anc) ? '(': '['); | |
| 3281 if (extent_detached_p (ext)) | |
| 3282 strcpy (bp, "detached"); | |
| 3283 else | |
| 826 | 3284 sprintf (bp, "%ld, %ld", |
| 819 | 3285 XINT (Fextent_start_position (obj)), |
| 3286 XINT (Fextent_end_position (obj))); | |
| 428 | 3287 bp += strlen (bp); |
| 3288 *bp++ = (extent_end_open_p (anc) ? ')': ']'); | |
| 3289 if (!NILP (extent_end_glyph (anc))) *bp++ = '*'; | |
| 3290 *bp++ = ' '; | |
| 3291 | |
| 3292 if (!NILP (extent_read_only (anc))) *bp++ = '%'; | |
| 3293 if (!NILP (extent_mouse_face (anc))) *bp++ = 'H'; | |
| 3294 if (extent_unique_p (anc)) *bp++ = 'U'; | |
| 3295 else if (extent_duplicable_p (anc)) *bp++ = 'D'; | |
| 3296 if (!NILP (extent_invisible (anc))) *bp++ = 'I'; | |
| 3297 | |
| 3298 if (!NILP (extent_read_only (anc)) || !NILP (extent_mouse_face (anc)) || | |
| 3299 extent_unique_p (anc) || | |
| 3300 extent_duplicable_p (anc) || !NILP (extent_invisible (anc))) | |
| 3301 *bp++ = ' '; | |
| 3302 *bp = '\0'; | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
3303 write_ascstring (printcharfun, buf); |
| 428 | 3304 |
| 3305 tail = extent_plist_slot (anc); | |
| 3306 | |
| 3307 for (; !NILP (tail); tail = Fcdr (Fcdr (tail))) | |
| 3308 { | |
| 3309 Lisp_Object v = XCAR (XCDR (tail)); | |
| 3310 if (NILP (v)) continue; | |
| 800 | 3311 write_fmt_string_lisp (printcharfun, "%S ", 1, XCAR (tail)); |
| 428 | 3312 } |
| 3313 | |
| 800 | 3314 write_fmt_string (printcharfun, "0x%lx", (long) ext); |
| 428 | 3315 } |
| 3316 | |
| 3317 static void | |
| 3318 print_extent (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) | |
| 3319 { | |
| 3320 if (escapeflag) | |
| 3321 { | |
| 442 | 3322 const char *title = ""; |
| 3323 const char *name = ""; | |
| 3324 const char *posttitle = ""; | |
| 428 | 3325 Lisp_Object obj2 = Qnil; |
| 3326 | |
| 3327 /* Destroyed extents have 't' in the object field, causing | |
| 2500 | 3328 extent_object() to ABORT (maybe). */ |
| 428 | 3329 if (EXTENT_LIVE_P (XEXTENT (obj))) |
| 3330 obj2 = extent_object (XEXTENT (obj)); | |
| 3331 | |
| 3332 if (NILP (obj2)) | |
| 3333 title = "no buffer"; | |
| 3334 else if (BUFFERP (obj2)) | |
| 3335 { | |
| 3336 if (BUFFER_LIVE_P (XBUFFER (obj2))) | |
| 3337 { | |
| 3338 title = "buffer "; | |
| 3339 name = (char *) XSTRING_DATA (XBUFFER (obj2)->name); | |
| 3340 } | |
| 3341 else | |
| 3342 { | |
| 3343 title = "Killed Buffer"; | |
| 3344 name = ""; | |
| 3345 } | |
| 3346 } | |
| 3347 else | |
| 3348 { | |
| 3349 assert (STRINGP (obj2)); | |
| 3350 title = "string \""; | |
| 3351 posttitle = "\""; | |
| 3352 name = (char *) XSTRING_DATA (obj2); | |
| 3353 } | |
| 3354 | |
| 3355 if (print_readably) | |
| 3356 { | |
| 3357 if (!EXTENT_LIVE_P (XEXTENT (obj))) | |
| 563 | 3358 printing_unreadable_object ("#<destroyed extent>"); |
| 428 | 3359 else |
| 563 | 3360 printing_unreadable_object ("#<extent 0x%lx>", |
| 428 | 3361 (long) XEXTENT (obj)); |
| 3362 } | |
| 3363 | |
| 3364 if (!EXTENT_LIVE_P (XEXTENT (obj))) | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
3365 write_ascstring (printcharfun, "#<destroyed extent"); |
| 428 | 3366 else |
| 3367 { | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
3368 write_ascstring (printcharfun, "#<extent "); |
| 428 | 3369 print_extent_1 (obj, printcharfun, escapeflag); |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
3370 write_ascstring (printcharfun, extent_detached_p (XEXTENT (obj)) |
| 826 | 3371 ? " from " : " in "); |
| 800 | 3372 write_fmt_string (printcharfun, "%s%s%s", title, name, posttitle); |
| 428 | 3373 } |
| 3374 } | |
| 3375 else | |
| 3376 { | |
| 3377 if (print_readably) | |
| 563 | 3378 printing_unreadable_object ("#<extent>"); |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
3379 write_ascstring (printcharfun, "#<extent"); |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
3380 } |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
3381 write_ascstring (printcharfun, ">"); |
| 428 | 3382 } |
| 3383 | |
| 3384 static int | |
| 3385 properties_equal (EXTENT e1, EXTENT e2, int depth) | |
| 3386 { | |
| 3387 /* When this function is called, all indirections have been followed. | |
| 3388 Thus, the indirection checks in the various macros below will not | |
| 3389 amount to anything, and could be removed. However, the time | |
| 3390 savings would probably not be significant. */ | |
| 3391 if (!(EQ (extent_face (e1), extent_face (e2)) && | |
| 3392 extent_priority (e1) == extent_priority (e2) && | |
| 3393 internal_equal (extent_begin_glyph (e1), extent_begin_glyph (e2), | |
| 3394 depth + 1) && | |
| 3395 internal_equal (extent_end_glyph (e1), extent_end_glyph (e2), | |
| 3396 depth + 1))) | |
| 3397 return 0; | |
| 3398 | |
| 3399 /* compare the bit flags. */ | |
| 3400 { | |
| 3401 /* The has_aux field should not be relevant. */ | |
| 3402 int e1_has_aux = e1->flags.has_aux; | |
| 3403 int e2_has_aux = e2->flags.has_aux; | |
| 3404 int value; | |
| 3405 | |
| 3406 e1->flags.has_aux = e2->flags.has_aux = 0; | |
| 3407 value = memcmp (&e1->flags, &e2->flags, sizeof (e1->flags)); | |
| 3408 e1->flags.has_aux = e1_has_aux; | |
| 3409 e2->flags.has_aux = e2_has_aux; | |
| 3410 if (value) | |
| 3411 return 0; | |
| 3412 } | |
| 3413 | |
| 3414 /* compare the random elements of the plists. */ | |
| 3415 return !plists_differ (extent_no_chase_plist (e1), | |
| 3416 extent_no_chase_plist (e2), | |
|
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4117
diff
changeset
|
3417 0, 0, depth + 1, 0); |
| 428 | 3418 } |
| 3419 | |
| 3420 static int | |
|
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4117
diff
changeset
|
3421 extent_equal (Lisp_Object obj1, Lisp_Object obj2, int depth, |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4117
diff
changeset
|
3422 int UNUSED (foldcase)) |
| 428 | 3423 { |
| 3424 struct extent *e1 = XEXTENT (obj1); | |
| 3425 struct extent *e2 = XEXTENT (obj2); | |
| 3426 return | |
| 3427 (extent_start (e1) == extent_start (e2) && | |
| 3428 extent_end (e1) == extent_end (e2) && | |
| 3429 internal_equal (extent_object (e1), extent_object (e2), depth + 1) && | |
| 3430 properties_equal (extent_ancestor (e1), extent_ancestor (e2), | |
| 3431 depth)); | |
| 3432 } | |
| 3433 | |
| 665 | 3434 static Hashcode |
| 428 | 3435 extent_hash (Lisp_Object obj, int depth) |
| 3436 { | |
| 3437 struct extent *e = XEXTENT (obj); | |
| 3438 /* No need to hash all of the elements; that would take too long. | |
| 3439 Just hash the most common ones. */ | |
| 3440 return HASH3 (extent_start (e), extent_end (e), | |
| 3441 internal_hash (extent_object (e), depth + 1)); | |
| 3442 } | |
| 3443 | |
| 1204 | 3444 static const struct memory_description extent_description[] = { |
| 442 | 3445 { XD_LISP_OBJECT, offsetof (struct extent, object) }, |
| 3446 { XD_LISP_OBJECT, offsetof (struct extent, flags.face) }, | |
| 3447 { XD_LISP_OBJECT, offsetof (struct extent, plist) }, | |
| 3448 { XD_END } | |
| 3449 }; | |
| 3450 | |
| 428 | 3451 static Lisp_Object |
| 3452 extent_getprop (Lisp_Object obj, Lisp_Object prop) | |
| 3453 { | |
| 3454 return Fextent_property (obj, prop, Qunbound); | |
| 3455 } | |
| 3456 | |
| 3457 static int | |
| 3458 extent_putprop (Lisp_Object obj, Lisp_Object prop, Lisp_Object value) | |
| 3459 { | |
| 3460 Fset_extent_property (obj, prop, value); | |
| 3461 return 1; | |
| 3462 } | |
| 3463 | |
| 3464 static int | |
| 3465 extent_remprop (Lisp_Object obj, Lisp_Object prop) | |
| 3466 { | |
| 826 | 3467 Lisp_Object retval = Fset_extent_property (obj, prop, Qunbound); |
| 3468 if (UNBOUNDP (retval)) | |
| 3469 return -1; | |
| 3470 else if (!NILP (retval)) | |
| 3471 return 1; | |
| 3472 else | |
| 3473 return 0; | |
| 428 | 3474 } |
| 3475 | |
| 3476 static Lisp_Object | |
| 3477 extent_plist (Lisp_Object obj) | |
| 3478 { | |
| 3479 return Fextent_properties (obj); | |
| 3480 } | |
| 3481 | |
| 934 | 3482 DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS ("extent", extent, |
| 3483 1, /*dumpable-flag*/ | |
| 3484 mark_extent, | |
| 3485 print_extent, | |
| 3486 /* NOTE: If you declare a | |
| 3487 finalization method here, | |
| 3488 it will NOT be called. | |
| 3489 Shaft city. */ | |
| 3490 0, | |
| 3491 extent_equal, extent_hash, | |
| 3492 extent_description, | |
| 3493 extent_getprop, extent_putprop, | |
| 3494 extent_remprop, extent_plist, | |
| 3495 struct extent); | |
| 428 | 3496 |
| 3497 /************************************************************************/ | |
| 3498 /* basic extent accessors */ | |
| 3499 /************************************************************************/ | |
| 3500 | |
| 3501 /* These functions are for checking externally-passed extent objects | |
| 3502 and returning an extent's basic properties, which include the | |
| 3503 buffer the extent is associated with, the endpoints of the extent's | |
| 3504 range, the open/closed-ness of those endpoints, and whether the | |
| 3505 extent is detached. Manipulating these properties requires | |
| 3506 manipulating the ordered lists that hold extents; thus, functions | |
| 3507 to do that are in a later section. */ | |
| 3508 | |
| 3509 /* Given a Lisp_Object that is supposed to be an extent, make sure it | |
| 3510 is OK and return an extent pointer. Extents can be in one of four | |
| 3511 states: | |
| 3512 | |
| 3513 1) destroyed | |
| 3514 2) detached and not associated with a buffer | |
| 3515 3) detached and associated with a buffer | |
| 3516 4) attached to a buffer | |
| 3517 | |
| 3518 If FLAGS is 0, types 2-4 are allowed. If FLAGS is DE_MUST_HAVE_BUFFER, | |
| 3519 types 3-4 are allowed. If FLAGS is DE_MUST_BE_ATTACHED, only type 4 | |
| 3520 is allowed. | |
| 3521 */ | |
| 3522 | |
| 3523 static EXTENT | |
| 3524 decode_extent (Lisp_Object extent_obj, unsigned int flags) | |
| 3525 { | |
| 3526 EXTENT extent; | |
| 3527 Lisp_Object obj; | |
| 3528 | |
| 3529 CHECK_LIVE_EXTENT (extent_obj); | |
| 3530 extent = XEXTENT (extent_obj); | |
| 3531 obj = extent_object (extent); | |
| 3532 | |
| 3533 /* the following condition will fail if we're dealing with a freed extent */ | |
| 3534 assert (NILP (obj) || BUFFERP (obj) || STRINGP (obj)); | |
| 3535 | |
| 3536 if (flags & DE_MUST_BE_ATTACHED) | |
| 3537 flags |= DE_MUST_HAVE_BUFFER; | |
| 3538 | |
| 3539 /* if buffer is dead, then convert extent to have no buffer. */ | |
| 3540 if (BUFFERP (obj) && !BUFFER_LIVE_P (XBUFFER (obj))) | |
| 3541 obj = extent_object (extent) = Qnil; | |
| 3542 | |
| 3543 assert (!NILP (obj) || extent_detached_p (extent)); | |
| 3544 | |
| 3545 if ((NILP (obj) && (flags & DE_MUST_HAVE_BUFFER)) | |
| 3546 || (extent_detached_p (extent) && (flags & DE_MUST_BE_ATTACHED))) | |
| 3547 { | |
| 442 | 3548 invalid_argument ("extent doesn't belong to a buffer or string", |
| 3549 extent_obj); | |
| 428 | 3550 } |
| 3551 | |
| 3552 return extent; | |
| 3553 } | |
| 3554 | |
| 826 | 3555 /* Note that the returned value is a char position, not a byte position. */ |
| 428 | 3556 |
| 3557 static Lisp_Object | |
| 3558 extent_endpoint_external (Lisp_Object extent_obj, int endp) | |
| 3559 { | |
| 3560 EXTENT extent = decode_extent (extent_obj, 0); | |
| 3561 | |
| 3562 if (extent_detached_p (extent)) | |
| 3563 return Qnil; | |
| 3564 else | |
| 826 | 3565 return make_int (extent_endpoint_char (extent, endp)); |
| 428 | 3566 } |
| 3567 | |
| 3568 DEFUN ("extentp", Fextentp, 1, 1, 0, /* | |
| 3569 Return t if OBJECT is an extent. | |
| 3570 */ | |
| 3571 (object)) | |
| 3572 { | |
| 3573 return EXTENTP (object) ? Qt : Qnil; | |
| 3574 } | |
| 3575 | |
| 3576 DEFUN ("extent-live-p", Fextent_live_p, 1, 1, 0, /* | |
| 3577 Return t if OBJECT is an extent that has not been destroyed. | |
| 3578 */ | |
| 3579 (object)) | |
| 3580 { | |
| 3581 return EXTENTP (object) && EXTENT_LIVE_P (XEXTENT (object)) ? Qt : Qnil; | |
| 3582 } | |
| 3583 | |
| 3584 DEFUN ("extent-detached-p", Fextent_detached_p, 1, 1, 0, /* | |
| 3585 Return t if EXTENT is detached. | |
| 3586 */ | |
| 3587 (extent)) | |
| 3588 { | |
| 3589 return extent_detached_p (decode_extent (extent, 0)) ? Qt : Qnil; | |
| 3590 } | |
| 3591 | |
| 3592 DEFUN ("extent-object", Fextent_object, 1, 1, 0, /* | |
| 3593 Return object (buffer or string) that EXTENT refers to. | |
| 3594 */ | |
| 3595 (extent)) | |
| 3596 { | |
| 3597 return extent_object (decode_extent (extent, 0)); | |
| 3598 } | |
| 3599 | |
| 3600 DEFUN ("extent-start-position", Fextent_start_position, 1, 1, 0, /* | |
| 3601 Return start position of EXTENT, or nil if EXTENT is detached. | |
| 3602 */ | |
| 3603 (extent)) | |
| 3604 { | |
| 3605 return extent_endpoint_external (extent, 0); | |
| 3606 } | |
| 3607 | |
| 3608 DEFUN ("extent-end-position", Fextent_end_position, 1, 1, 0, /* | |
| 3609 Return end position of EXTENT, or nil if EXTENT is detached. | |
| 3610 */ | |
| 3611 (extent)) | |
| 3612 { | |
| 3613 return extent_endpoint_external (extent, 1); | |
| 3614 } | |
| 3615 | |
| 3616 DEFUN ("extent-length", Fextent_length, 1, 1, 0, /* | |
| 3617 Return length of EXTENT in characters. | |
| 3618 */ | |
| 3619 (extent)) | |
| 3620 { | |
| 3621 EXTENT e = decode_extent (extent, DE_MUST_BE_ATTACHED); | |
| 826 | 3622 return make_int (extent_endpoint_char (e, 1) |
| 3623 - extent_endpoint_char (e, 0)); | |
| 428 | 3624 } |
| 3625 | |
| 3626 DEFUN ("next-extent", Fnext_extent, 1, 1, 0, /* | |
| 3627 Find next extent after EXTENT. | |
| 3628 If EXTENT is a buffer return the first extent in the buffer; likewise | |
| 3629 for strings. | |
| 3630 Extents in a buffer are ordered in what is called the "display" | |
| 3631 order, which sorts by increasing start positions and then by *decreasing* | |
| 3632 end positions. | |
| 3633 If you want to perform an operation on a series of extents, use | |
| 3634 `map-extents' instead of this function; it is much more efficient. | |
| 3635 The primary use of this function should be to enumerate all the | |
| 3636 extents in a buffer. | |
| 3637 Note: The display order is not necessarily the order that `map-extents' | |
| 3638 processes extents in! | |
| 3639 */ | |
| 3640 (extent)) | |
| 3641 { | |
| 3642 EXTENT next; | |
| 3643 | |
| 3644 if (EXTENTP (extent)) | |
| 3645 next = extent_next (decode_extent (extent, DE_MUST_BE_ATTACHED)); | |
| 3646 else | |
| 3647 next = extent_first (decode_buffer_or_string (extent)); | |
| 3648 | |
| 3649 if (!next) | |
| 3650 return Qnil; | |
| 793 | 3651 return wrap_extent (next); |
| 428 | 3652 } |
| 3653 | |
| 3654 DEFUN ("previous-extent", Fprevious_extent, 1, 1, 0, /* | |
| 3655 Find last extent before EXTENT. | |
| 3656 If EXTENT is a buffer return the last extent in the buffer; likewise | |
| 3657 for strings. | |
| 3658 This function is analogous to `next-extent'. | |
| 3659 */ | |
| 3660 (extent)) | |
| 3661 { | |
| 3662 EXTENT prev; | |
| 3663 | |
| 3664 if (EXTENTP (extent)) | |
| 3665 prev = extent_previous (decode_extent (extent, DE_MUST_BE_ATTACHED)); | |
| 3666 else | |
| 3667 prev = extent_last (decode_buffer_or_string (extent)); | |
| 3668 | |
| 3669 if (!prev) | |
| 3670 return Qnil; | |
| 793 | 3671 return wrap_extent (prev); |
| 428 | 3672 } |
| 3673 | |
| 3674 #ifdef DEBUG_XEMACS | |
| 3675 | |
| 3676 DEFUN ("next-e-extent", Fnext_e_extent, 1, 1, 0, /* | |
| 3677 Find next extent after EXTENT using the "e" order. | |
| 3678 If EXTENT is a buffer return the first extent in the buffer; likewise | |
| 3679 for strings. | |
| 3680 */ | |
| 3681 (extent)) | |
| 3682 { | |
| 3683 EXTENT next; | |
| 3684 | |
| 3685 if (EXTENTP (extent)) | |
| 3686 next = extent_e_next (decode_extent (extent, DE_MUST_BE_ATTACHED)); | |
| 3687 else | |
| 3688 next = extent_e_first (decode_buffer_or_string (extent)); | |
| 3689 | |
| 3690 if (!next) | |
| 3691 return Qnil; | |
| 793 | 3692 return wrap_extent (next); |
| 428 | 3693 } |
| 3694 | |
| 3695 DEFUN ("previous-e-extent", Fprevious_e_extent, 1, 1, 0, /* | |
| 3696 Find last extent before EXTENT using the "e" order. | |
| 3697 If EXTENT is a buffer return the last extent in the buffer; likewise | |
| 3698 for strings. | |
| 3699 This function is analogous to `next-e-extent'. | |
| 3700 */ | |
| 3701 (extent)) | |
| 3702 { | |
| 3703 EXTENT prev; | |
| 3704 | |
| 3705 if (EXTENTP (extent)) | |
| 3706 prev = extent_e_previous (decode_extent (extent, DE_MUST_BE_ATTACHED)); | |
| 3707 else | |
| 3708 prev = extent_e_last (decode_buffer_or_string (extent)); | |
| 3709 | |
| 3710 if (!prev) | |
| 3711 return Qnil; | |
| 793 | 3712 return wrap_extent (prev); |
| 428 | 3713 } |
| 3714 | |
| 3715 #endif | |
| 3716 | |
| 3717 DEFUN ("next-extent-change", Fnext_extent_change, 1, 2, 0, /* | |
| 3718 Return the next position after POS where an extent begins or ends. | |
| 3719 If POS is at the end of the buffer or string, POS will be returned; | |
| 3720 otherwise a position greater than POS will always be returned. | |
| 444 | 3721 If OBJECT is nil, the current buffer is assumed. |
| 428 | 3722 */ |
| 3723 (pos, object)) | |
| 3724 { | |
| 3725 Lisp_Object obj = decode_buffer_or_string (object); | |
| 826 | 3726 Bytexpos xpos; |
| 3727 | |
| 3728 xpos = get_buffer_or_string_pos_byte (obj, pos, GB_ALLOW_PAST_ACCESSIBLE); | |
| 3729 xpos = extent_find_end_of_run (obj, xpos, 1); | |
| 3730 return make_int (buffer_or_string_bytexpos_to_charxpos (obj, xpos)); | |
| 428 | 3731 } |
| 3732 | |
| 3733 DEFUN ("previous-extent-change", Fprevious_extent_change, 1, 2, 0, /* | |
| 3734 Return the last position before POS where an extent begins or ends. | |
| 3735 If POS is at the beginning of the buffer or string, POS will be returned; | |
| 3736 otherwise a position less than POS will always be returned. | |
| 3737 If OBJECT is nil, the current buffer is assumed. | |
| 3738 */ | |
| 3739 (pos, object)) | |
| 3740 { | |
| 3741 Lisp_Object obj = decode_buffer_or_string (object); | |
| 826 | 3742 Bytexpos xpos; |
| 3743 | |
| 3744 xpos = get_buffer_or_string_pos_byte (obj, pos, GB_ALLOW_PAST_ACCESSIBLE); | |
| 3745 xpos = extent_find_beginning_of_run (obj, xpos, 1); | |
| 3746 return make_int (buffer_or_string_bytexpos_to_charxpos (obj, xpos)); | |
| 428 | 3747 } |
| 3748 | |
| 3749 | |
| 3750 /************************************************************************/ | |
| 3751 /* parent and children stuff */ | |
| 3752 /************************************************************************/ | |
| 3753 | |
| 3754 DEFUN ("extent-parent", Fextent_parent, 1, 1, 0, /* | |
| 3755 Return the parent (if any) of EXTENT. | |
| 3756 If an extent has a parent, it derives all its properties from that extent | |
| 3757 and has no properties of its own. (The only "properties" that the | |
| 3758 extent keeps are the buffer/string it refers to and the start and end | |
| 3759 points.) It is possible for an extent's parent to itself have a parent. | |
| 3760 */ | |
| 3761 (extent)) | |
| 3762 /* do I win the prize for the strangest split infinitive? */ | |
| 3763 { | |
| 3764 EXTENT e = decode_extent (extent, 0); | |
| 3765 return extent_parent (e); | |
| 3766 } | |
| 3767 | |
| 3768 DEFUN ("extent-children", Fextent_children, 1, 1, 0, /* | |
| 3769 Return a list of the children (if any) of EXTENT. | |
| 3770 The children of an extent are all those extents whose parent is that extent. | |
| 3771 This function does not recursively trace children of children. | |
| 3772 \(To do that, use `extent-descendants'.) | |
| 3773 */ | |
| 3774 (extent)) | |
| 3775 { | |
| 3776 EXTENT e = decode_extent (extent, 0); | |
| 3777 Lisp_Object children = extent_children (e); | |
| 3778 | |
| 3779 if (!NILP (children)) | |
| 3780 return Fcopy_sequence (XWEAK_LIST_LIST (children)); | |
| 3781 else | |
| 3782 return Qnil; | |
| 3783 } | |
| 3784 | |
| 3785 static void | |
| 3786 remove_extent_from_children_list (EXTENT e, Lisp_Object child) | |
| 3787 { | |
| 3788 Lisp_Object children = extent_children (e); | |
| 3789 | |
| 3790 #ifdef ERROR_CHECK_EXTENTS | |
| 3791 assert (!NILP (memq_no_quit (child, XWEAK_LIST_LIST (children)))); | |
| 3792 #endif | |
| 3793 XWEAK_LIST_LIST (children) = | |
| 3794 delq_no_quit (child, XWEAK_LIST_LIST (children)); | |
| 3795 } | |
| 3796 | |
| 3797 static void | |
| 3798 add_extent_to_children_list (EXTENT e, Lisp_Object child) | |
| 3799 { | |
| 3800 Lisp_Object children = extent_children (e); | |
| 3801 | |
| 3802 if (NILP (children)) | |
| 3803 { | |
| 3804 children = make_weak_list (WEAK_LIST_SIMPLE); | |
| 3805 set_extent_no_chase_aux_field (e, children, children); | |
| 3806 } | |
| 3807 | |
| 3808 #ifdef ERROR_CHECK_EXTENTS | |
| 3809 assert (NILP (memq_no_quit (child, XWEAK_LIST_LIST (children)))); | |
| 3810 #endif | |
| 3811 XWEAK_LIST_LIST (children) = Fcons (child, XWEAK_LIST_LIST (children)); | |
| 3812 } | |
| 3813 | |
| 826 | 3814 |
| 3815 static int | |
| 3816 compare_key_value_pairs (const void *humpty, const void *dumpty) | |
| 3817 { | |
| 3818 Lisp_Object_pair *foo = (Lisp_Object_pair *) humpty; | |
| 3819 Lisp_Object_pair *bar = (Lisp_Object_pair *) dumpty; | |
| 3820 if (EQ (foo->key, bar->key)) | |
| 3821 return 0; | |
| 3822 return !NILP (Fstring_lessp (foo->key, bar->key)) ? -1 : 1; | |
| 3823 } | |
| 3824 | |
| 428 | 3825 DEFUN ("set-extent-parent", Fset_extent_parent, 2, 2, 0, /* |
| 3826 Set the parent of EXTENT to PARENT (may be nil). | |
| 3827 See `extent-parent'. | |
| 3828 */ | |
| 3829 (extent, parent)) | |
| 3830 { | |
| 3831 EXTENT e = decode_extent (extent, 0); | |
| 3832 Lisp_Object cur_parent = extent_parent (e); | |
| 3833 Lisp_Object rest; | |
| 3834 | |
| 793 | 3835 extent = wrap_extent (e); |
| 428 | 3836 if (!NILP (parent)) |
| 3837 CHECK_LIVE_EXTENT (parent); | |
| 3838 if (EQ (parent, cur_parent)) | |
| 3839 return Qnil; | |
| 3840 for (rest = parent; !NILP (rest); rest = extent_parent (XEXTENT (rest))) | |
| 3841 if (EQ (rest, extent)) | |
| 563 | 3842 signal_error (Qinvalid_change, |
| 442 | 3843 "Circular parent chain would result", |
| 3844 extent); | |
| 428 | 3845 if (NILP (parent)) |
| 3846 { | |
| 3847 remove_extent_from_children_list (XEXTENT (cur_parent), extent); | |
| 3848 set_extent_no_chase_aux_field (e, parent, Qnil); | |
| 3849 e->flags.has_parent = 0; | |
| 3850 } | |
| 3851 else | |
| 3852 { | |
| 3853 add_extent_to_children_list (XEXTENT (parent), extent); | |
| 3854 set_extent_no_chase_aux_field (e, parent, parent); | |
| 3855 e->flags.has_parent = 1; | |
| 3856 } | |
| 3857 /* changing the parent also changes the properties of all children. */ | |
| 3858 { | |
| 826 | 3859 Lisp_Object_pair_dynarr *oldprops, *newprops; |
| 3860 int i, orignewlength; | |
| 3861 | |
| 3862 /* perhaps there's a smarter way, but the following will work, | |
| 3863 and it's O(N*log N): | |
| 3864 | |
| 3865 (1) get the old props. | |
| 3866 (2) get the new props. | |
| 3867 (3) sort both. | |
| 3868 (4) loop through old props; if key not in new, add it, with value | |
| 3869 Qunbound. | |
| 3870 (5) vice-versa for new props. | |
| 3871 (6) sort both again. | |
| 3872 (7) now we have identical lists of keys; we run through and compare | |
| 3873 the values. | |
| 3874 | |
| 3875 Of course in reality the number of properties will be low, so | |
| 3876 an N^2 algorithm wouldn't be a problem, but the stuff below is just | |
| 3877 as easy to write given the existence of qsort and bsearch. | |
| 3878 */ | |
| 3879 | |
| 3880 oldprops = Dynarr_new (Lisp_Object_pair); | |
| 3881 newprops = Dynarr_new (Lisp_Object_pair); | |
| 3882 if (!NILP (cur_parent)) | |
| 3883 extent_properties (XEXTENT (cur_parent), oldprops); | |
| 3884 if (!NILP (parent)) | |
| 3885 extent_properties (XEXTENT (parent), newprops); | |
| 3886 | |
| 4967 | 3887 qsort (Dynarr_begin (oldprops), Dynarr_length (oldprops), |
| 826 | 3888 sizeof (Lisp_Object_pair), compare_key_value_pairs); |
| 4967 | 3889 qsort (Dynarr_begin (newprops), Dynarr_length (newprops), |
| 826 | 3890 sizeof (Lisp_Object_pair), compare_key_value_pairs); |
| 3891 orignewlength = Dynarr_length (newprops); | |
| 3892 for (i = 0; i < Dynarr_length (oldprops); i++) | |
| 3893 { | |
| 4967 | 3894 if (!bsearch (Dynarr_atp (oldprops, i), Dynarr_begin (newprops), |
| 826 | 3895 Dynarr_length (newprops), sizeof (Lisp_Object_pair), |
| 3896 compare_key_value_pairs)) | |
| 3897 { | |
| 3025 | 3898 Lisp_Object_pair new_; |
| 3899 new_.key = Dynarr_at (oldprops, i).key; | |
| 3900 new_.value = Qunbound; | |
| 3901 Dynarr_add (newprops, new_); | |
| 826 | 3902 } |
| 3903 } | |
| 3904 for (i = 0; i < orignewlength; i++) | |
| 3905 { | |
| 859 | 3906 if (!Dynarr_length (oldprops) || !bsearch (Dynarr_atp (newprops, i), |
| 4967 | 3907 Dynarr_begin (oldprops), |
| 859 | 3908 Dynarr_length (oldprops), |
| 3909 sizeof (Lisp_Object_pair), | |
| 3910 compare_key_value_pairs)) | |
| 826 | 3911 { |
| 3025 | 3912 Lisp_Object_pair new_; |
| 3913 new_.key = Dynarr_at (newprops, i).key; | |
| 3914 new_.value = Qunbound; | |
| 3915 Dynarr_add (oldprops, new_); | |
| 826 | 3916 } |
| 3917 } | |
| 4967 | 3918 qsort (Dynarr_begin (oldprops), Dynarr_length (oldprops), |
| 826 | 3919 sizeof (Lisp_Object_pair), compare_key_value_pairs); |
| 4967 | 3920 qsort (Dynarr_begin (newprops), Dynarr_length (newprops), |
| 826 | 3921 sizeof (Lisp_Object_pair), compare_key_value_pairs); |
| 3922 for (i = 0; i < Dynarr_length (oldprops); i++) | |
| 3923 { | |
| 3924 assert (EQ (Dynarr_at (oldprops, i).key, Dynarr_at (newprops, i).key)); | |
| 3925 if (!EQ (Dynarr_at (oldprops, i).value, Dynarr_at (newprops, i).value)) | |
| 3926 signal_extent_property_changed (e, Dynarr_at (oldprops, i).key, 1); | |
| 3927 } | |
| 3928 | |
| 3929 Dynarr_free (oldprops); | |
| 3930 Dynarr_free (newprops); | |
| 3931 #if 0 | |
| 3932 { | |
| 428 | 3933 int old_invis = (!NILP (cur_parent) && |
| 3934 !NILP (extent_invisible (XEXTENT (cur_parent)))); | |
| 3935 int new_invis = (!NILP (parent) && | |
| 3936 !NILP (extent_invisible (XEXTENT (parent)))); | |
| 3937 | |
| 3938 extent_maybe_changed_for_redisplay (e, 1, new_invis != old_invis); | |
| 3939 } | |
| 826 | 3940 #endif /* 0 */ |
| 3941 } | |
| 428 | 3942 return Qnil; |
| 3943 } | |
| 3944 | |
| 3945 | |
| 3946 /************************************************************************/ | |
| 3947 /* basic extent mutators */ | |
| 3948 /************************************************************************/ | |
| 3949 | |
| 3950 /* Note: If you track non-duplicable extents by undo, you'll get bogus | |
| 3951 undo records for transient extents via update-extent. | |
| 3952 For example, query-replace will do this. | |
| 3953 */ | |
| 3954 | |
| 3955 static void | |
| 826 | 3956 set_extent_endpoints_1 (EXTENT extent, Memxpos start, Memxpos end) |
| 428 | 3957 { |
| 3958 #ifdef ERROR_CHECK_EXTENTS | |
| 3959 Lisp_Object obj = extent_object (extent); | |
| 3960 | |
| 3961 assert (start <= end); | |
| 3962 if (BUFFERP (obj)) | |
| 3963 { | |
| 665 | 3964 assert (valid_membpos_p (XBUFFER (obj), start)); |
| 3965 assert (valid_membpos_p (XBUFFER (obj), end)); | |
| 428 | 3966 } |
| 3967 #endif | |
| 3968 | |
| 3969 /* Optimization: if the extent is already where we want it to be, | |
| 3970 do nothing. */ | |
| 3971 if (!extent_detached_p (extent) && extent_start (extent) == start && | |
| 3972 extent_end (extent) == end) | |
| 3973 return; | |
| 3974 | |
| 3975 if (extent_detached_p (extent)) | |
| 3976 { | |
| 3977 if (extent_duplicable_p (extent)) | |
| 3978 { | |
| 793 | 3979 Lisp_Object extent_obj = wrap_extent (extent); |
| 3980 | |
| 428 | 3981 record_extent (extent_obj, 1); |
| 3982 } | |
| 3983 } | |
| 3984 else | |
| 3985 extent_detach (extent); | |
| 3986 | |
| 3987 set_extent_start (extent, start); | |
| 3988 set_extent_end (extent, end); | |
| 3989 extent_attach (extent); | |
| 3990 } | |
| 3991 | |
| 3992 /* Set extent's endpoints to S and E, and put extent in buffer or string | |
| 3993 OBJECT. (If OBJECT is nil, do not change the extent's object.) */ | |
| 3994 | |
| 3995 void | |
| 826 | 3996 set_extent_endpoints (EXTENT extent, Bytexpos s, Bytexpos e, |
| 3997 Lisp_Object object) | |
| 3998 { | |
| 3999 Memxpos start, end; | |
| 428 | 4000 |
| 4001 if (NILP (object)) | |
| 4002 { | |
| 4003 object = extent_object (extent); | |
| 4004 assert (!NILP (object)); | |
| 4005 } | |
| 4006 else if (!EQ (object, extent_object (extent))) | |
| 4007 { | |
| 4008 extent_detach (extent); | |
| 4009 extent_object (extent) = object; | |
| 4010 } | |
| 4011 | |
| 4012 start = s < 0 ? extent_start (extent) : | |
| 826 | 4013 buffer_or_string_bytexpos_to_memxpos (object, s); |
| 428 | 4014 end = e < 0 ? extent_end (extent) : |
| 826 | 4015 buffer_or_string_bytexpos_to_memxpos (object, e); |
| 428 | 4016 set_extent_endpoints_1 (extent, start, end); |
| 4017 } | |
| 4018 | |
| 4019 static void | |
| 4020 set_extent_openness (EXTENT extent, int start_open, int end_open) | |
| 4021 { | |
| 4022 if (start_open != -1) | |
| 826 | 4023 { |
| 4024 extent_start_open_p (extent) = start_open; | |
| 4025 signal_extent_property_changed (extent, Qstart_open, 1); | |
| 4026 } | |
| 428 | 4027 if (end_open != -1) |
| 826 | 4028 { |
| 4029 extent_end_open_p (extent) = end_open; | |
| 4030 signal_extent_property_changed (extent, Qend_open, 1); | |
| 4031 } | |
| 428 | 4032 } |
| 4033 | |
| 4034 static EXTENT | |
| 826 | 4035 make_extent (Lisp_Object object, Bytexpos from, Bytexpos to) |
| 428 | 4036 { |
| 4037 EXTENT extent; | |
| 4038 | |
| 4039 extent = make_extent_detached (object); | |
| 4040 set_extent_endpoints (extent, from, to, Qnil); | |
| 4041 return extent; | |
| 4042 } | |
| 4043 | |
| 826 | 4044 /* Copy ORIGINAL, changing it to span FROM,TO in OBJECT. */ |
| 4045 | |
| 428 | 4046 static EXTENT |
| 826 | 4047 copy_extent (EXTENT original, Bytexpos from, Bytexpos to, Lisp_Object object) |
| 428 | 4048 { |
| 4049 EXTENT e; | |
| 4050 | |
| 4051 e = make_extent_detached (object); | |
| 4052 if (from >= 0) | |
| 4053 set_extent_endpoints (e, from, to, Qnil); | |
| 4054 | |
| 4055 e->plist = Fcopy_sequence (original->plist); | |
| 4056 memcpy (&e->flags, &original->flags, sizeof (e->flags)); | |
| 4057 if (e->flags.has_aux) | |
| 4058 { | |
| 4059 /* also need to copy the aux struct. It won't work for | |
| 4060 this extent to share the same aux struct as the original | |
| 4061 one. */ | |
| 2720 | 4062 struct extent_auxiliary *data = |
| 3017 | 4063 ALLOC_LCRECORD_TYPE (struct extent_auxiliary, |
| 428 | 4064 &lrecord_extent_auxiliary); |
| 4065 | |
| 3017 | 4066 COPY_LCRECORD (data, XEXTENT_AUXILIARY (XCAR (original->plist))); |
| 793 | 4067 XCAR (e->plist) = wrap_extent_auxiliary (data); |
| 428 | 4068 } |
| 4069 | |
| 4070 { | |
| 4071 /* we may have just added another child to the parent extent. */ | |
| 4072 Lisp_Object parent = extent_parent (e); | |
| 4073 if (!NILP (parent)) | |
| 4074 { | |
| 793 | 4075 Lisp_Object extent = wrap_extent (e); |
| 4076 | |
| 428 | 4077 add_extent_to_children_list (XEXTENT (parent), extent); |
| 4078 } | |
| 4079 } | |
| 4080 | |
| 4081 return e; | |
| 4082 } | |
| 4083 | |
| 4084 static void | |
| 4085 destroy_extent (EXTENT extent) | |
| 4086 { | |
| 4087 Lisp_Object rest, nextrest, children; | |
| 4088 Lisp_Object extent_obj; | |
| 4089 | |
| 4090 if (!extent_detached_p (extent)) | |
| 4091 extent_detach (extent); | |
| 4092 /* disassociate the extent from its children and parent */ | |
| 4093 children = extent_children (extent); | |
| 4094 if (!NILP (children)) | |
| 4095 { | |
| 4096 LIST_LOOP_DELETING (rest, nextrest, XWEAK_LIST_LIST (children)) | |
| 4097 Fset_extent_parent (XCAR (rest), Qnil); | |
| 4098 } | |
| 793 | 4099 extent_obj = wrap_extent (extent); |
| 428 | 4100 Fset_extent_parent (extent_obj, Qnil); |
| 4101 /* mark the extent as destroyed */ | |
| 4102 extent_object (extent) = Qt; | |
| 4103 } | |
| 4104 | |
| 4105 DEFUN ("make-extent", Fmake_extent, 2, 3, 0, /* | |
| 4106 Make an extent for the range [FROM, TO) in BUFFER-OR-STRING. | |
| 4107 BUFFER-OR-STRING defaults to the current buffer. Insertions at point | |
| 4108 TO will be outside of the extent; insertions at FROM will be inside the | |
| 4109 extent, causing the extent to grow. (This is the same way that markers | |
| 4110 behave.) You can change the behavior of insertions at the endpoints | |
| 4111 using `set-extent-property'. The extent is initially detached if both | |
| 4112 FROM and TO are nil, and in this case BUFFER-OR-STRING defaults to nil, | |
| 4113 meaning the extent is in no buffer and no string. | |
| 4114 */ | |
| 4115 (from, to, buffer_or_string)) | |
| 4116 { | |
| 4117 Lisp_Object extent_obj; | |
| 4118 Lisp_Object obj; | |
| 4119 | |
| 4120 obj = decode_buffer_or_string (buffer_or_string); | |
| 4121 if (NILP (from) && NILP (to)) | |
| 4122 { | |
| 4123 if (NILP (buffer_or_string)) | |
| 4124 obj = Qnil; | |
| 793 | 4125 extent_obj = wrap_extent (make_extent_detached (obj)); |
| 428 | 4126 } |
| 4127 else | |
| 4128 { | |
| 826 | 4129 Bytexpos start, end; |
| 428 | 4130 |
| 4131 get_buffer_or_string_range_byte (obj, from, to, &start, &end, | |
| 4132 GB_ALLOW_PAST_ACCESSIBLE); | |
| 826 | 4133 extent_obj = wrap_extent (make_extent (obj, start, end)); |
| 428 | 4134 } |
| 4135 return extent_obj; | |
| 4136 } | |
| 4137 | |
| 4138 DEFUN ("copy-extent", Fcopy_extent, 1, 2, 0, /* | |
| 4139 Make a copy of EXTENT. It is initially detached. | |
| 4140 Optional argument BUFFER-OR-STRING defaults to EXTENT's buffer or string. | |
| 4141 */ | |
| 4142 (extent, buffer_or_string)) | |
| 4143 { | |
| 4144 EXTENT ext = decode_extent (extent, 0); | |
| 4145 | |
| 4146 if (NILP (buffer_or_string)) | |
| 4147 buffer_or_string = extent_object (ext); | |
| 4148 else | |
| 4149 buffer_or_string = decode_buffer_or_string (buffer_or_string); | |
| 4150 | |
| 793 | 4151 return wrap_extent (copy_extent (ext, -1, -1, buffer_or_string)); |
| 428 | 4152 } |
| 4153 | |
| 4154 DEFUN ("delete-extent", Fdelete_extent, 1, 1, 0, /* | |
| 4155 Remove EXTENT from its buffer and destroy it. | |
| 4156 This does not modify the buffer's text, only its display properties. | |
| 4157 The extent cannot be used thereafter. | |
| 4158 */ | |
| 4159 (extent)) | |
| 4160 { | |
| 4161 EXTENT ext; | |
| 4162 | |
| 4163 /* We do not call decode_extent() here because already-destroyed | |
| 4164 extents are OK. */ | |
| 4165 CHECK_EXTENT (extent); | |
| 4166 ext = XEXTENT (extent); | |
| 4167 | |
| 4168 if (!EXTENT_LIVE_P (ext)) | |
| 4169 return Qnil; | |
| 4170 destroy_extent (ext); | |
| 4171 return Qnil; | |
| 4172 } | |
| 4173 | |
| 4174 DEFUN ("detach-extent", Fdetach_extent, 1, 1, 0, /* | |
| 4175 Remove EXTENT from its buffer in such a way that it can be re-inserted. | |
| 4176 An extent is also detached when all of its characters are all killed by a | |
| 4177 deletion, unless its `detachable' property has been unset. | |
| 4178 | |
| 4179 Extents which have the `duplicable' attribute are tracked by the undo | |
| 4180 mechanism. Detachment via `detach-extent' and string deletion is recorded, | |
| 4181 as is attachment via `insert-extent' and string insertion. Extent motion, | |
| 4182 face changes, and attachment via `make-extent' and `set-extent-endpoints' | |
| 4183 are not recorded. This means that extent changes which are to be undo-able | |
| 4184 must be performed by character editing, or by insertion and detachment of | |
| 4185 duplicable extents. | |
| 4186 */ | |
| 4187 (extent)) | |
| 4188 { | |
| 4189 EXTENT ext = decode_extent (extent, 0); | |
| 4190 | |
| 4191 if (extent_detached_p (ext)) | |
| 4192 return extent; | |
| 4193 if (extent_duplicable_p (ext)) | |
| 4194 record_extent (extent, 0); | |
| 4195 extent_detach (ext); | |
| 4196 | |
| 4197 return extent; | |
| 4198 } | |
| 4199 | |
| 4200 DEFUN ("set-extent-endpoints", Fset_extent_endpoints, 3, 4, 0, /* | |
| 4201 Set the endpoints of EXTENT to START, END. | |
| 4202 If START and END are null, call detach-extent on EXTENT. | |
| 4203 BUFFER-OR-STRING specifies the new buffer or string that the extent should | |
| 4204 be in, and defaults to EXTENT's buffer or string. (If nil, and EXTENT | |
| 4205 is in no buffer and no string, it defaults to the current buffer.) | |
| 4206 See documentation on `detach-extent' for a discussion of undo recording. | |
| 4207 */ | |
| 4208 (extent, start, end, buffer_or_string)) | |
| 4209 { | |
| 4210 EXTENT ext; | |
| 826 | 4211 Bytexpos s, e; |
| 428 | 4212 |
| 4213 ext = decode_extent (extent, 0); | |
| 4214 | |
| 4215 if (NILP (buffer_or_string)) | |
| 4216 { | |
| 4217 buffer_or_string = extent_object (ext); | |
| 4218 if (NILP (buffer_or_string)) | |
| 4219 buffer_or_string = Fcurrent_buffer (); | |
| 4220 } | |
| 4221 else | |
| 4222 buffer_or_string = decode_buffer_or_string (buffer_or_string); | |
| 4223 | |
| 4224 if (NILP (start) && NILP (end)) | |
| 4225 return Fdetach_extent (extent); | |
| 4226 | |
| 4227 get_buffer_or_string_range_byte (buffer_or_string, start, end, &s, &e, | |
| 4228 GB_ALLOW_PAST_ACCESSIBLE); | |
| 4229 | |
| 468 | 4230 buffer_or_string_extent_info_force (buffer_or_string); |
| 428 | 4231 set_extent_endpoints (ext, s, e, buffer_or_string); |
| 4232 return extent; | |
| 4233 } | |
| 4234 | |
| 4235 | |
| 4236 /************************************************************************/ | |
| 4237 /* mapping over extents */ | |
| 4238 /************************************************************************/ | |
| 4239 | |
| 4240 static unsigned int | |
| 4241 decode_map_extents_flags (Lisp_Object flags) | |
| 4242 { | |
| 4243 unsigned int retval = 0; | |
| 4244 unsigned int all_extents_specified = 0; | |
| 4245 unsigned int in_region_specified = 0; | |
| 4246 | |
| 4247 if (EQ (flags, Qt)) /* obsoleteness compatibility */ | |
| 4248 return ME_END_CLOSED; | |
| 4249 if (NILP (flags)) | |
| 4250 return 0; | |
| 4251 if (SYMBOLP (flags)) | |
| 4252 flags = Fcons (flags, Qnil); | |
| 4253 while (!NILP (flags)) | |
| 4254 { | |
| 4255 Lisp_Object sym; | |
| 4256 CHECK_CONS (flags); | |
| 4257 sym = XCAR (flags); | |
| 4258 CHECK_SYMBOL (sym); | |
| 4259 if (EQ (sym, Qall_extents_closed) || EQ (sym, Qall_extents_open) || | |
| 4260 EQ (sym, Qall_extents_closed_open) || | |
| 4261 EQ (sym, Qall_extents_open_closed)) | |
| 4262 { | |
| 4263 if (all_extents_specified) | |
| 563 | 4264 invalid_argument ("Only one `all-extents-*' flag may be specified", Qunbound); |
| 428 | 4265 all_extents_specified = 1; |
| 4266 } | |
| 4267 if (EQ (sym, Qstart_in_region) || EQ (sym, Qend_in_region) || | |
| 4268 EQ (sym, Qstart_and_end_in_region) || | |
| 4269 EQ (sym, Qstart_or_end_in_region)) | |
| 4270 { | |
| 4271 if (in_region_specified) | |
| 563 | 4272 invalid_argument ("Only one `*-in-region' flag may be specified", Qunbound); |
| 428 | 4273 in_region_specified = 1; |
| 4274 } | |
| 4275 | |
| 4276 /* I do so love that conditional operator ... */ | |
| 4277 retval |= | |
| 4278 EQ (sym, Qend_closed) ? ME_END_CLOSED : | |
| 4279 EQ (sym, Qstart_open) ? ME_START_OPEN : | |
| 4280 EQ (sym, Qall_extents_closed) ? ME_ALL_EXTENTS_CLOSED : | |
| 4281 EQ (sym, Qall_extents_open) ? ME_ALL_EXTENTS_OPEN : | |
| 4282 EQ (sym, Qall_extents_closed_open) ? ME_ALL_EXTENTS_CLOSED_OPEN : | |
| 4283 EQ (sym, Qall_extents_open_closed) ? ME_ALL_EXTENTS_OPEN_CLOSED : | |
| 4284 EQ (sym, Qstart_in_region) ? ME_START_IN_REGION : | |
| 4285 EQ (sym, Qend_in_region) ? ME_END_IN_REGION : | |
| 4286 EQ (sym, Qstart_and_end_in_region) ? ME_START_AND_END_IN_REGION : | |
| 4287 EQ (sym, Qstart_or_end_in_region) ? ME_START_OR_END_IN_REGION : | |
| 4288 EQ (sym, Qnegate_in_region) ? ME_NEGATE_IN_REGION : | |
| 563 | 4289 (invalid_constant ("Invalid `map-extents' flag", sym), 0); |
| 428 | 4290 |
| 4291 flags = XCDR (flags); | |
| 4292 } | |
| 4293 return retval; | |
| 4294 } | |
| 4295 | |
| 4296 DEFUN ("extent-in-region-p", Fextent_in_region_p, 1, 4, 0, /* | |
| 4297 Return whether EXTENT overlaps a specified region. | |
| 4298 This is equivalent to whether `map-extents' would visit EXTENT when called | |
| 4299 with these args. | |
| 4300 */ | |
| 4301 (extent, from, to, flags)) | |
| 4302 { | |
| 826 | 4303 Bytexpos start, end; |
| 428 | 4304 EXTENT ext = decode_extent (extent, DE_MUST_BE_ATTACHED); |
| 4305 Lisp_Object obj = extent_object (ext); | |
| 4306 | |
| 4307 get_buffer_or_string_range_byte (obj, from, to, &start, &end, GB_ALLOW_NIL | | |
| 4308 GB_ALLOW_PAST_ACCESSIBLE); | |
| 4309 | |
| 4310 return extent_in_region_p (ext, start, end, decode_map_extents_flags (flags)) ? | |
| 4311 Qt : Qnil; | |
| 4312 } | |
| 4313 | |
| 4314 struct slow_map_extents_arg | |
| 4315 { | |
| 4316 Lisp_Object map_arg; | |
| 4317 Lisp_Object map_routine; | |
| 4318 Lisp_Object result; | |
| 4319 Lisp_Object property; | |
| 4320 Lisp_Object value; | |
| 4321 }; | |
| 4322 | |
| 4323 static int | |
| 4324 slow_map_extents_function (EXTENT extent, void *arg) | |
| 4325 { | |
| 4326 /* This function can GC */ | |
| 4327 struct slow_map_extents_arg *closure = (struct slow_map_extents_arg *) arg; | |
| 793 | 4328 Lisp_Object extent_obj = wrap_extent (extent); |
| 4329 | |
| 428 | 4330 |
| 4331 /* make sure this extent qualifies according to the PROPERTY | |
| 4332 and VALUE args */ | |
| 4333 | |
| 4334 if (!NILP (closure->property)) | |
| 4335 { | |
| 4336 Lisp_Object value = Fextent_property (extent_obj, closure->property, | |
| 4337 Qnil); | |
| 4338 if ((NILP (closure->value) && NILP (value)) || | |
| 4339 (!NILP (closure->value) && !EQ (value, closure->value))) | |
| 4340 return 0; | |
| 4341 } | |
| 4342 | |
| 4343 closure->result = call2 (closure->map_routine, extent_obj, | |
| 4344 closure->map_arg); | |
| 4345 return !NILP (closure->result); | |
| 4346 } | |
| 4347 | |
| 4348 DEFUN ("map-extents", Fmap_extents, 1, 8, 0, /* | |
| 4349 Map FUNCTION over the extents which overlap a region in OBJECT. | |
| 4350 OBJECT is normally a buffer or string but could be an extent (see below). | |
| 4351 The region is normally bounded by [FROM, TO) (i.e. the beginning of the | |
| 4352 region is closed and the end of the region is open), but this can be | |
| 4353 changed with the FLAGS argument (see below for a complete discussion). | |
| 4354 | |
| 4355 FUNCTION is called with the arguments (extent, MAPARG). The arguments | |
| 4356 OBJECT, FROM, TO, MAPARG, and FLAGS are all optional and default to | |
| 4357 the current buffer, the beginning of OBJECT, the end of OBJECT, nil, | |
| 4358 and nil, respectively. `map-extents' returns the first non-nil result | |
| 4359 produced by FUNCTION, and no more calls to FUNCTION are made after it | |
| 4360 returns non-nil. | |
| 4361 | |
| 4362 If OBJECT is an extent, FROM and TO default to the extent's endpoints, | |
| 4363 and the mapping omits that extent and its predecessors. This feature | |
| 4364 supports restarting a loop based on `map-extents'. Note: OBJECT must | |
| 4365 be attached to a buffer or string, and the mapping is done over that | |
| 4366 buffer or string. | |
| 4367 | |
| 4368 An extent overlaps the region if there is any point in the extent that is | |
| 4369 also in the region. (For the purpose of overlap, zero-length extents and | |
| 4370 regions are treated as closed on both ends regardless of their endpoints' | |
| 4371 specified open/closedness.) Note that the endpoints of an extent or region | |
| 4372 are considered to be in that extent or region if and only if the | |
| 4373 corresponding end is closed. For example, the extent [5,7] overlaps the | |
| 4374 region [2,5] because 5 is in both the extent and the region. However, (5,7] | |
| 4375 does not overlap [2,5] because 5 is not in the extent, and neither [5,7] nor | |
| 4376 \(5,7] overlaps the region [2,5) because 5 is not in the region. | |
| 4377 | |
| 4378 The optional FLAGS can be a symbol or a list of one or more symbols, | |
| 4379 modifying the behavior of `map-extents'. Allowed symbols are: | |
| 4380 | |
| 4381 end-closed The region's end is closed. | |
| 4382 | |
| 4383 start-open The region's start is open. | |
| 4384 | |
| 4385 all-extents-closed Treat all extents as closed on both ends for the | |
| 4386 purpose of determining whether they overlap the | |
| 4387 region, irrespective of their actual open- or | |
| 4388 closedness. | |
| 4389 all-extents-open Treat all extents as open on both ends. | |
| 4390 all-extents-closed-open Treat all extents as start-closed, end-open. | |
| 4391 all-extents-open-closed Treat all extents as start-open, end-closed. | |
| 4392 | |
| 4393 start-in-region In addition to the above conditions for extent | |
| 4394 overlap, the extent's start position must lie within | |
| 4395 the specified region. Note that, for this | |
| 4396 condition, open start positions are treated as if | |
| 4397 0.5 was added to the endpoint's value, and open | |
| 4398 end positions are treated as if 0.5 was subtracted | |
| 4399 from the endpoint's value. | |
| 4400 end-in-region The extent's end position must lie within the | |
| 4401 region. | |
| 4402 start-and-end-in-region Both the extent's start and end positions must lie | |
| 4403 within the region. | |
| 4404 start-or-end-in-region Either the extent's start or end position must lie | |
| 4405 within the region. | |
| 4406 | |
| 4407 negate-in-region The condition specified by a `*-in-region' flag | |
| 4408 must NOT hold for the extent to be considered. | |
| 4409 | |
| 4410 | |
| 4411 At most one of `all-extents-closed', `all-extents-open', | |
| 4412 `all-extents-closed-open', and `all-extents-open-closed' may be specified. | |
| 4413 | |
| 4414 At most one of `start-in-region', `end-in-region', | |
| 4415 `start-and-end-in-region', and `start-or-end-in-region' may be specified. | |
| 4416 | |
| 4417 If optional arg PROPERTY is non-nil, only extents with that property set | |
| 4418 on them will be visited. If optional arg VALUE is non-nil, only extents | |
| 4419 whose value for that property is `eq' to VALUE will be visited. | |
| 4420 */ | |
| 4421 (function, object, from, to, maparg, flags, property, value)) | |
| 4422 { | |
| 4423 /* This function can GC */ | |
| 4424 struct slow_map_extents_arg closure; | |
| 4425 unsigned int me_flags; | |
| 826 | 4426 Bytexpos start, end; |
| 428 | 4427 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; |
| 4428 EXTENT after = 0; | |
| 4429 | |
| 4430 if (EXTENTP (object)) | |
| 4431 { | |
| 4432 after = decode_extent (object, DE_MUST_BE_ATTACHED); | |
| 4433 if (NILP (from)) | |
| 4434 from = Fextent_start_position (object); | |
| 4435 if (NILP (to)) | |
| 4436 to = Fextent_end_position (object); | |
| 4437 object = extent_object (after); | |
| 4438 } | |
| 4439 else | |
| 4440 object = decode_buffer_or_string (object); | |
| 4441 | |
| 4442 get_buffer_or_string_range_byte (object, from, to, &start, &end, | |
| 4443 GB_ALLOW_NIL | GB_ALLOW_PAST_ACCESSIBLE); | |
| 4444 | |
| 4445 me_flags = decode_map_extents_flags (flags); | |
| 4446 | |
| 4447 if (!NILP (property)) | |
| 4448 { | |
| 4449 if (!NILP (value)) | |
| 4450 value = canonicalize_extent_property (property, value); | |
| 4451 } | |
| 4452 | |
| 4453 GCPRO5 (function, maparg, object, property, value); | |
| 4454 | |
| 4455 closure.map_arg = maparg; | |
| 4456 closure.map_routine = function; | |
| 4457 closure.result = Qnil; | |
| 4458 closure.property = property; | |
| 4459 closure.value = value; | |
| 4460 | |
| 826 | 4461 map_extents (start, end, slow_map_extents_function, |
| 4462 (void *) &closure, object, after, | |
| 4463 /* You never know what the user might do ... */ | |
| 4464 me_flags | ME_MIGHT_CALL_ELISP); | |
| 428 | 4465 |
| 4466 UNGCPRO; | |
| 4467 return closure.result; | |
| 4468 } | |
| 4469 | |
| 4470 | |
| 4471 /************************************************************************/ | |
| 4472 /* mapping over extents -- other functions */ | |
| 4473 /************************************************************************/ | |
| 4474 | |
| 4475 /* ------------------------------- */ | |
| 4476 /* map-extent-children */ | |
| 4477 /* ------------------------------- */ | |
| 4478 | |
| 4479 struct slow_map_extent_children_arg | |
| 4480 { | |
| 4481 Lisp_Object map_arg; | |
| 4482 Lisp_Object map_routine; | |
| 4483 Lisp_Object result; | |
| 4484 Lisp_Object property; | |
| 4485 Lisp_Object value; | |
| 826 | 4486 Bytexpos start_min; |
| 4487 Bytexpos prev_start; | |
| 4488 Bytexpos prev_end; | |
| 428 | 4489 }; |
| 4490 | |
| 4491 static int | |
| 4492 slow_map_extent_children_function (EXTENT extent, void *arg) | |
| 4493 { | |
| 4494 /* This function can GC */ | |
| 4495 struct slow_map_extent_children_arg *closure = | |
| 4496 (struct slow_map_extent_children_arg *) arg; | |
| 4497 Lisp_Object extent_obj; | |
| 826 | 4498 Bytexpos start = extent_endpoint_byte (extent, 0); |
| 4499 Bytexpos end = extent_endpoint_byte (extent, 1); | |
| 428 | 4500 /* Make sure the extent starts inside the region of interest, |
| 4501 rather than just overlaps it. | |
| 4502 */ | |
| 4503 if (start < closure->start_min) | |
| 4504 return 0; | |
| 4505 /* Make sure the extent is not a child of a previous visited one. | |
| 4506 We know already, because of extent ordering, | |
| 4507 that start >= prev_start, and that if | |
| 4508 start == prev_start, then end <= prev_end. | |
| 4509 */ | |
| 4510 if (start == closure->prev_start) | |
| 4511 { | |
| 4512 if (end < closure->prev_end) | |
| 4513 return 0; | |
| 4514 } | |
| 4515 else /* start > prev_start */ | |
| 4516 { | |
| 4517 if (start < closure->prev_end) | |
| 4518 return 0; | |
| 4519 /* corner case: prev_end can be -1 if there is no prev */ | |
| 4520 } | |
| 793 | 4521 extent_obj = wrap_extent (extent); |
| 428 | 4522 |
| 4523 /* make sure this extent qualifies according to the PROPERTY | |
| 4524 and VALUE args */ | |
| 4525 | |
| 4526 if (!NILP (closure->property)) | |
| 4527 { | |
| 4528 Lisp_Object value = Fextent_property (extent_obj, closure->property, | |
| 4529 Qnil); | |
| 4530 if ((NILP (closure->value) && NILP (value)) || | |
| 4531 (!NILP (closure->value) && !EQ (value, closure->value))) | |
| 4532 return 0; | |
| 4533 } | |
| 4534 | |
| 4535 closure->result = call2 (closure->map_routine, extent_obj, | |
| 4536 closure->map_arg); | |
| 4537 | |
| 4538 /* Since the callback may change the buffer, compute all stored | |
| 4539 buffer positions here. | |
| 4540 */ | |
| 4541 closure->start_min = -1; /* no need for this any more */ | |
| 826 | 4542 closure->prev_start = extent_endpoint_byte (extent, 0); |
| 4543 closure->prev_end = extent_endpoint_byte (extent, 1); | |
| 428 | 4544 |
| 4545 return !NILP (closure->result); | |
| 4546 } | |
| 4547 | |
| 4548 DEFUN ("map-extent-children", Fmap_extent_children, 1, 8, 0, /* | |
| 4549 Map FUNCTION over the extents in the region from FROM to TO. | |
| 4550 FUNCTION is called with arguments (extent, MAPARG). See `map-extents' | |
| 4551 for a full discussion of the arguments FROM, TO, and FLAGS. | |
| 4552 | |
| 4553 The arguments are the same as for `map-extents', but this function differs | |
| 4554 in that it only visits extents which start in the given region, and also | |
| 4555 in that, after visiting an extent E, it skips all other extents which start | |
| 4556 inside E but end before E's end. | |
| 4557 | |
| 4558 Thus, this function may be used to walk a tree of extents in a buffer: | |
| 4559 (defun walk-extents (buffer &optional ignore) | |
| 4560 (map-extent-children 'walk-extents buffer)) | |
| 4561 */ | |
| 4562 (function, object, from, to, maparg, flags, property, value)) | |
| 4563 { | |
| 4564 /* This function can GC */ | |
| 4565 struct slow_map_extent_children_arg closure; | |
| 4566 unsigned int me_flags; | |
| 826 | 4567 Bytexpos start, end; |
| 428 | 4568 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; |
| 4569 EXTENT after = 0; | |
| 4570 | |
| 4571 if (EXTENTP (object)) | |
| 4572 { | |
| 4573 after = decode_extent (object, DE_MUST_BE_ATTACHED); | |
| 4574 if (NILP (from)) | |
| 4575 from = Fextent_start_position (object); | |
| 4576 if (NILP (to)) | |
| 4577 to = Fextent_end_position (object); | |
| 4578 object = extent_object (after); | |
| 4579 } | |
| 4580 else | |
| 4581 object = decode_buffer_or_string (object); | |
| 4582 | |
| 4583 get_buffer_or_string_range_byte (object, from, to, &start, &end, | |
| 4584 GB_ALLOW_NIL | GB_ALLOW_PAST_ACCESSIBLE); | |
| 4585 | |
| 4586 me_flags = decode_map_extents_flags (flags); | |
| 4587 | |
| 4588 if (!NILP (property)) | |
| 4589 { | |
| 4590 if (!NILP (value)) | |
| 4591 value = canonicalize_extent_property (property, value); | |
| 4592 } | |
| 4593 | |
| 4594 GCPRO5 (function, maparg, object, property, value); | |
| 4595 | |
| 4596 closure.map_arg = maparg; | |
| 4597 closure.map_routine = function; | |
| 4598 closure.result = Qnil; | |
| 4599 closure.property = property; | |
| 4600 closure.value = value; | |
| 4601 closure.start_min = start; | |
| 4602 closure.prev_start = -1; | |
| 4603 closure.prev_end = -1; | |
| 826 | 4604 map_extents (start, end, slow_map_extent_children_function, |
| 4605 (void *) &closure, object, after, | |
| 4606 /* You never know what the user might do ... */ | |
| 4607 me_flags | ME_MIGHT_CALL_ELISP); | |
| 428 | 4608 |
| 4609 UNGCPRO; | |
| 4610 return closure.result; | |
| 4611 } | |
| 4612 | |
| 4613 /* ------------------------------- */ | |
| 4614 /* extent-at */ | |
| 4615 /* ------------------------------- */ | |
| 4616 | |
| 4617 /* find "smallest" matching extent containing pos -- (flag == 0) means | |
| 4618 all extents match, else (EXTENT_FLAGS (extent) & flag) must be true; | |
| 4619 for more than one matching extent with precisely the same endpoints, | |
| 4620 we choose the last extent in the extents_list. | |
| 4621 The search stops just before "before", if that is non-null. | |
| 4622 */ | |
| 4623 | |
| 4624 struct extent_at_arg | |
| 4625 { | |
| 442 | 4626 Lisp_Object best_match; /* or list of extents */ |
| 826 | 4627 Memxpos best_start; |
| 4628 Memxpos best_end; | |
| 428 | 4629 Lisp_Object prop; |
| 4630 EXTENT before; | |
| 442 | 4631 int all_extents; |
| 428 | 4632 }; |
| 4633 | |
| 4634 static enum extent_at_flag | |
| 4635 decode_extent_at_flag (Lisp_Object at_flag) | |
| 4636 { | |
| 4637 if (NILP (at_flag)) | |
| 4638 return EXTENT_AT_AFTER; | |
| 4639 | |
| 4640 CHECK_SYMBOL (at_flag); | |
| 4641 if (EQ (at_flag, Qafter)) return EXTENT_AT_AFTER; | |
| 4642 if (EQ (at_flag, Qbefore)) return EXTENT_AT_BEFORE; | |
| 4643 if (EQ (at_flag, Qat)) return EXTENT_AT_AT; | |
| 4644 | |
| 563 | 4645 invalid_constant ("Invalid AT-FLAG in `extent-at'", at_flag); |
| 1204 | 4646 RETURN_NOT_REACHED (EXTENT_AT_AFTER); |
| 428 | 4647 } |
| 4648 | |
| 4649 static int | |
| 4650 extent_at_mapper (EXTENT e, void *arg) | |
| 4651 { | |
| 4652 struct extent_at_arg *closure = (struct extent_at_arg *) arg; | |
| 4653 | |
| 4654 if (e == closure->before) | |
| 4655 return 1; | |
| 4656 | |
| 4657 /* If closure->prop is non-nil, then the extent is only acceptable | |
| 4658 if it has a non-nil value for that property. */ | |
| 4659 if (!NILP (closure->prop)) | |
| 4660 { | |
| 793 | 4661 Lisp_Object extent = wrap_extent (e); |
| 4662 | |
| 428 | 4663 if (NILP (Fextent_property (extent, closure->prop, Qnil))) |
| 4664 return 0; | |
| 4665 } | |
| 4666 | |
| 442 | 4667 if (!closure->all_extents) |
| 428 | 4668 { |
| 442 | 4669 EXTENT current; |
| 4670 | |
| 4671 if (NILP (closure->best_match)) | |
| 428 | 4672 goto accept; |
| 442 | 4673 current = XEXTENT (closure->best_match); |
| 428 | 4674 /* redundant but quick test */ |
| 442 | 4675 if (extent_start (current) > extent_start (e)) |
| 428 | 4676 return 0; |
| 4677 | |
| 4678 /* we return the "last" best fit, instead of the first -- | |
| 4679 this is because then the glyph closest to two equivalent | |
| 4680 extents corresponds to the "extent-at" the text just past | |
| 4681 that same glyph */ | |
| 4682 else if (!EXTENT_LESS_VALS (e, closure->best_start, | |
| 4683 closure->best_end)) | |
| 4684 goto accept; | |
| 4685 else | |
| 4686 return 0; | |
| 4687 accept: | |
| 793 | 4688 closure->best_match = wrap_extent (e); |
| 428 | 4689 closure->best_start = extent_start (e); |
| 4690 closure->best_end = extent_end (e); | |
| 4691 } | |
| 442 | 4692 else |
| 4693 { | |
| 793 | 4694 Lisp_Object extent = wrap_extent (e); |
| 4695 | |
| 442 | 4696 closure->best_match = Fcons (extent, closure->best_match); |
| 4697 } | |
| 428 | 4698 |
| 4699 return 0; | |
| 4700 } | |
| 4701 | |
| 826 | 4702 Lisp_Object |
| 4703 extent_at (Bytexpos position, Lisp_Object object, | |
| 4704 Lisp_Object property, EXTENT before, | |
| 4705 enum extent_at_flag at_flag, int all_extents) | |
| 428 | 4706 { |
| 4707 struct extent_at_arg closure; | |
| 442 | 4708 struct gcpro gcpro1; |
| 428 | 4709 |
| 4710 /* it might be argued that invalid positions should cause | |
| 4711 errors, but the principle of least surprise dictates that | |
| 4712 nil should be returned (extent-at is often used in | |
| 4713 response to a mouse event, and in many cases previous events | |
| 4714 have changed the buffer contents). | |
| 4715 | |
| 4716 Also, the openness stuff in the text-property code currently | |
| 4717 does not check its limits and might go off the end. */ | |
| 4718 if ((at_flag == EXTENT_AT_BEFORE | |
| 4719 ? position <= buffer_or_string_absolute_begin_byte (object) | |
| 4720 : position < buffer_or_string_absolute_begin_byte (object)) | |
| 4721 || (at_flag == EXTENT_AT_AFTER | |
| 4722 ? position >= buffer_or_string_absolute_end_byte (object) | |
| 4723 : position > buffer_or_string_absolute_end_byte (object))) | |
| 4724 return Qnil; | |
| 4725 | |
| 442 | 4726 closure.best_match = Qnil; |
| 428 | 4727 closure.prop = property; |
| 4728 closure.before = before; | |
| 442 | 4729 closure.all_extents = all_extents; |
| 4730 | |
| 4731 GCPRO1 (closure.best_match); | |
| 826 | 4732 map_extents (at_flag == EXTENT_AT_BEFORE ? prev_bytexpos (object, position) : |
| 4733 position, | |
| 4734 at_flag == EXTENT_AT_AFTER ? next_bytexpos (object, position) : | |
| 4735 position, | |
| 4736 extent_at_mapper, (void *) &closure, object, 0, | |
| 4737 ME_START_OPEN | ME_ALL_EXTENTS_CLOSED); | |
| 442 | 4738 if (all_extents) |
| 4739 closure.best_match = Fnreverse (closure.best_match); | |
| 4740 UNGCPRO; | |
| 4741 | |
| 4742 return closure.best_match; | |
| 428 | 4743 } |
| 4744 | |
| 4745 DEFUN ("extent-at", Fextent_at, 1, 5, 0, /* | |
| 4746 Find "smallest" extent at POS in OBJECT having PROPERTY set. | |
| 4747 Normally, an extent is "at" POS if it overlaps the region (POS, POS+1); | |
| 4748 i.e. if it covers the character after POS. (However, see the definition | |
| 4749 of AT-FLAG.) "Smallest" means the extent that comes last in the display | |
| 4750 order; this normally means the extent whose start position is closest to | |
| 4751 POS. See `next-extent' for more information. | |
| 4752 OBJECT specifies a buffer or string and defaults to the current buffer. | |
| 4753 PROPERTY defaults to nil, meaning that any extent will do. | |
| 4754 Properties are attached to extents with `set-extent-property', which see. | |
| 4755 Returns nil if POS is invalid or there is no matching extent at POS. | |
| 4756 If the fourth argument BEFORE is not nil, it must be an extent; any returned | |
| 4757 extent will precede that extent. This feature allows `extent-at' to be | |
| 4758 used by a loop over extents. | |
| 4759 AT-FLAG controls how end cases are handled, and should be one of: | |
| 4760 | |
| 4761 nil or `after' An extent is at POS if it covers the character | |
| 4762 after POS. This is consistent with the way | |
| 4763 that text properties work. | |
| 4764 `before' An extent is at POS if it covers the character | |
| 4765 before POS. | |
| 4766 `at' An extent is at POS if it overlaps or abuts POS. | |
| 4767 This includes all zero-length extents at POS. | |
| 4768 | |
| 4769 Note that in all cases, the start-openness and end-openness of the extents | |
| 4770 considered is ignored. If you want to pay attention to those properties, | |
| 4771 you should use `map-extents', which gives you more control. | |
| 4772 */ | |
| 4773 (pos, object, property, before, at_flag)) | |
| 4774 { | |
| 826 | 4775 Bytexpos position; |
| 428 | 4776 EXTENT before_extent; |
| 4777 enum extent_at_flag fl; | |
| 4778 | |
| 4779 object = decode_buffer_or_string (object); | |
| 4780 position = get_buffer_or_string_pos_byte (object, pos, GB_NO_ERROR_IF_BAD); | |
| 4781 if (NILP (before)) | |
| 4782 before_extent = 0; | |
| 4783 else | |
| 4784 before_extent = decode_extent (before, DE_MUST_BE_ATTACHED); | |
| 4785 if (before_extent && !EQ (object, extent_object (before_extent))) | |
| 442 | 4786 invalid_argument ("extent not in specified buffer or string", object); |
| 428 | 4787 fl = decode_extent_at_flag (at_flag); |
| 4788 | |
| 826 | 4789 return extent_at (position, object, property, before_extent, fl, 0); |
| 442 | 4790 } |
| 4791 | |
| 4792 DEFUN ("extents-at", Fextents_at, 1, 5, 0, /* | |
| 4793 Find all extents at POS in OBJECT having PROPERTY set. | |
| 4794 Normally, an extent is "at" POS if it overlaps the region (POS, POS+1); | |
| 4795 i.e. if it covers the character after POS. (However, see the definition | |
| 4796 of AT-FLAG.) | |
| 4797 This provides similar functionality to `extent-list', but does so in a way | |
| 4798 that is compatible with `extent-at'. (For example, errors due to POS out of | |
| 4799 range are ignored; this makes it safer to use this function in response to | |
| 4800 a mouse event, because in many cases previous events have changed the buffer | |
| 4801 contents.) | |
| 4802 OBJECT specifies a buffer or string and defaults to the current buffer. | |
| 4803 PROPERTY defaults to nil, meaning that any extent will do. | |
| 4804 Properties are attached to extents with `set-extent-property', which see. | |
| 4805 Returns nil if POS is invalid or there is no matching extent at POS. | |
| 4806 If the fourth argument BEFORE is not nil, it must be an extent; any returned | |
| 4807 extent will precede that extent. This feature allows `extents-at' to be | |
| 4808 used by a loop over extents. | |
| 4809 AT-FLAG controls how end cases are handled, and should be one of: | |
| 4810 | |
| 4811 nil or `after' An extent is at POS if it covers the character | |
| 4812 after POS. This is consistent with the way | |
| 4813 that text properties work. | |
| 4814 `before' An extent is at POS if it covers the character | |
| 4815 before POS. | |
| 4816 `at' An extent is at POS if it overlaps or abuts POS. | |
| 4817 This includes all zero-length extents at POS. | |
| 4818 | |
| 4819 Note that in all cases, the start-openness and end-openness of the extents | |
| 4820 considered is ignored. If you want to pay attention to those properties, | |
| 4821 you should use `map-extents', which gives you more control. | |
| 4822 */ | |
| 4823 (pos, object, property, before, at_flag)) | |
| 4824 { | |
| 826 | 4825 Bytexpos position; |
| 442 | 4826 EXTENT before_extent; |
| 4827 enum extent_at_flag fl; | |
| 4828 | |
| 4829 object = decode_buffer_or_string (object); | |
| 4830 position = get_buffer_or_string_pos_byte (object, pos, GB_NO_ERROR_IF_BAD); | |
| 4831 if (NILP (before)) | |
| 4832 before_extent = 0; | |
| 4833 else | |
| 4834 before_extent = decode_extent (before, DE_MUST_BE_ATTACHED); | |
| 4835 if (before_extent && !EQ (object, extent_object (before_extent))) | |
| 4836 invalid_argument ("extent not in specified buffer or string", object); | |
| 4837 fl = decode_extent_at_flag (at_flag); | |
| 4838 | |
| 826 | 4839 return extent_at (position, object, property, before_extent, fl, 1); |
| 428 | 4840 } |
| 4841 | |
| 4842 /* ------------------------------- */ | |
| 4843 /* verify_extent_modification() */ | |
| 4844 /* ------------------------------- */ | |
| 4845 | |
| 4846 /* verify_extent_modification() is called when a buffer or string is | |
| 4847 modified to check whether the modification is occuring inside a | |
| 4848 read-only extent. | |
| 4849 */ | |
| 4850 | |
| 4851 struct verify_extents_arg | |
| 4852 { | |
| 4853 Lisp_Object object; | |
| 826 | 4854 Memxpos start; |
| 4855 Memxpos end; | |
| 428 | 4856 Lisp_Object iro; /* value of inhibit-read-only */ |
| 4857 }; | |
| 4858 | |
| 4859 static int | |
| 4860 verify_extent_mapper (EXTENT extent, void *arg) | |
| 4861 { | |
| 4862 struct verify_extents_arg *closure = (struct verify_extents_arg *) arg; | |
| 4863 Lisp_Object prop = extent_read_only (extent); | |
| 4864 | |
| 4865 if (NILP (prop)) | |
| 4866 return 0; | |
| 4867 | |
| 4868 if (CONSP (closure->iro) && !NILP (Fmemq (prop, closure->iro))) | |
| 4869 return 0; | |
| 4870 | |
| 4871 #if 0 /* Nobody seems to care for this any more -sb */ | |
| 4872 /* Allow deletion if the extent is completely contained in | |
| 4873 the region being deleted. | |
| 4874 This is important for supporting tokens which are internally | |
| 4875 write-protected, but which can be killed and yanked as a whole. | |
| 4876 Ignore open/closed distinctions at this point. | |
| 4877 -- Rose | |
| 4878 */ | |
| 4879 if (closure->start != closure->end && | |
| 4880 extent_start (extent) >= closure->start && | |
| 4881 extent_end (extent) <= closure->end) | |
| 4882 return 0; | |
| 4883 #endif | |
| 4884 | |
| 4885 while (1) | |
| 4886 Fsignal (Qbuffer_read_only, (list1 (closure->object))); | |
| 4887 | |
| 1204 | 4888 RETURN_NOT_REACHED(0); |
| 428 | 4889 } |
| 4890 | |
| 4891 /* Value of Vinhibit_read_only is precomputed and passed in for | |
| 4892 efficiency */ | |
| 4893 | |
| 4894 void | |
| 826 | 4895 verify_extent_modification (Lisp_Object object, Bytexpos from, Bytexpos to, |
| 428 | 4896 Lisp_Object inhibit_read_only_value) |
| 4897 { | |
| 4898 int closed; | |
| 4899 struct verify_extents_arg closure; | |
| 4900 | |
| 4901 /* If insertion, visit closed-endpoint extents touching the insertion | |
| 4902 point because the text would go inside those extents. If deletion, | |
| 4903 treat the range as open on both ends so that touching extents are not | |
| 4904 visited. Note that we assume that an insertion is occurring if the | |
| 4905 changed range has zero length, and a deletion otherwise. This | |
| 4906 fails if a change (i.e. non-insertion, non-deletion) is happening. | |
| 4907 As far as I know, this doesn't currently occur in XEmacs. --ben */ | |
| 4908 closed = (from==to); | |
| 4909 closure.object = object; | |
| 826 | 4910 closure.start = buffer_or_string_bytexpos_to_memxpos (object, from); |
| 4911 closure.end = buffer_or_string_bytexpos_to_memxpos (object, to); | |
| 428 | 4912 closure.iro = inhibit_read_only_value; |
| 4913 | |
| 826 | 4914 map_extents (from, to, verify_extent_mapper, (void *) &closure, |
| 4915 object, 0, closed ? ME_END_CLOSED : ME_START_OPEN); | |
| 428 | 4916 } |
| 4917 | |
| 4918 /* ------------------------------------ */ | |
| 4919 /* process_extents_for_insertion() */ | |
| 4920 /* ------------------------------------ */ | |
| 4921 | |
| 4922 struct process_extents_for_insertion_arg | |
| 4923 { | |
| 826 | 4924 Bytexpos opoint; |
| 428 | 4925 int length; |
| 4926 Lisp_Object object; | |
| 4927 }; | |
| 4928 | |
| 4929 /* A region of length LENGTH was just inserted at OPOINT. Modify all | |
| 4930 of the extents as required for the insertion, based on their | |
| 4931 start-open/end-open properties. | |
| 4932 */ | |
| 4933 | |
| 4934 static int | |
| 4935 process_extents_for_insertion_mapper (EXTENT extent, void *arg) | |
| 4936 { | |
| 4937 struct process_extents_for_insertion_arg *closure = | |
| 4938 (struct process_extents_for_insertion_arg *) arg; | |
| 826 | 4939 Memxpos indice = buffer_or_string_bytexpos_to_memxpos (closure->object, |
| 4940 closure->opoint); | |
| 428 | 4941 |
| 4942 /* When this function is called, one end of the newly-inserted text should | |
| 4943 be adjacent to some endpoint of the extent, or disjoint from it. If | |
| 4944 the insertion overlaps any existing extent, something is wrong. | |
| 4945 */ | |
| 4946 #ifdef ERROR_CHECK_EXTENTS | |
|
5050
6f2158fa75ed
Fix quick-build, use asserts() in place of ABORT()
Ben Wing <ben@xemacs.org>
parents:
4976
diff
changeset
|
4947 assert (extent_start (extent) <= indice || extent_start (extent) > indice + closure->length); |
|
6f2158fa75ed
Fix quick-build, use asserts() in place of ABORT()
Ben Wing <ben@xemacs.org>
parents:
4976
diff
changeset
|
4948 assert (extent_end (extent) <= indice || extent_end (extent) > indice + closure->length); |
| 428 | 4949 #endif |
| 4950 | |
| 4951 /* The extent-adjustment code adjusted the extent's endpoints as if | |
| 468 | 4952 all extents were closed-open -- endpoints at the insertion point |
| 4953 remain unchanged. We need to fix the other kinds of extents: | |
| 4954 | |
| 4955 1. Start position of start-open extents needs to be moved. | |
| 4956 | |
| 4957 2. End position of end-closed extents needs to be moved. | |
| 4958 | |
| 4959 Note that both conditions hold for zero-length (] extents at the | |
| 4960 insertion point. But under these rules, zero-length () extents | |
| 4961 would get adjusted such that their start is greater than their | |
| 4962 end; instead of allowing that, we treat them as [) extents by | |
| 4963 modifying condition #1 to not fire nothing when dealing with a | |
| 4964 zero-length open-open extent. | |
| 4965 | |
| 4966 Existence of zero-length open-open extents is unfortunately an | |
| 4967 inelegant part of the extent model, but there is no way around | |
| 4968 it. */ | |
| 428 | 4969 |
| 4970 { | |
| 826 | 4971 Memxpos new_start = extent_start (extent); |
| 4972 Memxpos new_end = extent_end (extent); | |
| 468 | 4973 |
| 4974 if (indice == extent_start (extent) && extent_start_open_p (extent) | |
| 4975 /* zero-length () extents are exempt; see comment above. */ | |
| 4976 && !(new_start == new_end && extent_end_open_p (extent)) | |
| 4977 ) | |
| 428 | 4978 new_start += closure->length; |
| 4979 if (indice == extent_end (extent) && !extent_end_open_p (extent)) | |
| 4980 new_end += closure->length; | |
| 468 | 4981 |
| 428 | 4982 set_extent_endpoints_1 (extent, new_start, new_end); |
| 4983 } | |
| 4984 | |
| 4985 return 0; | |
| 4986 } | |
| 4987 | |
| 4988 void | |
| 826 | 4989 process_extents_for_insertion (Lisp_Object object, Bytexpos opoint, |
| 428 | 4990 Bytecount length) |
| 4991 { | |
| 4992 struct process_extents_for_insertion_arg closure; | |
| 4993 | |
| 4994 closure.opoint = opoint; | |
| 4995 closure.length = length; | |
| 4996 closure.object = object; | |
| 4997 | |
| 826 | 4998 map_extents (opoint, opoint + length, |
| 4999 process_extents_for_insertion_mapper, | |
| 5000 (void *) &closure, object, 0, | |
| 5001 ME_END_CLOSED | ME_MIGHT_MODIFY_EXTENTS | | |
| 5002 ME_INCLUDE_INTERNAL); | |
| 428 | 5003 } |
| 5004 | |
| 5005 /* ------------------------------------ */ | |
| 5006 /* process_extents_for_deletion() */ | |
| 5007 /* ------------------------------------ */ | |
| 5008 | |
| 5009 struct process_extents_for_deletion_arg | |
| 5010 { | |
| 826 | 5011 Memxpos start, end; |
| 428 | 5012 int destroy_included_extents; |
| 5013 }; | |
| 5014 | |
| 5015 /* This function is called when we're about to delete the range [from, to]. | |
| 5016 Detach all of the extents that are completely inside the range [from, to], | |
| 5017 if they're detachable or open-open. */ | |
| 5018 | |
| 5019 static int | |
| 5020 process_extents_for_deletion_mapper (EXTENT extent, void *arg) | |
| 5021 { | |
| 5022 struct process_extents_for_deletion_arg *closure = | |
| 5023 (struct process_extents_for_deletion_arg *) arg; | |
| 5024 | |
| 5025 /* If the extent lies completely within the range that | |
| 5026 is being deleted, then nuke the extent if it's detachable | |
| 5027 (otherwise, it will become a zero-length extent). */ | |
| 5028 | |
| 5029 if (closure->start <= extent_start (extent) && | |
| 5030 extent_end (extent) <= closure->end) | |
| 5031 { | |
| 5032 if (extent_detachable_p (extent)) | |
| 5033 { | |
| 5034 if (closure->destroy_included_extents) | |
| 5035 destroy_extent (extent); | |
| 5036 else | |
| 5037 extent_detach (extent); | |
| 5038 } | |
| 5039 } | |
| 5040 | |
| 5041 return 0; | |
| 5042 } | |
| 5043 | |
| 5044 /* DESTROY_THEM means destroy the extents instead of just deleting them. | |
| 5045 It is unused currently, but perhaps might be used (there used to | |
| 5046 be a function process_extents_for_destruction(), #if 0'd out, | |
| 5047 that did the equivalent). */ | |
| 5048 void | |
| 826 | 5049 process_extents_for_deletion (Lisp_Object object, Bytexpos from, |
| 5050 Bytexpos to, int destroy_them) | |
| 428 | 5051 { |
| 5052 struct process_extents_for_deletion_arg closure; | |
| 5053 | |
| 826 | 5054 closure.start = buffer_or_string_bytexpos_to_memxpos (object, from); |
| 5055 closure.end = buffer_or_string_bytexpos_to_memxpos (object, to); | |
| 428 | 5056 closure.destroy_included_extents = destroy_them; |
| 5057 | |
| 826 | 5058 map_extents (from, to, process_extents_for_deletion_mapper, |
| 5059 (void *) &closure, object, 0, | |
| 5060 ME_END_CLOSED | ME_MIGHT_MODIFY_EXTENTS); | |
| 428 | 5061 } |
| 5062 | |
| 5063 /* ------------------------------- */ | |
| 5064 /* report_extent_modification() */ | |
| 5065 /* ------------------------------- */ | |
| 826 | 5066 |
| 5067 struct report_extent_modification_closure | |
| 5068 { | |
| 428 | 5069 Lisp_Object buffer; |
| 826 | 5070 Charxpos start, end; |
| 428 | 5071 int afterp; |
| 5072 int speccount; | |
| 5073 }; | |
| 5074 | |
| 5075 static Lisp_Object | |
| 5076 report_extent_modification_restore (Lisp_Object buffer) | |
| 5077 { | |
| 5078 if (current_buffer != XBUFFER (buffer)) | |
| 5079 Fset_buffer (buffer); | |
| 5080 return Qnil; | |
| 5081 } | |
| 5082 | |
| 5083 static int | |
| 5084 report_extent_modification_mapper (EXTENT extent, void *arg) | |
| 5085 { | |
| 5086 struct report_extent_modification_closure *closure = | |
| 5087 (struct report_extent_modification_closure *)arg; | |
| 5088 Lisp_Object exobj, startobj, endobj; | |
| 5089 Lisp_Object hook = (closure->afterp | |
| 5090 ? extent_after_change_functions (extent) | |
| 5091 : extent_before_change_functions (extent)); | |
| 5092 if (NILP (hook)) | |
| 5093 return 0; | |
| 5094 | |
| 793 | 5095 exobj = wrap_extent (extent); |
| 5096 startobj = make_int (closure->start); | |
| 5097 endobj = make_int (closure->end); | |
| 428 | 5098 |
| 5099 /* Now that we are sure to call elisp, set up an unwind-protect so | |
| 5100 inside_change_hook gets restored in case we throw. Also record | |
| 5101 the current buffer, in case we change it. Do the recording only | |
| 438 | 5102 once. |
| 5103 | |
| 5104 One confusing thing here is that our caller never actually calls | |
| 771 | 5105 unbind_to (closure.speccount). This is because |
| 826 | 5106 map_extents() unbinds before, and with a smaller |
| 771 | 5107 speccount. The additional unbind_to_1() in |
| 438 | 5108 report_extent_modification() would cause XEmacs to abort. */ |
| 428 | 5109 if (closure->speccount == -1) |
| 5110 { | |
| 5111 closure->speccount = specpdl_depth (); | |
| 5112 record_unwind_protect (report_extent_modification_restore, | |
| 5113 Fcurrent_buffer ()); | |
| 5114 } | |
| 5115 | |
| 5116 /* The functions will expect closure->buffer to be the current | |
| 5117 buffer, so change it if it isn't. */ | |
| 5118 if (current_buffer != XBUFFER (closure->buffer)) | |
| 5119 Fset_buffer (closure->buffer); | |
| 5120 | |
| 5121 /* #### It's a shame that we can't use any of the existing run_hook* | |
| 5122 functions here. This is so because all of them work with | |
| 5123 symbols, to be able to retrieve default values of local hooks. | |
| 438 | 5124 <sigh> |
| 5125 | |
| 5126 #### Idea: we could set up a dummy symbol, and call the hook | |
| 5127 functions on *that*. */ | |
| 428 | 5128 |
| 5129 if (!CONSP (hook) || EQ (XCAR (hook), Qlambda)) | |
| 5130 call3 (hook, exobj, startobj, endobj); | |
| 5131 else | |
| 5132 { | |
| 2367 | 5133 EXTERNAL_LIST_LOOP_2 (elt, hook) |
| 438 | 5134 /* #### Shouldn't this perform the same Fset_buffer() check as |
| 5135 above? */ | |
| 2367 | 5136 call3 (elt, exobj, startobj, endobj); |
| 428 | 5137 } |
| 5138 return 0; | |
| 5139 } | |
| 5140 | |
| 5141 void | |
| 665 | 5142 report_extent_modification (Lisp_Object buffer, Charbpos start, Charbpos end, |
| 438 | 5143 int afterp) |
| 428 | 5144 { |
| 5145 struct report_extent_modification_closure closure; | |
| 5146 | |
| 5147 closure.buffer = buffer; | |
| 5148 closure.start = start; | |
| 5149 closure.end = end; | |
| 5150 closure.afterp = afterp; | |
| 5151 closure.speccount = -1; | |
| 5152 | |
| 826 | 5153 map_extents (charbpos_to_bytebpos (XBUFFER (buffer), start), |
| 5154 charbpos_to_bytebpos (XBUFFER (buffer), end), | |
| 5155 report_extent_modification_mapper, (void *)&closure, | |
| 428 | 5156 buffer, NULL, ME_MIGHT_CALL_ELISP); |
| 5157 } | |
| 5158 | |
| 5159 | |
| 5160 /************************************************************************/ | |
| 5161 /* extent properties */ | |
| 5162 /************************************************************************/ | |
| 5163 | |
| 5164 static void | |
| 5165 set_extent_invisible (EXTENT extent, Lisp_Object value) | |
| 5166 { | |
| 5167 if (!EQ (extent_invisible (extent), value)) | |
| 5168 { | |
| 5169 set_extent_invisible_1 (extent, value); | |
| 826 | 5170 signal_extent_property_changed (extent, Qinvisible, 1); |
| 428 | 5171 } |
| 5172 } | |
| 5173 | |
| 5174 /* This function does "memoization" -- similar to the interning | |
| 5175 that happens with symbols. Given a list of faces, an equivalent | |
| 5176 list is returned such that if this function is called twice with | |
| 5177 input that is `equal', the resulting outputs will be `eq'. | |
| 5178 | |
| 5179 Note that the inputs and outputs are in general *not* `equal' -- | |
| 5180 faces in symbol form become actual face objects in the output. | |
| 5181 This is necessary so that temporary faces stay around. */ | |
| 5182 | |
| 5183 static Lisp_Object | |
| 5184 memoize_extent_face_internal (Lisp_Object list) | |
| 5185 { | |
| 5186 int len; | |
| 5187 int thelen; | |
| 5188 Lisp_Object cons, thecons; | |
| 5189 Lisp_Object oldtail, tail; | |
| 5190 struct gcpro gcpro1; | |
| 5191 | |
| 5192 if (NILP (list)) | |
| 5193 return Qnil; | |
| 5194 if (!CONSP (list)) | |
| 5195 return Fget_face (list); | |
| 5196 | |
| 5197 /* To do the memoization, we use a hash table mapping from | |
| 5198 external lists to internal lists. We do `equal' comparisons | |
| 5199 on the keys so the memoization works correctly. | |
| 5200 | |
| 5201 Note that we canonicalize things so that the keys in the | |
| 5202 hash table (the external lists) always contain symbols and | |
| 5203 the values (the internal lists) always contain face objects. | |
| 5204 | |
| 5205 We also maintain a "reverse" table that maps from the internal | |
| 5206 lists to the external equivalents. The idea here is twofold: | |
| 5207 | |
| 5208 1) `extent-face' wants to return a list containing face symbols | |
| 5209 rather than face objects. | |
| 5210 2) We don't want things to get quite so messed up if the user | |
| 5211 maliciously side-effects the returned lists. | |
| 5212 */ | |
| 5213 | |
| 5214 len = XINT (Flength (list)); | |
| 5215 thelen = XINT (Flength (Vextent_face_reusable_list)); | |
| 5216 oldtail = Qnil; | |
| 5217 tail = Qnil; | |
| 5218 GCPRO1 (oldtail); | |
| 5219 | |
| 5220 /* We canonicalize the given list into another list. | |
| 5221 We try to avoid consing except when necessary, so we have | |
| 5222 a reusable list. | |
| 5223 */ | |
| 5224 | |
| 5225 if (thelen < len) | |
| 5226 { | |
| 5227 cons = Vextent_face_reusable_list; | |
| 5228 while (!NILP (XCDR (cons))) | |
| 5229 cons = XCDR (cons); | |
| 5230 XCDR (cons) = Fmake_list (make_int (len - thelen), Qnil); | |
| 5231 } | |
| 5232 else if (thelen > len) | |
| 5233 { | |
| 5234 int i; | |
| 5235 | |
| 5236 /* Truncate the list temporarily so it's the right length; | |
| 5237 remember the old tail. */ | |
| 5238 cons = Vextent_face_reusable_list; | |
| 5239 for (i = 0; i < len - 1; i++) | |
| 5240 cons = XCDR (cons); | |
| 5241 tail = cons; | |
| 5242 oldtail = XCDR (cons); | |
| 5243 XCDR (cons) = Qnil; | |
| 5244 } | |
| 5245 | |
| 5246 thecons = Vextent_face_reusable_list; | |
| 2367 | 5247 { |
| 5248 EXTERNAL_LIST_LOOP_2 (face, list) | |
| 5249 { | |
| 5250 face = Fget_face (face); | |
| 5251 | |
| 5252 XCAR (thecons) = Fface_name (face); | |
| 5253 thecons = XCDR (thecons); | |
| 5254 } | |
| 5255 } | |
| 428 | 5256 |
| 5257 list = Fgethash (Vextent_face_reusable_list, Vextent_face_memoize_hash_table, | |
| 5258 Qnil); | |
| 5259 if (NILP (list)) | |
| 5260 { | |
| 5261 Lisp_Object symlist = Fcopy_sequence (Vextent_face_reusable_list); | |
| 5262 Lisp_Object facelist = Fcopy_sequence (Vextent_face_reusable_list); | |
| 5263 | |
| 5264 LIST_LOOP (cons, facelist) | |
| 5265 { | |
| 5266 XCAR (cons) = Fget_face (XCAR (cons)); | |
| 5267 } | |
| 5268 Fputhash (symlist, facelist, Vextent_face_memoize_hash_table); | |
| 5269 Fputhash (facelist, symlist, Vextent_face_reverse_memoize_hash_table); | |
| 5270 list = facelist; | |
| 5271 } | |
| 5272 | |
| 5273 /* Now restore the truncated tail of the reusable list, if necessary. */ | |
| 5274 if (!NILP (tail)) | |
| 5275 XCDR (tail) = oldtail; | |
| 5276 | |
| 5277 UNGCPRO; | |
| 5278 return list; | |
| 5279 } | |
| 5280 | |
| 5281 static Lisp_Object | |
| 5282 external_of_internal_memoized_face (Lisp_Object face) | |
| 5283 { | |
| 5284 if (NILP (face)) | |
| 5285 return Qnil; | |
| 5286 else if (!CONSP (face)) | |
| 5287 return XFACE (face)->name; | |
| 5288 else | |
| 5289 { | |
| 5290 face = Fgethash (face, Vextent_face_reverse_memoize_hash_table, | |
| 5291 Qunbound); | |
| 5292 assert (!UNBOUNDP (face)); | |
| 5293 return face; | |
| 5294 } | |
| 5295 } | |
| 5296 | |
| 826 | 5297 /* The idea here is that if we're given a list of faces, we |
| 5298 need to "memoize" this so that two lists of faces that are `equal' | |
| 5299 turn into the same object. When `set-extent-face' is called, we | |
| 5300 "memoize" into a list of actual faces; when `extent-face' is called, | |
| 5301 we do a reverse lookup to get the list of symbols. */ | |
| 5302 | |
| 428 | 5303 static Lisp_Object |
| 5304 canonicalize_extent_property (Lisp_Object prop, Lisp_Object value) | |
| 5305 { | |
| 5306 if (EQ (prop, Qface) || EQ (prop, Qmouse_face)) | |
| 5307 value = (external_of_internal_memoized_face | |
| 5308 (memoize_extent_face_internal (value))); | |
| 5309 return value; | |
| 5310 } | |
| 5311 | |
| 5312 /* Do we need a lisp-level function ? */ | |
| 826 | 5313 DEFUN ("set-extent-initial-redisplay-function", |
| 5314 Fset_extent_initial_redisplay_function, | |
| 444 | 5315 2,2,0, /* |
| 428 | 5316 Note: This feature is experimental! |
| 5317 | |
| 5318 Set initial-redisplay-function of EXTENT to the function | |
| 5319 FUNCTION. | |
| 5320 | |
| 5321 The first time the EXTENT is (re)displayed, an eval event will be | |
| 5322 dispatched calling FUNCTION with EXTENT as its only argument. | |
| 5323 */ | |
| 5324 (extent, function)) | |
| 5325 { | |
| 826 | 5326 /* #### This is totally broken. */ |
| 5327 EXTENT e = decode_extent (extent, DE_MUST_BE_ATTACHED); | |
| 428 | 5328 |
| 5329 e = extent_ancestor (e); /* Is this needed? Macro also does chasing!*/ | |
| 826 | 5330 set_extent_initial_redisplay_function (e, function); |
| 5331 extent_in_red_event_p (e) = 0; /* If the function changed we can spawn | |
| 428 | 5332 new events */ |
| 826 | 5333 signal_extent_property_changed (e, Qinitial_redisplay_function, 1); |
| 428 | 5334 return function; |
| 5335 } | |
| 5336 | |
| 5337 DEFUN ("extent-face", Fextent_face, 1, 1, 0, /* | |
| 5338 Return the name of the face in which EXTENT is displayed, or nil | |
| 5339 if the extent's face is unspecified. This might also return a list | |
| 5340 of face names. | |
| 5341 */ | |
| 5342 (extent)) | |
| 5343 { | |
| 5344 Lisp_Object face; | |
| 5345 | |
| 5346 CHECK_EXTENT (extent); | |
| 5347 face = extent_face (XEXTENT (extent)); | |
| 5348 | |
| 5349 return external_of_internal_memoized_face (face); | |
| 5350 } | |
| 5351 | |
| 5352 DEFUN ("set-extent-face", Fset_extent_face, 2, 2, 0, /* | |
| 5353 Make the given EXTENT have the graphic attributes specified by FACE. | |
| 5354 FACE can also be a list of faces, and all faces listed will apply, | |
| 5355 with faces earlier in the list taking priority over those later in the | |
| 5356 list. | |
| 5357 */ | |
| 5358 (extent, face)) | |
| 5359 { | |
| 5360 EXTENT e = decode_extent(extent, 0); | |
| 5361 Lisp_Object orig_face = face; | |
| 5362 | |
| 5363 /* retrieve the ancestor for efficiency and proper redisplay noting. */ | |
| 5364 e = extent_ancestor (e); | |
| 5365 | |
| 5366 face = memoize_extent_face_internal (face); | |
| 5367 | |
| 5368 extent_face (e) = face; | |
| 826 | 5369 signal_extent_property_changed (e, Qface, 1); |
| 428 | 5370 |
| 5371 return orig_face; | |
| 5372 } | |
| 5373 | |
| 5374 | |
| 5375 DEFUN ("extent-mouse-face", Fextent_mouse_face, 1, 1, 0, /* | |
| 5376 Return the face used to highlight EXTENT when the mouse passes over it. | |
| 5377 The return value will be a face name, a list of face names, or nil | |
| 5378 if the extent's mouse face is unspecified. | |
| 5379 */ | |
| 5380 (extent)) | |
| 5381 { | |
| 5382 Lisp_Object face; | |
| 5383 | |
| 5384 CHECK_EXTENT (extent); | |
| 5385 face = extent_mouse_face (XEXTENT (extent)); | |
| 5386 | |
| 5387 return external_of_internal_memoized_face (face); | |
| 5388 } | |
| 5389 | |
| 5390 DEFUN ("set-extent-mouse-face", Fset_extent_mouse_face, 2, 2, 0, /* | |
| 5391 Set the face used to highlight EXTENT when the mouse passes over it. | |
| 5392 FACE can also be a list of faces, and all faces listed will apply, | |
| 5393 with faces earlier in the list taking priority over those later in the | |
| 5394 list. | |
| 5395 */ | |
| 5396 (extent, face)) | |
| 5397 { | |
| 5398 EXTENT e; | |
| 5399 Lisp_Object orig_face = face; | |
| 5400 | |
| 5401 CHECK_EXTENT (extent); | |
| 5402 e = XEXTENT (extent); | |
| 5403 /* retrieve the ancestor for efficiency and proper redisplay noting. */ | |
| 5404 e = extent_ancestor (e); | |
| 5405 | |
| 5406 face = memoize_extent_face_internal (face); | |
| 5407 | |
| 5408 set_extent_mouse_face (e, face); | |
| 826 | 5409 signal_extent_property_changed (e, Qmouse_face, 1); |
| 428 | 5410 |
| 5411 return orig_face; | |
| 5412 } | |
| 5413 | |
| 5414 void | |
| 5415 set_extent_glyph (EXTENT extent, Lisp_Object glyph, int endp, | |
| 5416 glyph_layout layout) | |
| 5417 { | |
| 5418 extent = extent_ancestor (extent); | |
| 5419 | |
| 5420 if (!endp) | |
| 5421 { | |
| 5422 set_extent_begin_glyph (extent, glyph); | |
| 647 | 5423 set_extent_begin_glyph_layout (extent, layout); |
| 826 | 5424 signal_extent_property_changed (extent, Qbegin_glyph, 1); |
| 5425 signal_extent_property_changed (extent, Qbegin_glyph_layout, 1); | |
| 428 | 5426 } |
| 5427 else | |
| 5428 { | |
| 5429 set_extent_end_glyph (extent, glyph); | |
| 647 | 5430 set_extent_end_glyph_layout (extent, layout); |
| 826 | 5431 signal_extent_property_changed (extent, Qend_glyph, 1); |
| 5432 signal_extent_property_changed (extent, Qend_glyph_layout, 1); | |
| 428 | 5433 } |
| 5434 } | |
| 5435 | |
| 5436 static Lisp_Object | |
| 5437 glyph_layout_to_symbol (glyph_layout layout) | |
| 5438 { | |
| 5439 switch (layout) | |
| 5440 { | |
| 5441 case GL_TEXT: return Qtext; | |
| 5442 case GL_OUTSIDE_MARGIN: return Qoutside_margin; | |
| 5443 case GL_INSIDE_MARGIN: return Qinside_margin; | |
| 5444 case GL_WHITESPACE: return Qwhitespace; | |
| 5445 default: | |
| 2500 | 5446 ABORT (); |
| 428 | 5447 return Qnil; /* unreached */ |
| 5448 } | |
| 5449 } | |
| 5450 | |
| 5451 static glyph_layout | |
| 5452 symbol_to_glyph_layout (Lisp_Object layout_obj) | |
| 5453 { | |
| 5454 if (NILP (layout_obj)) | |
| 5455 return GL_TEXT; | |
| 5456 | |
| 5457 CHECK_SYMBOL (layout_obj); | |
| 5458 if (EQ (layout_obj, Qoutside_margin)) return GL_OUTSIDE_MARGIN; | |
| 5459 if (EQ (layout_obj, Qinside_margin)) return GL_INSIDE_MARGIN; | |
| 5460 if (EQ (layout_obj, Qwhitespace)) return GL_WHITESPACE; | |
| 5461 if (EQ (layout_obj, Qtext)) return GL_TEXT; | |
| 5462 | |
| 563 | 5463 invalid_constant ("Unknown glyph layout type", layout_obj); |
| 1204 | 5464 RETURN_NOT_REACHED (GL_TEXT); |
| 428 | 5465 } |
| 5466 | |
| 5467 static Lisp_Object | |
| 5468 set_extent_glyph_1 (Lisp_Object extent_obj, Lisp_Object glyph, int endp, | |
| 5469 Lisp_Object layout_obj) | |
| 5470 { | |
| 442 | 5471 EXTENT extent = decode_extent (extent_obj, 0); |
| 428 | 5472 glyph_layout layout = symbol_to_glyph_layout (layout_obj); |
| 5473 | |
| 5474 /* Make sure we've actually been given a valid glyph or it's nil | |
| 5475 (meaning we're deleting a glyph from an extent). */ | |
| 5476 if (!NILP (glyph)) | |
| 5477 CHECK_BUFFER_GLYPH (glyph); | |
| 5478 | |
| 5479 set_extent_glyph (extent, glyph, endp, layout); | |
| 5480 return glyph; | |
| 5481 } | |
| 5482 | |
| 5483 DEFUN ("set-extent-begin-glyph", Fset_extent_begin_glyph, 2, 3, 0, /* | |
| 5484 Display a bitmap, subwindow or string at the beginning of EXTENT. | |
| 5485 BEGIN-GLYPH must be a glyph object. The layout policy defaults to `text'. | |
| 5486 */ | |
| 5487 (extent, begin_glyph, layout)) | |
| 5488 { | |
| 5489 return set_extent_glyph_1 (extent, begin_glyph, 0, layout); | |
| 5490 } | |
| 5491 | |
| 5492 DEFUN ("set-extent-end-glyph", Fset_extent_end_glyph, 2, 3, 0, /* | |
| 5493 Display a bitmap, subwindow or string at the end of EXTENT. | |
| 5494 END-GLYPH must be a glyph object. The layout policy defaults to `text'. | |
| 5495 */ | |
| 5496 (extent, end_glyph, layout)) | |
| 5497 { | |
| 5498 return set_extent_glyph_1 (extent, end_glyph, 1, layout); | |
| 5499 } | |
| 5500 | |
| 5501 DEFUN ("extent-begin-glyph", Fextent_begin_glyph, 1, 1, 0, /* | |
| 5502 Return the glyph object displayed at the beginning of EXTENT. | |
| 5503 If there is none, nil is returned. | |
| 5504 */ | |
| 5505 (extent)) | |
| 5506 { | |
| 5507 return extent_begin_glyph (decode_extent (extent, 0)); | |
| 5508 } | |
| 5509 | |
| 5510 DEFUN ("extent-end-glyph", Fextent_end_glyph, 1, 1, 0, /* | |
| 5511 Return the glyph object displayed at the end of EXTENT. | |
| 5512 If there is none, nil is returned. | |
| 5513 */ | |
| 5514 (extent)) | |
| 5515 { | |
| 5516 return extent_end_glyph (decode_extent (extent, 0)); | |
| 5517 } | |
| 5518 | |
| 5519 DEFUN ("set-extent-begin-glyph-layout", Fset_extent_begin_glyph_layout, 2, 2, 0, /* | |
| 5520 Set the layout policy of EXTENT's begin glyph. | |
| 5521 Access this using the `extent-begin-glyph-layout' function. | |
| 5522 */ | |
| 5523 (extent, layout)) | |
| 5524 { | |
| 5525 EXTENT e = decode_extent (extent, 0); | |
| 5526 e = extent_ancestor (e); | |
| 647 | 5527 set_extent_begin_glyph_layout (e, symbol_to_glyph_layout (layout)); |
| 826 | 5528 signal_extent_property_changed (e, Qbegin_glyph_layout, 1); |
| 428 | 5529 return layout; |
| 5530 } | |
| 5531 | |
| 5532 DEFUN ("set-extent-end-glyph-layout", Fset_extent_end_glyph_layout, 2, 2, 0, /* | |
| 5533 Set the layout policy of EXTENT's end glyph. | |
| 5534 Access this using the `extent-end-glyph-layout' function. | |
| 5535 */ | |
| 5536 (extent, layout)) | |
| 5537 { | |
| 5538 EXTENT e = decode_extent (extent, 0); | |
| 5539 e = extent_ancestor (e); | |
| 647 | 5540 set_extent_end_glyph_layout (e, symbol_to_glyph_layout (layout)); |
| 826 | 5541 signal_extent_property_changed (e, Qend_glyph_layout, 1); |
| 428 | 5542 return layout; |
| 5543 } | |
| 5544 | |
| 5545 DEFUN ("extent-begin-glyph-layout", Fextent_begin_glyph_layout, 1, 1, 0, /* | |
| 5546 Return the layout policy associated with EXTENT's begin glyph. | |
| 5547 Set this using the `set-extent-begin-glyph-layout' function. | |
| 5548 */ | |
| 5549 (extent)) | |
| 5550 { | |
| 5551 EXTENT e = decode_extent (extent, 0); | |
| 5552 return glyph_layout_to_symbol ((glyph_layout) extent_begin_glyph_layout (e)); | |
| 5553 } | |
| 5554 | |
| 5555 DEFUN ("extent-end-glyph-layout", Fextent_end_glyph_layout, 1, 1, 0, /* | |
| 5556 Return the layout policy associated with EXTENT's end glyph. | |
| 5557 Set this using the `set-extent-end-glyph-layout' function. | |
| 5558 */ | |
| 5559 (extent)) | |
| 5560 { | |
| 5561 EXTENT e = decode_extent (extent, 0); | |
| 5562 return glyph_layout_to_symbol ((glyph_layout) extent_end_glyph_layout (e)); | |
| 5563 } | |
| 5564 | |
| 5565 DEFUN ("set-extent-priority", Fset_extent_priority, 2, 2, 0, /* | |
| 5566 Set the display priority of EXTENT to PRIORITY (an integer). | |
| 5567 When the extent attributes are being merged for display, the priority | |
| 5568 is used to determine which extent takes precedence in the event of a | |
| 5569 conflict (two extents whose faces both specify font, for example: the | |
| 5570 font of the extent with the higher priority will be used). | |
| 5571 Extents are created with priority 0; priorities may be negative. | |
| 5572 */ | |
| 5573 (extent, priority)) | |
| 5574 { | |
| 5575 EXTENT e = decode_extent (extent, 0); | |
| 5576 | |
| 5577 CHECK_INT (priority); | |
| 5578 e = extent_ancestor (e); | |
| 5579 set_extent_priority (e, XINT (priority)); | |
| 826 | 5580 signal_extent_property_changed (e, Qpriority, 1); |
| 428 | 5581 return priority; |
| 5582 } | |
| 5583 | |
| 5584 DEFUN ("extent-priority", Fextent_priority, 1, 1, 0, /* | |
| 5585 Return the display priority of EXTENT; see `set-extent-priority'. | |
| 5586 */ | |
| 5587 (extent)) | |
| 5588 { | |
| 5589 EXTENT e = decode_extent (extent, 0); | |
| 5590 return make_int (extent_priority (e)); | |
| 5591 } | |
| 5592 | |
| 5593 DEFUN ("set-extent-property", Fset_extent_property, 3, 3, 0, /* | |
| 5594 Change a property of an extent. | |
| 5595 PROPERTY may be any symbol; the value stored may be accessed with | |
| 5596 the `extent-property' function. | |
| 2758 | 5597 |
| 428 | 5598 The following symbols have predefined meanings: |
| 5599 | |
| 5600 detached Removes the extent from its buffer; setting this is | |
| 5601 the same as calling `detach-extent'. | |
| 5602 | |
| 5603 destroyed Removes the extent from its buffer, and makes it | |
| 5604 unusable in the future; this is the same calling | |
| 5605 `delete-extent'. | |
| 5606 | |
| 5607 priority Change redisplay priority; same as `set-extent-priority'. | |
| 5608 | |
| 5609 start-open Whether the set of characters within the extent is | |
| 5610 treated being open on the left, that is, whether | |
| 5611 the start position is an exclusive, rather than | |
| 5612 inclusive, boundary. If true, then characters | |
| 5613 inserted exactly at the beginning of the extent | |
| 5614 will remain outside of the extent; otherwise they | |
| 5615 will go into the extent, extending it. | |
| 5616 | |
| 5617 end-open Whether the set of characters within the extent is | |
| 5618 treated being open on the right, that is, whether | |
| 5619 the end position is an exclusive, rather than | |
| 5620 inclusive, boundary. If true, then characters | |
| 5621 inserted exactly at the end of the extent will | |
| 5622 remain outside of the extent; otherwise they will | |
| 5623 go into the extent, extending it. | |
| 5624 | |
| 5625 By default, extents have the `end-open' but not the | |
| 5626 `start-open' property set. | |
| 5627 | |
| 5628 read-only Text within this extent will be unmodifiable. | |
| 5629 | |
| 5630 initial-redisplay-function (EXPERIMENTAL) | |
| 5631 function to be called the first time (part of) the extent | |
| 5632 is redisplayed. It will be called with the extent as its | |
| 5633 first argument. | |
| 1041 | 5634 Note: The function will not be called immediately |
| 5635 during redisplay, an eval event will be dispatched. | |
| 428 | 5636 |
| 5637 detachable Whether the extent gets detached (as with | |
| 5638 `detach-extent') when all the text within the | |
| 5639 extent is deleted. This is true by default. If | |
| 5640 this property is not set, the extent becomes a | |
| 5641 zero-length extent when its text is deleted. (In | |
| 5642 such a case, the `start-open' property is | |
| 5643 automatically removed if both the `start-open' and | |
| 5644 `end-open' properties are set, since zero-length | |
| 5645 extents open on both ends are not allowed.) | |
| 5646 | |
| 5647 face The face in which to display the text. Setting | |
| 5648 this is the same as calling `set-extent-face'. | |
| 5649 | |
| 1041 | 5650 mouse-face If non-nil, the extent will be highlighted in this |
| 5651 face when the mouse moves over it. | |
| 428 | 5652 |
| 5653 pointer If non-nil, and a valid pointer glyph, this specifies | |
| 5654 the shape of the mouse pointer while over the extent. | |
| 5655 | |
| 5656 highlight Obsolete: Setting this property is equivalent to | |
| 1041 | 5657 setting a `mouse-face' property of `highlight'. |
| 5658 Reading this property returns non-nil if | |
| 5659 the extent has a non-nil `mouse-face' property. | |
| 428 | 5660 |
| 5661 duplicable Whether this extent should be copied into strings, | |
| 5662 so that kill, yank, and undo commands will restore | |
| 5663 or copy it. `duplicable' extents are copied from | |
| 5664 an extent into a string when `buffer-substring' or | |
| 5665 a similar function creates a string. The extents | |
| 5666 in a string are copied into other strings created | |
| 5667 from the string using `concat' or `substring'. | |
| 5668 When `insert' or a similar function inserts the | |
| 5669 string into a buffer, the extents are copied back | |
| 5670 into the buffer. | |
| 5671 | |
| 5672 unique Meaningful only in conjunction with `duplicable'. | |
| 5673 When this is set, there may be only one instance | |
| 5674 of this extent attached at a time: if it is copied | |
| 5675 to the kill ring and then yanked, the extent is | |
| 5676 not copied. If, however, it is killed (removed | |
| 5677 from the buffer) and then yanked, it will be | |
| 5678 re-attached at the new position. | |
| 5679 | |
| 5680 invisible If the value is non-nil, text under this extent | |
| 5681 may be treated as not present for the purpose of | |
| 5682 redisplay, or may be displayed using an ellipsis | |
| 5683 or other marker; see `buffer-invisibility-spec' | |
| 5684 and `invisible-text-glyph'. In all cases, | |
| 5685 however, the text is still visible to other | |
| 5686 functions that examine a buffer's text. | |
| 5687 | |
| 5688 keymap This keymap is consulted for mouse clicks on this | |
| 5689 extent, or keypresses made while point is within the | |
| 5690 extent. | |
| 5691 | |
| 5692 copy-function This is a hook that is run when a duplicable extent | |
| 5693 is about to be copied from a buffer to a string (or | |
| 5694 the kill ring). It is called with three arguments, | |
| 5695 the extent, and the buffer-positions within it | |
| 5696 which are being copied. If this function returns | |
| 5697 nil, then the extent will not be copied; otherwise | |
| 5698 it will. | |
| 5699 | |
| 5700 paste-function This is a hook that is run when a duplicable extent is | |
| 5701 about to be copied from a string (or the kill ring) | |
| 5702 into a buffer. It is called with three arguments, | |
| 5703 the original extent, and the buffer positions which | |
| 5704 the copied extent will occupy. (This hook is run | |
| 5705 after the corresponding text has already been | |
| 5706 inserted into the buffer.) Note that the extent | |
| 5707 argument may be detached when this function is run. | |
| 5708 If this function returns nil, no extent will be | |
| 5709 inserted. Otherwise, there will be an extent | |
| 5710 covering the range in question. | |
| 5711 | |
| 5712 If the original extent is not attached to a buffer, | |
| 5713 then it will be re-attached at this range. | |
| 5714 Otherwise, a copy will be made, and that copy | |
| 5715 attached here. | |
| 5716 | |
| 5717 The copy-function and paste-function are meaningful | |
| 5718 only for extents with the `duplicable' flag set, | |
| 5719 and if they are not specified, behave as if `t' was | |
| 5720 the returned value. When these hooks are invoked, | |
| 5721 the current buffer is the buffer which the extent | |
| 5722 is being copied from/to, respectively. | |
| 5723 | |
| 5724 begin-glyph A glyph to be displayed at the beginning of the extent, | |
| 5725 or nil. | |
| 5726 | |
| 5727 end-glyph A glyph to be displayed at the end of the extent, | |
| 5728 or nil. | |
| 5729 | |
| 5730 begin-glyph-layout The layout policy (one of `text', `whitespace', | |
| 5731 `inside-margin', or `outside-margin') of the extent's | |
| 5732 begin glyph. | |
| 5733 | |
| 1041 | 5734 end-glyph-layout The layout policy of the extent's end glyph. |
| 5735 | |
| 5736 syntax-table A cons or a syntax table object. If a cons, the car must | |
| 2767 | 5737 be an integer (interpreted as a syntax code, applicable |
| 5738 to all characters in the extent). Otherwise, syntax of | |
| 5739 characters in the extent is looked up in the syntax | |
| 5740 table. You should use the text property API to | |
| 5741 manipulate this property. (This may be required in the | |
| 5742 future.) | |
| 5743 | |
| 5744 The following property is available if `atomic-extents.el'--part of the | |
| 5745 `edit-utils' package--has been loaded: | |
| 2758 | 5746 |
| 5747 atomic When set, point will never fall inside the extent. | |
| 5748 Not as useful as you might think, as | |
| 5749 `delete-backward-char' still removes characters one by | |
| 2767 | 5750 one. This property as currently implemented is a |
| 5751 kludge, and be prepared for it to go away if and when we | |
| 5752 implement something better. | |
| 2758 | 5753 |
| 428 | 5754 */ |
| 5755 (extent, property, value)) | |
| 5756 { | |
| 5757 /* This function can GC if property is `keymap' */ | |
| 5758 EXTENT e = decode_extent (extent, 0); | |
| 826 | 5759 int signal_change = 0; |
| 5760 | |
| 5761 /* If VALUE is unbound, the property is being removed through `remprop'. | |
| 5762 Return Qunbound if removal disallowed, Qt if anything removed, | |
| 5763 Qnil otherwise. */ | |
| 5764 | |
| 5765 /* Keep in synch with stuff below. */ | |
| 5766 if (UNBOUNDP (value)) | |
| 5767 { | |
| 5768 int retval; | |
| 5769 | |
| 5770 if (EQ (property, Qread_only) | |
| 5771 || EQ (property, Qunique) | |
| 5772 || EQ (property, Qduplicable) | |
| 5773 || EQ (property, Qinvisible) | |
| 5774 || EQ (property, Qdetachable) | |
| 5775 || EQ (property, Qdetached) | |
| 5776 || EQ (property, Qdestroyed) | |
| 5777 || EQ (property, Qpriority) | |
| 5778 || EQ (property, Qface) | |
| 5779 || EQ (property, Qinitial_redisplay_function) | |
| 5780 || EQ (property, Qafter_change_functions) | |
| 5781 || EQ (property, Qbefore_change_functions) | |
| 5782 || EQ (property, Qmouse_face) | |
| 5783 || EQ (property, Qhighlight) | |
| 5784 || EQ (property, Qbegin_glyph_layout) | |
| 5785 || EQ (property, Qend_glyph_layout) | |
| 5786 || EQ (property, Qglyph_layout) | |
| 5787 || EQ (property, Qbegin_glyph) | |
| 5788 || EQ (property, Qend_glyph) | |
| 5789 || EQ (property, Qstart_open) | |
| 5790 || EQ (property, Qend_open) | |
| 5791 || EQ (property, Qstart_closed) | |
| 5792 || EQ (property, Qend_closed) | |
| 5793 || EQ (property, Qkeymap)) | |
| 5794 return Qunbound; | |
| 5795 | |
| 5796 retval = external_remprop (extent_plist_addr (e), property, 0, | |
| 5797 ERROR_ME); | |
| 5798 if (retval) | |
| 5799 signal_extent_property_changed (e, property, 1); | |
| 5800 return retval ? Qt : Qnil; | |
| 5801 } | |
| 428 | 5802 |
| 5803 if (EQ (property, Qread_only)) | |
| 826 | 5804 { |
| 5805 set_extent_read_only (e, value); | |
| 5806 signal_change = 1; | |
| 5807 } | |
| 428 | 5808 else if (EQ (property, Qunique)) |
| 826 | 5809 { |
| 5810 extent_unique_p (e) = !NILP (value); | |
| 5811 signal_change = 1; | |
| 5812 } | |
| 428 | 5813 else if (EQ (property, Qduplicable)) |
| 826 | 5814 { |
| 5815 extent_duplicable_p (e) = !NILP (value); | |
| 5816 signal_change = 1; | |
| 5817 } | |
| 428 | 5818 else if (EQ (property, Qinvisible)) |
| 5819 set_extent_invisible (e, value); | |
| 5820 else if (EQ (property, Qdetachable)) | |
| 826 | 5821 { |
| 5822 extent_detachable_p (e) = !NILP (value); | |
| 5823 signal_change = 1; | |
| 5824 } | |
| 428 | 5825 else if (EQ (property, Qdetached)) |
| 5826 { | |
| 5827 if (NILP (value)) | |
| 826 | 5828 invalid_operation ("can only set `detached' to t", Qunbound); |
| 428 | 5829 Fdetach_extent (extent); |
| 5830 } | |
| 5831 else if (EQ (property, Qdestroyed)) | |
| 5832 { | |
| 5833 if (NILP (value)) | |
| 826 | 5834 invalid_operation ("can only set `destroyed' to t", Qunbound); |
| 428 | 5835 Fdelete_extent (extent); |
| 5836 } | |
| 5837 else if (EQ (property, Qpriority)) | |
| 5838 Fset_extent_priority (extent, value); | |
| 5839 else if (EQ (property, Qface)) | |
| 5840 Fset_extent_face (extent, value); | |
| 5841 else if (EQ (property, Qinitial_redisplay_function)) | |
| 5842 Fset_extent_initial_redisplay_function (extent, value); | |
| 5843 else if (EQ (property, Qbefore_change_functions)) | |
| 826 | 5844 { |
| 5845 set_extent_before_change_functions (e, value); | |
| 5846 signal_change = 1; | |
| 5847 } | |
| 428 | 5848 else if (EQ (property, Qafter_change_functions)) |
| 826 | 5849 { |
| 5850 set_extent_after_change_functions (e, value); | |
| 5851 signal_change = 1; | |
| 5852 } | |
| 428 | 5853 else if (EQ (property, Qmouse_face)) |
| 5854 Fset_extent_mouse_face (extent, value); | |
| 5855 /* Obsolete: */ | |
| 5856 else if (EQ (property, Qhighlight)) | |
| 5857 Fset_extent_mouse_face (extent, Qhighlight); | |
| 5858 else if (EQ (property, Qbegin_glyph_layout)) | |
| 5859 Fset_extent_begin_glyph_layout (extent, value); | |
| 5860 else if (EQ (property, Qend_glyph_layout)) | |
| 5861 Fset_extent_end_glyph_layout (extent, value); | |
| 5862 /* For backwards compatibility. We use begin glyph because it is by | |
| 5863 far the more used of the two. */ | |
| 5864 else if (EQ (property, Qglyph_layout)) | |
| 5865 Fset_extent_begin_glyph_layout (extent, value); | |
| 5866 else if (EQ (property, Qbegin_glyph)) | |
| 5867 Fset_extent_begin_glyph (extent, value, Qnil); | |
| 5868 else if (EQ (property, Qend_glyph)) | |
| 5869 Fset_extent_end_glyph (extent, value, Qnil); | |
| 5870 else if (EQ (property, Qstart_open)) | |
| 5871 set_extent_openness (e, !NILP (value), -1); | |
| 5872 else if (EQ (property, Qend_open)) | |
| 5873 set_extent_openness (e, -1, !NILP (value)); | |
| 5874 /* Support (but don't document...) the obvious *_closed antonyms. */ | |
| 5875 else if (EQ (property, Qstart_closed)) | |
| 5876 set_extent_openness (e, NILP (value), -1); | |
| 5877 else if (EQ (property, Qend_closed)) | |
| 5878 set_extent_openness (e, -1, NILP (value)); | |
| 5879 else | |
| 5880 { | |
| 5881 if (EQ (property, Qkeymap)) | |
| 5882 while (!NILP (value) && NILP (Fkeymapp (value))) | |
| 5883 value = wrong_type_argument (Qkeymapp, value); | |
| 5884 | |
| 5885 external_plist_put (extent_plist_addr (e), property, value, 0, ERROR_ME); | |
| 826 | 5886 signal_change = 1; |
| 428 | 5887 } |
| 5888 | |
| 826 | 5889 if (signal_change) |
| 5890 signal_extent_property_changed (e, property, 1); | |
| 428 | 5891 return value; |
| 5892 } | |
| 5893 | |
| 5894 DEFUN ("set-extent-properties", Fset_extent_properties, 2, 2, 0, /* | |
| 5895 Change some properties of EXTENT. | |
| 5896 PLIST is a property list. | |
| 5897 For a list of built-in properties, see `set-extent-property'. | |
| 5898 */ | |
| 5899 (extent, plist)) | |
| 5900 { | |
| 5901 /* This function can GC, if one of the properties is `keymap' */ | |
| 5902 Lisp_Object property, value; | |
| 5903 struct gcpro gcpro1; | |
| 5904 GCPRO1 (plist); | |
| 5905 | |
| 5906 plist = Fcopy_sequence (plist); | |
| 5907 Fcanonicalize_plist (plist, Qnil); | |
| 5908 | |
| 5909 while (!NILP (plist)) | |
| 5910 { | |
| 5911 property = Fcar (plist); plist = Fcdr (plist); | |
| 5912 value = Fcar (plist); plist = Fcdr (plist); | |
| 5913 Fset_extent_property (extent, property, value); | |
| 5914 } | |
| 5915 UNGCPRO; | |
| 5916 return Qnil; | |
| 5917 } | |
| 5918 | |
| 5919 DEFUN ("extent-property", Fextent_property, 2, 3, 0, /* | |
| 5920 Return EXTENT's value for property PROPERTY. | |
| 444 | 5921 If no such property exists, DEFAULT is returned. |
| 428 | 5922 See `set-extent-property' for the built-in property names. |
| 5923 */ | |
| 5924 (extent, property, default_)) | |
| 5925 { | |
| 5926 EXTENT e = decode_extent (extent, 0); | |
| 5927 | |
| 5928 if (EQ (property, Qdetached)) | |
| 5929 return extent_detached_p (e) ? Qt : Qnil; | |
| 5930 else if (EQ (property, Qdestroyed)) | |
| 5931 return !EXTENT_LIVE_P (e) ? Qt : Qnil; | |
| 5932 else if (EQ (property, Qstart_open)) | |
| 5933 return extent_normal_field (e, start_open) ? Qt : Qnil; | |
| 5934 else if (EQ (property, Qend_open)) | |
| 5935 return extent_normal_field (e, end_open) ? Qt : Qnil; | |
| 5936 else if (EQ (property, Qunique)) | |
| 5937 return extent_normal_field (e, unique) ? Qt : Qnil; | |
| 5938 else if (EQ (property, Qduplicable)) | |
| 5939 return extent_normal_field (e, duplicable) ? Qt : Qnil; | |
| 5940 else if (EQ (property, Qdetachable)) | |
| 5941 return extent_normal_field (e, detachable) ? Qt : Qnil; | |
| 5942 /* Support (but don't document...) the obvious *_closed antonyms. */ | |
| 5943 else if (EQ (property, Qstart_closed)) | |
| 5944 return extent_start_open_p (e) ? Qnil : Qt; | |
| 5945 else if (EQ (property, Qend_closed)) | |
| 5946 return extent_end_open_p (e) ? Qnil : Qt; | |
| 5947 else if (EQ (property, Qpriority)) | |
| 5948 return make_int (extent_priority (e)); | |
| 5949 else if (EQ (property, Qread_only)) | |
| 5950 return extent_read_only (e); | |
| 5951 else if (EQ (property, Qinvisible)) | |
| 5952 return extent_invisible (e); | |
| 5953 else if (EQ (property, Qface)) | |
| 5954 return Fextent_face (extent); | |
| 5955 else if (EQ (property, Qinitial_redisplay_function)) | |
| 5956 return extent_initial_redisplay_function (e); | |
| 5957 else if (EQ (property, Qbefore_change_functions)) | |
| 5958 return extent_before_change_functions (e); | |
| 5959 else if (EQ (property, Qafter_change_functions)) | |
| 5960 return extent_after_change_functions (e); | |
| 5961 else if (EQ (property, Qmouse_face)) | |
| 5962 return Fextent_mouse_face (extent); | |
| 5963 /* Obsolete: */ | |
| 5964 else if (EQ (property, Qhighlight)) | |
| 5965 return !NILP (Fextent_mouse_face (extent)) ? Qt : Qnil; | |
| 5966 else if (EQ (property, Qbegin_glyph_layout)) | |
| 5967 return Fextent_begin_glyph_layout (extent); | |
| 5968 else if (EQ (property, Qend_glyph_layout)) | |
| 5969 return Fextent_end_glyph_layout (extent); | |
| 5970 /* For backwards compatibility. We use begin glyph because it is by | |
| 5971 far the more used of the two. */ | |
| 5972 else if (EQ (property, Qglyph_layout)) | |
| 5973 return Fextent_begin_glyph_layout (extent); | |
| 5974 else if (EQ (property, Qbegin_glyph)) | |
| 5975 return extent_begin_glyph (e); | |
| 5976 else if (EQ (property, Qend_glyph)) | |
| 5977 return extent_end_glyph (e); | |
| 5978 else | |
| 5979 { | |
| 5980 Lisp_Object value = external_plist_get (extent_plist_addr (e), | |
| 5981 property, 0, ERROR_ME); | |
| 5982 return UNBOUNDP (value) ? default_ : value; | |
| 5983 } | |
| 5984 } | |
| 5985 | |
| 826 | 5986 static void |
| 5987 extent_properties (EXTENT e, Lisp_Object_pair_dynarr *props) | |
| 5988 { | |
| 5989 Lisp_Object face, anc_obj; | |
| 428 | 5990 glyph_layout layout; |
| 826 | 5991 EXTENT anc; |
| 5992 | |
| 5993 #define ADD_PROP(miftaaH, maal) \ | |
| 5994 do { \ | |
| 5995 Lisp_Object_pair p; \ | |
| 5996 p.key = miftaaH; \ | |
| 5997 p.value = maal; \ | |
| 5998 Dynarr_add (props, p); \ | |
| 5999 } while (0) | |
| 6000 | |
| 428 | 6001 if (!EXTENT_LIVE_P (e)) |
| 826 | 6002 { |
| 6003 ADD_PROP (Qdestroyed, Qt); | |
| 6004 return; | |
| 6005 } | |
| 428 | 6006 |
| 6007 anc = extent_ancestor (e); | |
| 793 | 6008 anc_obj = wrap_extent (anc); |
| 428 | 6009 |
| 6010 /* For efficiency, use the ancestor for all properties except detached */ | |
| 826 | 6011 { |
| 6012 EXTERNAL_PROPERTY_LIST_LOOP_3 (key, value, extent_plist_slot (anc)) | |
| 6013 ADD_PROP (key, value); | |
| 6014 } | |
| 428 | 6015 |
| 6016 if (!NILP (face = Fextent_face (anc_obj))) | |
| 826 | 6017 ADD_PROP (Qface, face); |
| 428 | 6018 |
| 6019 if (!NILP (face = Fextent_mouse_face (anc_obj))) | |
| 826 | 6020 ADD_PROP (Qmouse_face, face); |
| 428 | 6021 |
| 6022 if ((layout = (glyph_layout) extent_begin_glyph_layout (anc)) != GL_TEXT) | |
| 6023 { | |
| 6024 Lisp_Object sym = glyph_layout_to_symbol (layout); | |
| 826 | 6025 ADD_PROP (Qglyph_layout, sym); /* compatibility */ |
| 6026 ADD_PROP (Qbegin_glyph_layout, sym); | |
| 428 | 6027 } |
| 6028 | |
| 6029 if ((layout = (glyph_layout) extent_end_glyph_layout (anc)) != GL_TEXT) | |
| 826 | 6030 ADD_PROP (Qend_glyph_layout, glyph_layout_to_symbol (layout)); |
| 428 | 6031 |
| 6032 if (!NILP (extent_end_glyph (anc))) | |
| 826 | 6033 ADD_PROP (Qend_glyph, extent_end_glyph (anc)); |
| 428 | 6034 |
| 6035 if (!NILP (extent_begin_glyph (anc))) | |
| 826 | 6036 ADD_PROP (Qbegin_glyph, extent_begin_glyph (anc)); |
| 428 | 6037 |
| 6038 if (extent_priority (anc) != 0) | |
| 826 | 6039 ADD_PROP (Qpriority, make_int (extent_priority (anc))); |
| 428 | 6040 |
| 6041 if (!NILP (extent_initial_redisplay_function (anc))) | |
| 826 | 6042 ADD_PROP (Qinitial_redisplay_function, |
| 6043 extent_initial_redisplay_function (anc)); | |
| 428 | 6044 |
| 6045 if (!NILP (extent_before_change_functions (anc))) | |
| 826 | 6046 ADD_PROP (Qbefore_change_functions, extent_before_change_functions (anc)); |
| 428 | 6047 |
| 6048 if (!NILP (extent_after_change_functions (anc))) | |
| 826 | 6049 ADD_PROP (Qafter_change_functions, extent_after_change_functions (anc)); |
| 428 | 6050 |
| 6051 if (!NILP (extent_invisible (anc))) | |
| 826 | 6052 ADD_PROP (Qinvisible, extent_invisible (anc)); |
| 428 | 6053 |
| 6054 if (!NILP (extent_read_only (anc))) | |
| 826 | 6055 ADD_PROP (Qread_only, extent_read_only (anc)); |
| 428 | 6056 |
| 6057 if (extent_normal_field (anc, end_open)) | |
| 826 | 6058 ADD_PROP (Qend_open, Qt); |
| 428 | 6059 |
| 6060 if (extent_normal_field (anc, start_open)) | |
| 826 | 6061 ADD_PROP (Qstart_open, Qt); |
| 428 | 6062 |
| 6063 if (extent_normal_field (anc, detachable)) | |
| 826 | 6064 ADD_PROP (Qdetachable, Qt); |
| 428 | 6065 |
| 6066 if (extent_normal_field (anc, duplicable)) | |
| 826 | 6067 ADD_PROP (Qduplicable, Qt); |
| 428 | 6068 |
| 6069 if (extent_normal_field (anc, unique)) | |
| 826 | 6070 ADD_PROP (Qunique, Qt); |
| 428 | 6071 |
| 6072 /* detached is not an inherited property */ | |
| 6073 if (extent_detached_p (e)) | |
| 826 | 6074 ADD_PROP (Qdetached, Qt); |
| 6075 | |
| 6076 #undef ADD_PROP | |
| 6077 } | |
| 6078 | |
| 6079 DEFUN ("extent-properties", Fextent_properties, 1, 1, 0, /* | |
| 6080 Return a property list of the attributes of EXTENT. | |
| 6081 Do not modify this list; use `set-extent-property' instead. | |
| 6082 */ | |
| 6083 (extent)) | |
| 6084 { | |
| 6085 EXTENT e; | |
| 6086 Lisp_Object result = Qnil; | |
| 6087 Lisp_Object_pair_dynarr *props; | |
| 6088 int i; | |
| 6089 | |
| 6090 CHECK_EXTENT (extent); | |
| 6091 e = XEXTENT (extent); | |
| 6092 props = Dynarr_new (Lisp_Object_pair); | |
| 6093 extent_properties (e, props); | |
| 6094 | |
| 6095 for (i = 0; i < Dynarr_length (props); i++) | |
| 6096 result = cons3 (Dynarr_at (props, i).key, Dynarr_at (props, i).value, | |
| 6097 result); | |
| 6098 | |
| 6099 Dynarr_free (props); | |
| 428 | 6100 return result; |
| 6101 } | |
| 6102 | |
| 6103 | |
| 6104 /************************************************************************/ | |
| 6105 /* highlighting */ | |
| 6106 /************************************************************************/ | |
| 6107 | |
| 6108 /* The display code looks into the Vlast_highlighted_extent variable to | |
| 6109 correctly display highlighted extents. This updates that variable, | |
| 6110 and marks the appropriate buffers as needing some redisplay. | |
| 6111 */ | |
| 6112 static void | |
| 6113 do_highlight (Lisp_Object extent_obj, int highlight_p) | |
| 6114 { | |
| 6115 if (( highlight_p && (EQ (Vlast_highlighted_extent, extent_obj))) || | |
| 6116 (!highlight_p && (EQ (Vlast_highlighted_extent, Qnil)))) | |
| 6117 return; | |
| 6118 if (EXTENTP (Vlast_highlighted_extent) && | |
| 6119 EXTENT_LIVE_P (XEXTENT (Vlast_highlighted_extent))) | |
| 6120 { | |
| 6121 /* do not recurse on descendants. Only one extent is highlighted | |
| 6122 at a time. */ | |
| 826 | 6123 /* A bit of a lie. */ |
| 6124 signal_extent_property_changed (XEXTENT (Vlast_highlighted_extent), | |
| 6125 Qface, 0); | |
| 428 | 6126 } |
| 6127 Vlast_highlighted_extent = Qnil; | |
| 6128 if (!NILP (extent_obj) | |
| 6129 && BUFFERP (extent_object (XEXTENT (extent_obj))) | |
| 6130 && highlight_p) | |
| 6131 { | |
| 826 | 6132 signal_extent_property_changed (XEXTENT (extent_obj), Qface, 0); |
| 428 | 6133 Vlast_highlighted_extent = extent_obj; |
| 6134 } | |
| 6135 } | |
| 6136 | |
| 6137 DEFUN ("force-highlight-extent", Fforce_highlight_extent, 1, 2, 0, /* | |
| 6138 Highlight or unhighlight the given extent. | |
| 6139 If the second arg is non-nil, it will be highlighted, else dehighlighted. | |
| 6140 This is the same as `highlight-extent', except that it will work even | |
| 6141 on extents without the `mouse-face' property. | |
| 6142 */ | |
| 6143 (extent, highlight_p)) | |
| 6144 { | |
| 6145 if (NILP (extent)) | |
| 6146 highlight_p = Qnil; | |
| 6147 else | |
| 793 | 6148 extent = wrap_extent (decode_extent (extent, DE_MUST_BE_ATTACHED)); |
| 428 | 6149 do_highlight (extent, !NILP (highlight_p)); |
| 6150 return Qnil; | |
| 6151 } | |
| 6152 | |
| 6153 DEFUN ("highlight-extent", Fhighlight_extent, 1, 2, 0, /* | |
| 6154 Highlight EXTENT, if it is highlightable. | |
| 6155 \(that is, if it has the `mouse-face' property). | |
| 6156 If the second arg is non-nil, it will be highlighted, else dehighlighted. | |
| 6157 Highlighted extents are displayed as if they were merged with the face | |
| 6158 or faces specified by the `mouse-face' property. | |
| 6159 */ | |
| 6160 (extent, highlight_p)) | |
| 6161 { | |
| 6162 if (EXTENTP (extent) && NILP (extent_mouse_face (XEXTENT (extent)))) | |
| 6163 return Qnil; | |
| 6164 else | |
| 6165 return Fforce_highlight_extent (extent, highlight_p); | |
| 6166 } | |
| 6167 | |
| 6168 | |
| 6169 /************************************************************************/ | |
| 6170 /* strings and extents */ | |
| 6171 /************************************************************************/ | |
| 6172 | |
| 6173 /* copy/paste hooks */ | |
| 6174 | |
| 6175 static int | |
| 826 | 6176 run_extent_copy_paste_internal (EXTENT e, Charxpos from, Charxpos to, |
| 428 | 6177 Lisp_Object object, |
| 6178 Lisp_Object prop) | |
| 6179 { | |
| 6180 /* This function can GC */ | |
| 6181 Lisp_Object extent; | |
| 6182 Lisp_Object copy_fn; | |
| 793 | 6183 extent = wrap_extent (e); |
| 428 | 6184 copy_fn = Fextent_property (extent, prop, Qnil); |
| 6185 if (!NILP (copy_fn)) | |
| 6186 { | |
| 6187 Lisp_Object flag; | |
| 6188 struct gcpro gcpro1, gcpro2, gcpro3; | |
| 6189 GCPRO3 (extent, copy_fn, object); | |
| 6190 if (BUFFERP (object)) | |
| 6191 flag = call3_in_buffer (XBUFFER (object), copy_fn, extent, | |
| 6192 make_int (from), make_int (to)); | |
| 6193 else | |
| 6194 flag = call3 (copy_fn, extent, make_int (from), make_int (to)); | |
| 6195 UNGCPRO; | |
| 6196 if (NILP (flag) || !EXTENT_LIVE_P (XEXTENT (extent))) | |
| 6197 return 0; | |
| 6198 } | |
| 6199 return 1; | |
| 6200 } | |
| 6201 | |
| 6202 static int | |
| 826 | 6203 run_extent_copy_function (EXTENT e, Bytexpos from, Bytexpos to) |
| 428 | 6204 { |
| 6205 Lisp_Object object = extent_object (e); | |
| 6206 /* This function can GC */ | |
| 6207 return run_extent_copy_paste_internal | |
| 826 | 6208 (e, buffer_or_string_bytexpos_to_charxpos (object, from), |
| 6209 buffer_or_string_bytexpos_to_charxpos (object, to), object, | |
| 428 | 6210 Qcopy_function); |
| 6211 } | |
| 6212 | |
| 6213 static int | |
| 826 | 6214 run_extent_paste_function (EXTENT e, Bytexpos from, Bytexpos to, |
| 428 | 6215 Lisp_Object object) |
| 6216 { | |
| 6217 /* This function can GC */ | |
| 6218 return run_extent_copy_paste_internal | |
| 826 | 6219 (e, buffer_or_string_bytexpos_to_charxpos (object, from), |
| 6220 buffer_or_string_bytexpos_to_charxpos (object, to), object, | |
| 428 | 6221 Qpaste_function); |
| 6222 } | |
| 6223 | |
| 826 | 6224 static int |
| 6225 run_extent_paste_function_char (EXTENT e, Charxpos from, Charxpos to, | |
| 6226 Lisp_Object object) | |
| 6227 { | |
| 6228 /* This function can GC */ | |
| 6229 return run_extent_copy_paste_internal (e, from, to, object, Qpaste_function); | |
| 6230 } | |
| 6231 | |
| 428 | 6232 static Lisp_Object |
| 826 | 6233 insert_extent (EXTENT extent, Bytexpos new_start, Bytexpos new_end, |
| 428 | 6234 Lisp_Object object, int run_hooks) |
| 6235 { | |
| 6236 /* This function can GC */ | |
| 6237 if (!EQ (extent_object (extent), object)) | |
| 6238 goto copy_it; | |
| 6239 | |
| 6240 if (extent_detached_p (extent)) | |
| 6241 { | |
| 6242 if (run_hooks && | |
| 6243 !run_extent_paste_function (extent, new_start, new_end, object)) | |
| 6244 /* The paste-function said don't re-attach this extent here. */ | |
| 6245 return Qnil; | |
| 6246 else | |
| 826 | 6247 set_extent_endpoints (extent, new_start, new_end, Qnil); |
| 428 | 6248 } |
| 6249 else | |
| 6250 { | |
| 826 | 6251 Bytexpos exstart = extent_endpoint_byte (extent, 0); |
| 6252 Bytexpos exend = extent_endpoint_byte (extent, 1); | |
| 428 | 6253 |
| 6254 if (exend < new_start || exstart > new_end) | |
| 6255 goto copy_it; | |
| 6256 else | |
| 6257 { | |
| 6258 new_start = min (exstart, new_start); | |
| 6259 new_end = max (exend, new_end); | |
| 6260 if (exstart != new_start || exend != new_end) | |
| 826 | 6261 set_extent_endpoints (extent, new_start, new_end, Qnil); |
| 428 | 6262 } |
| 6263 } | |
| 6264 | |
| 793 | 6265 return wrap_extent (extent); |
| 428 | 6266 |
| 6267 copy_it: | |
| 6268 if (run_hooks && | |
| 6269 !run_extent_paste_function (extent, new_start, new_end, object)) | |
| 6270 /* The paste-function said don't attach a copy of the extent here. */ | |
| 6271 return Qnil; | |
| 6272 else | |
| 793 | 6273 return wrap_extent (copy_extent (extent, new_start, new_end, object)); |
| 428 | 6274 } |
| 6275 | |
| 6276 DEFUN ("insert-extent", Finsert_extent, 1, 5, 0, /* | |
| 6277 Insert EXTENT from START to END in BUFFER-OR-STRING. | |
| 6278 BUFFER-OR-STRING defaults to the current buffer if omitted. | |
| 826 | 6279 If EXTENT is already on the same object, and overlaps or is adjacent to |
| 6280 the given range, its range is merely extended to include the new range. | |
| 6281 Otherwise, a copy is made of the extent at the new position and object. | |
| 6282 When a copy is made, the new extent is returned, copy/paste hooks are run, | |
| 6283 and the change is noted for undo recording. When no copy is made, nil is | |
| 6284 returned. See documentation on `detach-extent' for a discussion of undo | |
| 6285 recording. | |
| 6286 | |
| 428 | 6287 The fourth arg, NO-HOOKS, can be used to inhibit the running of the |
| 826 | 6288 extent's `paste-function' property if it has one. |
| 6289 | |
| 6290 It's not really clear why this function exists any more. It was a holdover | |
| 6291 from a much older implementation of extents, before extents could really | |
| 6292 exist on strings. | |
| 428 | 6293 */ |
| 6294 (extent, start, end, no_hooks, buffer_or_string)) | |
| 6295 { | |
| 6296 EXTENT ext = decode_extent (extent, 0); | |
| 6297 Lisp_Object copy; | |
| 826 | 6298 Bytexpos s, e; |
| 428 | 6299 |
| 6300 buffer_or_string = decode_buffer_or_string (buffer_or_string); | |
| 6301 get_buffer_or_string_range_byte (buffer_or_string, start, end, &s, &e, | |
| 6302 GB_ALLOW_PAST_ACCESSIBLE); | |
| 6303 | |
| 6304 copy = insert_extent (ext, s, e, buffer_or_string, NILP (no_hooks)); | |
| 6305 if (EXTENTP (copy)) | |
| 6306 { | |
| 6307 if (extent_duplicable_p (XEXTENT (copy))) | |
| 6308 record_extent (copy, 1); | |
| 6309 } | |
| 6310 return copy; | |
| 6311 } | |
| 6312 | |
| 6313 | |
| 6314 /* adding buffer extents to a string */ | |
| 6315 | |
| 6316 struct add_string_extents_arg | |
| 6317 { | |
| 826 | 6318 Bytexpos from; |
| 428 | 6319 Bytecount length; |
| 6320 Lisp_Object string; | |
| 6321 }; | |
| 6322 | |
| 6323 static int | |
| 6324 add_string_extents_mapper (EXTENT extent, void *arg) | |
| 6325 { | |
| 6326 /* This function can GC */ | |
| 6327 struct add_string_extents_arg *closure = | |
| 6328 (struct add_string_extents_arg *) arg; | |
| 826 | 6329 Bytecount start = extent_endpoint_byte (extent, 0) - closure->from; |
| 6330 Bytecount end = extent_endpoint_byte (extent, 1) - closure->from; | |
| 428 | 6331 |
| 6332 if (extent_duplicable_p (extent)) | |
| 6333 { | |
| 6334 start = max (start, 0); | |
| 6335 end = min (end, closure->length); | |
| 6336 | |
| 6337 /* Run the copy-function to give an extent the option of | |
| 6338 not being copied into the string (or kill ring). | |
| 6339 */ | |
| 6340 if (extent_duplicable_p (extent) && | |
| 6341 !run_extent_copy_function (extent, start + closure->from, | |
| 6342 end + closure->from)) | |
| 6343 return 0; | |
| 6344 copy_extent (extent, start, end, closure->string); | |
| 6345 } | |
| 6346 | |
| 6347 return 0; | |
| 6348 } | |
| 6349 | |
| 826 | 6350 struct add_string_extents_the_hard_way_arg |
| 6351 { | |
| 6352 Charxpos from; | |
| 6353 Charcount length; | |
| 6354 Lisp_Object string; | |
| 6355 }; | |
| 6356 | |
| 6357 static int | |
| 6358 add_string_extents_the_hard_way_mapper (EXTENT extent, void *arg) | |
| 6359 { | |
| 6360 /* This function can GC */ | |
| 6361 struct add_string_extents_arg *closure = | |
| 6362 (struct add_string_extents_arg *) arg; | |
| 6363 Charcount start = extent_endpoint_char (extent, 0) - closure->from; | |
| 6364 Charcount end = extent_endpoint_char (extent, 1) - closure->from; | |
| 6365 | |
| 6366 if (extent_duplicable_p (extent)) | |
| 6367 { | |
| 6368 start = max (start, 0); | |
| 6369 end = min (end, closure->length); | |
| 6370 | |
| 6371 /* Run the copy-function to give an extent the option of | |
| 6372 not being copied into the string (or kill ring). | |
| 6373 */ | |
| 6374 if (extent_duplicable_p (extent) && | |
| 6375 !run_extent_copy_function (extent, start + closure->from, | |
| 6376 end + closure->from)) | |
| 6377 return 0; | |
| 6378 copy_extent (extent, | |
| 6379 string_index_char_to_byte (closure->string, start), | |
| 6380 string_index_char_to_byte (closure->string, end), | |
| 6381 closure->string); | |
| 6382 } | |
| 6383 | |
| 6384 return 0; | |
| 6385 } | |
| 6386 | |
| 428 | 6387 /* Add the extents in buffer BUF from OPOINT to OPOINT+LENGTH to |
| 6388 the string STRING. */ | |
| 6389 void | |
| 826 | 6390 add_string_extents (Lisp_Object string, struct buffer *buf, Bytexpos opoint, |
| 428 | 6391 Bytecount length) |
| 6392 { | |
| 6393 /* This function can GC */ | |
| 6394 struct gcpro gcpro1, gcpro2; | |
| 6395 Lisp_Object buffer; | |
| 6396 | |
| 771 | 6397 buffer = wrap_buffer (buf); |
| 428 | 6398 GCPRO2 (buffer, string); |
| 826 | 6399 |
| 6400 if (XSTRING_FORMAT (string) == BUF_FORMAT (buf)) | |
| 6401 { | |
| 6402 struct add_string_extents_arg closure; | |
| 6403 closure.from = opoint; | |
| 6404 closure.length = length; | |
| 6405 closure.string = string; | |
| 6406 map_extents (opoint, opoint + length, add_string_extents_mapper, | |
| 6407 (void *) &closure, buffer, 0, | |
| 6408 /* ignore extents that just abut the region */ | |
| 6409 ME_END_CLOSED | ME_ALL_EXTENTS_OPEN | | |
| 6410 /* we are calling E-Lisp (the extent's copy function) | |
| 6411 so anything might happen */ | |
| 6412 ME_MIGHT_CALL_ELISP); | |
| 6413 } | |
| 6414 else | |
| 6415 { | |
| 6416 struct add_string_extents_the_hard_way_arg closure; | |
| 6417 closure.from = bytebpos_to_charbpos (buf, opoint); | |
| 6418 closure.length = (bytebpos_to_charbpos (buf, opoint + length) - | |
| 6419 closure.from); | |
| 6420 closure.string = string; | |
| 6421 | |
| 6422 /* If the string and buffer are in different formats, things get | |
| 6423 tricky; the only reasonable way to do the operation is entirely in | |
| 6424 char offsets, which are invariant to format changes. In practice, | |
| 6425 this won't be time-consuming because the byte/char conversions are | |
| 6426 mostly in the buffer, which will be in a fixed-width format. */ | |
| 6427 map_extents (opoint, opoint + length, | |
| 6428 add_string_extents_the_hard_way_mapper, | |
| 6429 (void *) &closure, buffer, 0, | |
| 6430 /* ignore extents that just abut the region */ | |
| 6431 ME_END_CLOSED | ME_ALL_EXTENTS_OPEN | | |
| 6432 /* we are calling E-Lisp (the extent's copy function) | |
| 6433 so anything might happen */ | |
| 6434 ME_MIGHT_CALL_ELISP); | |
| 6435 | |
| 6436 } | |
| 6437 | |
| 428 | 6438 UNGCPRO; |
| 6439 } | |
| 6440 | |
| 6441 struct splice_in_string_extents_arg | |
| 6442 { | |
| 6443 Bytecount pos; | |
| 6444 Bytecount length; | |
| 826 | 6445 Bytexpos opoint; |
| 428 | 6446 Lisp_Object buffer; |
| 6447 }; | |
| 6448 | |
| 6449 static int | |
| 6450 splice_in_string_extents_mapper (EXTENT extent, void *arg) | |
| 6451 { | |
| 6452 /* This function can GC */ | |
| 6453 struct splice_in_string_extents_arg *closure = | |
| 6454 (struct splice_in_string_extents_arg *) arg; | |
| 6455 /* BASE_START and BASE_END are the limits in the buffer of the string | |
| 6456 that was just inserted. | |
| 826 | 6457 |
| 428 | 6458 NEW_START and NEW_END are the prospective buffer positions of the |
| 6459 extent that is going into the buffer. */ | |
| 826 | 6460 Bytexpos base_start = closure->opoint; |
| 6461 Bytexpos base_end = base_start + closure->length; | |
| 6462 Bytexpos new_start = (base_start + extent_endpoint_byte (extent, 0) - | |
| 6463 closure->pos); | |
| 6464 Bytexpos new_end = (base_start + extent_endpoint_byte (extent, 1) - | |
| 428 | 6465 closure->pos); |
| 6466 | |
| 6467 if (new_start < base_start) | |
| 6468 new_start = base_start; | |
| 6469 if (new_end > base_end) | |
| 6470 new_end = base_end; | |
| 6471 if (new_end <= new_start) | |
| 6472 return 0; | |
| 6473 | |
| 6474 if (!extent_duplicable_p (extent)) | |
| 6475 return 0; | |
| 6476 | |
| 6477 if (!inside_undo && | |
| 6478 !run_extent_paste_function (extent, new_start, new_end, | |
| 6479 closure->buffer)) | |
| 6480 return 0; | |
| 6481 copy_extent (extent, new_start, new_end, closure->buffer); | |
| 6482 | |
| 6483 return 0; | |
| 6484 } | |
| 6485 | |
| 826 | 6486 struct splice_in_string_extents_the_hard_way_arg |
| 6487 { | |
| 6488 Charcount pos; | |
| 6489 Charcount length; | |
| 6490 Charxpos opoint; | |
| 6491 Lisp_Object buffer; | |
| 6492 }; | |
| 6493 | |
| 6494 static int | |
| 6495 splice_in_string_extents_the_hard_way_mapper (EXTENT extent, void *arg) | |
| 6496 { | |
| 6497 /* This function can GC */ | |
| 6498 struct splice_in_string_extents_arg *closure = | |
| 6499 (struct splice_in_string_extents_arg *) arg; | |
| 6500 /* BASE_START and BASE_END are the limits in the buffer of the string | |
| 6501 that was just inserted. | |
| 6502 | |
| 6503 NEW_START and NEW_END are the prospective buffer positions of the | |
| 6504 extent that is going into the buffer. */ | |
| 6505 Charxpos base_start = closure->opoint; | |
| 6506 Charxpos base_end = base_start + closure->length; | |
| 6507 Charxpos new_start = (base_start + extent_endpoint_char (extent, 0) - | |
| 6508 closure->pos); | |
| 6509 Charxpos new_end = (base_start + extent_endpoint_char (extent, 1) - | |
| 6510 closure->pos); | |
| 6511 | |
| 6512 if (new_start < base_start) | |
| 6513 new_start = base_start; | |
| 6514 if (new_end > base_end) | |
| 6515 new_end = base_end; | |
| 6516 if (new_end <= new_start) | |
| 6517 return 0; | |
| 6518 | |
| 6519 if (!extent_duplicable_p (extent)) | |
| 6520 return 0; | |
| 6521 | |
| 6522 if (!inside_undo && | |
| 6523 !run_extent_paste_function_char (extent, new_start, new_end, | |
| 6524 closure->buffer)) | |
| 6525 return 0; | |
| 6526 copy_extent (extent, | |
| 6527 charbpos_to_bytebpos (XBUFFER (closure->buffer), new_start), | |
| 6528 charbpos_to_bytebpos (XBUFFER (closure->buffer), new_end), | |
| 6529 closure->buffer); | |
| 6530 | |
| 6531 return 0; | |
| 6532 } | |
| 6533 | |
| 428 | 6534 /* We have just inserted a section of STRING (starting at POS, of |
| 6535 length LENGTH) into buffer BUF at OPOINT. Do whatever is necessary | |
| 6536 to get the string's extents into the buffer. */ | |
| 6537 | |
| 6538 void | |
| 6539 splice_in_string_extents (Lisp_Object string, struct buffer *buf, | |
| 826 | 6540 Bytexpos opoint, Bytecount length, Bytecount pos) |
| 6541 { | |
| 428 | 6542 struct gcpro gcpro1, gcpro2; |
| 793 | 6543 Lisp_Object buffer = wrap_buffer (buf); |
| 6544 | |
| 428 | 6545 GCPRO2 (buffer, string); |
| 826 | 6546 if (XSTRING_FORMAT (string) == BUF_FORMAT (buf)) |
| 6547 { | |
| 6548 struct splice_in_string_extents_arg closure; | |
| 6549 closure.opoint = opoint; | |
| 6550 closure.pos = pos; | |
| 6551 closure.length = length; | |
| 6552 closure.buffer = buffer; | |
| 6553 map_extents (pos, pos + length, | |
| 6554 splice_in_string_extents_mapper, | |
| 6555 (void *) &closure, string, 0, | |
| 6556 /* ignore extents that just abut the region */ | |
| 6557 ME_END_CLOSED | ME_ALL_EXTENTS_OPEN | | |
| 6558 /* we are calling E-Lisp (the extent's copy function) | |
| 6559 so anything might happen */ | |
| 6560 ME_MIGHT_CALL_ELISP); | |
| 6561 } | |
| 6562 else | |
| 6563 { | |
| 6564 struct splice_in_string_extents_the_hard_way_arg closure; | |
| 6565 closure.opoint = bytebpos_to_charbpos (buf, opoint); | |
| 6566 closure.pos = string_index_byte_to_char (string, pos); | |
| 6567 closure.length = string_offset_byte_to_char_len (string, pos, length); | |
| 6568 closure.buffer = buffer; | |
| 6569 | |
| 6570 /* If the string and buffer are in different formats, things get | |
| 6571 tricky; the only reasonable way to do the operation is entirely in | |
| 6572 char offsets, which are invariant to format changes. In practice, | |
| 6573 this won't be time-consuming because the byte/char conversions are | |
| 6574 mostly in the buffer, which will be in a fixed-width format. */ | |
| 6575 map_extents (pos, pos + length, | |
| 6576 splice_in_string_extents_the_hard_way_mapper, | |
| 6577 (void *) &closure, string, 0, | |
| 6578 /* ignore extents that just abut the region */ | |
| 6579 ME_END_CLOSED | ME_ALL_EXTENTS_OPEN | | |
| 6580 /* we are calling E-Lisp (the extent's copy function) | |
| 6581 so anything might happen */ | |
| 6582 ME_MIGHT_CALL_ELISP); | |
| 6583 | |
| 6584 } | |
| 428 | 6585 UNGCPRO; |
| 6586 } | |
| 6587 | |
| 6588 struct copy_string_extents_arg | |
| 6589 { | |
| 6590 Bytecount new_pos; | |
| 6591 Bytecount old_pos; | |
| 6592 Bytecount length; | |
| 6593 Lisp_Object new_string; | |
| 6594 }; | |
| 6595 | |
| 6596 struct copy_string_extents_1_arg | |
| 6597 { | |
| 6598 Lisp_Object parent_in_question; | |
| 6599 EXTENT found_extent; | |
| 6600 }; | |
| 6601 | |
| 6602 static int | |
| 6603 copy_string_extents_mapper (EXTENT extent, void *arg) | |
| 6604 { | |
| 6605 struct copy_string_extents_arg *closure = | |
| 6606 (struct copy_string_extents_arg *) arg; | |
| 6607 Bytecount old_start, old_end, new_start, new_end; | |
| 6608 | |
| 826 | 6609 old_start = extent_endpoint_byte (extent, 0); |
| 6610 old_end = extent_endpoint_byte (extent, 1); | |
| 428 | 6611 |
| 6612 old_start = max (closure->old_pos, old_start); | |
| 6613 old_end = min (closure->old_pos + closure->length, old_end); | |
| 6614 | |
| 6615 if (old_start >= old_end) | |
| 6616 return 0; | |
| 6617 | |
| 6618 new_start = old_start + closure->new_pos - closure->old_pos; | |
| 6619 new_end = old_end + closure->new_pos - closure->old_pos; | |
| 6620 | |
| 6621 copy_extent (extent, new_start, new_end, closure->new_string); | |
| 6622 return 0; | |
| 6623 } | |
| 6624 | |
| 6625 /* The string NEW_STRING was partially constructed from OLD_STRING. | |
| 6626 In particular, the section of length LEN starting at NEW_POS in | |
| 6627 NEW_STRING came from the section of the same length starting at | |
| 6628 OLD_POS in OLD_STRING. Copy the extents as appropriate. */ | |
| 6629 | |
| 6630 void | |
| 6631 copy_string_extents (Lisp_Object new_string, Lisp_Object old_string, | |
| 6632 Bytecount new_pos, Bytecount old_pos, | |
| 6633 Bytecount length) | |
| 6634 { | |
| 6635 struct copy_string_extents_arg closure; | |
| 6636 struct gcpro gcpro1, gcpro2; | |
| 6637 | |
| 6638 closure.new_pos = new_pos; | |
| 6639 closure.old_pos = old_pos; | |
| 6640 closure.new_string = new_string; | |
| 6641 closure.length = length; | |
| 6642 GCPRO2 (new_string, old_string); | |
| 826 | 6643 map_extents (old_pos, old_pos + length, |
| 6644 copy_string_extents_mapper, | |
| 6645 (void *) &closure, old_string, 0, | |
| 6646 /* ignore extents that just abut the region */ | |
| 6647 ME_END_CLOSED | ME_ALL_EXTENTS_OPEN | | |
| 6648 /* we are calling E-Lisp (the extent's copy function) | |
| 6649 so anything might happen */ | |
| 6650 ME_MIGHT_CALL_ELISP); | |
| 428 | 6651 UNGCPRO; |
| 6652 } | |
| 6653 | |
| 6654 /* Checklist for sanity checking: | |
| 6655 - {kill, yank, copy} at {open, closed} {start, end} of {writable, read-only} extent | |
| 6656 - {kill, copy} & yank {once, repeatedly} duplicable extent in {same, different} buffer | |
| 6657 */ | |
| 6658 | |
| 6659 | |
| 6660 /************************************************************************/ | |
| 6661 /* text properties */ | |
| 6662 /************************************************************************/ | |
| 6663 | |
| 6664 /* Text properties | |
| 6665 Originally this stuff was implemented in lisp (all of the functionality | |
| 6666 exists to make that possible) but speed was a problem. | |
| 6667 */ | |
| 6668 | |
| 6669 Lisp_Object Qtext_prop; | |
| 6670 Lisp_Object Qtext_prop_extent_paste_function; | |
| 6671 | |
| 826 | 6672 /* Retrieve the value of the property PROP of the text at position POSITION |
| 6673 in OBJECT. TEXT-PROPS-ONLY means only look at extents with the | |
| 6674 `text-prop' property, i.e. extents created by the text property | |
| 6675 routines. Otherwise, all extents are examined. &&#### finish Note that | |
| 6676 the default extent_at_flag is EXTENT_AT_DEFAULT (same as | |
| 6677 EXTENT_AT_AFTER). */ | |
| 6678 Lisp_Object | |
| 6679 get_char_property (Bytexpos position, Lisp_Object prop, | |
| 6680 Lisp_Object object, enum extent_at_flag fl, | |
| 6681 int text_props_only) | |
| 428 | 6682 { |
| 6683 Lisp_Object extent; | |
| 6684 | |
| 6685 /* text_props_only specifies whether we only consider text-property | |
| 3025 | 6686 extents (those with the `text-prop' property set) or all extents. */ |
| 428 | 6687 if (!text_props_only) |
| 826 | 6688 extent = extent_at (position, object, prop, 0, fl, 0); |
| 428 | 6689 else |
| 6690 { | |
| 6691 EXTENT prior = 0; | |
| 6692 while (1) | |
| 6693 { | |
| 826 | 6694 extent = extent_at (position, object, Qtext_prop, prior, fl, 0); |
| 428 | 6695 if (NILP (extent)) |
| 6696 return Qnil; | |
| 6697 if (EQ (prop, Fextent_property (extent, Qtext_prop, Qnil))) | |
| 6698 break; | |
| 6699 prior = XEXTENT (extent); | |
| 6700 } | |
| 6701 } | |
| 6702 | |
| 6703 if (!NILP (extent)) | |
| 6704 return Fextent_property (extent, prop, Qnil); | |
| 6705 if (!NILP (Vdefault_text_properties)) | |
| 6706 return Fplist_get (Vdefault_text_properties, prop, Qnil); | |
| 6707 return Qnil; | |
| 6708 } | |
| 6709 | |
| 6710 static Lisp_Object | |
| 826 | 6711 get_char_property_char (Lisp_Object pos, Lisp_Object prop, Lisp_Object object, |
| 6712 Lisp_Object at_flag, int text_props_only) | |
| 6713 { | |
| 6714 Bytexpos position; | |
| 428 | 6715 int invert = 0; |
| 6716 | |
| 6717 object = decode_buffer_or_string (object); | |
| 6718 position = get_buffer_or_string_pos_byte (object, pos, GB_NO_ERROR_IF_BAD); | |
| 6719 | |
| 6720 /* We canonicalize the start/end-open/closed properties to the | |
| 6721 non-default version -- "adding" the default property really | |
| 6722 needs to remove the non-default one. See below for more | |
| 6723 on this. */ | |
| 6724 if (EQ (prop, Qstart_closed)) | |
| 6725 { | |
| 6726 prop = Qstart_open; | |
| 6727 invert = 1; | |
| 6728 } | |
| 6729 | |
| 6730 if (EQ (prop, Qend_open)) | |
| 6731 { | |
| 6732 prop = Qend_closed; | |
| 6733 invert = 1; | |
| 6734 } | |
| 6735 | |
| 6736 { | |
| 6737 Lisp_Object val = | |
| 826 | 6738 get_char_property (position, prop, object, |
| 6739 decode_extent_at_flag (at_flag), | |
| 6740 text_props_only); | |
| 428 | 6741 if (invert) |
| 6742 val = NILP (val) ? Qt : Qnil; | |
| 6743 return val; | |
| 6744 } | |
| 6745 } | |
| 6746 | |
| 6747 DEFUN ("get-text-property", Fget_text_property, 2, 4, 0, /* | |
| 6748 Return the value of the PROP property at the given position. | |
| 6749 Optional arg OBJECT specifies the buffer or string to look in, and | |
| 6750 defaults to the current buffer. | |
| 6751 Optional arg AT-FLAG controls what it means for a property to be "at" | |
| 6752 a position, and has the same meaning as in `extent-at'. | |
| 6753 This examines only those properties added with `put-text-property'. | |
| 6754 See also `get-char-property'. | |
| 6755 */ | |
| 6756 (pos, prop, object, at_flag)) | |
| 6757 { | |
| 826 | 6758 return get_char_property_char (pos, prop, object, at_flag, 1); |
| 428 | 6759 } |
| 6760 | |
| 6761 DEFUN ("get-char-property", Fget_char_property, 2, 4, 0, /* | |
| 6762 Return the value of the PROP property at the given position. | |
| 6763 Optional arg OBJECT specifies the buffer or string to look in, and | |
| 6764 defaults to the current buffer. | |
| 6765 Optional arg AT-FLAG controls what it means for a property to be "at" | |
| 6766 a position, and has the same meaning as in `extent-at'. | |
| 6767 This examines properties on all extents. | |
| 6768 See also `get-text-property'. | |
| 6769 */ | |
| 6770 (pos, prop, object, at_flag)) | |
| 6771 { | |
| 826 | 6772 return get_char_property_char (pos, prop, object, at_flag, 0); |
| 428 | 6773 } |
| 6774 | |
| 6775 /* About start/end-open/closed: | |
| 6776 | |
| 6777 These properties have to be handled specially because of their | |
| 6778 strange behavior. If I put the "start-open" property on a region, | |
| 6779 then *all* text-property extents in the region have to have their | |
| 6780 start be open. This is unlike all other properties, which don't | |
| 6781 affect the extents of text properties other than their own. | |
| 6782 | |
| 6783 So: | |
| 6784 | |
| 6785 1) We have to map start-closed to (not start-open) and end-open | |
| 6786 to (not end-closed) -- i.e. adding the default is really the | |
| 6787 same as remove the non-default property. It won't work, for | |
| 6788 example, to have both "start-open" and "start-closed" on | |
| 6789 the same region. | |
| 6790 2) Whenever we add one of these properties, we go through all | |
| 6791 text-property extents in the region and set the appropriate | |
| 6792 open/closedness on them. | |
| 6793 3) Whenever we change a text-property extent for a property, | |
| 6794 we have to make sure we set the open/closedness properly. | |
| 6795 | |
| 6796 (2) and (3) together rely on, and maintain, the invariant | |
| 6797 that the open/closedness of text-property extents is correct | |
| 6798 at the beginning and end of each operation. | |
| 6799 */ | |
| 6800 | |
| 6801 struct put_text_prop_arg | |
| 6802 { | |
| 6803 Lisp_Object prop, value; /* The property and value we are storing */ | |
| 826 | 6804 Bytexpos start, end; /* The region into which we are storing it */ |
| 428 | 6805 Lisp_Object object; |
| 6806 Lisp_Object the_extent; /* Our chosen extent; this is used for | |
| 6807 communication between subsequent passes. */ | |
| 6808 int changed_p; /* Output: whether we have modified anything */ | |
| 6809 }; | |
| 6810 | |
| 6811 static int | |
| 6812 put_text_prop_mapper (EXTENT e, void *arg) | |
| 6813 { | |
| 6814 struct put_text_prop_arg *closure = (struct put_text_prop_arg *) arg; | |
| 6815 | |
| 6816 Lisp_Object object = closure->object; | |
| 6817 Lisp_Object value = closure->value; | |
| 826 | 6818 Bytexpos e_start, e_end; |
| 6819 Bytexpos start = closure->start; | |
| 6820 Bytexpos end = closure->end; | |
| 428 | 6821 Lisp_Object extent, e_val; |
| 6822 int is_eq; | |
| 6823 | |
| 793 | 6824 extent = wrap_extent (e); |
| 428 | 6825 |
| 3025 | 6826 /* Note: in some cases when the property itself is `start-open' |
| 6827 or `end-closed', the checks to set the openness may do a bit | |
| 428 | 6828 of extra work; but it won't hurt because we then fix up the |
| 6829 openness later on in put_text_prop_openness_mapper(). */ | |
| 6830 if (!EQ (Fextent_property (extent, Qtext_prop, Qnil), closure->prop)) | |
| 6831 /* It's not for this property; do nothing. */ | |
| 6832 return 0; | |
| 6833 | |
| 826 | 6834 e_start = extent_endpoint_byte (e, 0); |
| 6835 e_end = extent_endpoint_byte (e, 1); | |
| 428 | 6836 e_val = Fextent_property (extent, closure->prop, Qnil); |
| 6837 is_eq = EQ (value, e_val); | |
| 6838 | |
| 6839 if (!NILP (value) && NILP (closure->the_extent) && is_eq) | |
| 6840 { | |
| 6841 /* We want there to be an extent here at the end, and we haven't picked | |
| 6842 one yet, so use this one. Extend it as necessary. We only reuse an | |
| 6843 extent which has an EQ value for the prop in question to avoid | |
| 6844 side-effecting the kill ring (that is, we never change the property | |
| 6845 on an extent after it has been created.) | |
| 6846 */ | |
| 6847 if (e_start != start || e_end != end) | |
| 6848 { | |
| 826 | 6849 Bytexpos new_start = min (e_start, start); |
| 6850 Bytexpos new_end = max (e_end, end); | |
| 428 | 6851 set_extent_endpoints (e, new_start, new_end, Qnil); |
| 6852 /* If we changed the endpoint, then we need to set its | |
| 6853 openness. */ | |
| 6854 set_extent_openness (e, new_start != e_start | |
| 826 | 6855 ? !NILP (get_char_property |
| 428 | 6856 (start, Qstart_open, object, |
| 6857 EXTENT_AT_AFTER, 1)) : -1, | |
| 6858 new_end != e_end | |
| 826 | 6859 ? NILP (get_char_property |
| 6860 (prev_bytexpos (object, end), | |
| 6861 Qend_closed, object, | |
| 428 | 6862 EXTENT_AT_AFTER, 1)) |
| 6863 : -1); | |
| 6864 closure->changed_p = 1; | |
| 6865 } | |
| 6866 closure->the_extent = extent; | |
| 6867 } | |
| 6868 | |
| 6869 /* Even if we're adding a prop, at this point, we want all other extents of | |
| 6870 this prop to go away (as now they overlap). So the theory here is that, | |
| 6871 when we are adding a prop to a region that has multiple (disjoint) | |
| 6872 occurrences of that prop in it already, we pick one of those and extend | |
| 6873 it, and remove the others. | |
| 6874 */ | |
| 6875 | |
| 6876 else if (EQ (extent, closure->the_extent)) | |
| 6877 { | |
| 6878 /* just in case map-extents hits it again (does that happen?) */ | |
| 6879 ; | |
| 6880 } | |
| 6881 else if (e_start >= start && e_end <= end) | |
| 6882 { | |
| 6883 /* Extent is contained in region; remove it. Don't destroy or modify | |
| 6884 it, because we don't want to change the attributes pointed to by the | |
| 6885 duplicates in the kill ring. | |
| 6886 */ | |
| 6887 extent_detach (e); | |
| 6888 closure->changed_p = 1; | |
| 6889 } | |
| 6890 else if (!NILP (closure->the_extent) && | |
| 6891 is_eq && | |
| 6892 e_start <= end && | |
| 6893 e_end >= start) | |
| 6894 { | |
| 6895 EXTENT te = XEXTENT (closure->the_extent); | |
| 6896 /* This extent overlaps, and has the same prop/value as the extent we've | |
| 6897 decided to reuse, so we can remove this existing extent as well (the | |
| 6898 whole thing, even the part outside of the region) and extend | |
| 6899 the-extent to cover it, resulting in the minimum number of extents in | |
| 6900 the buffer. | |
| 6901 */ | |
| 826 | 6902 Bytexpos the_start = extent_endpoint_byte (te, 0); |
| 6903 Bytexpos the_end = extent_endpoint_byte (te, 1); | |
| 428 | 6904 if (e_start != the_start && /* note AND not OR -- hmm, why is this |
| 6905 the case? I think it's because the | |
| 6906 assumption that the text-property | |
| 6907 extents don't overlap makes it | |
| 6908 OK; changing it to an OR would | |
| 6909 result in changed_p sometimes getting | |
| 6910 falsely marked. Is this bad? */ | |
| 6911 e_end != the_end) | |
| 6912 { | |
| 826 | 6913 Bytexpos new_start = min (e_start, the_start); |
| 6914 Bytexpos new_end = max (e_end, the_end); | |
| 428 | 6915 set_extent_endpoints (te, new_start, new_end, Qnil); |
| 6916 /* If we changed the endpoint, then we need to set its | |
| 6917 openness. We are setting the endpoint to be the same as | |
| 6918 that of the extent we're about to remove, and we assume | |
| 6919 (the invariant mentioned above) that extent has the | |
| 6920 proper endpoint setting, so we just use it. */ | |
| 6921 set_extent_openness (te, new_start != e_start ? | |
| 6922 (int) extent_start_open_p (e) : -1, | |
| 6923 new_end != e_end ? | |
| 6924 (int) extent_end_open_p (e) : -1); | |
| 6925 closure->changed_p = 1; | |
| 6926 } | |
| 6927 extent_detach (e); | |
| 6928 } | |
| 6929 else if (e_end <= end) | |
| 6930 { | |
| 6931 /* Extent begins before start but ends before end, so we can just | |
| 6932 decrease its end position. | |
| 6933 */ | |
| 6934 if (e_end != start) | |
| 6935 { | |
| 6936 set_extent_endpoints (e, e_start, start, Qnil); | |
| 826 | 6937 set_extent_openness (e, -1, |
| 6938 NILP (get_char_property | |
| 6939 (prev_bytexpos (object, start), | |
| 6940 Qend_closed, object, | |
| 6941 EXTENT_AT_AFTER, 1))); | |
| 428 | 6942 closure->changed_p = 1; |
| 6943 } | |
| 6944 } | |
| 6945 else if (e_start >= start) | |
| 6946 { | |
| 6947 /* Extent ends after end but begins after start, so we can just | |
| 6948 increase its start position. | |
| 6949 */ | |
| 6950 if (e_start != end) | |
| 6951 { | |
| 6952 set_extent_endpoints (e, end, e_end, Qnil); | |
| 826 | 6953 set_extent_openness (e, !NILP (get_char_property |
| 428 | 6954 (end, Qstart_open, object, |
| 6955 EXTENT_AT_AFTER, 1)), -1); | |
| 6956 closure->changed_p = 1; | |
| 6957 } | |
| 6958 } | |
| 6959 else | |
| 6960 { | |
| 6961 /* Otherwise, `extent' straddles the region. We need to split it. | |
| 6962 */ | |
| 6963 set_extent_endpoints (e, e_start, start, Qnil); | |
| 826 | 6964 set_extent_openness (e, -1, NILP (get_char_property |
| 6965 (prev_bytexpos (object, start), | |
| 6966 Qend_closed, object, | |
| 428 | 6967 EXTENT_AT_AFTER, 1))); |
| 6968 set_extent_openness (copy_extent (e, end, e_end, extent_object (e)), | |
| 826 | 6969 !NILP (get_char_property |
| 428 | 6970 (end, Qstart_open, object, |
| 6971 EXTENT_AT_AFTER, 1)), -1); | |
| 6972 closure->changed_p = 1; | |
| 6973 } | |
| 6974 | |
| 6975 return 0; /* to continue mapping. */ | |
| 6976 } | |
| 6977 | |
| 6978 static int | |
| 6979 put_text_prop_openness_mapper (EXTENT e, void *arg) | |
| 6980 { | |
| 6981 struct put_text_prop_arg *closure = (struct put_text_prop_arg *) arg; | |
| 826 | 6982 Bytexpos e_start, e_end; |
| 6983 Bytexpos start = closure->start; | |
| 6984 Bytexpos end = closure->end; | |
| 793 | 6985 Lisp_Object extent = wrap_extent (e); |
| 6986 | |
| 826 | 6987 e_start = extent_endpoint_byte (e, 0); |
| 6988 e_end = extent_endpoint_byte (e, 1); | |
| 428 | 6989 |
| 6990 if (NILP (Fextent_property (extent, Qtext_prop, Qnil))) | |
| 6991 { | |
| 6992 /* It's not a text-property extent; do nothing. */ | |
| 6993 ; | |
| 6994 } | |
| 6995 /* Note end conditions and NILP/!NILP's carefully. */ | |
| 6996 else if (EQ (closure->prop, Qstart_open) | |
| 6997 && e_start >= start && e_start < end) | |
| 6998 set_extent_openness (e, !NILP (closure->value), -1); | |
| 6999 else if (EQ (closure->prop, Qend_closed) | |
| 7000 && e_end > start && e_end <= end) | |
| 7001 set_extent_openness (e, -1, NILP (closure->value)); | |
| 7002 | |
| 7003 return 0; /* to continue mapping. */ | |
| 7004 } | |
| 7005 | |
| 7006 static int | |
| 826 | 7007 put_text_prop (Bytexpos start, Bytexpos end, Lisp_Object object, |
| 428 | 7008 Lisp_Object prop, Lisp_Object value, |
| 7009 int duplicable_p) | |
| 7010 { | |
| 7011 /* This function can GC */ | |
| 7012 struct put_text_prop_arg closure; | |
| 7013 | |
| 7014 if (start == end) /* There are no characters in the region. */ | |
| 7015 return 0; | |
| 7016 | |
| 7017 /* convert to the non-default versions, since a nil property is | |
| 7018 the same as it not being present. */ | |
| 7019 if (EQ (prop, Qstart_closed)) | |
| 7020 { | |
| 7021 prop = Qstart_open; | |
| 7022 value = NILP (value) ? Qt : Qnil; | |
| 7023 } | |
| 7024 else if (EQ (prop, Qend_open)) | |
| 7025 { | |
| 7026 prop = Qend_closed; | |
| 7027 value = NILP (value) ? Qt : Qnil; | |
| 7028 } | |
| 7029 | |
| 7030 value = canonicalize_extent_property (prop, value); | |
| 7031 | |
| 7032 closure.prop = prop; | |
| 7033 closure.value = value; | |
| 7034 closure.start = start; | |
| 7035 closure.end = end; | |
| 7036 closure.object = object; | |
| 7037 closure.changed_p = 0; | |
| 7038 closure.the_extent = Qnil; | |
| 7039 | |
| 826 | 7040 map_extents (start, end, |
| 7041 put_text_prop_mapper, | |
| 7042 (void *) &closure, object, 0, | |
| 7043 /* get all extents that abut the region */ | |
| 7044 ME_ALL_EXTENTS_CLOSED | ME_END_CLOSED | | |
| 7045 #if 0 | |
| 7046 /* it might move the SOE because the callback function calls | |
| 7047 get_char_property(), which calls extent_at(), which calls | |
| 7048 map_extents() | |
| 7049 | |
| 7050 #### this was comment out before, and nothing seemed broken; | |
| 7051 #### but when I added the above comment and uncommented it, | |
| 7052 #### text property operations (e.g. font-lock) suddenly | |
| 7053 #### became *WAY* slow, and dominated font-lock, when a | |
| 7054 #### single extent spanning the entire buffer | |
| 7055 #### existed. --ben */ | |
| 7056 ME_MIGHT_MOVE_SOE | | |
| 7057 #endif | |
| 7058 /* it might QUIT or error if the user has | |
| 7059 fucked with the extent plist. */ | |
| 7060 ME_MIGHT_THROW | | |
| 7061 ME_MIGHT_MODIFY_EXTENTS); | |
| 428 | 7062 |
| 7063 /* If we made it through the loop without reusing an extent | |
| 7064 (and we want there to be one) make it now. | |
| 7065 */ | |
| 7066 if (!NILP (value) && NILP (closure.the_extent)) | |
| 7067 { | |
| 826 | 7068 Lisp_Object extent = |
| 7069 wrap_extent (make_extent (object, start, end)); | |
| 793 | 7070 |
| 428 | 7071 closure.changed_p = 1; |
| 7072 Fset_extent_property (extent, Qtext_prop, prop); | |
| 7073 Fset_extent_property (extent, prop, value); | |
| 7074 if (duplicable_p) | |
| 7075 { | |
| 7076 extent_duplicable_p (XEXTENT (extent)) = 1; | |
| 7077 Fset_extent_property (extent, Qpaste_function, | |
| 7078 Qtext_prop_extent_paste_function); | |
| 7079 } | |
| 7080 set_extent_openness (XEXTENT (extent), | |
| 826 | 7081 !NILP (get_char_property |
| 428 | 7082 (start, Qstart_open, object, |
| 7083 EXTENT_AT_AFTER, 1)), | |
| 826 | 7084 NILP (get_char_property |
| 7085 (prev_bytexpos (object, end), | |
| 7086 Qend_closed, object, | |
| 428 | 7087 EXTENT_AT_AFTER, 1))); |
| 7088 } | |
| 7089 | |
| 7090 if (EQ (prop, Qstart_open) || EQ (prop, Qend_closed)) | |
| 7091 { | |
| 826 | 7092 map_extents (start, end, put_text_prop_openness_mapper, |
| 7093 (void *) &closure, object, 0, | |
| 7094 /* get all extents that abut the region */ | |
| 7095 ME_ALL_EXTENTS_CLOSED | ME_END_CLOSED | | |
| 7096 ME_MIGHT_MODIFY_EXTENTS); | |
| 428 | 7097 } |
| 7098 | |
| 7099 return closure.changed_p; | |
| 7100 } | |
| 7101 | |
| 7102 DEFUN ("put-text-property", Fput_text_property, 4, 5, 0, /* | |
| 7103 Adds the given property/value to all characters in the specified region. | |
| 7104 The property is conceptually attached to the characters rather than the | |
| 7105 region. The properties are copied when the characters are copied/pasted. | |
| 7106 Fifth argument OBJECT is the buffer or string containing the text, and | |
| 7107 defaults to the current buffer. | |
| 7108 */ | |
| 7109 (start, end, prop, value, object)) | |
| 7110 { | |
| 7111 /* This function can GC */ | |
| 826 | 7112 Bytexpos s, e; |
| 428 | 7113 |
| 7114 object = decode_buffer_or_string (object); | |
| 7115 get_buffer_or_string_range_byte (object, start, end, &s, &e, 0); | |
| 7116 put_text_prop (s, e, object, prop, value, 1); | |
| 7117 return prop; | |
| 7118 } | |
| 7119 | |
| 7120 DEFUN ("put-nonduplicable-text-property", Fput_nonduplicable_text_property, | |
| 7121 4, 5, 0, /* | |
| 7122 Adds the given property/value to all characters in the specified region. | |
| 7123 The property is conceptually attached to the characters rather than the | |
| 7124 region, however the properties will not be copied when the characters | |
| 7125 are copied. | |
| 7126 Fifth argument OBJECT is the buffer or string containing the text, and | |
| 7127 defaults to the current buffer. | |
| 7128 */ | |
| 7129 (start, end, prop, value, object)) | |
| 7130 { | |
| 7131 /* This function can GC */ | |
| 826 | 7132 Bytexpos s, e; |
| 428 | 7133 |
| 7134 object = decode_buffer_or_string (object); | |
| 7135 get_buffer_or_string_range_byte (object, start, end, &s, &e, 0); | |
| 7136 put_text_prop (s, e, object, prop, value, 0); | |
| 7137 return prop; | |
| 7138 } | |
| 7139 | |
| 7140 DEFUN ("add-text-properties", Fadd_text_properties, 3, 4, 0, /* | |
| 7141 Add properties to the characters from START to END. | |
| 7142 The third argument PROPS is a property list specifying the property values | |
| 7143 to add. The optional fourth argument, OBJECT, is the buffer or string | |
| 7144 containing the text and defaults to the current buffer. Returns t if | |
| 7145 any property was changed, nil otherwise. | |
| 7146 */ | |
| 7147 (start, end, props, object)) | |
| 7148 { | |
| 7149 /* This function can GC */ | |
| 7150 int changed = 0; | |
| 826 | 7151 Bytexpos s, e; |
| 428 | 7152 |
| 7153 object = decode_buffer_or_string (object); | |
| 7154 get_buffer_or_string_range_byte (object, start, end, &s, &e, 0); | |
| 7155 CHECK_LIST (props); | |
| 7156 for (; !NILP (props); props = Fcdr (Fcdr (props))) | |
| 7157 { | |
| 7158 Lisp_Object prop = XCAR (props); | |
| 7159 Lisp_Object value = Fcar (XCDR (props)); | |
| 7160 changed |= put_text_prop (s, e, object, prop, value, 1); | |
| 7161 } | |
| 7162 return changed ? Qt : Qnil; | |
| 7163 } | |
| 7164 | |
| 7165 | |
| 7166 DEFUN ("add-nonduplicable-text-properties", Fadd_nonduplicable_text_properties, | |
| 7167 3, 4, 0, /* | |
| 7168 Add nonduplicable properties to the characters from START to END. | |
| 7169 \(The properties will not be copied when the characters are copied.) | |
| 7170 The third argument PROPS is a property list specifying the property values | |
| 7171 to add. The optional fourth argument, OBJECT, is the buffer or string | |
| 7172 containing the text and defaults to the current buffer. Returns t if | |
| 7173 any property was changed, nil otherwise. | |
| 7174 */ | |
| 7175 (start, end, props, object)) | |
| 7176 { | |
| 7177 /* This function can GC */ | |
| 7178 int changed = 0; | |
| 826 | 7179 Bytexpos s, e; |
| 428 | 7180 |
| 7181 object = decode_buffer_or_string (object); | |
| 7182 get_buffer_or_string_range_byte (object, start, end, &s, &e, 0); | |
| 7183 CHECK_LIST (props); | |
| 7184 for (; !NILP (props); props = Fcdr (Fcdr (props))) | |
| 7185 { | |
| 7186 Lisp_Object prop = XCAR (props); | |
| 7187 Lisp_Object value = Fcar (XCDR (props)); | |
| 7188 changed |= put_text_prop (s, e, object, prop, value, 0); | |
| 7189 } | |
| 7190 return changed ? Qt : Qnil; | |
| 7191 } | |
| 7192 | |
| 7193 DEFUN ("remove-text-properties", Fremove_text_properties, 3, 4, 0, /* | |
| 7194 Remove the given properties from all characters in the specified region. | |
| 7195 PROPS should be a plist, but the values in that plist are ignored (treated | |
| 7196 as nil). Returns t if any property was changed, nil otherwise. | |
| 7197 Fourth argument OBJECT is the buffer or string containing the text, and | |
| 7198 defaults to the current buffer. | |
| 7199 */ | |
| 7200 (start, end, props, object)) | |
| 7201 { | |
| 7202 /* This function can GC */ | |
| 7203 int changed = 0; | |
| 826 | 7204 Bytexpos s, e; |
| 428 | 7205 |
| 7206 object = decode_buffer_or_string (object); | |
| 7207 get_buffer_or_string_range_byte (object, start, end, &s, &e, 0); | |
| 7208 CHECK_LIST (props); | |
| 7209 for (; !NILP (props); props = Fcdr (Fcdr (props))) | |
| 7210 { | |
| 7211 Lisp_Object prop = XCAR (props); | |
| 7212 changed |= put_text_prop (s, e, object, prop, Qnil, 1); | |
| 7213 } | |
| 7214 return changed ? Qt : Qnil; | |
| 7215 } | |
| 7216 | |
| 7217 /* Whenever a text-prop extent is pasted into a buffer (via `yank' or `insert' | |
| 7218 or whatever) we attach the properties to the buffer by calling | |
| 7219 `put-text-property' instead of by simply allowing the extent to be copied or | |
| 7220 re-attached. Then we return nil, telling the extents code not to attach it | |
| 7221 again. By handing the insertion hackery in this way, we make kill/yank | |
| 7222 behave consistently with put-text-property and not fragment the extents | |
| 7223 (since text-prop extents must partition, not overlap). | |
| 7224 | |
| 7225 The lisp implementation of this was probably fast enough, but since I moved | |
| 7226 the rest of the put-text-prop code here, I moved this as well for | |
| 7227 completeness. | |
| 7228 */ | |
| 7229 DEFUN ("text-prop-extent-paste-function", Ftext_prop_extent_paste_function, | |
| 7230 3, 3, 0, /* | |
| 7231 Used as the `paste-function' property of `text-prop' extents. | |
| 7232 */ | |
| 7233 (extent, from, to)) | |
| 7234 { | |
| 7235 /* This function can GC */ | |
| 7236 Lisp_Object prop, val; | |
| 7237 | |
| 7238 prop = Fextent_property (extent, Qtext_prop, Qnil); | |
| 7239 if (NILP (prop)) | |
| 563 | 7240 signal_error (Qinternal_error, |
| 442 | 7241 "Internal error: no text-prop", extent); |
| 428 | 7242 val = Fextent_property (extent, prop, Qnil); |
| 7243 #if 0 | |
| 7244 /* removed by bill perry, 2/9/97 | |
| 7245 ** This little bit of code would not allow you to have a text property | |
| 7246 ** with a value of Qnil. This is bad bad bad. | |
| 7247 */ | |
| 7248 if (NILP (val)) | |
| 563 | 7249 signal_error_2 (Qinternal_error, |
| 442 | 7250 "Internal error: no text-prop", |
| 7251 extent, prop); | |
| 428 | 7252 #endif |
| 7253 Fput_text_property (from, to, prop, val, Qnil); | |
| 7254 return Qnil; /* important! */ | |
| 7255 } | |
| 7256 | |
| 826 | 7257 Bytexpos |
| 2506 | 7258 next_previous_single_property_change (Bytexpos pos, Lisp_Object prop, |
| 7259 Lisp_Object object, Bytexpos limit, | |
| 7260 Boolint next, Boolint text_props_only) | |
| 826 | 7261 { |
| 7262 Lisp_Object extent, value; | |
| 7263 int limit_was_nil; | |
| 2506 | 7264 enum extent_at_flag at_flag = next ? EXTENT_AT_AFTER : EXTENT_AT_BEFORE; |
| 826 | 7265 if (limit < 0) |
| 7266 { | |
| 2506 | 7267 limit = (next ? buffer_or_string_accessible_end_byte : |
| 7268 buffer_or_string_accessible_begin_byte) (object); | |
| 826 | 7269 limit_was_nil = 1; |
| 7270 } | |
| 7271 else | |
| 7272 limit_was_nil = 0; | |
| 7273 | |
| 2506 | 7274 /* Retrieve initial property value to compare against */ |
| 7275 extent = extent_at (pos, object, prop, 0, at_flag, 0); | |
| 7276 /* If we only want text-prop extents, ignore all others */ | |
| 7277 if (text_props_only && !NILP (extent) && | |
| 7278 NILP (Fextent_property (extent, Qtext_prop, Qnil))) | |
| 7279 extent = Qnil; | |
| 826 | 7280 if (!NILP (extent)) |
| 7281 value = Fextent_property (extent, prop, Qnil); | |
| 7282 else | |
| 7283 value = Qnil; | |
| 7284 | |
| 7285 while (1) | |
| 7286 { | |
| 2506 | 7287 pos = (next ? extent_find_end_of_run : extent_find_beginning_of_run) |
| 7288 (object, pos, 1); | |
| 7289 if (next ? pos >= limit : pos <= limit) | |
| 7290 break; /* property is the same all the way to the beginning/end */ | |
| 7291 extent = extent_at (pos, object, prop, 0, at_flag, 0); | |
| 7292 /* If we only want text-prop extents, ignore all others */ | |
| 7293 if (text_props_only && !NILP (extent) && | |
| 7294 NILP (Fextent_property (extent, Qtext_prop, Qnil))) | |
| 7295 extent = Qnil; | |
| 826 | 7296 if ((NILP (extent) && !NILP (value)) || |
| 7297 (!NILP (extent) && !EQ (value, | |
| 7298 Fextent_property (extent, prop, Qnil)))) | |
| 7299 return pos; | |
| 7300 } | |
| 7301 | |
| 7302 if (limit_was_nil) | |
| 7303 return -1; | |
| 7304 else | |
| 7305 return limit; | |
| 7306 } | |
| 7307 | |
| 2506 | 7308 static Lisp_Object |
| 7309 next_previous_single_property_change_fn (Lisp_Object pos, Lisp_Object prop, | |
| 7310 Lisp_Object object, Lisp_Object limit, | |
| 7311 Boolint next, Boolint text_props_only) | |
| 7312 { | |
| 7313 Bytexpos xpos; | |
| 7314 Bytexpos blim; | |
| 7315 | |
| 7316 object = decode_buffer_or_string (object); | |
| 7317 xpos = get_buffer_or_string_pos_byte (object, pos, 0); | |
| 7318 blim = !NILP (limit) ? get_buffer_or_string_pos_byte (object, limit, 0) : -1; | |
| 7319 blim = next_previous_single_property_change (xpos, prop, object, blim, | |
| 7320 next, text_props_only); | |
| 7321 | |
| 7322 if (blim < 0) | |
| 7323 return Qnil; | |
| 826 | 7324 else |
| 2506 | 7325 return make_int (buffer_or_string_bytexpos_to_charxpos (object, blim)); |
| 826 | 7326 } |
| 428 | 7327 |
| 7328 DEFUN ("next-single-property-change", Fnext_single_property_change, | |
| 7329 2, 4, 0, /* | |
| 7330 Return the position of next property change for a specific property. | |
| 7331 Scans characters forward from POS till it finds a change in the PROP | |
| 7332 property, then returns the position of the change. The optional third | |
| 7333 argument OBJECT is the buffer or string to scan (defaults to the current | |
| 7334 buffer). | |
| 7335 The property values are compared with `eq'. | |
| 444 | 7336 Return nil if the property is constant all the way to the end of OBJECT. |
| 428 | 7337 If the value is non-nil, it is a position greater than POS, never equal. |
| 7338 | |
| 7339 If the optional fourth argument LIMIT is non-nil, don't search | |
| 7340 past position LIMIT; return LIMIT if nothing is found before LIMIT. | |
| 7341 If two or more extents with conflicting non-nil values for PROP overlap | |
| 7342 a particular character, it is undefined which value is considered to be | |
| 7343 the value of PROP. (Note that this situation will not happen if you always | |
| 7344 use the text-property primitives.) | |
| 2506 | 7345 |
| 7346 This function looks only at extents created using the text-property primitives. | |
| 7347 To look at all extents, use `next-single-char-property-change'. | |
| 428 | 7348 */ |
| 7349 (pos, prop, object, limit)) | |
| 7350 { | |
| 2506 | 7351 return next_previous_single_property_change_fn (pos, prop, object, limit, |
| 7352 1, 1); | |
| 826 | 7353 } |
| 428 | 7354 |
| 7355 DEFUN ("previous-single-property-change", Fprevious_single_property_change, | |
| 7356 2, 4, 0, /* | |
| 7357 Return the position of next property change for a specific property. | |
| 7358 Scans characters backward from POS till it finds a change in the PROP | |
| 7359 property, then returns the position of the change. The optional third | |
| 7360 argument OBJECT is the buffer or string to scan (defaults to the current | |
| 7361 buffer). | |
| 7362 The property values are compared with `eq'. | |
| 444 | 7363 Return nil if the property is constant all the way to the start of OBJECT. |
| 428 | 7364 If the value is non-nil, it is a position less than POS, never equal. |
| 7365 | |
| 7366 If the optional fourth argument LIMIT is non-nil, don't search back | |
| 7367 past position LIMIT; return LIMIT if nothing is found until LIMIT. | |
| 7368 If two or more extents with conflicting non-nil values for PROP overlap | |
| 7369 a particular character, it is undefined which value is considered to be | |
| 7370 the value of PROP. (Note that this situation will not happen if you always | |
| 7371 use the text-property primitives.) | |
| 2506 | 7372 |
| 7373 This function looks only at extents created using the text-property primitives. | |
| 7374 To look at all extents, use `next-single-char-property-change'. | |
| 7375 */ | |
| 7376 (pos, prop, object, limit)) | |
| 7377 { | |
| 7378 return next_previous_single_property_change_fn (pos, prop, object, limit, | |
| 7379 0, 1); | |
| 7380 } | |
| 7381 | |
| 7382 DEFUN ("next-single-char-property-change", Fnext_single_char_property_change, | |
| 7383 2, 4, 0, /* | |
| 7384 Return the position of next property change for a specific property. | |
| 7385 Scans characters forward from POS till it finds a change in the PROP | |
| 7386 property, then returns the position of the change. The optional third | |
| 7387 argument OBJECT is the buffer or string to scan (defaults to the current | |
| 7388 buffer). | |
| 7389 The property values are compared with `eq'. | |
| 7390 Return nil if the property is constant all the way to the end of OBJECT. | |
| 7391 If the value is non-nil, it is a position greater than POS, never equal. | |
| 7392 | |
| 7393 If the optional fourth argument LIMIT is non-nil, don't search | |
| 7394 past position LIMIT; return LIMIT if nothing is found before LIMIT. | |
| 7395 If two or more extents with conflicting non-nil values for PROP overlap | |
| 7396 a particular character, it is undefined which value is considered to be | |
| 7397 the value of PROP. (Note that this situation will not happen if you always | |
| 7398 use the text-property primitives.) | |
| 7399 | |
| 7400 This function looks at all extents. To look at only extents created using the | |
| 7401 text-property primitives, use `next-single-char-property-change'. | |
| 428 | 7402 */ |
| 7403 (pos, prop, object, limit)) | |
| 7404 { | |
| 2506 | 7405 return next_previous_single_property_change_fn (pos, prop, object, limit, |
| 7406 1, 0); | |
| 7407 } | |
| 7408 | |
| 7409 DEFUN ("previous-single-char-property-change", | |
| 7410 Fprevious_single_char_property_change, | |
| 7411 2, 4, 0, /* | |
| 7412 Return the position of next property change for a specific property. | |
| 7413 Scans characters backward from POS till it finds a change in the PROP | |
| 7414 property, then returns the position of the change. The optional third | |
| 7415 argument OBJECT is the buffer or string to scan (defaults to the current | |
| 7416 buffer). | |
| 7417 The property values are compared with `eq'. | |
| 7418 Return nil if the property is constant all the way to the start of OBJECT. | |
| 7419 If the value is non-nil, it is a position less than POS, never equal. | |
| 7420 | |
| 7421 If the optional fourth argument LIMIT is non-nil, don't search back | |
| 7422 past position LIMIT; return LIMIT if nothing is found until LIMIT. | |
| 7423 If two or more extents with conflicting non-nil values for PROP overlap | |
| 7424 a particular character, it is undefined which value is considered to be | |
| 7425 the value of PROP. (Note that this situation will not happen if you always | |
| 7426 use the text-property primitives.) | |
| 7427 | |
| 7428 This function looks at all extents. To look at only extents created using the | |
| 7429 text-property primitives, use `next-single-char-property-change'. | |
| 7430 */ | |
| 7431 (pos, prop, object, limit)) | |
| 7432 { | |
| 7433 return next_previous_single_property_change_fn (pos, prop, object, limit, | |
| 7434 0, 0); | |
| 428 | 7435 } |
| 7436 | |
| 7437 #ifdef MEMORY_USAGE_STATS | |
| 7438 | |
| 7439 int | |
| 2286 | 7440 compute_buffer_extent_usage (struct buffer *UNUSED (b), |
| 7441 struct overhead_stats *UNUSED (ovstats)) | |
| 428 | 7442 { |
| 7443 /* #### not yet written */ | |
| 7444 return 0; | |
| 7445 } | |
| 7446 | |
| 7447 #endif /* MEMORY_USAGE_STATS */ | |
| 7448 | |
| 7449 | |
| 7450 /************************************************************************/ | |
| 7451 /* initialization */ | |
| 7452 /************************************************************************/ | |
| 7453 | |
| 7454 void | |
| 7455 syms_of_extents (void) | |
| 7456 { | |
| 442 | 7457 INIT_LRECORD_IMPLEMENTATION (extent); |
| 7458 INIT_LRECORD_IMPLEMENTATION (extent_info); | |
| 7459 INIT_LRECORD_IMPLEMENTATION (extent_auxiliary); | |
| 3092 | 7460 #ifdef NEW_GC |
| 7461 INIT_LRECORD_IMPLEMENTATION (gap_array_marker); | |
| 7462 INIT_LRECORD_IMPLEMENTATION (gap_array); | |
| 7463 INIT_LRECORD_IMPLEMENTATION (extent_list_marker); | |
| 7464 INIT_LRECORD_IMPLEMENTATION (extent_list); | |
| 7465 INIT_LRECORD_IMPLEMENTATION (stack_of_extents); | |
| 3263 | 7466 #endif /* NEW_GC */ |
| 442 | 7467 |
| 563 | 7468 DEFSYMBOL (Qextentp); |
| 7469 DEFSYMBOL (Qextent_live_p); | |
| 7470 | |
| 7471 DEFSYMBOL (Qall_extents_closed); | |
| 7472 DEFSYMBOL (Qall_extents_open); | |
| 7473 DEFSYMBOL (Qall_extents_closed_open); | |
| 7474 DEFSYMBOL (Qall_extents_open_closed); | |
| 7475 DEFSYMBOL (Qstart_in_region); | |
| 7476 DEFSYMBOL (Qend_in_region); | |
| 7477 DEFSYMBOL (Qstart_and_end_in_region); | |
| 7478 DEFSYMBOL (Qstart_or_end_in_region); | |
| 7479 DEFSYMBOL (Qnegate_in_region); | |
| 7480 | |
| 7481 DEFSYMBOL (Qdetached); | |
| 7482 DEFSYMBOL (Qdestroyed); | |
| 7483 DEFSYMBOL (Qbegin_glyph); | |
| 7484 DEFSYMBOL (Qend_glyph); | |
| 7485 DEFSYMBOL (Qstart_open); | |
| 7486 DEFSYMBOL (Qend_open); | |
| 7487 DEFSYMBOL (Qstart_closed); | |
| 7488 DEFSYMBOL (Qend_closed); | |
| 7489 DEFSYMBOL (Qread_only); | |
| 7490 /* DEFSYMBOL (Qhighlight); in faces.c */ | |
| 7491 DEFSYMBOL (Qunique); | |
| 7492 DEFSYMBOL (Qduplicable); | |
| 7493 DEFSYMBOL (Qdetachable); | |
| 7494 DEFSYMBOL (Qpriority); | |
| 7495 DEFSYMBOL (Qmouse_face); | |
| 7496 DEFSYMBOL (Qinitial_redisplay_function); | |
| 7497 | |
| 7498 | |
| 7499 DEFSYMBOL (Qglyph_layout); /* backwards compatibility */ | |
| 7500 DEFSYMBOL (Qbegin_glyph_layout); | |
| 7501 DEFSYMBOL (Qend_glyph_layout); | |
| 7502 DEFSYMBOL (Qoutside_margin); | |
| 7503 DEFSYMBOL (Qinside_margin); | |
| 7504 DEFSYMBOL (Qwhitespace); | |
| 428 | 7505 /* Qtext defined in general.c */ |
| 7506 | |
| 563 | 7507 DEFSYMBOL (Qpaste_function); |
| 7508 DEFSYMBOL (Qcopy_function); | |
| 7509 | |
| 7510 DEFSYMBOL (Qtext_prop); | |
| 7511 DEFSYMBOL (Qtext_prop_extent_paste_function); | |
| 428 | 7512 |
| 7513 DEFSUBR (Fextentp); | |
| 7514 DEFSUBR (Fextent_live_p); | |
| 7515 DEFSUBR (Fextent_detached_p); | |
| 7516 DEFSUBR (Fextent_start_position); | |
| 7517 DEFSUBR (Fextent_end_position); | |
| 7518 DEFSUBR (Fextent_object); | |
| 7519 DEFSUBR (Fextent_length); | |
| 7520 | |
| 7521 DEFSUBR (Fmake_extent); | |
| 7522 DEFSUBR (Fcopy_extent); | |
| 7523 DEFSUBR (Fdelete_extent); | |
| 7524 DEFSUBR (Fdetach_extent); | |
| 7525 DEFSUBR (Fset_extent_endpoints); | |
| 7526 DEFSUBR (Fnext_extent); | |
| 7527 DEFSUBR (Fprevious_extent); | |
| 1204 | 7528 #ifdef DEBUG_XEMACS |
| 428 | 7529 DEFSUBR (Fnext_e_extent); |
| 7530 DEFSUBR (Fprevious_e_extent); | |
| 7531 #endif | |
| 7532 DEFSUBR (Fnext_extent_change); | |
| 7533 DEFSUBR (Fprevious_extent_change); | |
| 7534 | |
| 7535 DEFSUBR (Fextent_parent); | |
| 7536 DEFSUBR (Fextent_children); | |
| 7537 DEFSUBR (Fset_extent_parent); | |
| 7538 | |
| 7539 DEFSUBR (Fextent_in_region_p); | |
| 7540 DEFSUBR (Fmap_extents); | |
| 7541 DEFSUBR (Fmap_extent_children); | |
| 7542 DEFSUBR (Fextent_at); | |
| 442 | 7543 DEFSUBR (Fextents_at); |
| 428 | 7544 |
| 7545 DEFSUBR (Fset_extent_initial_redisplay_function); | |
| 7546 DEFSUBR (Fextent_face); | |
| 7547 DEFSUBR (Fset_extent_face); | |
| 7548 DEFSUBR (Fextent_mouse_face); | |
| 7549 DEFSUBR (Fset_extent_mouse_face); | |
| 7550 DEFSUBR (Fset_extent_begin_glyph); | |
| 7551 DEFSUBR (Fset_extent_end_glyph); | |
| 7552 DEFSUBR (Fextent_begin_glyph); | |
| 7553 DEFSUBR (Fextent_end_glyph); | |
| 7554 DEFSUBR (Fset_extent_begin_glyph_layout); | |
| 7555 DEFSUBR (Fset_extent_end_glyph_layout); | |
| 7556 DEFSUBR (Fextent_begin_glyph_layout); | |
| 7557 DEFSUBR (Fextent_end_glyph_layout); | |
| 7558 DEFSUBR (Fset_extent_priority); | |
| 7559 DEFSUBR (Fextent_priority); | |
| 7560 DEFSUBR (Fset_extent_property); | |
| 7561 DEFSUBR (Fset_extent_properties); | |
| 7562 DEFSUBR (Fextent_property); | |
| 7563 DEFSUBR (Fextent_properties); | |
| 7564 | |
| 7565 DEFSUBR (Fhighlight_extent); | |
| 7566 DEFSUBR (Fforce_highlight_extent); | |
| 7567 | |
| 7568 DEFSUBR (Finsert_extent); | |
| 7569 | |
| 7570 DEFSUBR (Fget_text_property); | |
| 7571 DEFSUBR (Fget_char_property); | |
| 7572 DEFSUBR (Fput_text_property); | |
| 7573 DEFSUBR (Fput_nonduplicable_text_property); | |
| 7574 DEFSUBR (Fadd_text_properties); | |
| 7575 DEFSUBR (Fadd_nonduplicable_text_properties); | |
| 7576 DEFSUBR (Fremove_text_properties); | |
| 7577 DEFSUBR (Ftext_prop_extent_paste_function); | |
| 7578 DEFSUBR (Fnext_single_property_change); | |
| 7579 DEFSUBR (Fprevious_single_property_change); | |
| 2506 | 7580 DEFSUBR (Fnext_single_char_property_change); |
| 7581 DEFSUBR (Fprevious_single_char_property_change); | |
| 428 | 7582 } |
| 7583 | |
| 7584 void | |
| 7585 reinit_vars_of_extents (void) | |
| 7586 { | |
| 7587 extent_auxiliary_defaults.begin_glyph = Qnil; | |
| 7588 extent_auxiliary_defaults.end_glyph = Qnil; | |
| 7589 extent_auxiliary_defaults.parent = Qnil; | |
| 7590 extent_auxiliary_defaults.children = Qnil; | |
| 7591 extent_auxiliary_defaults.priority = 0; | |
| 7592 extent_auxiliary_defaults.invisible = Qnil; | |
| 7593 extent_auxiliary_defaults.read_only = Qnil; | |
| 7594 extent_auxiliary_defaults.mouse_face = Qnil; | |
| 7595 extent_auxiliary_defaults.initial_redisplay_function = Qnil; | |
| 7596 extent_auxiliary_defaults.before_change_functions = Qnil; | |
| 7597 extent_auxiliary_defaults.after_change_functions = Qnil; | |
| 7598 } | |
| 7599 | |
| 7600 void | |
| 7601 vars_of_extents (void) | |
| 7602 { | |
| 7603 DEFVAR_INT ("mouse-highlight-priority", &mouse_highlight_priority /* | |
| 7604 The priority to use for the mouse-highlighting pseudo-extent | |
| 7605 that is used to highlight extents with the `mouse-face' attribute set. | |
| 7606 See `set-extent-priority'. | |
| 7607 */ ); | |
| 7608 /* Set mouse-highlight-priority (which ends up being used both for the | |
| 7609 mouse-highlighting pseudo-extent and the primary selection extent) | |
| 7610 to a very high value because very few extents should override it. | |
| 7611 1000 gives lots of room below it for different-prioritized extents. | |
| 7612 10 doesn't. ediff, for example, likes to use priorities around 100. | |
| 7613 --ben */ | |
| 7614 mouse_highlight_priority = /* 10 */ 1000; | |
| 7615 | |
| 7616 DEFVAR_LISP ("default-text-properties", &Vdefault_text_properties /* | |
| 7617 Property list giving default values for text properties. | |
| 7618 Whenever a character does not specify a value for a property, the value | |
| 7619 stored in this list is used instead. This only applies when the | |
| 7620 functions `get-text-property' or `get-char-property' are called. | |
| 7621 */ ); | |
| 7622 Vdefault_text_properties = Qnil; | |
| 7623 | |
| 7624 staticpro (&Vlast_highlighted_extent); | |
| 7625 Vlast_highlighted_extent = Qnil; | |
| 7626 | |
| 7627 Vextent_face_reusable_list = Fcons (Qnil, Qnil); | |
| 7628 staticpro (&Vextent_face_reusable_list); | |
| 771 | 7629 |
| 428 | 7630 staticpro (&Vextent_face_memoize_hash_table); |
| 7631 /* The memoize hash table maps from lists of symbols to lists of | |
| 7632 faces. It needs to be `equal' to implement the memoization. | |
| 7633 The reverse table maps in the other direction and just needs | |
| 7634 to do `eq' comparison because the lists of faces are already | |
| 7635 memoized. */ | |
| 7636 Vextent_face_memoize_hash_table = | |
| 7637 make_lisp_hash_table (100, HASH_TABLE_VALUE_WEAK, HASH_TABLE_EQUAL); | |
| 7638 staticpro (&Vextent_face_reverse_memoize_hash_table); | |
| 7639 Vextent_face_reverse_memoize_hash_table = | |
| 7640 make_lisp_hash_table (100, HASH_TABLE_KEY_WEAK, HASH_TABLE_EQ); | |
| 1292 | 7641 |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
7642 QSin_map_extents_internal = build_defer_string ("(in map-extents-internal)"); |
| 1292 | 7643 staticpro (&QSin_map_extents_internal); |
| 7644 } |