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