Mercurial > hg > xemacs-beta
annotate src/extents.c @ 4967:0d4c9d0f6a8d
rewrite dynarr code
-------------------- ChangeLog entries follow: --------------------
src/ChangeLog addition:
2010-02-03 Ben Wing <ben@xemacs.org>
* device-x.c (x_get_resource_prefix):
* device-x.c (Fx_get_resource):
* device-x.c (Fx_get_resource_prefix):
* device-x.c (Fx_put_resource):
* dialog-msw.c:
* dialog-msw.c (handle_question_dialog_box):
* dired-msw.c (mswindows_sort_files):
* dired-msw.c (mswindows_get_files):
* extents.c (extent_fragment_sort_by_priority):
* extents.c (Fset_extent_parent):
* file-coding.c (coding_reader):
* file-coding.c (coding_writer):
* file-coding.c (gzip_convert):
* frame.c (generate_title_string):
* gutter.c (calculate_gutter_size_from_display_lines):
* indent.c (vmotion_1):
* lread.c (read_bit_vector):
* mule-coding.c (iso2022_decode):
* rangetab.c:
* rangetab.c (Fcopy_range_table):
* rangetab.c (Fget_range_table):
* rangetab.c (unified_range_table_copy_data):
* redisplay-msw.c (mswindows_output_string):
* redisplay-output.c (output_display_line):
* redisplay-output.c (redisplay_move_cursor):
* redisplay-output.c (redisplay_clear_bottom_of_window):
* redisplay-tty.c (tty_output_ichar_dynarr):
* redisplay-tty.c (set_foreground_to):
* redisplay-tty.c (set_background_to):
* redisplay-xlike-inc.c (XLIKE_output_string):
* redisplay.c (redisplay_window_text_width_string):
* redisplay.c (redisplay_text_width_string):
* redisplay.c (create_text_block):
* redisplay.c (SET_CURRENT_MODE_CHARS_PIXSIZE):
* redisplay.c (generate_fstring_runes):
* redisplay.c (regenerate_modeline):
* redisplay.c (ensure_modeline_generated):
* redisplay.c (real_current_modeline_height):
* redisplay.c (create_string_text_block):
* redisplay.c (regenerate_window):
* redisplay.c (REGEN_INC_FIND_START_END):
* redisplay.c (point_visible):
* redisplay.c (redisplay_window):
* redisplay.c (mark_glyph_block_dynarr):
* redisplay.c (line_start_cache_start):
* redisplay.c (start_with_line_at_pixpos):
* redisplay.c (update_line_start_cache):
* redisplay.c (glyph_to_pixel_translation):
* redisplay.c (pixel_to_glyph_translation):
* sysdep.c (qxe_readdir):
* text.c (dfc_convert_to_external_format):
* text.c (dfc_convert_to_internal_format):
* toolbar-common.c (common_output_toolbar_button):
* window.c (window_modeline_height):
* window.c (Fwindow_last_line_visible_height):
* window.c (window_displayed_height):
* window.c (window_scroll):
* window.c (get_current_pixel_pos):
Use Dynarr_begin() in place of Dynarr_atp (foo, 0).
* dynarr.c (Dynarr_realloc):
* dynarr.c (Dynarr_lisp_realloc):
* dynarr.c (Dynarr_resize):
* dynarr.c (Dynarr_insert_many):
* dynarr.c (Dynarr_delete_many):
* dynarr.c (Dynarr_memory_usage):
* dynarr.c (stack_like_malloc):
* dynarr.c (stack_like_free):
* lisp.h:
* lisp.h (DECLARE_DYNARR_LISP_IMP):
* lisp.h (XD_DYNARR_DESC):
* lisp.h (Dynarr_pop):
* gutter.c (output_gutter):
* redisplay-output.c (sync_rune_structs):
* redisplay-output.c (redisplay_output_window):
Redo the dynarr code, add greater checks.
Rename the `len', `largest' and `max' members to `len_',
`largest_' and `max_' to try and catch existing places that might
directly modify these values. Make new accessors Dynarr_largest()
and Dynarr_max() and make them and existing Dynarr_length() be
non-lvalues by adding '+ 0' to them; fix a couple of places in the
redisplay code that tried to modify the length directly by setting
Dynarr_length(). Use the accessors whenever possible even in the
dynarr code itself. The accessors also verify that 0 <= len <=
largest <= max. Rename settor function Dynarr_set_size() to
Dynarr_set_length() and use it more consistently; also create
lower-level Dynarr_set_length_1(). This latter function should be
the only function that directly modifies the `len_' member of a
Dynarr, and in the process makes sure that the `largest' value is
kept correct.
Consistently use ERROR_CHECK_STRUCTURES instead of
ERROR_CHECK_TYPES for error-checking code. Reintroduce the
temporarily disabled verification code on the positions of
Dynarr_at(), Dynarr_atp() and Dynarr_atp_past_end().
Also create Dynarr_resize_if() in place of a repeated
code fragment. Clean up all the functions that modify Dynarrs to
use the new macros and functions and verify the correctness of the
Dynarr both before and after the change.
Note that there are two kinds of verification -- one for accessing
and one for modifying. The difference is that the modify
verification additionally checks to make sure that the Dynarr
isn't locked. (This is used in redisplay to check for problems
with reentrancy.)
* lrecord.h: Move XD_DYNARR_DESC to lisp.h, grouping with the dynarr code.
| author | Ben Wing <ben@xemacs.org> |
|---|---|
| date | Wed, 03 Feb 2010 20:51:18 -0600 |
| parents | e813cf16c015 |
| children | 16112448d484 |
| rev | line source |
|---|---|
| 428 | 1 /* Copyright (c) 1994, 1995 Free Software Foundation, Inc. |
| 2 Copyright (c) 1995 Sun Microsystems, Inc. | |
| 2506 | 3 Copyright (c) 1995, 1996, 2000, 2002, 2003, 2004, 2005 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); | |
| 1726 | 773 xfree (ga, Gap_Array *); |
| 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); | |
| 1726 | 996 xfree (el, Extent_List *); |
| 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); | |
| 1726 | 1818 xfree (soe, struct stack_of_extents *); |
| 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); | |
| 1726 | 2932 xfree (ef, struct extent_fragment *); |
| 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 | |
| 4947 if (extent_start (extent) > indice && | |
| 4948 extent_start (extent) < indice + closure->length) | |
| 2500 | 4949 ABORT (); |
| 428 | 4950 if (extent_end (extent) > indice && |
| 4951 extent_end (extent) < indice + closure->length) | |
| 2500 | 4952 ABORT (); |
| 428 | 4953 #endif |
| 4954 | |
| 4955 /* The extent-adjustment code adjusted the extent's endpoints as if | |
| 468 | 4956 all extents were closed-open -- endpoints at the insertion point |
| 4957 remain unchanged. We need to fix the other kinds of extents: | |
| 4958 | |
| 4959 1. Start position of start-open extents needs to be moved. | |
| 4960 | |
| 4961 2. End position of end-closed extents needs to be moved. | |
| 4962 | |
| 4963 Note that both conditions hold for zero-length (] extents at the | |
| 4964 insertion point. But under these rules, zero-length () extents | |
| 4965 would get adjusted such that their start is greater than their | |
| 4966 end; instead of allowing that, we treat them as [) extents by | |
| 4967 modifying condition #1 to not fire nothing when dealing with a | |
| 4968 zero-length open-open extent. | |
| 4969 | |
| 4970 Existence of zero-length open-open extents is unfortunately an | |
| 4971 inelegant part of the extent model, but there is no way around | |
| 4972 it. */ | |
| 428 | 4973 |
| 4974 { | |
| 826 | 4975 Memxpos new_start = extent_start (extent); |
| 4976 Memxpos new_end = extent_end (extent); | |
| 468 | 4977 |
| 4978 if (indice == extent_start (extent) && extent_start_open_p (extent) | |
| 4979 /* zero-length () extents are exempt; see comment above. */ | |
| 4980 && !(new_start == new_end && extent_end_open_p (extent)) | |
| 4981 ) | |
| 428 | 4982 new_start += closure->length; |
| 4983 if (indice == extent_end (extent) && !extent_end_open_p (extent)) | |
| 4984 new_end += closure->length; | |
| 468 | 4985 |
| 428 | 4986 set_extent_endpoints_1 (extent, new_start, new_end); |
| 4987 } | |
| 4988 | |
| 4989 return 0; | |
| 4990 } | |
| 4991 | |
| 4992 void | |
| 826 | 4993 process_extents_for_insertion (Lisp_Object object, Bytexpos opoint, |
| 428 | 4994 Bytecount length) |
| 4995 { | |
| 4996 struct process_extents_for_insertion_arg closure; | |
| 4997 | |
| 4998 closure.opoint = opoint; | |
| 4999 closure.length = length; | |
| 5000 closure.object = object; | |
| 5001 | |
| 826 | 5002 map_extents (opoint, opoint + length, |
| 5003 process_extents_for_insertion_mapper, | |
| 5004 (void *) &closure, object, 0, | |
| 5005 ME_END_CLOSED | ME_MIGHT_MODIFY_EXTENTS | | |
| 5006 ME_INCLUDE_INTERNAL); | |
| 428 | 5007 } |
| 5008 | |
| 5009 /* ------------------------------------ */ | |
| 5010 /* process_extents_for_deletion() */ | |
| 5011 /* ------------------------------------ */ | |
| 5012 | |
| 5013 struct process_extents_for_deletion_arg | |
| 5014 { | |
| 826 | 5015 Memxpos start, end; |
| 428 | 5016 int destroy_included_extents; |
| 5017 }; | |
| 5018 | |
| 5019 /* This function is called when we're about to delete the range [from, to]. | |
| 5020 Detach all of the extents that are completely inside the range [from, to], | |
| 5021 if they're detachable or open-open. */ | |
| 5022 | |
| 5023 static int | |
| 5024 process_extents_for_deletion_mapper (EXTENT extent, void *arg) | |
| 5025 { | |
| 5026 struct process_extents_for_deletion_arg *closure = | |
| 5027 (struct process_extents_for_deletion_arg *) arg; | |
| 5028 | |
| 5029 /* If the extent lies completely within the range that | |
| 5030 is being deleted, then nuke the extent if it's detachable | |
| 5031 (otherwise, it will become a zero-length extent). */ | |
| 5032 | |
| 5033 if (closure->start <= extent_start (extent) && | |
| 5034 extent_end (extent) <= closure->end) | |
| 5035 { | |
| 5036 if (extent_detachable_p (extent)) | |
| 5037 { | |
| 5038 if (closure->destroy_included_extents) | |
| 5039 destroy_extent (extent); | |
| 5040 else | |
| 5041 extent_detach (extent); | |
| 5042 } | |
| 5043 } | |
| 5044 | |
| 5045 return 0; | |
| 5046 } | |
| 5047 | |
| 5048 /* DESTROY_THEM means destroy the extents instead of just deleting them. | |
| 5049 It is unused currently, but perhaps might be used (there used to | |
| 5050 be a function process_extents_for_destruction(), #if 0'd out, | |
| 5051 that did the equivalent). */ | |
| 5052 void | |
| 826 | 5053 process_extents_for_deletion (Lisp_Object object, Bytexpos from, |
| 5054 Bytexpos to, int destroy_them) | |
| 428 | 5055 { |
| 5056 struct process_extents_for_deletion_arg closure; | |
| 5057 | |
| 826 | 5058 closure.start = buffer_or_string_bytexpos_to_memxpos (object, from); |
| 5059 closure.end = buffer_or_string_bytexpos_to_memxpos (object, to); | |
| 428 | 5060 closure.destroy_included_extents = destroy_them; |
| 5061 | |
| 826 | 5062 map_extents (from, to, process_extents_for_deletion_mapper, |
| 5063 (void *) &closure, object, 0, | |
| 5064 ME_END_CLOSED | ME_MIGHT_MODIFY_EXTENTS); | |
| 428 | 5065 } |
| 5066 | |
| 5067 /* ------------------------------- */ | |
| 5068 /* report_extent_modification() */ | |
| 5069 /* ------------------------------- */ | |
| 826 | 5070 |
| 5071 struct report_extent_modification_closure | |
| 5072 { | |
| 428 | 5073 Lisp_Object buffer; |
| 826 | 5074 Charxpos start, end; |
| 428 | 5075 int afterp; |
| 5076 int speccount; | |
| 5077 }; | |
| 5078 | |
| 5079 static Lisp_Object | |
| 5080 report_extent_modification_restore (Lisp_Object buffer) | |
| 5081 { | |
| 5082 if (current_buffer != XBUFFER (buffer)) | |
| 5083 Fset_buffer (buffer); | |
| 5084 return Qnil; | |
| 5085 } | |
| 5086 | |
| 5087 static int | |
| 5088 report_extent_modification_mapper (EXTENT extent, void *arg) | |
| 5089 { | |
| 5090 struct report_extent_modification_closure *closure = | |
| 5091 (struct report_extent_modification_closure *)arg; | |
| 5092 Lisp_Object exobj, startobj, endobj; | |
| 5093 Lisp_Object hook = (closure->afterp | |
| 5094 ? extent_after_change_functions (extent) | |
| 5095 : extent_before_change_functions (extent)); | |
| 5096 if (NILP (hook)) | |
| 5097 return 0; | |
| 5098 | |
| 793 | 5099 exobj = wrap_extent (extent); |
| 5100 startobj = make_int (closure->start); | |
| 5101 endobj = make_int (closure->end); | |
| 428 | 5102 |
| 5103 /* Now that we are sure to call elisp, set up an unwind-protect so | |
| 5104 inside_change_hook gets restored in case we throw. Also record | |
| 5105 the current buffer, in case we change it. Do the recording only | |
| 438 | 5106 once. |
| 5107 | |
| 5108 One confusing thing here is that our caller never actually calls | |
| 771 | 5109 unbind_to (closure.speccount). This is because |
| 826 | 5110 map_extents() unbinds before, and with a smaller |
| 771 | 5111 speccount. The additional unbind_to_1() in |
| 438 | 5112 report_extent_modification() would cause XEmacs to abort. */ |
| 428 | 5113 if (closure->speccount == -1) |
| 5114 { | |
| 5115 closure->speccount = specpdl_depth (); | |
| 5116 record_unwind_protect (report_extent_modification_restore, | |
| 5117 Fcurrent_buffer ()); | |
| 5118 } | |
| 5119 | |
| 5120 /* The functions will expect closure->buffer to be the current | |
| 5121 buffer, so change it if it isn't. */ | |
| 5122 if (current_buffer != XBUFFER (closure->buffer)) | |
| 5123 Fset_buffer (closure->buffer); | |
| 5124 | |
| 5125 /* #### It's a shame that we can't use any of the existing run_hook* | |
| 5126 functions here. This is so because all of them work with | |
| 5127 symbols, to be able to retrieve default values of local hooks. | |
| 438 | 5128 <sigh> |
| 5129 | |
| 5130 #### Idea: we could set up a dummy symbol, and call the hook | |
| 5131 functions on *that*. */ | |
| 428 | 5132 |
| 5133 if (!CONSP (hook) || EQ (XCAR (hook), Qlambda)) | |
| 5134 call3 (hook, exobj, startobj, endobj); | |
| 5135 else | |
| 5136 { | |
| 2367 | 5137 EXTERNAL_LIST_LOOP_2 (elt, hook) |
| 438 | 5138 /* #### Shouldn't this perform the same Fset_buffer() check as |
| 5139 above? */ | |
| 2367 | 5140 call3 (elt, exobj, startobj, endobj); |
| 428 | 5141 } |
| 5142 return 0; | |
| 5143 } | |
| 5144 | |
| 5145 void | |
| 665 | 5146 report_extent_modification (Lisp_Object buffer, Charbpos start, Charbpos end, |
| 438 | 5147 int afterp) |
| 428 | 5148 { |
| 5149 struct report_extent_modification_closure closure; | |
| 5150 | |
| 5151 closure.buffer = buffer; | |
| 5152 closure.start = start; | |
| 5153 closure.end = end; | |
| 5154 closure.afterp = afterp; | |
| 5155 closure.speccount = -1; | |
| 5156 | |
| 826 | 5157 map_extents (charbpos_to_bytebpos (XBUFFER (buffer), start), |
| 5158 charbpos_to_bytebpos (XBUFFER (buffer), end), | |
| 5159 report_extent_modification_mapper, (void *)&closure, | |
| 428 | 5160 buffer, NULL, ME_MIGHT_CALL_ELISP); |
| 5161 } | |
| 5162 | |
| 5163 | |
| 5164 /************************************************************************/ | |
| 5165 /* extent properties */ | |
| 5166 /************************************************************************/ | |
| 5167 | |
| 5168 static void | |
| 5169 set_extent_invisible (EXTENT extent, Lisp_Object value) | |
| 5170 { | |
| 5171 if (!EQ (extent_invisible (extent), value)) | |
| 5172 { | |
| 5173 set_extent_invisible_1 (extent, value); | |
| 826 | 5174 signal_extent_property_changed (extent, Qinvisible, 1); |
| 428 | 5175 } |
| 5176 } | |
| 5177 | |
| 5178 /* This function does "memoization" -- similar to the interning | |
| 5179 that happens with symbols. Given a list of faces, an equivalent | |
| 5180 list is returned such that if this function is called twice with | |
| 5181 input that is `equal', the resulting outputs will be `eq'. | |
| 5182 | |
| 5183 Note that the inputs and outputs are in general *not* `equal' -- | |
| 5184 faces in symbol form become actual face objects in the output. | |
| 5185 This is necessary so that temporary faces stay around. */ | |
| 5186 | |
| 5187 static Lisp_Object | |
| 5188 memoize_extent_face_internal (Lisp_Object list) | |
| 5189 { | |
| 5190 int len; | |
| 5191 int thelen; | |
| 5192 Lisp_Object cons, thecons; | |
| 5193 Lisp_Object oldtail, tail; | |
| 5194 struct gcpro gcpro1; | |
| 5195 | |
| 5196 if (NILP (list)) | |
| 5197 return Qnil; | |
| 5198 if (!CONSP (list)) | |
| 5199 return Fget_face (list); | |
| 5200 | |
| 5201 /* To do the memoization, we use a hash table mapping from | |
| 5202 external lists to internal lists. We do `equal' comparisons | |
| 5203 on the keys so the memoization works correctly. | |
| 5204 | |
| 5205 Note that we canonicalize things so that the keys in the | |
| 5206 hash table (the external lists) always contain symbols and | |
| 5207 the values (the internal lists) always contain face objects. | |
| 5208 | |
| 5209 We also maintain a "reverse" table that maps from the internal | |
| 5210 lists to the external equivalents. The idea here is twofold: | |
| 5211 | |
| 5212 1) `extent-face' wants to return a list containing face symbols | |
| 5213 rather than face objects. | |
| 5214 2) We don't want things to get quite so messed up if the user | |
| 5215 maliciously side-effects the returned lists. | |
| 5216 */ | |
| 5217 | |
| 5218 len = XINT (Flength (list)); | |
| 5219 thelen = XINT (Flength (Vextent_face_reusable_list)); | |
| 5220 oldtail = Qnil; | |
| 5221 tail = Qnil; | |
| 5222 GCPRO1 (oldtail); | |
| 5223 | |
| 5224 /* We canonicalize the given list into another list. | |
| 5225 We try to avoid consing except when necessary, so we have | |
| 5226 a reusable list. | |
| 5227 */ | |
| 5228 | |
| 5229 if (thelen < len) | |
| 5230 { | |
| 5231 cons = Vextent_face_reusable_list; | |
| 5232 while (!NILP (XCDR (cons))) | |
| 5233 cons = XCDR (cons); | |
| 5234 XCDR (cons) = Fmake_list (make_int (len - thelen), Qnil); | |
| 5235 } | |
| 5236 else if (thelen > len) | |
| 5237 { | |
| 5238 int i; | |
| 5239 | |
| 5240 /* Truncate the list temporarily so it's the right length; | |
| 5241 remember the old tail. */ | |
| 5242 cons = Vextent_face_reusable_list; | |
| 5243 for (i = 0; i < len - 1; i++) | |
| 5244 cons = XCDR (cons); | |
| 5245 tail = cons; | |
| 5246 oldtail = XCDR (cons); | |
| 5247 XCDR (cons) = Qnil; | |
| 5248 } | |
| 5249 | |
| 5250 thecons = Vextent_face_reusable_list; | |
| 2367 | 5251 { |
| 5252 EXTERNAL_LIST_LOOP_2 (face, list) | |
| 5253 { | |
| 5254 face = Fget_face (face); | |
| 5255 | |
| 5256 XCAR (thecons) = Fface_name (face); | |
| 5257 thecons = XCDR (thecons); | |
| 5258 } | |
| 5259 } | |
| 428 | 5260 |
| 5261 list = Fgethash (Vextent_face_reusable_list, Vextent_face_memoize_hash_table, | |
| 5262 Qnil); | |
| 5263 if (NILP (list)) | |
| 5264 { | |
| 5265 Lisp_Object symlist = Fcopy_sequence (Vextent_face_reusable_list); | |
| 5266 Lisp_Object facelist = Fcopy_sequence (Vextent_face_reusable_list); | |
| 5267 | |
| 5268 LIST_LOOP (cons, facelist) | |
| 5269 { | |
| 5270 XCAR (cons) = Fget_face (XCAR (cons)); | |
| 5271 } | |
| 5272 Fputhash (symlist, facelist, Vextent_face_memoize_hash_table); | |
| 5273 Fputhash (facelist, symlist, Vextent_face_reverse_memoize_hash_table); | |
| 5274 list = facelist; | |
| 5275 } | |
| 5276 | |
| 5277 /* Now restore the truncated tail of the reusable list, if necessary. */ | |
| 5278 if (!NILP (tail)) | |
| 5279 XCDR (tail) = oldtail; | |
| 5280 | |
| 5281 UNGCPRO; | |
| 5282 return list; | |
| 5283 } | |
| 5284 | |
| 5285 static Lisp_Object | |
| 5286 external_of_internal_memoized_face (Lisp_Object face) | |
| 5287 { | |
| 5288 if (NILP (face)) | |
| 5289 return Qnil; | |
| 5290 else if (!CONSP (face)) | |
| 5291 return XFACE (face)->name; | |
| 5292 else | |
| 5293 { | |
| 5294 face = Fgethash (face, Vextent_face_reverse_memoize_hash_table, | |
| 5295 Qunbound); | |
| 5296 assert (!UNBOUNDP (face)); | |
| 5297 return face; | |
| 5298 } | |
| 5299 } | |
| 5300 | |
| 826 | 5301 /* The idea here is that if we're given a list of faces, we |
| 5302 need to "memoize" this so that two lists of faces that are `equal' | |
| 5303 turn into the same object. When `set-extent-face' is called, we | |
| 5304 "memoize" into a list of actual faces; when `extent-face' is called, | |
| 5305 we do a reverse lookup to get the list of symbols. */ | |
| 5306 | |
| 428 | 5307 static Lisp_Object |
| 5308 canonicalize_extent_property (Lisp_Object prop, Lisp_Object value) | |
| 5309 { | |
| 5310 if (EQ (prop, Qface) || EQ (prop, Qmouse_face)) | |
| 5311 value = (external_of_internal_memoized_face | |
| 5312 (memoize_extent_face_internal (value))); | |
| 5313 return value; | |
| 5314 } | |
| 5315 | |
| 5316 /* Do we need a lisp-level function ? */ | |
| 826 | 5317 DEFUN ("set-extent-initial-redisplay-function", |
| 5318 Fset_extent_initial_redisplay_function, | |
| 444 | 5319 2,2,0, /* |
| 428 | 5320 Note: This feature is experimental! |
| 5321 | |
| 5322 Set initial-redisplay-function of EXTENT to the function | |
| 5323 FUNCTION. | |
| 5324 | |
| 5325 The first time the EXTENT is (re)displayed, an eval event will be | |
| 5326 dispatched calling FUNCTION with EXTENT as its only argument. | |
| 5327 */ | |
| 5328 (extent, function)) | |
| 5329 { | |
| 826 | 5330 /* #### This is totally broken. */ |
| 5331 EXTENT e = decode_extent (extent, DE_MUST_BE_ATTACHED); | |
| 428 | 5332 |
| 5333 e = extent_ancestor (e); /* Is this needed? Macro also does chasing!*/ | |
| 826 | 5334 set_extent_initial_redisplay_function (e, function); |
| 5335 extent_in_red_event_p (e) = 0; /* If the function changed we can spawn | |
| 428 | 5336 new events */ |
| 826 | 5337 signal_extent_property_changed (e, Qinitial_redisplay_function, 1); |
| 428 | 5338 return function; |
| 5339 } | |
| 5340 | |
| 5341 DEFUN ("extent-face", Fextent_face, 1, 1, 0, /* | |
| 5342 Return the name of the face in which EXTENT is displayed, or nil | |
| 5343 if the extent's face is unspecified. This might also return a list | |
| 5344 of face names. | |
| 5345 */ | |
| 5346 (extent)) | |
| 5347 { | |
| 5348 Lisp_Object face; | |
| 5349 | |
| 5350 CHECK_EXTENT (extent); | |
| 5351 face = extent_face (XEXTENT (extent)); | |
| 5352 | |
| 5353 return external_of_internal_memoized_face (face); | |
| 5354 } | |
| 5355 | |
| 5356 DEFUN ("set-extent-face", Fset_extent_face, 2, 2, 0, /* | |
| 5357 Make the given EXTENT have the graphic attributes specified by FACE. | |
| 5358 FACE can also be a list of faces, and all faces listed will apply, | |
| 5359 with faces earlier in the list taking priority over those later in the | |
| 5360 list. | |
| 5361 */ | |
| 5362 (extent, face)) | |
| 5363 { | |
| 5364 EXTENT e = decode_extent(extent, 0); | |
| 5365 Lisp_Object orig_face = face; | |
| 5366 | |
| 5367 /* retrieve the ancestor for efficiency and proper redisplay noting. */ | |
| 5368 e = extent_ancestor (e); | |
| 5369 | |
| 5370 face = memoize_extent_face_internal (face); | |
| 5371 | |
| 5372 extent_face (e) = face; | |
| 826 | 5373 signal_extent_property_changed (e, Qface, 1); |
| 428 | 5374 |
| 5375 return orig_face; | |
| 5376 } | |
| 5377 | |
| 5378 | |
| 5379 DEFUN ("extent-mouse-face", Fextent_mouse_face, 1, 1, 0, /* | |
| 5380 Return the face used to highlight EXTENT when the mouse passes over it. | |
| 5381 The return value will be a face name, a list of face names, or nil | |
| 5382 if the extent's mouse face is unspecified. | |
| 5383 */ | |
| 5384 (extent)) | |
| 5385 { | |
| 5386 Lisp_Object face; | |
| 5387 | |
| 5388 CHECK_EXTENT (extent); | |
| 5389 face = extent_mouse_face (XEXTENT (extent)); | |
| 5390 | |
| 5391 return external_of_internal_memoized_face (face); | |
| 5392 } | |
| 5393 | |
| 5394 DEFUN ("set-extent-mouse-face", Fset_extent_mouse_face, 2, 2, 0, /* | |
| 5395 Set the face used to highlight EXTENT when the mouse passes over it. | |
| 5396 FACE can also be a list of faces, and all faces listed will apply, | |
| 5397 with faces earlier in the list taking priority over those later in the | |
| 5398 list. | |
| 5399 */ | |
| 5400 (extent, face)) | |
| 5401 { | |
| 5402 EXTENT e; | |
| 5403 Lisp_Object orig_face = face; | |
| 5404 | |
| 5405 CHECK_EXTENT (extent); | |
| 5406 e = XEXTENT (extent); | |
| 5407 /* retrieve the ancestor for efficiency and proper redisplay noting. */ | |
| 5408 e = extent_ancestor (e); | |
| 5409 | |
| 5410 face = memoize_extent_face_internal (face); | |
| 5411 | |
| 5412 set_extent_mouse_face (e, face); | |
| 826 | 5413 signal_extent_property_changed (e, Qmouse_face, 1); |
| 428 | 5414 |
| 5415 return orig_face; | |
| 5416 } | |
| 5417 | |
| 5418 void | |
| 5419 set_extent_glyph (EXTENT extent, Lisp_Object glyph, int endp, | |
| 5420 glyph_layout layout) | |
| 5421 { | |
| 5422 extent = extent_ancestor (extent); | |
| 5423 | |
| 5424 if (!endp) | |
| 5425 { | |
| 5426 set_extent_begin_glyph (extent, glyph); | |
| 647 | 5427 set_extent_begin_glyph_layout (extent, layout); |
| 826 | 5428 signal_extent_property_changed (extent, Qbegin_glyph, 1); |
| 5429 signal_extent_property_changed (extent, Qbegin_glyph_layout, 1); | |
| 428 | 5430 } |
| 5431 else | |
| 5432 { | |
| 5433 set_extent_end_glyph (extent, glyph); | |
| 647 | 5434 set_extent_end_glyph_layout (extent, layout); |
| 826 | 5435 signal_extent_property_changed (extent, Qend_glyph, 1); |
| 5436 signal_extent_property_changed (extent, Qend_glyph_layout, 1); | |
| 428 | 5437 } |
| 5438 } | |
| 5439 | |
| 5440 static Lisp_Object | |
| 5441 glyph_layout_to_symbol (glyph_layout layout) | |
| 5442 { | |
| 5443 switch (layout) | |
| 5444 { | |
| 5445 case GL_TEXT: return Qtext; | |
| 5446 case GL_OUTSIDE_MARGIN: return Qoutside_margin; | |
| 5447 case GL_INSIDE_MARGIN: return Qinside_margin; | |
| 5448 case GL_WHITESPACE: return Qwhitespace; | |
| 5449 default: | |
| 2500 | 5450 ABORT (); |
| 428 | 5451 return Qnil; /* unreached */ |
| 5452 } | |
| 5453 } | |
| 5454 | |
| 5455 static glyph_layout | |
| 5456 symbol_to_glyph_layout (Lisp_Object layout_obj) | |
| 5457 { | |
| 5458 if (NILP (layout_obj)) | |
| 5459 return GL_TEXT; | |
| 5460 | |
| 5461 CHECK_SYMBOL (layout_obj); | |
| 5462 if (EQ (layout_obj, Qoutside_margin)) return GL_OUTSIDE_MARGIN; | |
| 5463 if (EQ (layout_obj, Qinside_margin)) return GL_INSIDE_MARGIN; | |
| 5464 if (EQ (layout_obj, Qwhitespace)) return GL_WHITESPACE; | |
| 5465 if (EQ (layout_obj, Qtext)) return GL_TEXT; | |
| 5466 | |
| 563 | 5467 invalid_constant ("Unknown glyph layout type", layout_obj); |
| 1204 | 5468 RETURN_NOT_REACHED (GL_TEXT); |
| 428 | 5469 } |
| 5470 | |
| 5471 static Lisp_Object | |
| 5472 set_extent_glyph_1 (Lisp_Object extent_obj, Lisp_Object glyph, int endp, | |
| 5473 Lisp_Object layout_obj) | |
| 5474 { | |
| 442 | 5475 EXTENT extent = decode_extent (extent_obj, 0); |
| 428 | 5476 glyph_layout layout = symbol_to_glyph_layout (layout_obj); |
| 5477 | |
| 5478 /* Make sure we've actually been given a valid glyph or it's nil | |
| 5479 (meaning we're deleting a glyph from an extent). */ | |
| 5480 if (!NILP (glyph)) | |
| 5481 CHECK_BUFFER_GLYPH (glyph); | |
| 5482 | |
| 5483 set_extent_glyph (extent, glyph, endp, layout); | |
| 5484 return glyph; | |
| 5485 } | |
| 5486 | |
| 5487 DEFUN ("set-extent-begin-glyph", Fset_extent_begin_glyph, 2, 3, 0, /* | |
| 5488 Display a bitmap, subwindow or string at the beginning of EXTENT. | |
| 5489 BEGIN-GLYPH must be a glyph object. The layout policy defaults to `text'. | |
| 5490 */ | |
| 5491 (extent, begin_glyph, layout)) | |
| 5492 { | |
| 5493 return set_extent_glyph_1 (extent, begin_glyph, 0, layout); | |
| 5494 } | |
| 5495 | |
| 5496 DEFUN ("set-extent-end-glyph", Fset_extent_end_glyph, 2, 3, 0, /* | |
| 5497 Display a bitmap, subwindow or string at the end of EXTENT. | |
| 5498 END-GLYPH must be a glyph object. The layout policy defaults to `text'. | |
| 5499 */ | |
| 5500 (extent, end_glyph, layout)) | |
| 5501 { | |
| 5502 return set_extent_glyph_1 (extent, end_glyph, 1, layout); | |
| 5503 } | |
| 5504 | |
| 5505 DEFUN ("extent-begin-glyph", Fextent_begin_glyph, 1, 1, 0, /* | |
| 5506 Return the glyph object displayed at the beginning of EXTENT. | |
| 5507 If there is none, nil is returned. | |
| 5508 */ | |
| 5509 (extent)) | |
| 5510 { | |
| 5511 return extent_begin_glyph (decode_extent (extent, 0)); | |
| 5512 } | |
| 5513 | |
| 5514 DEFUN ("extent-end-glyph", Fextent_end_glyph, 1, 1, 0, /* | |
| 5515 Return the glyph object displayed at the end of EXTENT. | |
| 5516 If there is none, nil is returned. | |
| 5517 */ | |
| 5518 (extent)) | |
| 5519 { | |
| 5520 return extent_end_glyph (decode_extent (extent, 0)); | |
| 5521 } | |
| 5522 | |
| 5523 DEFUN ("set-extent-begin-glyph-layout", Fset_extent_begin_glyph_layout, 2, 2, 0, /* | |
| 5524 Set the layout policy of EXTENT's begin glyph. | |
| 5525 Access this using the `extent-begin-glyph-layout' function. | |
| 5526 */ | |
| 5527 (extent, layout)) | |
| 5528 { | |
| 5529 EXTENT e = decode_extent (extent, 0); | |
| 5530 e = extent_ancestor (e); | |
| 647 | 5531 set_extent_begin_glyph_layout (e, symbol_to_glyph_layout (layout)); |
| 826 | 5532 signal_extent_property_changed (e, Qbegin_glyph_layout, 1); |
| 428 | 5533 return layout; |
| 5534 } | |
| 5535 | |
| 5536 DEFUN ("set-extent-end-glyph-layout", Fset_extent_end_glyph_layout, 2, 2, 0, /* | |
| 5537 Set the layout policy of EXTENT's end glyph. | |
| 5538 Access this using the `extent-end-glyph-layout' function. | |
| 5539 */ | |
| 5540 (extent, layout)) | |
| 5541 { | |
| 5542 EXTENT e = decode_extent (extent, 0); | |
| 5543 e = extent_ancestor (e); | |
| 647 | 5544 set_extent_end_glyph_layout (e, symbol_to_glyph_layout (layout)); |
| 826 | 5545 signal_extent_property_changed (e, Qend_glyph_layout, 1); |
| 428 | 5546 return layout; |
| 5547 } | |
| 5548 | |
| 5549 DEFUN ("extent-begin-glyph-layout", Fextent_begin_glyph_layout, 1, 1, 0, /* | |
| 5550 Return the layout policy associated with EXTENT's begin glyph. | |
| 5551 Set this using the `set-extent-begin-glyph-layout' function. | |
| 5552 */ | |
| 5553 (extent)) | |
| 5554 { | |
| 5555 EXTENT e = decode_extent (extent, 0); | |
| 5556 return glyph_layout_to_symbol ((glyph_layout) extent_begin_glyph_layout (e)); | |
| 5557 } | |
| 5558 | |
| 5559 DEFUN ("extent-end-glyph-layout", Fextent_end_glyph_layout, 1, 1, 0, /* | |
| 5560 Return the layout policy associated with EXTENT's end glyph. | |
| 5561 Set this using the `set-extent-end-glyph-layout' function. | |
| 5562 */ | |
| 5563 (extent)) | |
| 5564 { | |
| 5565 EXTENT e = decode_extent (extent, 0); | |
| 5566 return glyph_layout_to_symbol ((glyph_layout) extent_end_glyph_layout (e)); | |
| 5567 } | |
| 5568 | |
| 5569 DEFUN ("set-extent-priority", Fset_extent_priority, 2, 2, 0, /* | |
| 5570 Set the display priority of EXTENT to PRIORITY (an integer). | |
| 5571 When the extent attributes are being merged for display, the priority | |
| 5572 is used to determine which extent takes precedence in the event of a | |
| 5573 conflict (two extents whose faces both specify font, for example: the | |
| 5574 font of the extent with the higher priority will be used). | |
| 5575 Extents are created with priority 0; priorities may be negative. | |
| 5576 */ | |
| 5577 (extent, priority)) | |
| 5578 { | |
| 5579 EXTENT e = decode_extent (extent, 0); | |
| 5580 | |
| 5581 CHECK_INT (priority); | |
| 5582 e = extent_ancestor (e); | |
| 5583 set_extent_priority (e, XINT (priority)); | |
| 826 | 5584 signal_extent_property_changed (e, Qpriority, 1); |
| 428 | 5585 return priority; |
| 5586 } | |
| 5587 | |
| 5588 DEFUN ("extent-priority", Fextent_priority, 1, 1, 0, /* | |
| 5589 Return the display priority of EXTENT; see `set-extent-priority'. | |
| 5590 */ | |
| 5591 (extent)) | |
| 5592 { | |
| 5593 EXTENT e = decode_extent (extent, 0); | |
| 5594 return make_int (extent_priority (e)); | |
| 5595 } | |
| 5596 | |
| 5597 DEFUN ("set-extent-property", Fset_extent_property, 3, 3, 0, /* | |
| 5598 Change a property of an extent. | |
| 5599 PROPERTY may be any symbol; the value stored may be accessed with | |
| 5600 the `extent-property' function. | |
| 2758 | 5601 |
| 428 | 5602 The following symbols have predefined meanings: |
| 5603 | |
| 5604 detached Removes the extent from its buffer; setting this is | |
| 5605 the same as calling `detach-extent'. | |
| 5606 | |
| 5607 destroyed Removes the extent from its buffer, and makes it | |
| 5608 unusable in the future; this is the same calling | |
| 5609 `delete-extent'. | |
| 5610 | |
| 5611 priority Change redisplay priority; same as `set-extent-priority'. | |
| 5612 | |
| 5613 start-open Whether the set of characters within the extent is | |
| 5614 treated being open on the left, that is, whether | |
| 5615 the start position is an exclusive, rather than | |
| 5616 inclusive, boundary. If true, then characters | |
| 5617 inserted exactly at the beginning of the extent | |
| 5618 will remain outside of the extent; otherwise they | |
| 5619 will go into the extent, extending it. | |
| 5620 | |
| 5621 end-open Whether the set of characters within the extent is | |
| 5622 treated being open on the right, that is, whether | |
| 5623 the end position is an exclusive, rather than | |
| 5624 inclusive, boundary. If true, then characters | |
| 5625 inserted exactly at the end of the extent will | |
| 5626 remain outside of the extent; otherwise they will | |
| 5627 go into the extent, extending it. | |
| 5628 | |
| 5629 By default, extents have the `end-open' but not the | |
| 5630 `start-open' property set. | |
| 5631 | |
| 5632 read-only Text within this extent will be unmodifiable. | |
| 5633 | |
| 5634 initial-redisplay-function (EXPERIMENTAL) | |
| 5635 function to be called the first time (part of) the extent | |
| 5636 is redisplayed. It will be called with the extent as its | |
| 5637 first argument. | |
| 1041 | 5638 Note: The function will not be called immediately |
| 5639 during redisplay, an eval event will be dispatched. | |
| 428 | 5640 |
| 5641 detachable Whether the extent gets detached (as with | |
| 5642 `detach-extent') when all the text within the | |
| 5643 extent is deleted. This is true by default. If | |
| 5644 this property is not set, the extent becomes a | |
| 5645 zero-length extent when its text is deleted. (In | |
| 5646 such a case, the `start-open' property is | |
| 5647 automatically removed if both the `start-open' and | |
| 5648 `end-open' properties are set, since zero-length | |
| 5649 extents open on both ends are not allowed.) | |
| 5650 | |
| 5651 face The face in which to display the text. Setting | |
| 5652 this is the same as calling `set-extent-face'. | |
| 5653 | |
| 1041 | 5654 mouse-face If non-nil, the extent will be highlighted in this |
| 5655 face when the mouse moves over it. | |
| 428 | 5656 |
| 5657 pointer If non-nil, and a valid pointer glyph, this specifies | |
| 5658 the shape of the mouse pointer while over the extent. | |
| 5659 | |
| 5660 highlight Obsolete: Setting this property is equivalent to | |
| 1041 | 5661 setting a `mouse-face' property of `highlight'. |
| 5662 Reading this property returns non-nil if | |
| 5663 the extent has a non-nil `mouse-face' property. | |
| 428 | 5664 |
| 5665 duplicable Whether this extent should be copied into strings, | |
| 5666 so that kill, yank, and undo commands will restore | |
| 5667 or copy it. `duplicable' extents are copied from | |
| 5668 an extent into a string when `buffer-substring' or | |
| 5669 a similar function creates a string. The extents | |
| 5670 in a string are copied into other strings created | |
| 5671 from the string using `concat' or `substring'. | |
| 5672 When `insert' or a similar function inserts the | |
| 5673 string into a buffer, the extents are copied back | |
| 5674 into the buffer. | |
| 5675 | |
| 5676 unique Meaningful only in conjunction with `duplicable'. | |
| 5677 When this is set, there may be only one instance | |
| 5678 of this extent attached at a time: if it is copied | |
| 5679 to the kill ring and then yanked, the extent is | |
| 5680 not copied. If, however, it is killed (removed | |
| 5681 from the buffer) and then yanked, it will be | |
| 5682 re-attached at the new position. | |
| 5683 | |
| 5684 invisible If the value is non-nil, text under this extent | |
| 5685 may be treated as not present for the purpose of | |
| 5686 redisplay, or may be displayed using an ellipsis | |
| 5687 or other marker; see `buffer-invisibility-spec' | |
| 5688 and `invisible-text-glyph'. In all cases, | |
| 5689 however, the text is still visible to other | |
| 5690 functions that examine a buffer's text. | |
| 5691 | |
| 5692 keymap This keymap is consulted for mouse clicks on this | |
| 5693 extent, or keypresses made while point is within the | |
| 5694 extent. | |
| 5695 | |
| 5696 copy-function This is a hook that is run when a duplicable extent | |
| 5697 is about to be copied from a buffer to a string (or | |
| 5698 the kill ring). It is called with three arguments, | |
| 5699 the extent, and the buffer-positions within it | |
| 5700 which are being copied. If this function returns | |
| 5701 nil, then the extent will not be copied; otherwise | |
| 5702 it will. | |
| 5703 | |
| 5704 paste-function This is a hook that is run when a duplicable extent is | |
| 5705 about to be copied from a string (or the kill ring) | |
| 5706 into a buffer. It is called with three arguments, | |
| 5707 the original extent, and the buffer positions which | |
| 5708 the copied extent will occupy. (This hook is run | |
| 5709 after the corresponding text has already been | |
| 5710 inserted into the buffer.) Note that the extent | |
| 5711 argument may be detached when this function is run. | |
| 5712 If this function returns nil, no extent will be | |
| 5713 inserted. Otherwise, there will be an extent | |
| 5714 covering the range in question. | |
| 5715 | |
| 5716 If the original extent is not attached to a buffer, | |
| 5717 then it will be re-attached at this range. | |
| 5718 Otherwise, a copy will be made, and that copy | |
| 5719 attached here. | |
| 5720 | |
| 5721 The copy-function and paste-function are meaningful | |
| 5722 only for extents with the `duplicable' flag set, | |
| 5723 and if they are not specified, behave as if `t' was | |
| 5724 the returned value. When these hooks are invoked, | |
| 5725 the current buffer is the buffer which the extent | |
| 5726 is being copied from/to, respectively. | |
| 5727 | |
| 5728 begin-glyph A glyph to be displayed at the beginning of the extent, | |
| 5729 or nil. | |
| 5730 | |
| 5731 end-glyph A glyph to be displayed at the end of the extent, | |
| 5732 or nil. | |
| 5733 | |
| 5734 begin-glyph-layout The layout policy (one of `text', `whitespace', | |
| 5735 `inside-margin', or `outside-margin') of the extent's | |
| 5736 begin glyph. | |
| 5737 | |
| 1041 | 5738 end-glyph-layout The layout policy of the extent's end glyph. |
| 5739 | |
| 5740 syntax-table A cons or a syntax table object. If a cons, the car must | |
| 2767 | 5741 be an integer (interpreted as a syntax code, applicable |
| 5742 to all characters in the extent). Otherwise, syntax of | |
| 5743 characters in the extent is looked up in the syntax | |
| 5744 table. You should use the text property API to | |
| 5745 manipulate this property. (This may be required in the | |
| 5746 future.) | |
| 5747 | |
| 5748 The following property is available if `atomic-extents.el'--part of the | |
| 5749 `edit-utils' package--has been loaded: | |
| 2758 | 5750 |
| 5751 atomic When set, point will never fall inside the extent. | |
| 5752 Not as useful as you might think, as | |
| 5753 `delete-backward-char' still removes characters one by | |
| 2767 | 5754 one. This property as currently implemented is a |
| 5755 kludge, and be prepared for it to go away if and when we | |
| 5756 implement something better. | |
| 2758 | 5757 |
| 428 | 5758 */ |
| 5759 (extent, property, value)) | |
| 5760 { | |
| 5761 /* This function can GC if property is `keymap' */ | |
| 5762 EXTENT e = decode_extent (extent, 0); | |
| 826 | 5763 int signal_change = 0; |
| 5764 | |
| 5765 /* If VALUE is unbound, the property is being removed through `remprop'. | |
| 5766 Return Qunbound if removal disallowed, Qt if anything removed, | |
| 5767 Qnil otherwise. */ | |
| 5768 | |
| 5769 /* Keep in synch with stuff below. */ | |
| 5770 if (UNBOUNDP (value)) | |
| 5771 { | |
| 5772 int retval; | |
| 5773 | |
| 5774 if (EQ (property, Qread_only) | |
| 5775 || EQ (property, Qunique) | |
| 5776 || EQ (property, Qduplicable) | |
| 5777 || EQ (property, Qinvisible) | |
| 5778 || EQ (property, Qdetachable) | |
| 5779 || EQ (property, Qdetached) | |
| 5780 || EQ (property, Qdestroyed) | |
| 5781 || EQ (property, Qpriority) | |
| 5782 || EQ (property, Qface) | |
| 5783 || EQ (property, Qinitial_redisplay_function) | |
| 5784 || EQ (property, Qafter_change_functions) | |
| 5785 || EQ (property, Qbefore_change_functions) | |
| 5786 || EQ (property, Qmouse_face) | |
| 5787 || EQ (property, Qhighlight) | |
| 5788 || EQ (property, Qbegin_glyph_layout) | |
| 5789 || EQ (property, Qend_glyph_layout) | |
| 5790 || EQ (property, Qglyph_layout) | |
| 5791 || EQ (property, Qbegin_glyph) | |
| 5792 || EQ (property, Qend_glyph) | |
| 5793 || EQ (property, Qstart_open) | |
| 5794 || EQ (property, Qend_open) | |
| 5795 || EQ (property, Qstart_closed) | |
| 5796 || EQ (property, Qend_closed) | |
| 5797 || EQ (property, Qkeymap)) | |
| 5798 return Qunbound; | |
| 5799 | |
| 5800 retval = external_remprop (extent_plist_addr (e), property, 0, | |
| 5801 ERROR_ME); | |
| 5802 if (retval) | |
| 5803 signal_extent_property_changed (e, property, 1); | |
| 5804 return retval ? Qt : Qnil; | |
| 5805 } | |
| 428 | 5806 |
| 5807 if (EQ (property, Qread_only)) | |
| 826 | 5808 { |
| 5809 set_extent_read_only (e, value); | |
| 5810 signal_change = 1; | |
| 5811 } | |
| 428 | 5812 else if (EQ (property, Qunique)) |
| 826 | 5813 { |
| 5814 extent_unique_p (e) = !NILP (value); | |
| 5815 signal_change = 1; | |
| 5816 } | |
| 428 | 5817 else if (EQ (property, Qduplicable)) |
| 826 | 5818 { |
| 5819 extent_duplicable_p (e) = !NILP (value); | |
| 5820 signal_change = 1; | |
| 5821 } | |
| 428 | 5822 else if (EQ (property, Qinvisible)) |
| 5823 set_extent_invisible (e, value); | |
| 5824 else if (EQ (property, Qdetachable)) | |
| 826 | 5825 { |
| 5826 extent_detachable_p (e) = !NILP (value); | |
| 5827 signal_change = 1; | |
| 5828 } | |
| 428 | 5829 else if (EQ (property, Qdetached)) |
| 5830 { | |
| 5831 if (NILP (value)) | |
| 826 | 5832 invalid_operation ("can only set `detached' to t", Qunbound); |
| 428 | 5833 Fdetach_extent (extent); |
| 5834 } | |
| 5835 else if (EQ (property, Qdestroyed)) | |
| 5836 { | |
| 5837 if (NILP (value)) | |
| 826 | 5838 invalid_operation ("can only set `destroyed' to t", Qunbound); |
| 428 | 5839 Fdelete_extent (extent); |
| 5840 } | |
| 5841 else if (EQ (property, Qpriority)) | |
| 5842 Fset_extent_priority (extent, value); | |
| 5843 else if (EQ (property, Qface)) | |
| 5844 Fset_extent_face (extent, value); | |
| 5845 else if (EQ (property, Qinitial_redisplay_function)) | |
| 5846 Fset_extent_initial_redisplay_function (extent, value); | |
| 5847 else if (EQ (property, Qbefore_change_functions)) | |
| 826 | 5848 { |
| 5849 set_extent_before_change_functions (e, value); | |
| 5850 signal_change = 1; | |
| 5851 } | |
| 428 | 5852 else if (EQ (property, Qafter_change_functions)) |
| 826 | 5853 { |
| 5854 set_extent_after_change_functions (e, value); | |
| 5855 signal_change = 1; | |
| 5856 } | |
| 428 | 5857 else if (EQ (property, Qmouse_face)) |
| 5858 Fset_extent_mouse_face (extent, value); | |
| 5859 /* Obsolete: */ | |
| 5860 else if (EQ (property, Qhighlight)) | |
| 5861 Fset_extent_mouse_face (extent, Qhighlight); | |
| 5862 else if (EQ (property, Qbegin_glyph_layout)) | |
| 5863 Fset_extent_begin_glyph_layout (extent, value); | |
| 5864 else if (EQ (property, Qend_glyph_layout)) | |
| 5865 Fset_extent_end_glyph_layout (extent, value); | |
| 5866 /* For backwards compatibility. We use begin glyph because it is by | |
| 5867 far the more used of the two. */ | |
| 5868 else if (EQ (property, Qglyph_layout)) | |
| 5869 Fset_extent_begin_glyph_layout (extent, value); | |
| 5870 else if (EQ (property, Qbegin_glyph)) | |
| 5871 Fset_extent_begin_glyph (extent, value, Qnil); | |
| 5872 else if (EQ (property, Qend_glyph)) | |
| 5873 Fset_extent_end_glyph (extent, value, Qnil); | |
| 5874 else if (EQ (property, Qstart_open)) | |
| 5875 set_extent_openness (e, !NILP (value), -1); | |
| 5876 else if (EQ (property, Qend_open)) | |
| 5877 set_extent_openness (e, -1, !NILP (value)); | |
| 5878 /* Support (but don't document...) the obvious *_closed antonyms. */ | |
| 5879 else if (EQ (property, Qstart_closed)) | |
| 5880 set_extent_openness (e, NILP (value), -1); | |
| 5881 else if (EQ (property, Qend_closed)) | |
| 5882 set_extent_openness (e, -1, NILP (value)); | |
| 5883 else | |
| 5884 { | |
| 5885 if (EQ (property, Qkeymap)) | |
| 5886 while (!NILP (value) && NILP (Fkeymapp (value))) | |
| 5887 value = wrong_type_argument (Qkeymapp, value); | |
| 5888 | |
| 5889 external_plist_put (extent_plist_addr (e), property, value, 0, ERROR_ME); | |
| 826 | 5890 signal_change = 1; |
| 428 | 5891 } |
| 5892 | |
| 826 | 5893 if (signal_change) |
| 5894 signal_extent_property_changed (e, property, 1); | |
| 428 | 5895 return value; |
| 5896 } | |
| 5897 | |
| 5898 DEFUN ("set-extent-properties", Fset_extent_properties, 2, 2, 0, /* | |
| 5899 Change some properties of EXTENT. | |
| 5900 PLIST is a property list. | |
| 5901 For a list of built-in properties, see `set-extent-property'. | |
| 5902 */ | |
| 5903 (extent, plist)) | |
| 5904 { | |
| 5905 /* This function can GC, if one of the properties is `keymap' */ | |
| 5906 Lisp_Object property, value; | |
| 5907 struct gcpro gcpro1; | |
| 5908 GCPRO1 (plist); | |
| 5909 | |
| 5910 plist = Fcopy_sequence (plist); | |
| 5911 Fcanonicalize_plist (plist, Qnil); | |
| 5912 | |
| 5913 while (!NILP (plist)) | |
| 5914 { | |
| 5915 property = Fcar (plist); plist = Fcdr (plist); | |
| 5916 value = Fcar (plist); plist = Fcdr (plist); | |
| 5917 Fset_extent_property (extent, property, value); | |
| 5918 } | |
| 5919 UNGCPRO; | |
| 5920 return Qnil; | |
| 5921 } | |
| 5922 | |
| 5923 DEFUN ("extent-property", Fextent_property, 2, 3, 0, /* | |
| 5924 Return EXTENT's value for property PROPERTY. | |
| 444 | 5925 If no such property exists, DEFAULT is returned. |
| 428 | 5926 See `set-extent-property' for the built-in property names. |
| 5927 */ | |
| 5928 (extent, property, default_)) | |
| 5929 { | |
| 5930 EXTENT e = decode_extent (extent, 0); | |
| 5931 | |
| 5932 if (EQ (property, Qdetached)) | |
| 5933 return extent_detached_p (e) ? Qt : Qnil; | |
| 5934 else if (EQ (property, Qdestroyed)) | |
| 5935 return !EXTENT_LIVE_P (e) ? Qt : Qnil; | |
| 5936 else if (EQ (property, Qstart_open)) | |
| 5937 return extent_normal_field (e, start_open) ? Qt : Qnil; | |
| 5938 else if (EQ (property, Qend_open)) | |
| 5939 return extent_normal_field (e, end_open) ? Qt : Qnil; | |
| 5940 else if (EQ (property, Qunique)) | |
| 5941 return extent_normal_field (e, unique) ? Qt : Qnil; | |
| 5942 else if (EQ (property, Qduplicable)) | |
| 5943 return extent_normal_field (e, duplicable) ? Qt : Qnil; | |
| 5944 else if (EQ (property, Qdetachable)) | |
| 5945 return extent_normal_field (e, detachable) ? Qt : Qnil; | |
| 5946 /* Support (but don't document...) the obvious *_closed antonyms. */ | |
| 5947 else if (EQ (property, Qstart_closed)) | |
| 5948 return extent_start_open_p (e) ? Qnil : Qt; | |
| 5949 else if (EQ (property, Qend_closed)) | |
| 5950 return extent_end_open_p (e) ? Qnil : Qt; | |
| 5951 else if (EQ (property, Qpriority)) | |
| 5952 return make_int (extent_priority (e)); | |
| 5953 else if (EQ (property, Qread_only)) | |
| 5954 return extent_read_only (e); | |
| 5955 else if (EQ (property, Qinvisible)) | |
| 5956 return extent_invisible (e); | |
| 5957 else if (EQ (property, Qface)) | |
| 5958 return Fextent_face (extent); | |
| 5959 else if (EQ (property, Qinitial_redisplay_function)) | |
| 5960 return extent_initial_redisplay_function (e); | |
| 5961 else if (EQ (property, Qbefore_change_functions)) | |
| 5962 return extent_before_change_functions (e); | |
| 5963 else if (EQ (property, Qafter_change_functions)) | |
| 5964 return extent_after_change_functions (e); | |
| 5965 else if (EQ (property, Qmouse_face)) | |
| 5966 return Fextent_mouse_face (extent); | |
| 5967 /* Obsolete: */ | |
| 5968 else if (EQ (property, Qhighlight)) | |
| 5969 return !NILP (Fextent_mouse_face (extent)) ? Qt : Qnil; | |
| 5970 else if (EQ (property, Qbegin_glyph_layout)) | |
| 5971 return Fextent_begin_glyph_layout (extent); | |
| 5972 else if (EQ (property, Qend_glyph_layout)) | |
| 5973 return Fextent_end_glyph_layout (extent); | |
| 5974 /* For backwards compatibility. We use begin glyph because it is by | |
| 5975 far the more used of the two. */ | |
| 5976 else if (EQ (property, Qglyph_layout)) | |
| 5977 return Fextent_begin_glyph_layout (extent); | |
| 5978 else if (EQ (property, Qbegin_glyph)) | |
| 5979 return extent_begin_glyph (e); | |
| 5980 else if (EQ (property, Qend_glyph)) | |
| 5981 return extent_end_glyph (e); | |
| 5982 else | |
| 5983 { | |
| 5984 Lisp_Object value = external_plist_get (extent_plist_addr (e), | |
| 5985 property, 0, ERROR_ME); | |
| 5986 return UNBOUNDP (value) ? default_ : value; | |
| 5987 } | |
| 5988 } | |
| 5989 | |
| 826 | 5990 static void |
| 5991 extent_properties (EXTENT e, Lisp_Object_pair_dynarr *props) | |
| 5992 { | |
| 5993 Lisp_Object face, anc_obj; | |
| 428 | 5994 glyph_layout layout; |
| 826 | 5995 EXTENT anc; |
| 5996 | |
| 5997 #define ADD_PROP(miftaaH, maal) \ | |
| 5998 do { \ | |
| 5999 Lisp_Object_pair p; \ | |
| 6000 p.key = miftaaH; \ | |
| 6001 p.value = maal; \ | |
| 6002 Dynarr_add (props, p); \ | |
| 6003 } while (0) | |
| 6004 | |
| 428 | 6005 if (!EXTENT_LIVE_P (e)) |
| 826 | 6006 { |
| 6007 ADD_PROP (Qdestroyed, Qt); | |
| 6008 return; | |
| 6009 } | |
| 428 | 6010 |
| 6011 anc = extent_ancestor (e); | |
| 793 | 6012 anc_obj = wrap_extent (anc); |
| 428 | 6013 |
| 6014 /* For efficiency, use the ancestor for all properties except detached */ | |
| 826 | 6015 { |
| 6016 EXTERNAL_PROPERTY_LIST_LOOP_3 (key, value, extent_plist_slot (anc)) | |
| 6017 ADD_PROP (key, value); | |
| 6018 } | |
| 428 | 6019 |
| 6020 if (!NILP (face = Fextent_face (anc_obj))) | |
| 826 | 6021 ADD_PROP (Qface, face); |
| 428 | 6022 |
| 6023 if (!NILP (face = Fextent_mouse_face (anc_obj))) | |
| 826 | 6024 ADD_PROP (Qmouse_face, face); |
| 428 | 6025 |
| 6026 if ((layout = (glyph_layout) extent_begin_glyph_layout (anc)) != GL_TEXT) | |
| 6027 { | |
| 6028 Lisp_Object sym = glyph_layout_to_symbol (layout); | |
| 826 | 6029 ADD_PROP (Qglyph_layout, sym); /* compatibility */ |
| 6030 ADD_PROP (Qbegin_glyph_layout, sym); | |
| 428 | 6031 } |
| 6032 | |
| 6033 if ((layout = (glyph_layout) extent_end_glyph_layout (anc)) != GL_TEXT) | |
| 826 | 6034 ADD_PROP (Qend_glyph_layout, glyph_layout_to_symbol (layout)); |
| 428 | 6035 |
| 6036 if (!NILP (extent_end_glyph (anc))) | |
| 826 | 6037 ADD_PROP (Qend_glyph, extent_end_glyph (anc)); |
| 428 | 6038 |
| 6039 if (!NILP (extent_begin_glyph (anc))) | |
| 826 | 6040 ADD_PROP (Qbegin_glyph, extent_begin_glyph (anc)); |
| 428 | 6041 |
| 6042 if (extent_priority (anc) != 0) | |
| 826 | 6043 ADD_PROP (Qpriority, make_int (extent_priority (anc))); |
| 428 | 6044 |
| 6045 if (!NILP (extent_initial_redisplay_function (anc))) | |
| 826 | 6046 ADD_PROP (Qinitial_redisplay_function, |
| 6047 extent_initial_redisplay_function (anc)); | |
| 428 | 6048 |
| 6049 if (!NILP (extent_before_change_functions (anc))) | |
| 826 | 6050 ADD_PROP (Qbefore_change_functions, extent_before_change_functions (anc)); |
| 428 | 6051 |
| 6052 if (!NILP (extent_after_change_functions (anc))) | |
| 826 | 6053 ADD_PROP (Qafter_change_functions, extent_after_change_functions (anc)); |
| 428 | 6054 |
| 6055 if (!NILP (extent_invisible (anc))) | |
| 826 | 6056 ADD_PROP (Qinvisible, extent_invisible (anc)); |
| 428 | 6057 |
| 6058 if (!NILP (extent_read_only (anc))) | |
| 826 | 6059 ADD_PROP (Qread_only, extent_read_only (anc)); |
| 428 | 6060 |
| 6061 if (extent_normal_field (anc, end_open)) | |
| 826 | 6062 ADD_PROP (Qend_open, Qt); |
| 428 | 6063 |
| 6064 if (extent_normal_field (anc, start_open)) | |
| 826 | 6065 ADD_PROP (Qstart_open, Qt); |
| 428 | 6066 |
| 6067 if (extent_normal_field (anc, detachable)) | |
| 826 | 6068 ADD_PROP (Qdetachable, Qt); |
| 428 | 6069 |
| 6070 if (extent_normal_field (anc, duplicable)) | |
| 826 | 6071 ADD_PROP (Qduplicable, Qt); |
| 428 | 6072 |
| 6073 if (extent_normal_field (anc, unique)) | |
| 826 | 6074 ADD_PROP (Qunique, Qt); |
| 428 | 6075 |
| 6076 /* detached is not an inherited property */ | |
| 6077 if (extent_detached_p (e)) | |
| 826 | 6078 ADD_PROP (Qdetached, Qt); |
| 6079 | |
| 6080 #undef ADD_PROP | |
| 6081 } | |
| 6082 | |
| 6083 DEFUN ("extent-properties", Fextent_properties, 1, 1, 0, /* | |
| 6084 Return a property list of the attributes of EXTENT. | |
| 6085 Do not modify this list; use `set-extent-property' instead. | |
| 6086 */ | |
| 6087 (extent)) | |
| 6088 { | |
| 6089 EXTENT e; | |
| 6090 Lisp_Object result = Qnil; | |
| 6091 Lisp_Object_pair_dynarr *props; | |
| 6092 int i; | |
| 6093 | |
| 6094 CHECK_EXTENT (extent); | |
| 6095 e = XEXTENT (extent); | |
| 6096 props = Dynarr_new (Lisp_Object_pair); | |
| 6097 extent_properties (e, props); | |
| 6098 | |
| 6099 for (i = 0; i < Dynarr_length (props); i++) | |
| 6100 result = cons3 (Dynarr_at (props, i).key, Dynarr_at (props, i).value, | |
| 6101 result); | |
| 6102 | |
| 6103 Dynarr_free (props); | |
| 428 | 6104 return result; |
| 6105 } | |
| 6106 | |
| 6107 | |
| 6108 /************************************************************************/ | |
| 6109 /* highlighting */ | |
| 6110 /************************************************************************/ | |
| 6111 | |
| 6112 /* The display code looks into the Vlast_highlighted_extent variable to | |
| 6113 correctly display highlighted extents. This updates that variable, | |
| 6114 and marks the appropriate buffers as needing some redisplay. | |
| 6115 */ | |
| 6116 static void | |
| 6117 do_highlight (Lisp_Object extent_obj, int highlight_p) | |
| 6118 { | |
| 6119 if (( highlight_p && (EQ (Vlast_highlighted_extent, extent_obj))) || | |
| 6120 (!highlight_p && (EQ (Vlast_highlighted_extent, Qnil)))) | |
| 6121 return; | |
| 6122 if (EXTENTP (Vlast_highlighted_extent) && | |
| 6123 EXTENT_LIVE_P (XEXTENT (Vlast_highlighted_extent))) | |
| 6124 { | |
| 6125 /* do not recurse on descendants. Only one extent is highlighted | |
| 6126 at a time. */ | |
| 826 | 6127 /* A bit of a lie. */ |
| 6128 signal_extent_property_changed (XEXTENT (Vlast_highlighted_extent), | |
| 6129 Qface, 0); | |
| 428 | 6130 } |
| 6131 Vlast_highlighted_extent = Qnil; | |
| 6132 if (!NILP (extent_obj) | |
| 6133 && BUFFERP (extent_object (XEXTENT (extent_obj))) | |
| 6134 && highlight_p) | |
| 6135 { | |
| 826 | 6136 signal_extent_property_changed (XEXTENT (extent_obj), Qface, 0); |
| 428 | 6137 Vlast_highlighted_extent = extent_obj; |
| 6138 } | |
| 6139 } | |
| 6140 | |
| 6141 DEFUN ("force-highlight-extent", Fforce_highlight_extent, 1, 2, 0, /* | |
| 6142 Highlight or unhighlight the given extent. | |
| 6143 If the second arg is non-nil, it will be highlighted, else dehighlighted. | |
| 6144 This is the same as `highlight-extent', except that it will work even | |
| 6145 on extents without the `mouse-face' property. | |
| 6146 */ | |
| 6147 (extent, highlight_p)) | |
| 6148 { | |
| 6149 if (NILP (extent)) | |
| 6150 highlight_p = Qnil; | |
| 6151 else | |
| 793 | 6152 extent = wrap_extent (decode_extent (extent, DE_MUST_BE_ATTACHED)); |
| 428 | 6153 do_highlight (extent, !NILP (highlight_p)); |
| 6154 return Qnil; | |
| 6155 } | |
| 6156 | |
| 6157 DEFUN ("highlight-extent", Fhighlight_extent, 1, 2, 0, /* | |
| 6158 Highlight EXTENT, if it is highlightable. | |
| 6159 \(that is, if it has the `mouse-face' property). | |
| 6160 If the second arg is non-nil, it will be highlighted, else dehighlighted. | |
| 6161 Highlighted extents are displayed as if they were merged with the face | |
| 6162 or faces specified by the `mouse-face' property. | |
| 6163 */ | |
| 6164 (extent, highlight_p)) | |
| 6165 { | |
| 6166 if (EXTENTP (extent) && NILP (extent_mouse_face (XEXTENT (extent)))) | |
| 6167 return Qnil; | |
| 6168 else | |
| 6169 return Fforce_highlight_extent (extent, highlight_p); | |
| 6170 } | |
| 6171 | |
| 6172 | |
| 6173 /************************************************************************/ | |
| 6174 /* strings and extents */ | |
| 6175 /************************************************************************/ | |
| 6176 | |
| 6177 /* copy/paste hooks */ | |
| 6178 | |
| 6179 static int | |
| 826 | 6180 run_extent_copy_paste_internal (EXTENT e, Charxpos from, Charxpos to, |
| 428 | 6181 Lisp_Object object, |
| 6182 Lisp_Object prop) | |
| 6183 { | |
| 6184 /* This function can GC */ | |
| 6185 Lisp_Object extent; | |
| 6186 Lisp_Object copy_fn; | |
| 793 | 6187 extent = wrap_extent (e); |
| 428 | 6188 copy_fn = Fextent_property (extent, prop, Qnil); |
| 6189 if (!NILP (copy_fn)) | |
| 6190 { | |
| 6191 Lisp_Object flag; | |
| 6192 struct gcpro gcpro1, gcpro2, gcpro3; | |
| 6193 GCPRO3 (extent, copy_fn, object); | |
| 6194 if (BUFFERP (object)) | |
| 6195 flag = call3_in_buffer (XBUFFER (object), copy_fn, extent, | |
| 6196 make_int (from), make_int (to)); | |
| 6197 else | |
| 6198 flag = call3 (copy_fn, extent, make_int (from), make_int (to)); | |
| 6199 UNGCPRO; | |
| 6200 if (NILP (flag) || !EXTENT_LIVE_P (XEXTENT (extent))) | |
| 6201 return 0; | |
| 6202 } | |
| 6203 return 1; | |
| 6204 } | |
| 6205 | |
| 6206 static int | |
| 826 | 6207 run_extent_copy_function (EXTENT e, Bytexpos from, Bytexpos to) |
| 428 | 6208 { |
| 6209 Lisp_Object object = extent_object (e); | |
| 6210 /* This function can GC */ | |
| 6211 return run_extent_copy_paste_internal | |
| 826 | 6212 (e, buffer_or_string_bytexpos_to_charxpos (object, from), |
| 6213 buffer_or_string_bytexpos_to_charxpos (object, to), object, | |
| 428 | 6214 Qcopy_function); |
| 6215 } | |
| 6216 | |
| 6217 static int | |
| 826 | 6218 run_extent_paste_function (EXTENT e, Bytexpos from, Bytexpos to, |
| 428 | 6219 Lisp_Object object) |
| 6220 { | |
| 6221 /* This function can GC */ | |
| 6222 return run_extent_copy_paste_internal | |
| 826 | 6223 (e, buffer_or_string_bytexpos_to_charxpos (object, from), |
| 6224 buffer_or_string_bytexpos_to_charxpos (object, to), object, | |
| 428 | 6225 Qpaste_function); |
| 6226 } | |
| 6227 | |
| 826 | 6228 static int |
| 6229 run_extent_paste_function_char (EXTENT e, Charxpos from, Charxpos to, | |
| 6230 Lisp_Object object) | |
| 6231 { | |
| 6232 /* This function can GC */ | |
| 6233 return run_extent_copy_paste_internal (e, from, to, object, Qpaste_function); | |
| 6234 } | |
| 6235 | |
| 428 | 6236 static Lisp_Object |
| 826 | 6237 insert_extent (EXTENT extent, Bytexpos new_start, Bytexpos new_end, |
| 428 | 6238 Lisp_Object object, int run_hooks) |
| 6239 { | |
| 6240 /* This function can GC */ | |
| 6241 if (!EQ (extent_object (extent), object)) | |
| 6242 goto copy_it; | |
| 6243 | |
| 6244 if (extent_detached_p (extent)) | |
| 6245 { | |
| 6246 if (run_hooks && | |
| 6247 !run_extent_paste_function (extent, new_start, new_end, object)) | |
| 6248 /* The paste-function said don't re-attach this extent here. */ | |
| 6249 return Qnil; | |
| 6250 else | |
| 826 | 6251 set_extent_endpoints (extent, new_start, new_end, Qnil); |
| 428 | 6252 } |
| 6253 else | |
| 6254 { | |
| 826 | 6255 Bytexpos exstart = extent_endpoint_byte (extent, 0); |
| 6256 Bytexpos exend = extent_endpoint_byte (extent, 1); | |
| 428 | 6257 |
| 6258 if (exend < new_start || exstart > new_end) | |
| 6259 goto copy_it; | |
| 6260 else | |
| 6261 { | |
| 6262 new_start = min (exstart, new_start); | |
| 6263 new_end = max (exend, new_end); | |
| 6264 if (exstart != new_start || exend != new_end) | |
| 826 | 6265 set_extent_endpoints (extent, new_start, new_end, Qnil); |
| 428 | 6266 } |
| 6267 } | |
| 6268 | |
| 793 | 6269 return wrap_extent (extent); |
| 428 | 6270 |
| 6271 copy_it: | |
| 6272 if (run_hooks && | |
| 6273 !run_extent_paste_function (extent, new_start, new_end, object)) | |
| 6274 /* The paste-function said don't attach a copy of the extent here. */ | |
| 6275 return Qnil; | |
| 6276 else | |
| 793 | 6277 return wrap_extent (copy_extent (extent, new_start, new_end, object)); |
| 428 | 6278 } |
| 6279 | |
| 6280 DEFUN ("insert-extent", Finsert_extent, 1, 5, 0, /* | |
| 6281 Insert EXTENT from START to END in BUFFER-OR-STRING. | |
| 6282 BUFFER-OR-STRING defaults to the current buffer if omitted. | |
| 826 | 6283 If EXTENT is already on the same object, and overlaps or is adjacent to |
| 6284 the given range, its range is merely extended to include the new range. | |
| 6285 Otherwise, a copy is made of the extent at the new position and object. | |
| 6286 When a copy is made, the new extent is returned, copy/paste hooks are run, | |
| 6287 and the change is noted for undo recording. When no copy is made, nil is | |
| 6288 returned. See documentation on `detach-extent' for a discussion of undo | |
| 6289 recording. | |
| 6290 | |
| 428 | 6291 The fourth arg, NO-HOOKS, can be used to inhibit the running of the |
| 826 | 6292 extent's `paste-function' property if it has one. |
| 6293 | |
| 6294 It's not really clear why this function exists any more. It was a holdover | |
| 6295 from a much older implementation of extents, before extents could really | |
| 6296 exist on strings. | |
| 428 | 6297 */ |
| 6298 (extent, start, end, no_hooks, buffer_or_string)) | |
| 6299 { | |
| 6300 EXTENT ext = decode_extent (extent, 0); | |
| 6301 Lisp_Object copy; | |
| 826 | 6302 Bytexpos s, e; |
| 428 | 6303 |
| 6304 buffer_or_string = decode_buffer_or_string (buffer_or_string); | |
| 6305 get_buffer_or_string_range_byte (buffer_or_string, start, end, &s, &e, | |
| 6306 GB_ALLOW_PAST_ACCESSIBLE); | |
| 6307 | |
| 6308 copy = insert_extent (ext, s, e, buffer_or_string, NILP (no_hooks)); | |
| 6309 if (EXTENTP (copy)) | |
| 6310 { | |
| 6311 if (extent_duplicable_p (XEXTENT (copy))) | |
| 6312 record_extent (copy, 1); | |
| 6313 } | |
| 6314 return copy; | |
| 6315 } | |
| 6316 | |
| 6317 | |
| 6318 /* adding buffer extents to a string */ | |
| 6319 | |
| 6320 struct add_string_extents_arg | |
| 6321 { | |
| 826 | 6322 Bytexpos from; |
| 428 | 6323 Bytecount length; |
| 6324 Lisp_Object string; | |
| 6325 }; | |
| 6326 | |
| 6327 static int | |
| 6328 add_string_extents_mapper (EXTENT extent, void *arg) | |
| 6329 { | |
| 6330 /* This function can GC */ | |
| 6331 struct add_string_extents_arg *closure = | |
| 6332 (struct add_string_extents_arg *) arg; | |
| 826 | 6333 Bytecount start = extent_endpoint_byte (extent, 0) - closure->from; |
| 6334 Bytecount end = extent_endpoint_byte (extent, 1) - closure->from; | |
| 428 | 6335 |
| 6336 if (extent_duplicable_p (extent)) | |
| 6337 { | |
| 6338 start = max (start, 0); | |
| 6339 end = min (end, closure->length); | |
| 6340 | |
| 6341 /* Run the copy-function to give an extent the option of | |
| 6342 not being copied into the string (or kill ring). | |
| 6343 */ | |
| 6344 if (extent_duplicable_p (extent) && | |
| 6345 !run_extent_copy_function (extent, start + closure->from, | |
| 6346 end + closure->from)) | |
| 6347 return 0; | |
| 6348 copy_extent (extent, start, end, closure->string); | |
| 6349 } | |
| 6350 | |
| 6351 return 0; | |
| 6352 } | |
| 6353 | |
| 826 | 6354 struct add_string_extents_the_hard_way_arg |
| 6355 { | |
| 6356 Charxpos from; | |
| 6357 Charcount length; | |
| 6358 Lisp_Object string; | |
| 6359 }; | |
| 6360 | |
| 6361 static int | |
| 6362 add_string_extents_the_hard_way_mapper (EXTENT extent, void *arg) | |
| 6363 { | |
| 6364 /* This function can GC */ | |
| 6365 struct add_string_extents_arg *closure = | |
| 6366 (struct add_string_extents_arg *) arg; | |
| 6367 Charcount start = extent_endpoint_char (extent, 0) - closure->from; | |
| 6368 Charcount end = extent_endpoint_char (extent, 1) - closure->from; | |
| 6369 | |
| 6370 if (extent_duplicable_p (extent)) | |
| 6371 { | |
| 6372 start = max (start, 0); | |
| 6373 end = min (end, closure->length); | |
| 6374 | |
| 6375 /* Run the copy-function to give an extent the option of | |
| 6376 not being copied into the string (or kill ring). | |
| 6377 */ | |
| 6378 if (extent_duplicable_p (extent) && | |
| 6379 !run_extent_copy_function (extent, start + closure->from, | |
| 6380 end + closure->from)) | |
| 6381 return 0; | |
| 6382 copy_extent (extent, | |
| 6383 string_index_char_to_byte (closure->string, start), | |
| 6384 string_index_char_to_byte (closure->string, end), | |
| 6385 closure->string); | |
| 6386 } | |
| 6387 | |
| 6388 return 0; | |
| 6389 } | |
| 6390 | |
| 428 | 6391 /* Add the extents in buffer BUF from OPOINT to OPOINT+LENGTH to |
| 6392 the string STRING. */ | |
| 6393 void | |
| 826 | 6394 add_string_extents (Lisp_Object string, struct buffer *buf, Bytexpos opoint, |
| 428 | 6395 Bytecount length) |
| 6396 { | |
| 6397 /* This function can GC */ | |
| 6398 struct gcpro gcpro1, gcpro2; | |
| 6399 Lisp_Object buffer; | |
| 6400 | |
| 771 | 6401 buffer = wrap_buffer (buf); |
| 428 | 6402 GCPRO2 (buffer, string); |
| 826 | 6403 |
| 6404 if (XSTRING_FORMAT (string) == BUF_FORMAT (buf)) | |
| 6405 { | |
| 6406 struct add_string_extents_arg closure; | |
| 6407 closure.from = opoint; | |
| 6408 closure.length = length; | |
| 6409 closure.string = string; | |
| 6410 map_extents (opoint, opoint + length, add_string_extents_mapper, | |
| 6411 (void *) &closure, buffer, 0, | |
| 6412 /* ignore extents that just abut the region */ | |
| 6413 ME_END_CLOSED | ME_ALL_EXTENTS_OPEN | | |
| 6414 /* we are calling E-Lisp (the extent's copy function) | |
| 6415 so anything might happen */ | |
| 6416 ME_MIGHT_CALL_ELISP); | |
| 6417 } | |
| 6418 else | |
| 6419 { | |
| 6420 struct add_string_extents_the_hard_way_arg closure; | |
| 6421 closure.from = bytebpos_to_charbpos (buf, opoint); | |
| 6422 closure.length = (bytebpos_to_charbpos (buf, opoint + length) - | |
| 6423 closure.from); | |
| 6424 closure.string = string; | |
| 6425 | |
| 6426 /* If the string and buffer are in different formats, things get | |
| 6427 tricky; the only reasonable way to do the operation is entirely in | |
| 6428 char offsets, which are invariant to format changes. In practice, | |
| 6429 this won't be time-consuming because the byte/char conversions are | |
| 6430 mostly in the buffer, which will be in a fixed-width format. */ | |
| 6431 map_extents (opoint, opoint + length, | |
| 6432 add_string_extents_the_hard_way_mapper, | |
| 6433 (void *) &closure, buffer, 0, | |
| 6434 /* ignore extents that just abut the region */ | |
| 6435 ME_END_CLOSED | ME_ALL_EXTENTS_OPEN | | |
| 6436 /* we are calling E-Lisp (the extent's copy function) | |
| 6437 so anything might happen */ | |
| 6438 ME_MIGHT_CALL_ELISP); | |
| 6439 | |
| 6440 } | |
| 6441 | |
| 428 | 6442 UNGCPRO; |
| 6443 } | |
| 6444 | |
| 6445 struct splice_in_string_extents_arg | |
| 6446 { | |
| 6447 Bytecount pos; | |
| 6448 Bytecount length; | |
| 826 | 6449 Bytexpos opoint; |
| 428 | 6450 Lisp_Object buffer; |
| 6451 }; | |
| 6452 | |
| 6453 static int | |
| 6454 splice_in_string_extents_mapper (EXTENT extent, void *arg) | |
| 6455 { | |
| 6456 /* This function can GC */ | |
| 6457 struct splice_in_string_extents_arg *closure = | |
| 6458 (struct splice_in_string_extents_arg *) arg; | |
| 6459 /* BASE_START and BASE_END are the limits in the buffer of the string | |
| 6460 that was just inserted. | |
| 826 | 6461 |
| 428 | 6462 NEW_START and NEW_END are the prospective buffer positions of the |
| 6463 extent that is going into the buffer. */ | |
| 826 | 6464 Bytexpos base_start = closure->opoint; |
| 6465 Bytexpos base_end = base_start + closure->length; | |
| 6466 Bytexpos new_start = (base_start + extent_endpoint_byte (extent, 0) - | |
| 6467 closure->pos); | |
| 6468 Bytexpos new_end = (base_start + extent_endpoint_byte (extent, 1) - | |
| 428 | 6469 closure->pos); |
| 6470 | |
| 6471 if (new_start < base_start) | |
| 6472 new_start = base_start; | |
| 6473 if (new_end > base_end) | |
| 6474 new_end = base_end; | |
| 6475 if (new_end <= new_start) | |
| 6476 return 0; | |
| 6477 | |
| 6478 if (!extent_duplicable_p (extent)) | |
| 6479 return 0; | |
| 6480 | |
| 6481 if (!inside_undo && | |
| 6482 !run_extent_paste_function (extent, new_start, new_end, | |
| 6483 closure->buffer)) | |
| 6484 return 0; | |
| 6485 copy_extent (extent, new_start, new_end, closure->buffer); | |
| 6486 | |
| 6487 return 0; | |
| 6488 } | |
| 6489 | |
| 826 | 6490 struct splice_in_string_extents_the_hard_way_arg |
| 6491 { | |
| 6492 Charcount pos; | |
| 6493 Charcount length; | |
| 6494 Charxpos opoint; | |
| 6495 Lisp_Object buffer; | |
| 6496 }; | |
| 6497 | |
| 6498 static int | |
| 6499 splice_in_string_extents_the_hard_way_mapper (EXTENT extent, void *arg) | |
| 6500 { | |
| 6501 /* This function can GC */ | |
| 6502 struct splice_in_string_extents_arg *closure = | |
| 6503 (struct splice_in_string_extents_arg *) arg; | |
| 6504 /* BASE_START and BASE_END are the limits in the buffer of the string | |
| 6505 that was just inserted. | |
| 6506 | |
| 6507 NEW_START and NEW_END are the prospective buffer positions of the | |
| 6508 extent that is going into the buffer. */ | |
| 6509 Charxpos base_start = closure->opoint; | |
| 6510 Charxpos base_end = base_start + closure->length; | |
| 6511 Charxpos new_start = (base_start + extent_endpoint_char (extent, 0) - | |
| 6512 closure->pos); | |
| 6513 Charxpos new_end = (base_start + extent_endpoint_char (extent, 1) - | |
| 6514 closure->pos); | |
| 6515 | |
| 6516 if (new_start < base_start) | |
| 6517 new_start = base_start; | |
| 6518 if (new_end > base_end) | |
| 6519 new_end = base_end; | |
| 6520 if (new_end <= new_start) | |
| 6521 return 0; | |
| 6522 | |
| 6523 if (!extent_duplicable_p (extent)) | |
| 6524 return 0; | |
| 6525 | |
| 6526 if (!inside_undo && | |
| 6527 !run_extent_paste_function_char (extent, new_start, new_end, | |
| 6528 closure->buffer)) | |
| 6529 return 0; | |
| 6530 copy_extent (extent, | |
| 6531 charbpos_to_bytebpos (XBUFFER (closure->buffer), new_start), | |
| 6532 charbpos_to_bytebpos (XBUFFER (closure->buffer), new_end), | |
| 6533 closure->buffer); | |
| 6534 | |
| 6535 return 0; | |
| 6536 } | |
| 6537 | |
| 428 | 6538 /* We have just inserted a section of STRING (starting at POS, of |
| 6539 length LENGTH) into buffer BUF at OPOINT. Do whatever is necessary | |
| 6540 to get the string's extents into the buffer. */ | |
| 6541 | |
| 6542 void | |
| 6543 splice_in_string_extents (Lisp_Object string, struct buffer *buf, | |
| 826 | 6544 Bytexpos opoint, Bytecount length, Bytecount pos) |
| 6545 { | |
| 428 | 6546 struct gcpro gcpro1, gcpro2; |
| 793 | 6547 Lisp_Object buffer = wrap_buffer (buf); |
| 6548 | |
| 428 | 6549 GCPRO2 (buffer, string); |
| 826 | 6550 if (XSTRING_FORMAT (string) == BUF_FORMAT (buf)) |
| 6551 { | |
| 6552 struct splice_in_string_extents_arg closure; | |
| 6553 closure.opoint = opoint; | |
| 6554 closure.pos = pos; | |
| 6555 closure.length = length; | |
| 6556 closure.buffer = buffer; | |
| 6557 map_extents (pos, pos + length, | |
| 6558 splice_in_string_extents_mapper, | |
| 6559 (void *) &closure, string, 0, | |
| 6560 /* ignore extents that just abut the region */ | |
| 6561 ME_END_CLOSED | ME_ALL_EXTENTS_OPEN | | |
| 6562 /* we are calling E-Lisp (the extent's copy function) | |
| 6563 so anything might happen */ | |
| 6564 ME_MIGHT_CALL_ELISP); | |
| 6565 } | |
| 6566 else | |
| 6567 { | |
| 6568 struct splice_in_string_extents_the_hard_way_arg closure; | |
| 6569 closure.opoint = bytebpos_to_charbpos (buf, opoint); | |
| 6570 closure.pos = string_index_byte_to_char (string, pos); | |
| 6571 closure.length = string_offset_byte_to_char_len (string, pos, length); | |
| 6572 closure.buffer = buffer; | |
| 6573 | |
| 6574 /* If the string and buffer are in different formats, things get | |
| 6575 tricky; the only reasonable way to do the operation is entirely in | |
| 6576 char offsets, which are invariant to format changes. In practice, | |
| 6577 this won't be time-consuming because the byte/char conversions are | |
| 6578 mostly in the buffer, which will be in a fixed-width format. */ | |
| 6579 map_extents (pos, pos + length, | |
| 6580 splice_in_string_extents_the_hard_way_mapper, | |
| 6581 (void *) &closure, string, 0, | |
| 6582 /* ignore extents that just abut the region */ | |
| 6583 ME_END_CLOSED | ME_ALL_EXTENTS_OPEN | | |
| 6584 /* we are calling E-Lisp (the extent's copy function) | |
| 6585 so anything might happen */ | |
| 6586 ME_MIGHT_CALL_ELISP); | |
| 6587 | |
| 6588 } | |
| 428 | 6589 UNGCPRO; |
| 6590 } | |
| 6591 | |
| 6592 struct copy_string_extents_arg | |
| 6593 { | |
| 6594 Bytecount new_pos; | |
| 6595 Bytecount old_pos; | |
| 6596 Bytecount length; | |
| 6597 Lisp_Object new_string; | |
| 6598 }; | |
| 6599 | |
| 6600 struct copy_string_extents_1_arg | |
| 6601 { | |
| 6602 Lisp_Object parent_in_question; | |
| 6603 EXTENT found_extent; | |
| 6604 }; | |
| 6605 | |
| 6606 static int | |
| 6607 copy_string_extents_mapper (EXTENT extent, void *arg) | |
| 6608 { | |
| 6609 struct copy_string_extents_arg *closure = | |
| 6610 (struct copy_string_extents_arg *) arg; | |
| 6611 Bytecount old_start, old_end, new_start, new_end; | |
| 6612 | |
| 826 | 6613 old_start = extent_endpoint_byte (extent, 0); |
| 6614 old_end = extent_endpoint_byte (extent, 1); | |
| 428 | 6615 |
| 6616 old_start = max (closure->old_pos, old_start); | |
| 6617 old_end = min (closure->old_pos + closure->length, old_end); | |
| 6618 | |
| 6619 if (old_start >= old_end) | |
| 6620 return 0; | |
| 6621 | |
| 6622 new_start = old_start + closure->new_pos - closure->old_pos; | |
| 6623 new_end = old_end + closure->new_pos - closure->old_pos; | |
| 6624 | |
| 6625 copy_extent (extent, new_start, new_end, closure->new_string); | |
| 6626 return 0; | |
| 6627 } | |
| 6628 | |
| 6629 /* The string NEW_STRING was partially constructed from OLD_STRING. | |
| 6630 In particular, the section of length LEN starting at NEW_POS in | |
| 6631 NEW_STRING came from the section of the same length starting at | |
| 6632 OLD_POS in OLD_STRING. Copy the extents as appropriate. */ | |
| 6633 | |
| 6634 void | |
| 6635 copy_string_extents (Lisp_Object new_string, Lisp_Object old_string, | |
| 6636 Bytecount new_pos, Bytecount old_pos, | |
| 6637 Bytecount length) | |
| 6638 { | |
| 6639 struct copy_string_extents_arg closure; | |
| 6640 struct gcpro gcpro1, gcpro2; | |
| 6641 | |
| 6642 closure.new_pos = new_pos; | |
| 6643 closure.old_pos = old_pos; | |
| 6644 closure.new_string = new_string; | |
| 6645 closure.length = length; | |
| 6646 GCPRO2 (new_string, old_string); | |
| 826 | 6647 map_extents (old_pos, old_pos + length, |
| 6648 copy_string_extents_mapper, | |
| 6649 (void *) &closure, old_string, 0, | |
| 6650 /* ignore extents that just abut the region */ | |
| 6651 ME_END_CLOSED | ME_ALL_EXTENTS_OPEN | | |
| 6652 /* we are calling E-Lisp (the extent's copy function) | |
| 6653 so anything might happen */ | |
| 6654 ME_MIGHT_CALL_ELISP); | |
| 428 | 6655 UNGCPRO; |
| 6656 } | |
| 6657 | |
| 6658 /* Checklist for sanity checking: | |
| 6659 - {kill, yank, copy} at {open, closed} {start, end} of {writable, read-only} extent | |
| 6660 - {kill, copy} & yank {once, repeatedly} duplicable extent in {same, different} buffer | |
| 6661 */ | |
| 6662 | |
| 6663 | |
| 6664 /************************************************************************/ | |
| 6665 /* text properties */ | |
| 6666 /************************************************************************/ | |
| 6667 | |
| 6668 /* Text properties | |
| 6669 Originally this stuff was implemented in lisp (all of the functionality | |
| 6670 exists to make that possible) but speed was a problem. | |
| 6671 */ | |
| 6672 | |
| 6673 Lisp_Object Qtext_prop; | |
| 6674 Lisp_Object Qtext_prop_extent_paste_function; | |
| 6675 | |
| 826 | 6676 /* Retrieve the value of the property PROP of the text at position POSITION |
| 6677 in OBJECT. TEXT-PROPS-ONLY means only look at extents with the | |
| 6678 `text-prop' property, i.e. extents created by the text property | |
| 6679 routines. Otherwise, all extents are examined. &&#### finish Note that | |
| 6680 the default extent_at_flag is EXTENT_AT_DEFAULT (same as | |
| 6681 EXTENT_AT_AFTER). */ | |
| 6682 Lisp_Object | |
| 6683 get_char_property (Bytexpos position, Lisp_Object prop, | |
| 6684 Lisp_Object object, enum extent_at_flag fl, | |
| 6685 int text_props_only) | |
| 428 | 6686 { |
| 6687 Lisp_Object extent; | |
| 6688 | |
| 6689 /* text_props_only specifies whether we only consider text-property | |
| 3025 | 6690 extents (those with the `text-prop' property set) or all extents. */ |
| 428 | 6691 if (!text_props_only) |
| 826 | 6692 extent = extent_at (position, object, prop, 0, fl, 0); |
| 428 | 6693 else |
| 6694 { | |
| 6695 EXTENT prior = 0; | |
| 6696 while (1) | |
| 6697 { | |
| 826 | 6698 extent = extent_at (position, object, Qtext_prop, prior, fl, 0); |
| 428 | 6699 if (NILP (extent)) |
| 6700 return Qnil; | |
| 6701 if (EQ (prop, Fextent_property (extent, Qtext_prop, Qnil))) | |
| 6702 break; | |
| 6703 prior = XEXTENT (extent); | |
| 6704 } | |
| 6705 } | |
| 6706 | |
| 6707 if (!NILP (extent)) | |
| 6708 return Fextent_property (extent, prop, Qnil); | |
| 6709 if (!NILP (Vdefault_text_properties)) | |
| 6710 return Fplist_get (Vdefault_text_properties, prop, Qnil); | |
| 6711 return Qnil; | |
| 6712 } | |
| 6713 | |
| 6714 static Lisp_Object | |
| 826 | 6715 get_char_property_char (Lisp_Object pos, Lisp_Object prop, Lisp_Object object, |
| 6716 Lisp_Object at_flag, int text_props_only) | |
| 6717 { | |
| 6718 Bytexpos position; | |
| 428 | 6719 int invert = 0; |
| 6720 | |
| 6721 object = decode_buffer_or_string (object); | |
| 6722 position = get_buffer_or_string_pos_byte (object, pos, GB_NO_ERROR_IF_BAD); | |
| 6723 | |
| 6724 /* We canonicalize the start/end-open/closed properties to the | |
| 6725 non-default version -- "adding" the default property really | |
| 6726 needs to remove the non-default one. See below for more | |
| 6727 on this. */ | |
| 6728 if (EQ (prop, Qstart_closed)) | |
| 6729 { | |
| 6730 prop = Qstart_open; | |
| 6731 invert = 1; | |
| 6732 } | |
| 6733 | |
| 6734 if (EQ (prop, Qend_open)) | |
| 6735 { | |
| 6736 prop = Qend_closed; | |
| 6737 invert = 1; | |
| 6738 } | |
| 6739 | |
| 6740 { | |
| 6741 Lisp_Object val = | |
| 826 | 6742 get_char_property (position, prop, object, |
| 6743 decode_extent_at_flag (at_flag), | |
| 6744 text_props_only); | |
| 428 | 6745 if (invert) |
| 6746 val = NILP (val) ? Qt : Qnil; | |
| 6747 return val; | |
| 6748 } | |
| 6749 } | |
| 6750 | |
| 6751 DEFUN ("get-text-property", Fget_text_property, 2, 4, 0, /* | |
| 6752 Return the value of the PROP property at the given position. | |
| 6753 Optional arg OBJECT specifies the buffer or string to look in, and | |
| 6754 defaults to the current buffer. | |
| 6755 Optional arg AT-FLAG controls what it means for a property to be "at" | |
| 6756 a position, and has the same meaning as in `extent-at'. | |
| 6757 This examines only those properties added with `put-text-property'. | |
| 6758 See also `get-char-property'. | |
| 6759 */ | |
| 6760 (pos, prop, object, at_flag)) | |
| 6761 { | |
| 826 | 6762 return get_char_property_char (pos, prop, object, at_flag, 1); |
| 428 | 6763 } |
| 6764 | |
| 6765 DEFUN ("get-char-property", Fget_char_property, 2, 4, 0, /* | |
| 6766 Return the value of the PROP property at the given position. | |
| 6767 Optional arg OBJECT specifies the buffer or string to look in, and | |
| 6768 defaults to the current buffer. | |
| 6769 Optional arg AT-FLAG controls what it means for a property to be "at" | |
| 6770 a position, and has the same meaning as in `extent-at'. | |
| 6771 This examines properties on all extents. | |
| 6772 See also `get-text-property'. | |
| 6773 */ | |
| 6774 (pos, prop, object, at_flag)) | |
| 6775 { | |
| 826 | 6776 return get_char_property_char (pos, prop, object, at_flag, 0); |
| 428 | 6777 } |
| 6778 | |
| 6779 /* About start/end-open/closed: | |
| 6780 | |
| 6781 These properties have to be handled specially because of their | |
| 6782 strange behavior. If I put the "start-open" property on a region, | |
| 6783 then *all* text-property extents in the region have to have their | |
| 6784 start be open. This is unlike all other properties, which don't | |
| 6785 affect the extents of text properties other than their own. | |
| 6786 | |
| 6787 So: | |
| 6788 | |
| 6789 1) We have to map start-closed to (not start-open) and end-open | |
| 6790 to (not end-closed) -- i.e. adding the default is really the | |
| 6791 same as remove the non-default property. It won't work, for | |
| 6792 example, to have both "start-open" and "start-closed" on | |
| 6793 the same region. | |
| 6794 2) Whenever we add one of these properties, we go through all | |
| 6795 text-property extents in the region and set the appropriate | |
| 6796 open/closedness on them. | |
| 6797 3) Whenever we change a text-property extent for a property, | |
| 6798 we have to make sure we set the open/closedness properly. | |
| 6799 | |
| 6800 (2) and (3) together rely on, and maintain, the invariant | |
| 6801 that the open/closedness of text-property extents is correct | |
| 6802 at the beginning and end of each operation. | |
| 6803 */ | |
| 6804 | |
| 6805 struct put_text_prop_arg | |
| 6806 { | |
| 6807 Lisp_Object prop, value; /* The property and value we are storing */ | |
| 826 | 6808 Bytexpos start, end; /* The region into which we are storing it */ |
| 428 | 6809 Lisp_Object object; |
| 6810 Lisp_Object the_extent; /* Our chosen extent; this is used for | |
| 6811 communication between subsequent passes. */ | |
| 6812 int changed_p; /* Output: whether we have modified anything */ | |
| 6813 }; | |
| 6814 | |
| 6815 static int | |
| 6816 put_text_prop_mapper (EXTENT e, void *arg) | |
| 6817 { | |
| 6818 struct put_text_prop_arg *closure = (struct put_text_prop_arg *) arg; | |
| 6819 | |
| 6820 Lisp_Object object = closure->object; | |
| 6821 Lisp_Object value = closure->value; | |
| 826 | 6822 Bytexpos e_start, e_end; |
| 6823 Bytexpos start = closure->start; | |
| 6824 Bytexpos end = closure->end; | |
| 428 | 6825 Lisp_Object extent, e_val; |
| 6826 int is_eq; | |
| 6827 | |
| 793 | 6828 extent = wrap_extent (e); |
| 428 | 6829 |
| 3025 | 6830 /* Note: in some cases when the property itself is `start-open' |
| 6831 or `end-closed', the checks to set the openness may do a bit | |
| 428 | 6832 of extra work; but it won't hurt because we then fix up the |
| 6833 openness later on in put_text_prop_openness_mapper(). */ | |
| 6834 if (!EQ (Fextent_property (extent, Qtext_prop, Qnil), closure->prop)) | |
| 6835 /* It's not for this property; do nothing. */ | |
| 6836 return 0; | |
| 6837 | |
| 826 | 6838 e_start = extent_endpoint_byte (e, 0); |
| 6839 e_end = extent_endpoint_byte (e, 1); | |
| 428 | 6840 e_val = Fextent_property (extent, closure->prop, Qnil); |
| 6841 is_eq = EQ (value, e_val); | |
| 6842 | |
| 6843 if (!NILP (value) && NILP (closure->the_extent) && is_eq) | |
| 6844 { | |
| 6845 /* We want there to be an extent here at the end, and we haven't picked | |
| 6846 one yet, so use this one. Extend it as necessary. We only reuse an | |
| 6847 extent which has an EQ value for the prop in question to avoid | |
| 6848 side-effecting the kill ring (that is, we never change the property | |
| 6849 on an extent after it has been created.) | |
| 6850 */ | |
| 6851 if (e_start != start || e_end != end) | |
| 6852 { | |
| 826 | 6853 Bytexpos new_start = min (e_start, start); |
| 6854 Bytexpos new_end = max (e_end, end); | |
| 428 | 6855 set_extent_endpoints (e, new_start, new_end, Qnil); |
| 6856 /* If we changed the endpoint, then we need to set its | |
| 6857 openness. */ | |
| 6858 set_extent_openness (e, new_start != e_start | |
| 826 | 6859 ? !NILP (get_char_property |
| 428 | 6860 (start, Qstart_open, object, |
| 6861 EXTENT_AT_AFTER, 1)) : -1, | |
| 6862 new_end != e_end | |
| 826 | 6863 ? NILP (get_char_property |
| 6864 (prev_bytexpos (object, end), | |
| 6865 Qend_closed, object, | |
| 428 | 6866 EXTENT_AT_AFTER, 1)) |
| 6867 : -1); | |
| 6868 closure->changed_p = 1; | |
| 6869 } | |
| 6870 closure->the_extent = extent; | |
| 6871 } | |
| 6872 | |
| 6873 /* Even if we're adding a prop, at this point, we want all other extents of | |
| 6874 this prop to go away (as now they overlap). So the theory here is that, | |
| 6875 when we are adding a prop to a region that has multiple (disjoint) | |
| 6876 occurrences of that prop in it already, we pick one of those and extend | |
| 6877 it, and remove the others. | |
| 6878 */ | |
| 6879 | |
| 6880 else if (EQ (extent, closure->the_extent)) | |
| 6881 { | |
| 6882 /* just in case map-extents hits it again (does that happen?) */ | |
| 6883 ; | |
| 6884 } | |
| 6885 else if (e_start >= start && e_end <= end) | |
| 6886 { | |
| 6887 /* Extent is contained in region; remove it. Don't destroy or modify | |
| 6888 it, because we don't want to change the attributes pointed to by the | |
| 6889 duplicates in the kill ring. | |
| 6890 */ | |
| 6891 extent_detach (e); | |
| 6892 closure->changed_p = 1; | |
| 6893 } | |
| 6894 else if (!NILP (closure->the_extent) && | |
| 6895 is_eq && | |
| 6896 e_start <= end && | |
| 6897 e_end >= start) | |
| 6898 { | |
| 6899 EXTENT te = XEXTENT (closure->the_extent); | |
| 6900 /* This extent overlaps, and has the same prop/value as the extent we've | |
| 6901 decided to reuse, so we can remove this existing extent as well (the | |
| 6902 whole thing, even the part outside of the region) and extend | |
| 6903 the-extent to cover it, resulting in the minimum number of extents in | |
| 6904 the buffer. | |
| 6905 */ | |
| 826 | 6906 Bytexpos the_start = extent_endpoint_byte (te, 0); |
| 6907 Bytexpos the_end = extent_endpoint_byte (te, 1); | |
| 428 | 6908 if (e_start != the_start && /* note AND not OR -- hmm, why is this |
| 6909 the case? I think it's because the | |
| 6910 assumption that the text-property | |
| 6911 extents don't overlap makes it | |
| 6912 OK; changing it to an OR would | |
| 6913 result in changed_p sometimes getting | |
| 6914 falsely marked. Is this bad? */ | |
| 6915 e_end != the_end) | |
| 6916 { | |
| 826 | 6917 Bytexpos new_start = min (e_start, the_start); |
| 6918 Bytexpos new_end = max (e_end, the_end); | |
| 428 | 6919 set_extent_endpoints (te, new_start, new_end, Qnil); |
| 6920 /* If we changed the endpoint, then we need to set its | |
| 6921 openness. We are setting the endpoint to be the same as | |
| 6922 that of the extent we're about to remove, and we assume | |
| 6923 (the invariant mentioned above) that extent has the | |
| 6924 proper endpoint setting, so we just use it. */ | |
| 6925 set_extent_openness (te, new_start != e_start ? | |
| 6926 (int) extent_start_open_p (e) : -1, | |
| 6927 new_end != e_end ? | |
| 6928 (int) extent_end_open_p (e) : -1); | |
| 6929 closure->changed_p = 1; | |
| 6930 } | |
| 6931 extent_detach (e); | |
| 6932 } | |
| 6933 else if (e_end <= end) | |
| 6934 { | |
| 6935 /* Extent begins before start but ends before end, so we can just | |
| 6936 decrease its end position. | |
| 6937 */ | |
| 6938 if (e_end != start) | |
| 6939 { | |
| 6940 set_extent_endpoints (e, e_start, start, Qnil); | |
| 826 | 6941 set_extent_openness (e, -1, |
| 6942 NILP (get_char_property | |
| 6943 (prev_bytexpos (object, start), | |
| 6944 Qend_closed, object, | |
| 6945 EXTENT_AT_AFTER, 1))); | |
| 428 | 6946 closure->changed_p = 1; |
| 6947 } | |
| 6948 } | |
| 6949 else if (e_start >= start) | |
| 6950 { | |
| 6951 /* Extent ends after end but begins after start, so we can just | |
| 6952 increase its start position. | |
| 6953 */ | |
| 6954 if (e_start != end) | |
| 6955 { | |
| 6956 set_extent_endpoints (e, end, e_end, Qnil); | |
| 826 | 6957 set_extent_openness (e, !NILP (get_char_property |
| 428 | 6958 (end, Qstart_open, object, |
| 6959 EXTENT_AT_AFTER, 1)), -1); | |
| 6960 closure->changed_p = 1; | |
| 6961 } | |
| 6962 } | |
| 6963 else | |
| 6964 { | |
| 6965 /* Otherwise, `extent' straddles the region. We need to split it. | |
| 6966 */ | |
| 6967 set_extent_endpoints (e, e_start, start, Qnil); | |
| 826 | 6968 set_extent_openness (e, -1, NILP (get_char_property |
| 6969 (prev_bytexpos (object, start), | |
| 6970 Qend_closed, object, | |
| 428 | 6971 EXTENT_AT_AFTER, 1))); |
| 6972 set_extent_openness (copy_extent (e, end, e_end, extent_object (e)), | |
| 826 | 6973 !NILP (get_char_property |
| 428 | 6974 (end, Qstart_open, object, |
| 6975 EXTENT_AT_AFTER, 1)), -1); | |
| 6976 closure->changed_p = 1; | |
| 6977 } | |
| 6978 | |
| 6979 return 0; /* to continue mapping. */ | |
| 6980 } | |
| 6981 | |
| 6982 static int | |
| 6983 put_text_prop_openness_mapper (EXTENT e, void *arg) | |
| 6984 { | |
| 6985 struct put_text_prop_arg *closure = (struct put_text_prop_arg *) arg; | |
| 826 | 6986 Bytexpos e_start, e_end; |
| 6987 Bytexpos start = closure->start; | |
| 6988 Bytexpos end = closure->end; | |
| 793 | 6989 Lisp_Object extent = wrap_extent (e); |
| 6990 | |
| 826 | 6991 e_start = extent_endpoint_byte (e, 0); |
| 6992 e_end = extent_endpoint_byte (e, 1); | |
| 428 | 6993 |
| 6994 if (NILP (Fextent_property (extent, Qtext_prop, Qnil))) | |
| 6995 { | |
| 6996 /* It's not a text-property extent; do nothing. */ | |
| 6997 ; | |
| 6998 } | |
| 6999 /* Note end conditions and NILP/!NILP's carefully. */ | |
| 7000 else if (EQ (closure->prop, Qstart_open) | |
| 7001 && e_start >= start && e_start < end) | |
| 7002 set_extent_openness (e, !NILP (closure->value), -1); | |
| 7003 else if (EQ (closure->prop, Qend_closed) | |
| 7004 && e_end > start && e_end <= end) | |
| 7005 set_extent_openness (e, -1, NILP (closure->value)); | |
| 7006 | |
| 7007 return 0; /* to continue mapping. */ | |
| 7008 } | |
| 7009 | |
| 7010 static int | |
| 826 | 7011 put_text_prop (Bytexpos start, Bytexpos end, Lisp_Object object, |
| 428 | 7012 Lisp_Object prop, Lisp_Object value, |
| 7013 int duplicable_p) | |
| 7014 { | |
| 7015 /* This function can GC */ | |
| 7016 struct put_text_prop_arg closure; | |
| 7017 | |
| 7018 if (start == end) /* There are no characters in the region. */ | |
| 7019 return 0; | |
| 7020 | |
| 7021 /* convert to the non-default versions, since a nil property is | |
| 7022 the same as it not being present. */ | |
| 7023 if (EQ (prop, Qstart_closed)) | |
| 7024 { | |
| 7025 prop = Qstart_open; | |
| 7026 value = NILP (value) ? Qt : Qnil; | |
| 7027 } | |
| 7028 else if (EQ (prop, Qend_open)) | |
| 7029 { | |
| 7030 prop = Qend_closed; | |
| 7031 value = NILP (value) ? Qt : Qnil; | |
| 7032 } | |
| 7033 | |
| 7034 value = canonicalize_extent_property (prop, value); | |
| 7035 | |
| 7036 closure.prop = prop; | |
| 7037 closure.value = value; | |
| 7038 closure.start = start; | |
| 7039 closure.end = end; | |
| 7040 closure.object = object; | |
| 7041 closure.changed_p = 0; | |
| 7042 closure.the_extent = Qnil; | |
| 7043 | |
| 826 | 7044 map_extents (start, end, |
| 7045 put_text_prop_mapper, | |
| 7046 (void *) &closure, object, 0, | |
| 7047 /* get all extents that abut the region */ | |
| 7048 ME_ALL_EXTENTS_CLOSED | ME_END_CLOSED | | |
| 7049 #if 0 | |
| 7050 /* it might move the SOE because the callback function calls | |
| 7051 get_char_property(), which calls extent_at(), which calls | |
| 7052 map_extents() | |
| 7053 | |
| 7054 #### this was comment out before, and nothing seemed broken; | |
| 7055 #### but when I added the above comment and uncommented it, | |
| 7056 #### text property operations (e.g. font-lock) suddenly | |
| 7057 #### became *WAY* slow, and dominated font-lock, when a | |
| 7058 #### single extent spanning the entire buffer | |
| 7059 #### existed. --ben */ | |
| 7060 ME_MIGHT_MOVE_SOE | | |
| 7061 #endif | |
| 7062 /* it might QUIT or error if the user has | |
| 7063 fucked with the extent plist. */ | |
| 7064 ME_MIGHT_THROW | | |
| 7065 ME_MIGHT_MODIFY_EXTENTS); | |
| 428 | 7066 |
| 7067 /* If we made it through the loop without reusing an extent | |
| 7068 (and we want there to be one) make it now. | |
| 7069 */ | |
| 7070 if (!NILP (value) && NILP (closure.the_extent)) | |
| 7071 { | |
| 826 | 7072 Lisp_Object extent = |
| 7073 wrap_extent (make_extent (object, start, end)); | |
| 793 | 7074 |
| 428 | 7075 closure.changed_p = 1; |
| 7076 Fset_extent_property (extent, Qtext_prop, prop); | |
| 7077 Fset_extent_property (extent, prop, value); | |
| 7078 if (duplicable_p) | |
| 7079 { | |
| 7080 extent_duplicable_p (XEXTENT (extent)) = 1; | |
| 7081 Fset_extent_property (extent, Qpaste_function, | |
| 7082 Qtext_prop_extent_paste_function); | |
| 7083 } | |
| 7084 set_extent_openness (XEXTENT (extent), | |
| 826 | 7085 !NILP (get_char_property |
| 428 | 7086 (start, Qstart_open, object, |
| 7087 EXTENT_AT_AFTER, 1)), | |
| 826 | 7088 NILP (get_char_property |
| 7089 (prev_bytexpos (object, end), | |
| 7090 Qend_closed, object, | |
| 428 | 7091 EXTENT_AT_AFTER, 1))); |
| 7092 } | |
| 7093 | |
| 7094 if (EQ (prop, Qstart_open) || EQ (prop, Qend_closed)) | |
| 7095 { | |
| 826 | 7096 map_extents (start, end, put_text_prop_openness_mapper, |
| 7097 (void *) &closure, object, 0, | |
| 7098 /* get all extents that abut the region */ | |
| 7099 ME_ALL_EXTENTS_CLOSED | ME_END_CLOSED | | |
| 7100 ME_MIGHT_MODIFY_EXTENTS); | |
| 428 | 7101 } |
| 7102 | |
| 7103 return closure.changed_p; | |
| 7104 } | |
| 7105 | |
| 7106 DEFUN ("put-text-property", Fput_text_property, 4, 5, 0, /* | |
| 7107 Adds the given property/value to all characters in the specified region. | |
| 7108 The property is conceptually attached to the characters rather than the | |
| 7109 region. The properties are copied when the characters are copied/pasted. | |
| 7110 Fifth argument OBJECT is the buffer or string containing the text, and | |
| 7111 defaults to the current buffer. | |
| 7112 */ | |
| 7113 (start, end, prop, value, object)) | |
| 7114 { | |
| 7115 /* This function can GC */ | |
| 826 | 7116 Bytexpos s, e; |
| 428 | 7117 |
| 7118 object = decode_buffer_or_string (object); | |
| 7119 get_buffer_or_string_range_byte (object, start, end, &s, &e, 0); | |
| 7120 put_text_prop (s, e, object, prop, value, 1); | |
| 7121 return prop; | |
| 7122 } | |
| 7123 | |
| 7124 DEFUN ("put-nonduplicable-text-property", Fput_nonduplicable_text_property, | |
| 7125 4, 5, 0, /* | |
| 7126 Adds the given property/value to all characters in the specified region. | |
| 7127 The property is conceptually attached to the characters rather than the | |
| 7128 region, however the properties will not be copied when the characters | |
| 7129 are copied. | |
| 7130 Fifth argument OBJECT is the buffer or string containing the text, and | |
| 7131 defaults to the current buffer. | |
| 7132 */ | |
| 7133 (start, end, prop, value, object)) | |
| 7134 { | |
| 7135 /* This function can GC */ | |
| 826 | 7136 Bytexpos s, e; |
| 428 | 7137 |
| 7138 object = decode_buffer_or_string (object); | |
| 7139 get_buffer_or_string_range_byte (object, start, end, &s, &e, 0); | |
| 7140 put_text_prop (s, e, object, prop, value, 0); | |
| 7141 return prop; | |
| 7142 } | |
| 7143 | |
| 7144 DEFUN ("add-text-properties", Fadd_text_properties, 3, 4, 0, /* | |
| 7145 Add properties to the characters from START to END. | |
| 7146 The third argument PROPS is a property list specifying the property values | |
| 7147 to add. The optional fourth argument, OBJECT, is the buffer or string | |
| 7148 containing the text and defaults to the current buffer. Returns t if | |
| 7149 any property was changed, nil otherwise. | |
| 7150 */ | |
| 7151 (start, end, props, object)) | |
| 7152 { | |
| 7153 /* This function can GC */ | |
| 7154 int changed = 0; | |
| 826 | 7155 Bytexpos s, e; |
| 428 | 7156 |
| 7157 object = decode_buffer_or_string (object); | |
| 7158 get_buffer_or_string_range_byte (object, start, end, &s, &e, 0); | |
| 7159 CHECK_LIST (props); | |
| 7160 for (; !NILP (props); props = Fcdr (Fcdr (props))) | |
| 7161 { | |
| 7162 Lisp_Object prop = XCAR (props); | |
| 7163 Lisp_Object value = Fcar (XCDR (props)); | |
| 7164 changed |= put_text_prop (s, e, object, prop, value, 1); | |
| 7165 } | |
| 7166 return changed ? Qt : Qnil; | |
| 7167 } | |
| 7168 | |
| 7169 | |
| 7170 DEFUN ("add-nonduplicable-text-properties", Fadd_nonduplicable_text_properties, | |
| 7171 3, 4, 0, /* | |
| 7172 Add nonduplicable properties to the characters from START to END. | |
| 7173 \(The properties will not be copied when the characters are copied.) | |
| 7174 The third argument PROPS is a property list specifying the property values | |
| 7175 to add. The optional fourth argument, OBJECT, is the buffer or string | |
| 7176 containing the text and defaults to the current buffer. Returns t if | |
| 7177 any property was changed, nil otherwise. | |
| 7178 */ | |
| 7179 (start, end, props, object)) | |
| 7180 { | |
| 7181 /* This function can GC */ | |
| 7182 int changed = 0; | |
| 826 | 7183 Bytexpos s, e; |
| 428 | 7184 |
| 7185 object = decode_buffer_or_string (object); | |
| 7186 get_buffer_or_string_range_byte (object, start, end, &s, &e, 0); | |
| 7187 CHECK_LIST (props); | |
| 7188 for (; !NILP (props); props = Fcdr (Fcdr (props))) | |
| 7189 { | |
| 7190 Lisp_Object prop = XCAR (props); | |
| 7191 Lisp_Object value = Fcar (XCDR (props)); | |
| 7192 changed |= put_text_prop (s, e, object, prop, value, 0); | |
| 7193 } | |
| 7194 return changed ? Qt : Qnil; | |
| 7195 } | |
| 7196 | |
| 7197 DEFUN ("remove-text-properties", Fremove_text_properties, 3, 4, 0, /* | |
| 7198 Remove the given properties from all characters in the specified region. | |
| 7199 PROPS should be a plist, but the values in that plist are ignored (treated | |
| 7200 as nil). Returns t if any property was changed, nil otherwise. | |
| 7201 Fourth argument OBJECT is the buffer or string containing the text, and | |
| 7202 defaults to the current buffer. | |
| 7203 */ | |
| 7204 (start, end, props, object)) | |
| 7205 { | |
| 7206 /* This function can GC */ | |
| 7207 int changed = 0; | |
| 826 | 7208 Bytexpos s, e; |
| 428 | 7209 |
| 7210 object = decode_buffer_or_string (object); | |
| 7211 get_buffer_or_string_range_byte (object, start, end, &s, &e, 0); | |
| 7212 CHECK_LIST (props); | |
| 7213 for (; !NILP (props); props = Fcdr (Fcdr (props))) | |
| 7214 { | |
| 7215 Lisp_Object prop = XCAR (props); | |
| 7216 changed |= put_text_prop (s, e, object, prop, Qnil, 1); | |
| 7217 } | |
| 7218 return changed ? Qt : Qnil; | |
| 7219 } | |
| 7220 | |
| 7221 /* Whenever a text-prop extent is pasted into a buffer (via `yank' or `insert' | |
| 7222 or whatever) we attach the properties to the buffer by calling | |
| 7223 `put-text-property' instead of by simply allowing the extent to be copied or | |
| 7224 re-attached. Then we return nil, telling the extents code not to attach it | |
| 7225 again. By handing the insertion hackery in this way, we make kill/yank | |
| 7226 behave consistently with put-text-property and not fragment the extents | |
| 7227 (since text-prop extents must partition, not overlap). | |
| 7228 | |
| 7229 The lisp implementation of this was probably fast enough, but since I moved | |
| 7230 the rest of the put-text-prop code here, I moved this as well for | |
| 7231 completeness. | |
| 7232 */ | |
| 7233 DEFUN ("text-prop-extent-paste-function", Ftext_prop_extent_paste_function, | |
| 7234 3, 3, 0, /* | |
| 7235 Used as the `paste-function' property of `text-prop' extents. | |
| 7236 */ | |
| 7237 (extent, from, to)) | |
| 7238 { | |
| 7239 /* This function can GC */ | |
| 7240 Lisp_Object prop, val; | |
| 7241 | |
| 7242 prop = Fextent_property (extent, Qtext_prop, Qnil); | |
| 7243 if (NILP (prop)) | |
| 563 | 7244 signal_error (Qinternal_error, |
| 442 | 7245 "Internal error: no text-prop", extent); |
| 428 | 7246 val = Fextent_property (extent, prop, Qnil); |
| 7247 #if 0 | |
| 7248 /* removed by bill perry, 2/9/97 | |
| 7249 ** This little bit of code would not allow you to have a text property | |
| 7250 ** with a value of Qnil. This is bad bad bad. | |
| 7251 */ | |
| 7252 if (NILP (val)) | |
| 563 | 7253 signal_error_2 (Qinternal_error, |
| 442 | 7254 "Internal error: no text-prop", |
| 7255 extent, prop); | |
| 428 | 7256 #endif |
| 7257 Fput_text_property (from, to, prop, val, Qnil); | |
| 7258 return Qnil; /* important! */ | |
| 7259 } | |
| 7260 | |
| 826 | 7261 Bytexpos |
| 2506 | 7262 next_previous_single_property_change (Bytexpos pos, Lisp_Object prop, |
| 7263 Lisp_Object object, Bytexpos limit, | |
| 7264 Boolint next, Boolint text_props_only) | |
| 826 | 7265 { |
| 7266 Lisp_Object extent, value; | |
| 7267 int limit_was_nil; | |
| 2506 | 7268 enum extent_at_flag at_flag = next ? EXTENT_AT_AFTER : EXTENT_AT_BEFORE; |
| 826 | 7269 if (limit < 0) |
| 7270 { | |
| 2506 | 7271 limit = (next ? buffer_or_string_accessible_end_byte : |
| 7272 buffer_or_string_accessible_begin_byte) (object); | |
| 826 | 7273 limit_was_nil = 1; |
| 7274 } | |
| 7275 else | |
| 7276 limit_was_nil = 0; | |
| 7277 | |
| 2506 | 7278 /* Retrieve initial property value to compare against */ |
| 7279 extent = extent_at (pos, object, prop, 0, at_flag, 0); | |
| 7280 /* If we only want text-prop extents, ignore all others */ | |
| 7281 if (text_props_only && !NILP (extent) && | |
| 7282 NILP (Fextent_property (extent, Qtext_prop, Qnil))) | |
| 7283 extent = Qnil; | |
| 826 | 7284 if (!NILP (extent)) |
| 7285 value = Fextent_property (extent, prop, Qnil); | |
| 7286 else | |
| 7287 value = Qnil; | |
| 7288 | |
| 7289 while (1) | |
| 7290 { | |
| 2506 | 7291 pos = (next ? extent_find_end_of_run : extent_find_beginning_of_run) |
| 7292 (object, pos, 1); | |
| 7293 if (next ? pos >= limit : pos <= limit) | |
| 7294 break; /* property is the same all the way to the beginning/end */ | |
| 7295 extent = extent_at (pos, object, prop, 0, at_flag, 0); | |
| 7296 /* If we only want text-prop extents, ignore all others */ | |
| 7297 if (text_props_only && !NILP (extent) && | |
| 7298 NILP (Fextent_property (extent, Qtext_prop, Qnil))) | |
| 7299 extent = Qnil; | |
| 826 | 7300 if ((NILP (extent) && !NILP (value)) || |
| 7301 (!NILP (extent) && !EQ (value, | |
| 7302 Fextent_property (extent, prop, Qnil)))) | |
| 7303 return pos; | |
| 7304 } | |
| 7305 | |
| 7306 if (limit_was_nil) | |
| 7307 return -1; | |
| 7308 else | |
| 7309 return limit; | |
| 7310 } | |
| 7311 | |
| 2506 | 7312 static Lisp_Object |
| 7313 next_previous_single_property_change_fn (Lisp_Object pos, Lisp_Object prop, | |
| 7314 Lisp_Object object, Lisp_Object limit, | |
| 7315 Boolint next, Boolint text_props_only) | |
| 7316 { | |
| 7317 Bytexpos xpos; | |
| 7318 Bytexpos blim; | |
| 7319 | |
| 7320 object = decode_buffer_or_string (object); | |
| 7321 xpos = get_buffer_or_string_pos_byte (object, pos, 0); | |
| 7322 blim = !NILP (limit) ? get_buffer_or_string_pos_byte (object, limit, 0) : -1; | |
| 7323 blim = next_previous_single_property_change (xpos, prop, object, blim, | |
| 7324 next, text_props_only); | |
| 7325 | |
| 7326 if (blim < 0) | |
| 7327 return Qnil; | |
| 826 | 7328 else |
| 2506 | 7329 return make_int (buffer_or_string_bytexpos_to_charxpos (object, blim)); |
| 826 | 7330 } |
| 428 | 7331 |
| 7332 DEFUN ("next-single-property-change", Fnext_single_property_change, | |
| 7333 2, 4, 0, /* | |
| 7334 Return the position of next property change for a specific property. | |
| 7335 Scans characters forward from POS till it finds a change in the PROP | |
| 7336 property, then returns the position of the change. The optional third | |
| 7337 argument OBJECT is the buffer or string to scan (defaults to the current | |
| 7338 buffer). | |
| 7339 The property values are compared with `eq'. | |
| 444 | 7340 Return nil if the property is constant all the way to the end of OBJECT. |
| 428 | 7341 If the value is non-nil, it is a position greater than POS, never equal. |
| 7342 | |
| 7343 If the optional fourth argument LIMIT is non-nil, don't search | |
| 7344 past position LIMIT; return LIMIT if nothing is found before LIMIT. | |
| 7345 If two or more extents with conflicting non-nil values for PROP overlap | |
| 7346 a particular character, it is undefined which value is considered to be | |
| 7347 the value of PROP. (Note that this situation will not happen if you always | |
| 7348 use the text-property primitives.) | |
| 2506 | 7349 |
| 7350 This function looks only at extents created using the text-property primitives. | |
| 7351 To look at all extents, use `next-single-char-property-change'. | |
| 428 | 7352 */ |
| 7353 (pos, prop, object, limit)) | |
| 7354 { | |
| 2506 | 7355 return next_previous_single_property_change_fn (pos, prop, object, limit, |
| 7356 1, 1); | |
| 826 | 7357 } |
| 428 | 7358 |
| 7359 DEFUN ("previous-single-property-change", Fprevious_single_property_change, | |
| 7360 2, 4, 0, /* | |
| 7361 Return the position of next property change for a specific property. | |
| 7362 Scans characters backward from POS till it finds a change in the PROP | |
| 7363 property, then returns the position of the change. The optional third | |
| 7364 argument OBJECT is the buffer or string to scan (defaults to the current | |
| 7365 buffer). | |
| 7366 The property values are compared with `eq'. | |
| 444 | 7367 Return nil if the property is constant all the way to the start of OBJECT. |
| 428 | 7368 If the value is non-nil, it is a position less than POS, never equal. |
| 7369 | |
| 7370 If the optional fourth argument LIMIT is non-nil, don't search back | |
| 7371 past position LIMIT; return LIMIT if nothing is found until LIMIT. | |
| 7372 If two or more extents with conflicting non-nil values for PROP overlap | |
| 7373 a particular character, it is undefined which value is considered to be | |
| 7374 the value of PROP. (Note that this situation will not happen if you always | |
| 7375 use the text-property primitives.) | |
| 2506 | 7376 |
| 7377 This function looks only at extents created using the text-property primitives. | |
| 7378 To look at all extents, use `next-single-char-property-change'. | |
| 7379 */ | |
| 7380 (pos, prop, object, limit)) | |
| 7381 { | |
| 7382 return next_previous_single_property_change_fn (pos, prop, object, limit, | |
| 7383 0, 1); | |
| 7384 } | |
| 7385 | |
| 7386 DEFUN ("next-single-char-property-change", Fnext_single_char_property_change, | |
| 7387 2, 4, 0, /* | |
| 7388 Return the position of next property change for a specific property. | |
| 7389 Scans characters forward from POS till it finds a change in the PROP | |
| 7390 property, then returns the position of the change. The optional third | |
| 7391 argument OBJECT is the buffer or string to scan (defaults to the current | |
| 7392 buffer). | |
| 7393 The property values are compared with `eq'. | |
| 7394 Return nil if the property is constant all the way to the end of OBJECT. | |
| 7395 If the value is non-nil, it is a position greater than POS, never equal. | |
| 7396 | |
| 7397 If the optional fourth argument LIMIT is non-nil, don't search | |
| 7398 past position LIMIT; return LIMIT if nothing is found before LIMIT. | |
| 7399 If two or more extents with conflicting non-nil values for PROP overlap | |
| 7400 a particular character, it is undefined which value is considered to be | |
| 7401 the value of PROP. (Note that this situation will not happen if you always | |
| 7402 use the text-property primitives.) | |
| 7403 | |
| 7404 This function looks at all extents. To look at only extents created using the | |
| 7405 text-property primitives, use `next-single-char-property-change'. | |
| 428 | 7406 */ |
| 7407 (pos, prop, object, limit)) | |
| 7408 { | |
| 2506 | 7409 return next_previous_single_property_change_fn (pos, prop, object, limit, |
| 7410 1, 0); | |
| 7411 } | |
| 7412 | |
| 7413 DEFUN ("previous-single-char-property-change", | |
| 7414 Fprevious_single_char_property_change, | |
| 7415 2, 4, 0, /* | |
| 7416 Return the position of next property change for a specific property. | |
| 7417 Scans characters backward from POS till it finds a change in the PROP | |
| 7418 property, then returns the position of the change. The optional third | |
| 7419 argument OBJECT is the buffer or string to scan (defaults to the current | |
| 7420 buffer). | |
| 7421 The property values are compared with `eq'. | |
| 7422 Return nil if the property is constant all the way to the start of OBJECT. | |
| 7423 If the value is non-nil, it is a position less than POS, never equal. | |
| 7424 | |
| 7425 If the optional fourth argument LIMIT is non-nil, don't search back | |
| 7426 past position LIMIT; return LIMIT if nothing is found until LIMIT. | |
| 7427 If two or more extents with conflicting non-nil values for PROP overlap | |
| 7428 a particular character, it is undefined which value is considered to be | |
| 7429 the value of PROP. (Note that this situation will not happen if you always | |
| 7430 use the text-property primitives.) | |
| 7431 | |
| 7432 This function looks at all extents. To look at only extents created using the | |
| 7433 text-property primitives, use `next-single-char-property-change'. | |
| 7434 */ | |
| 7435 (pos, prop, object, limit)) | |
| 7436 { | |
| 7437 return next_previous_single_property_change_fn (pos, prop, object, limit, | |
| 7438 0, 0); | |
| 428 | 7439 } |
| 7440 | |
| 7441 #ifdef MEMORY_USAGE_STATS | |
| 7442 | |
| 7443 int | |
| 2286 | 7444 compute_buffer_extent_usage (struct buffer *UNUSED (b), |
| 7445 struct overhead_stats *UNUSED (ovstats)) | |
| 428 | 7446 { |
| 7447 /* #### not yet written */ | |
| 7448 return 0; | |
| 7449 } | |
| 7450 | |
| 7451 #endif /* MEMORY_USAGE_STATS */ | |
| 7452 | |
| 7453 | |
| 7454 /************************************************************************/ | |
| 7455 /* initialization */ | |
| 7456 /************************************************************************/ | |
| 7457 | |
| 7458 void | |
| 7459 syms_of_extents (void) | |
| 7460 { | |
| 442 | 7461 INIT_LRECORD_IMPLEMENTATION (extent); |
| 7462 INIT_LRECORD_IMPLEMENTATION (extent_info); | |
| 7463 INIT_LRECORD_IMPLEMENTATION (extent_auxiliary); | |
| 3092 | 7464 #ifdef NEW_GC |
| 7465 INIT_LRECORD_IMPLEMENTATION (gap_array_marker); | |
| 7466 INIT_LRECORD_IMPLEMENTATION (gap_array); | |
| 7467 INIT_LRECORD_IMPLEMENTATION (extent_list_marker); | |
| 7468 INIT_LRECORD_IMPLEMENTATION (extent_list); | |
| 7469 INIT_LRECORD_IMPLEMENTATION (stack_of_extents); | |
| 3263 | 7470 #endif /* NEW_GC */ |
| 442 | 7471 |
| 563 | 7472 DEFSYMBOL (Qextentp); |
| 7473 DEFSYMBOL (Qextent_live_p); | |
| 7474 | |
| 7475 DEFSYMBOL (Qall_extents_closed); | |
| 7476 DEFSYMBOL (Qall_extents_open); | |
| 7477 DEFSYMBOL (Qall_extents_closed_open); | |
| 7478 DEFSYMBOL (Qall_extents_open_closed); | |
| 7479 DEFSYMBOL (Qstart_in_region); | |
| 7480 DEFSYMBOL (Qend_in_region); | |
| 7481 DEFSYMBOL (Qstart_and_end_in_region); | |
| 7482 DEFSYMBOL (Qstart_or_end_in_region); | |
| 7483 DEFSYMBOL (Qnegate_in_region); | |
| 7484 | |
| 7485 DEFSYMBOL (Qdetached); | |
| 7486 DEFSYMBOL (Qdestroyed); | |
| 7487 DEFSYMBOL (Qbegin_glyph); | |
| 7488 DEFSYMBOL (Qend_glyph); | |
| 7489 DEFSYMBOL (Qstart_open); | |
| 7490 DEFSYMBOL (Qend_open); | |
| 7491 DEFSYMBOL (Qstart_closed); | |
| 7492 DEFSYMBOL (Qend_closed); | |
| 7493 DEFSYMBOL (Qread_only); | |
| 7494 /* DEFSYMBOL (Qhighlight); in faces.c */ | |
| 7495 DEFSYMBOL (Qunique); | |
| 7496 DEFSYMBOL (Qduplicable); | |
| 7497 DEFSYMBOL (Qdetachable); | |
| 7498 DEFSYMBOL (Qpriority); | |
| 7499 DEFSYMBOL (Qmouse_face); | |
| 7500 DEFSYMBOL (Qinitial_redisplay_function); | |
| 7501 | |
| 7502 | |
| 7503 DEFSYMBOL (Qglyph_layout); /* backwards compatibility */ | |
| 7504 DEFSYMBOL (Qbegin_glyph_layout); | |
| 7505 DEFSYMBOL (Qend_glyph_layout); | |
| 7506 DEFSYMBOL (Qoutside_margin); | |
| 7507 DEFSYMBOL (Qinside_margin); | |
| 7508 DEFSYMBOL (Qwhitespace); | |
| 428 | 7509 /* Qtext defined in general.c */ |
| 7510 | |
| 563 | 7511 DEFSYMBOL (Qpaste_function); |
| 7512 DEFSYMBOL (Qcopy_function); | |
| 7513 | |
| 7514 DEFSYMBOL (Qtext_prop); | |
| 7515 DEFSYMBOL (Qtext_prop_extent_paste_function); | |
| 428 | 7516 |
| 7517 DEFSUBR (Fextentp); | |
| 7518 DEFSUBR (Fextent_live_p); | |
| 7519 DEFSUBR (Fextent_detached_p); | |
| 7520 DEFSUBR (Fextent_start_position); | |
| 7521 DEFSUBR (Fextent_end_position); | |
| 7522 DEFSUBR (Fextent_object); | |
| 7523 DEFSUBR (Fextent_length); | |
| 7524 | |
| 7525 DEFSUBR (Fmake_extent); | |
| 7526 DEFSUBR (Fcopy_extent); | |
| 7527 DEFSUBR (Fdelete_extent); | |
| 7528 DEFSUBR (Fdetach_extent); | |
| 7529 DEFSUBR (Fset_extent_endpoints); | |
| 7530 DEFSUBR (Fnext_extent); | |
| 7531 DEFSUBR (Fprevious_extent); | |
| 1204 | 7532 #ifdef DEBUG_XEMACS |
| 428 | 7533 DEFSUBR (Fnext_e_extent); |
| 7534 DEFSUBR (Fprevious_e_extent); | |
| 7535 #endif | |
| 7536 DEFSUBR (Fnext_extent_change); | |
| 7537 DEFSUBR (Fprevious_extent_change); | |
| 7538 | |
| 7539 DEFSUBR (Fextent_parent); | |
| 7540 DEFSUBR (Fextent_children); | |
| 7541 DEFSUBR (Fset_extent_parent); | |
| 7542 | |
| 7543 DEFSUBR (Fextent_in_region_p); | |
| 7544 DEFSUBR (Fmap_extents); | |
| 7545 DEFSUBR (Fmap_extent_children); | |
| 7546 DEFSUBR (Fextent_at); | |
| 442 | 7547 DEFSUBR (Fextents_at); |
| 428 | 7548 |
| 7549 DEFSUBR (Fset_extent_initial_redisplay_function); | |
| 7550 DEFSUBR (Fextent_face); | |
| 7551 DEFSUBR (Fset_extent_face); | |
| 7552 DEFSUBR (Fextent_mouse_face); | |
| 7553 DEFSUBR (Fset_extent_mouse_face); | |
| 7554 DEFSUBR (Fset_extent_begin_glyph); | |
| 7555 DEFSUBR (Fset_extent_end_glyph); | |
| 7556 DEFSUBR (Fextent_begin_glyph); | |
| 7557 DEFSUBR (Fextent_end_glyph); | |
| 7558 DEFSUBR (Fset_extent_begin_glyph_layout); | |
| 7559 DEFSUBR (Fset_extent_end_glyph_layout); | |
| 7560 DEFSUBR (Fextent_begin_glyph_layout); | |
| 7561 DEFSUBR (Fextent_end_glyph_layout); | |
| 7562 DEFSUBR (Fset_extent_priority); | |
| 7563 DEFSUBR (Fextent_priority); | |
| 7564 DEFSUBR (Fset_extent_property); | |
| 7565 DEFSUBR (Fset_extent_properties); | |
| 7566 DEFSUBR (Fextent_property); | |
| 7567 DEFSUBR (Fextent_properties); | |
| 7568 | |
| 7569 DEFSUBR (Fhighlight_extent); | |
| 7570 DEFSUBR (Fforce_highlight_extent); | |
| 7571 | |
| 7572 DEFSUBR (Finsert_extent); | |
| 7573 | |
| 7574 DEFSUBR (Fget_text_property); | |
| 7575 DEFSUBR (Fget_char_property); | |
| 7576 DEFSUBR (Fput_text_property); | |
| 7577 DEFSUBR (Fput_nonduplicable_text_property); | |
| 7578 DEFSUBR (Fadd_text_properties); | |
| 7579 DEFSUBR (Fadd_nonduplicable_text_properties); | |
| 7580 DEFSUBR (Fremove_text_properties); | |
| 7581 DEFSUBR (Ftext_prop_extent_paste_function); | |
| 7582 DEFSUBR (Fnext_single_property_change); | |
| 7583 DEFSUBR (Fprevious_single_property_change); | |
| 2506 | 7584 DEFSUBR (Fnext_single_char_property_change); |
| 7585 DEFSUBR (Fprevious_single_char_property_change); | |
| 428 | 7586 } |
| 7587 | |
| 7588 void | |
| 7589 reinit_vars_of_extents (void) | |
| 7590 { | |
| 7591 extent_auxiliary_defaults.begin_glyph = Qnil; | |
| 7592 extent_auxiliary_defaults.end_glyph = Qnil; | |
| 7593 extent_auxiliary_defaults.parent = Qnil; | |
| 7594 extent_auxiliary_defaults.children = Qnil; | |
| 7595 extent_auxiliary_defaults.priority = 0; | |
| 7596 extent_auxiliary_defaults.invisible = Qnil; | |
| 7597 extent_auxiliary_defaults.read_only = Qnil; | |
| 7598 extent_auxiliary_defaults.mouse_face = Qnil; | |
| 7599 extent_auxiliary_defaults.initial_redisplay_function = Qnil; | |
| 7600 extent_auxiliary_defaults.before_change_functions = Qnil; | |
| 7601 extent_auxiliary_defaults.after_change_functions = Qnil; | |
| 7602 } | |
| 7603 | |
| 7604 void | |
| 7605 vars_of_extents (void) | |
| 7606 { | |
| 7607 DEFVAR_INT ("mouse-highlight-priority", &mouse_highlight_priority /* | |
| 7608 The priority to use for the mouse-highlighting pseudo-extent | |
| 7609 that is used to highlight extents with the `mouse-face' attribute set. | |
| 7610 See `set-extent-priority'. | |
| 7611 */ ); | |
| 7612 /* Set mouse-highlight-priority (which ends up being used both for the | |
| 7613 mouse-highlighting pseudo-extent and the primary selection extent) | |
| 7614 to a very high value because very few extents should override it. | |
| 7615 1000 gives lots of room below it for different-prioritized extents. | |
| 7616 10 doesn't. ediff, for example, likes to use priorities around 100. | |
| 7617 --ben */ | |
| 7618 mouse_highlight_priority = /* 10 */ 1000; | |
| 7619 | |
| 7620 DEFVAR_LISP ("default-text-properties", &Vdefault_text_properties /* | |
| 7621 Property list giving default values for text properties. | |
| 7622 Whenever a character does not specify a value for a property, the value | |
| 7623 stored in this list is used instead. This only applies when the | |
| 7624 functions `get-text-property' or `get-char-property' are called. | |
| 7625 */ ); | |
| 7626 Vdefault_text_properties = Qnil; | |
| 7627 | |
| 7628 staticpro (&Vlast_highlighted_extent); | |
| 7629 Vlast_highlighted_extent = Qnil; | |
| 7630 | |
| 7631 Vextent_face_reusable_list = Fcons (Qnil, Qnil); | |
| 7632 staticpro (&Vextent_face_reusable_list); | |
| 771 | 7633 |
| 428 | 7634 staticpro (&Vextent_face_memoize_hash_table); |
| 7635 /* The memoize hash table maps from lists of symbols to lists of | |
| 7636 faces. It needs to be `equal' to implement the memoization. | |
| 7637 The reverse table maps in the other direction and just needs | |
| 7638 to do `eq' comparison because the lists of faces are already | |
| 7639 memoized. */ | |
| 7640 Vextent_face_memoize_hash_table = | |
| 7641 make_lisp_hash_table (100, HASH_TABLE_VALUE_WEAK, HASH_TABLE_EQUAL); | |
| 7642 staticpro (&Vextent_face_reverse_memoize_hash_table); | |
| 7643 Vextent_face_reverse_memoize_hash_table = | |
| 7644 make_lisp_hash_table (100, HASH_TABLE_KEY_WEAK, HASH_TABLE_EQ); | |
| 1292 | 7645 |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
7646 QSin_map_extents_internal = build_defer_string ("(in map-extents-internal)"); |
| 1292 | 7647 staticpro (&QSin_map_extents_internal); |
| 7648 } |