Mercurial > hg > xemacs-beta
annotate src/marker.c @ 5923:61d7d7bcbe76 cygwin
merged heads after pull -u
| author | Henry Thompson <ht@markup.co.uk> |
|---|---|
| date | Thu, 05 Feb 2015 17:19:05 +0000 |
| parents | 56144c8593a8 |
| children |
| rev | line source |
|---|---|
| 428 | 1 /* Markers: examining, setting and killing. |
| 2 Copyright (C) 1985, 1992, 1993, 1994, 1995 Free Software Foundation, Inc. | |
|
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5125
diff
changeset
|
3 Copyright (C) 2002, 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: FSF 19.30. */ | |
| 21 | |
| 22 /* This file has been Mule-ized. */ | |
| 23 | |
| 24 /* Note that markers are currently kept in an unordered list. | |
| 25 This means that marker operations may be inefficient if | |
| 26 there are a bunch of markers in the buffer. This probably | |
| 27 won't have a significant impact on redisplay (which uses | |
| 28 markers), but if it does, it wouldn't be too hard to change | |
| 29 to an ordered gap array. (Just copy the code from extents.c.) | |
| 30 */ | |
| 31 | |
| 32 #include <config.h> | |
| 33 #include "lisp.h" | |
| 34 | |
| 35 #include "buffer.h" | |
| 36 | |
| 37 static Lisp_Object | |
| 38 mark_marker (Lisp_Object obj) | |
| 39 { | |
| 440 | 40 Lisp_Marker *marker = XMARKER (obj); |
| 428 | 41 Lisp_Object buf; |
| 42 /* DO NOT mark through the marker's chain. | |
| 43 The buffer's markers chain does not preserve markers from gc; | |
| 44 Instead, markers are removed from the chain when they are freed | |
| 45 by gc. | |
| 46 */ | |
| 47 if (!marker->buffer) | |
| 48 return (Qnil); | |
| 49 | |
| 793 | 50 buf = wrap_buffer (marker->buffer); |
| 428 | 51 return (buf); |
| 52 } | |
| 53 | |
| 54 static void | |
| 2286 | 55 print_marker (Lisp_Object obj, Lisp_Object printcharfun, |
| 56 int UNUSED (escapeflag)) | |
| 428 | 57 { |
| 440 | 58 Lisp_Marker *marker = XMARKER (obj); |
| 428 | 59 |
| 60 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
|
61 printing_unreadable_object_fmt ("#<marker 0x%x>", LISP_OBJECT_UID (obj)); |
| 428 | 62 |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
3263
diff
changeset
|
63 write_ascstring (printcharfun, GETTEXT ("#<marker ")); |
| 428 | 64 if (!marker->buffer) |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
3263
diff
changeset
|
65 write_ascstring (printcharfun, GETTEXT ("in no buffer")); |
| 428 | 66 else |
| 67 { | |
| 826 | 68 write_fmt_string (printcharfun, "at %ld in ", |
| 69 (long) marker_position (obj)); | |
| 428 | 70 print_internal (marker->buffer->name, printcharfun, 0); |
| 71 } | |
| 826 | 72 if (marker->insertion_type) |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
3263
diff
changeset
|
73 write_ascstring (printcharfun, " insertion-type=t"); |
|
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
|
74 write_fmt_string (printcharfun, " 0x%x>", LISP_OBJECT_UID (obj)); |
| 428 | 75 } |
| 76 | |
| 77 static int | |
|
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
3263
diff
changeset
|
78 marker_equal (Lisp_Object obj1, Lisp_Object obj2, int UNUSED (depth), |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
3263
diff
changeset
|
79 int UNUSED (foldcase)) |
| 428 | 80 { |
| 440 | 81 Lisp_Marker *marker1 = XMARKER (obj1); |
| 82 Lisp_Marker *marker2 = XMARKER (obj2); | |
| 428 | 83 |
| 84 return ((marker1->buffer == marker2->buffer) && | |
| 665 | 85 (marker1->membpos == marker2->membpos || |
| 428 | 86 /* All markers pointing nowhere are equal */ |
| 87 !marker1->buffer)); | |
| 88 } | |
| 89 | |
| 2515 | 90 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
|
91 marker_hash (Lisp_Object obj, int UNUSED (depth), Boolint UNUSED (equalp)) |
| 428 | 92 { |
| 2515 | 93 Hashcode hash = (Hashcode) XMARKER (obj)->buffer; |
| 428 | 94 if (hash) |
| 665 | 95 hash = HASH2 (hash, XMARKER (obj)->membpos); |
| 428 | 96 return hash; |
| 97 } | |
| 98 | |
| 1204 | 99 static const struct memory_description marker_description[] = { |
| 2551 | 100 { XD_LISP_OBJECT, offsetof (Lisp_Marker, next), 0, { 0 }, XD_FLAG_NO_KKCC }, |
| 101 { XD_LISP_OBJECT, offsetof (Lisp_Marker, prev), 0, { 0 }, XD_FLAG_NO_KKCC }, | |
| 440 | 102 { XD_LISP_OBJECT, offsetof (Lisp_Marker, buffer) }, |
| 428 | 103 { XD_END } |
| 104 }; | |
| 105 | |
| 3263 | 106 #ifdef NEW_GC |
| 2720 | 107 static void |
|
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5125
diff
changeset
|
108 finalize_marker (Lisp_Object obj) |
| 2720 | 109 { |
|
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5125
diff
changeset
|
110 unchain_marker (obj); |
| 2720 | 111 } |
|
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:
5160
diff
changeset
|
112 #endif /* NEW_GC */ |
| 2720 | 113 |
|
5118
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
114 DEFINE_DUMPABLE_FROB_BLOCK_LISP_OBJECT ("marker", marker, |
|
5124
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
115 mark_marker, print_marker, |
|
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:
5160
diff
changeset
|
116 IF_NEW_GC (finalize_marker), |
|
5124
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
117 marker_equal, marker_hash, |
|
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
118 marker_description, Lisp_Marker); |
| 428 | 119 |
| 120 /* Operations on markers. */ | |
| 121 | |
| 122 DEFUN ("marker-buffer", Fmarker_buffer, 1, 1, 0, /* | |
| 123 Return the buffer that MARKER points into, or nil if none. | |
| 124 Return nil if MARKER points into a dead buffer or doesn't point anywhere. | |
| 125 */ | |
| 126 (marker)) | |
| 127 { | |
| 128 struct buffer *buf; | |
| 129 CHECK_MARKER (marker); | |
| 130 /* Return marker's buffer only if it is not dead. */ | |
| 131 if ((buf = XMARKER (marker)->buffer) && BUFFER_LIVE_P (buf)) | |
| 132 { | |
| 793 | 133 return wrap_buffer (buf); |
| 428 | 134 } |
| 135 return Qnil; | |
| 136 } | |
| 137 | |
| 138 DEFUN ("marker-position", Fmarker_position, 1, 1, 0, /* | |
| 139 Return the position MARKER points at, as a character number. | |
| 140 Return `nil' if marker doesn't point anywhere. | |
| 141 */ | |
| 142 (marker)) | |
| 143 { | |
| 144 CHECK_MARKER (marker); | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
145 return XMARKER (marker)->buffer ? make_fixnum (marker_position (marker)) : Qnil; |
| 428 | 146 } |
| 147 | |
| 148 #if 0 /* useful debugging function */ | |
| 149 | |
| 150 static void | |
| 151 check_marker_circularities (struct buffer *buf) | |
| 152 { | |
| 440 | 153 Lisp_Marker *tortoise, *hare; |
| 428 | 154 |
| 155 tortoise = BUF_MARKERS (buf); | |
| 156 hare = tortoise; | |
| 157 | |
| 158 if (!tortoise) | |
| 159 return; | |
| 160 | |
| 161 while (1) | |
| 162 { | |
| 163 assert (hare->buffer == buf); | |
| 164 hare = hare->next; | |
| 165 if (!hare) | |
| 166 return; | |
| 167 assert (hare->buffer == buf); | |
| 168 hare = hare->next; | |
| 169 if (!hare) | |
| 170 return; | |
| 171 tortoise = tortoise->next; | |
| 172 assert (tortoise != hare); | |
| 173 } | |
| 174 } | |
| 175 | |
| 176 #endif | |
| 177 | |
| 178 static Lisp_Object | |
| 444 | 179 set_marker_internal (Lisp_Object marker, Lisp_Object position, |
| 180 Lisp_Object buffer, int restricted_p) | |
| 428 | 181 { |
| 665 | 182 Charbpos charno; |
| 428 | 183 struct buffer *b; |
| 440 | 184 Lisp_Marker *m; |
| 428 | 185 int point_p; |
| 186 | |
| 187 CHECK_MARKER (marker); | |
| 188 | |
| 189 point_p = POINT_MARKER_P (marker); | |
| 190 | |
| 191 /* If position is nil or a marker that points nowhere, | |
| 192 make this marker point nowhere. */ | |
| 444 | 193 if (NILP (position) || |
| 194 (MARKERP (position) && !XMARKER (position)->buffer)) | |
| 428 | 195 { |
| 196 if (point_p) | |
| 563 | 197 invalid_operation ("Can't make point-marker point nowhere", |
| 198 marker); | |
| 428 | 199 if (XMARKER (marker)->buffer) |
| 200 unchain_marker (marker); | |
| 201 return marker; | |
| 202 } | |
| 203 | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
204 CHECK_FIXNUM_COERCE_MARKER (position); |
| 428 | 205 if (NILP (buffer)) |
| 206 b = current_buffer; | |
| 207 else | |
| 208 { | |
| 209 CHECK_BUFFER (buffer); | |
| 210 b = XBUFFER (buffer); | |
| 211 /* If buffer is dead, set marker to point nowhere. */ | |
| 212 if (!BUFFER_LIVE_P (XBUFFER (buffer))) | |
| 213 { | |
| 214 if (point_p) | |
| 563 | 215 invalid_operation |
| 428 | 216 ("Can't move point-marker in a killed buffer", marker); |
| 217 if (XMARKER (marker)->buffer) | |
| 218 unchain_marker (marker); | |
| 219 return marker; | |
| 220 } | |
| 221 } | |
| 222 | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
223 charno = XFIXNUM (position); |
| 428 | 224 m = XMARKER (marker); |
| 225 | |
| 226 if (restricted_p) | |
| 227 { | |
| 228 if (charno < BUF_BEGV (b)) charno = BUF_BEGV (b); | |
| 229 if (charno > BUF_ZV (b)) charno = BUF_ZV (b); | |
| 230 } | |
| 231 else | |
| 232 { | |
| 233 if (charno < BUF_BEG (b)) charno = BUF_BEG (b); | |
| 234 if (charno > BUF_Z (b)) charno = BUF_Z (b); | |
| 235 } | |
| 236 | |
| 237 if (point_p) | |
| 238 { | |
| 239 #ifndef moving_point_by_moving_its_marker_is_a_bug | |
| 240 BUF_SET_PT (b, charno); /* this will move the marker */ | |
| 241 #else /* It's not a feature, so it must be a bug */ | |
| 563 | 242 invalid_operation ("DEBUG: attempt to move point via point-marker", |
| 243 marker); | |
| 428 | 244 #endif |
| 245 } | |
| 246 else | |
| 247 { | |
| 665 | 248 m->membpos = charbpos_to_membpos (b, charno); |
| 428 | 249 } |
| 250 | |
| 251 if (m->buffer != b) | |
| 252 { | |
| 253 if (point_p) | |
| 563 | 254 invalid_operation ("Can't change buffer of point-marker", marker); |
| 428 | 255 if (m->buffer != 0) |
| 256 unchain_marker (marker); | |
| 257 m->buffer = b; | |
| 258 marker_next (m) = BUF_MARKERS (b); | |
| 259 marker_prev (m) = 0; | |
| 260 if (BUF_MARKERS (b)) | |
| 261 marker_prev (BUF_MARKERS (b)) = m; | |
| 262 BUF_MARKERS (b) = m; | |
| 263 } | |
| 264 | |
| 265 return marker; | |
| 266 } | |
| 267 | |
| 268 | |
| 269 DEFUN ("set-marker", Fset_marker, 2, 3, 0, /* | |
| 444 | 270 Move MARKER to position POSITION in BUFFER. |
| 271 POSITION can be a marker, an integer or nil. If POSITION is an | |
| 272 integer, make MARKER point before the POSITIONth character in BUFFER. | |
| 273 If POSITION is nil, makes MARKER point nowhere. Then it no longer | |
| 274 slows down editing in any buffer. If POSITION is less than 1, move | |
| 275 MARKER to the beginning of BUFFER. If POSITION is greater than the | |
| 276 size of BUFFER, move MARKER to the end of BUFFER. | |
| 428 | 277 BUFFER defaults to the current buffer. |
| 444 | 278 If this marker was returned by (point-marker t), then changing its |
| 279 position moves point. You cannot change its buffer or make it point | |
| 280 nowhere. | |
| 281 The return value is MARKER. | |
| 428 | 282 */ |
| 444 | 283 (marker, position, buffer)) |
| 428 | 284 { |
| 444 | 285 return set_marker_internal (marker, position, buffer, 0); |
| 428 | 286 } |
| 287 | |
| 288 | |
| 289 /* This version of Fset_marker won't let the position | |
| 290 be outside the visible part. */ | |
| 291 Lisp_Object | |
| 444 | 292 set_marker_restricted (Lisp_Object marker, Lisp_Object position, |
| 293 Lisp_Object buffer) | |
| 428 | 294 { |
| 444 | 295 return set_marker_internal (marker, position, buffer, 1); |
| 428 | 296 } |
| 297 | |
| 298 | |
| 299 /* This is called during garbage collection, | |
| 300 so we must be careful to ignore and preserve mark bits, | |
| 301 including those in chain fields of markers. */ | |
| 302 | |
| 303 void | |
| 304 unchain_marker (Lisp_Object m) | |
| 305 { | |
| 440 | 306 Lisp_Marker *marker = XMARKER (m); |
| 428 | 307 struct buffer *b = marker->buffer; |
| 308 | |
| 309 if (b == 0) | |
| 310 return; | |
| 311 | |
| 800 | 312 #ifdef ERROR_CHECK_STRUCTURES |
| 428 | 313 assert (BUFFER_LIVE_P (b)); |
| 314 #endif | |
| 315 | |
| 316 if (marker_next (marker)) | |
| 317 marker_prev (marker_next (marker)) = marker_prev (marker); | |
| 318 if (marker_prev (marker)) | |
| 319 marker_next (marker_prev (marker)) = marker_next (marker); | |
| 320 else | |
| 321 BUF_MARKERS (b) = marker_next (marker); | |
| 322 | |
| 800 | 323 #ifdef ERROR_CHECK_STRUCTURES |
| 428 | 324 assert (marker != XMARKER (b->point_marker)); |
| 325 #endif | |
| 326 | |
| 327 marker->buffer = 0; | |
| 328 } | |
| 329 | |
| 665 | 330 Bytebpos |
| 826 | 331 byte_marker_position (Lisp_Object marker) |
| 428 | 332 { |
| 440 | 333 Lisp_Marker *m = XMARKER (marker); |
| 428 | 334 struct buffer *buf = m->buffer; |
| 665 | 335 Bytebpos pos; |
| 428 | 336 |
| 337 if (!buf) | |
| 563 | 338 invalid_argument ("Marker does not point anywhere", Qunbound); |
| 428 | 339 |
| 340 /* FSF claims that marker indices could end up denormalized, i.e. | |
| 341 in the gap. This is way bogus if it ever happens, and means | |
| 342 something fucked up elsewhere. Since I've overhauled all this | |
| 343 shit, I don't think this can happen. In any case, the following | |
| 344 macro has an assert() in it that will catch these denormalized | |
| 345 positions. */ | |
| 665 | 346 pos = membpos_to_bytebpos (buf, m->membpos); |
| 428 | 347 |
| 348 return pos; | |
| 349 } | |
| 350 | |
| 665 | 351 Charbpos |
| 428 | 352 marker_position (Lisp_Object marker) |
| 353 { | |
| 354 struct buffer *buf = XMARKER (marker)->buffer; | |
| 355 | |
| 356 if (!buf) | |
| 563 | 357 invalid_argument ("Marker does not point anywhere", Qunbound); |
| 428 | 358 |
| 826 | 359 return bytebpos_to_charbpos (buf, byte_marker_position (marker)); |
| 428 | 360 } |
| 361 | |
| 362 void | |
| 826 | 363 set_byte_marker_position (Lisp_Object marker, Bytebpos pos) |
| 428 | 364 { |
| 440 | 365 Lisp_Marker *m = XMARKER (marker); |
| 428 | 366 struct buffer *buf = m->buffer; |
| 367 | |
| 368 if (!buf) | |
| 563 | 369 invalid_argument ("Marker does not point anywhere", Qunbound); |
| 428 | 370 |
| 665 | 371 m->membpos = bytebpos_to_membpos (buf, pos); |
| 428 | 372 } |
| 373 | |
| 374 void | |
| 665 | 375 set_marker_position (Lisp_Object marker, Charbpos pos) |
| 428 | 376 { |
| 377 struct buffer *buf = XMARKER (marker)->buffer; | |
| 378 | |
| 379 if (!buf) | |
| 563 | 380 invalid_argument ("Marker does not point anywhere", Qunbound); |
| 428 | 381 |
| 826 | 382 set_byte_marker_position (marker, charbpos_to_bytebpos (buf, pos)); |
| 428 | 383 } |
| 384 | |
| 385 static Lisp_Object | |
| 386 copy_marker_1 (Lisp_Object marker, Lisp_Object type, int noseeum) | |
| 387 { | |
| 3025 | 388 REGISTER Lisp_Object new_; |
| 428 | 389 |
| 390 while (1) | |
| 391 { | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
392 if (FIXNUMP (marker) || MARKERP (marker)) |
| 428 | 393 { |
| 394 if (noseeum) | |
| 3025 | 395 new_ = noseeum_make_marker (); |
| 428 | 396 else |
| 3025 | 397 new_ = Fmake_marker (); |
| 398 Fset_marker (new_, marker, | |
| 428 | 399 (MARKERP (marker) ? Fmarker_buffer (marker) : Qnil)); |
| 3025 | 400 XMARKER (new_)->insertion_type = !NILP (type); |
| 401 return new_; | |
| 428 | 402 } |
| 403 else | |
| 404 marker = wrong_type_argument (Qinteger_or_marker_p, marker); | |
| 405 } | |
| 406 | |
| 1204 | 407 RETURN_NOT_REACHED (Qnil); /* not reached */ |
| 428 | 408 } |
| 409 | |
| 410 DEFUN ("copy-marker", Fcopy_marker, 1, 2, 0, /* | |
| 444 | 411 Return a new marker pointing at the same place as MARKER-OR-INTEGER. |
| 412 If MARKER-OR-INTEGER is an integer, return a new marker pointing | |
| 428 | 413 at that position in the current buffer. |
| 444 | 414 Optional argument MARKER-TYPE specifies the insertion type of the new |
| 415 marker; see `marker-insertion-type'. | |
| 428 | 416 */ |
| 444 | 417 (marker_or_integer, marker_type)) |
| 428 | 418 { |
| 444 | 419 return copy_marker_1 (marker_or_integer, marker_type, 0); |
| 428 | 420 } |
| 421 | |
| 422 Lisp_Object | |
| 444 | 423 noseeum_copy_marker (Lisp_Object marker, Lisp_Object marker_type) |
| 428 | 424 { |
| 444 | 425 return copy_marker_1 (marker, marker_type, 1); |
| 428 | 426 } |
| 427 | |
| 428 DEFUN ("marker-insertion-type", Fmarker_insertion_type, 1, 1, 0, /* | |
| 429 Return insertion type of MARKER: t if it stays after inserted text. | |
| 430 nil means the marker stays before text inserted there. | |
| 431 */ | |
| 432 (marker)) | |
| 433 { | |
| 434 CHECK_MARKER (marker); | |
| 435 return XMARKER (marker)->insertion_type ? Qt : Qnil; | |
| 436 } | |
| 437 | |
| 438 DEFUN ("set-marker-insertion-type", Fset_marker_insertion_type, 2, 2, 0, /* | |
| 439 Set the insertion-type of MARKER to TYPE. | |
| 440 If TYPE is t, it means the marker advances when you insert text at it. | |
| 441 If TYPE is nil, it means the marker stays behind when you insert text at it. | |
| 442 */ | |
| 443 (marker, type)) | |
| 444 { | |
| 445 CHECK_MARKER (marker); | |
| 446 | |
| 447 XMARKER (marker)->insertion_type = ! NILP (type); | |
| 448 return type; | |
| 449 } | |
| 450 | |
| 451 /* #### What is the possible use of this? It looks quite useless to | |
| 452 me, because there is no way to find *which* markers are positioned | |
| 453 at POSITION. Additional bogosity bonus: (buffer-has-markers-at | |
| 454 (point)) will always return t because of the `point-marker'. The | |
| 455 same goes for the position of mark. Bletch! | |
| 456 | |
| 457 Someone should discuss this with Stallman, but I don't have the | |
| 458 stomach. In fact, this function sucks so badly that I'm disabling | |
| 459 it by default (although I've debugged it). If you want to use it, | |
| 460 use extents instead. --hniksic */ | |
| 461 #if 0 | |
| 826 | 462 DEFUN ("buffer-has-markers-at", Fbuffer_has_markers_at, 1, 1, 0, /* |
| 428 | 463 Return t if there are markers pointing at POSITION in the current buffer. |
| 464 */ | |
| 465 (position)) | |
| 466 { | |
| 440 | 467 Lisp_Marker *marker; |
| 665 | 468 Membpos pos; |
| 428 | 469 |
| 665 | 470 /* A small optimization trick: convert POS to membpos now, rather |
| 471 than converting every marker's memory index to charbpos. */ | |
| 472 pos = bytebpos_to_membpos (current_buffer, | |
| 428 | 473 get_buffer_pos_byte (current_buffer, position, |
| 474 GB_COERCE_RANGE)); | |
| 475 | |
| 476 for (marker = BUF_MARKERS (current_buffer); | |
| 477 marker; | |
| 478 marker = marker_next (marker)) | |
| 479 { | |
| 665 | 480 /* We use marker->membpos, so we don't have to go through the |
| 428 | 481 unwieldy operation of creating a Lisp_Object for |
| 482 marker_position() every time around. */ | |
| 665 | 483 if (marker->membpos == pos) |
| 428 | 484 return Qt; |
| 485 } | |
| 486 | |
| 487 return Qnil; | |
| 488 } | |
| 489 #endif /* 0 */ | |
| 490 | |
| 491 #ifdef MEMORY_USAGE_STATS | |
| 492 | |
|
5160
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5157
diff
changeset
|
493 Bytecount |
|
5170
5ddbab03b0e6
various fixes to memory-usage stats
Ben Wing <ben@xemacs.org>
parents:
5169
diff
changeset
|
494 compute_buffer_marker_usage (struct buffer *b) |
| 428 | 495 { |
| 440 | 496 Lisp_Marker *m; |
|
5160
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5157
diff
changeset
|
497 Bytecount total = 0; |
| 428 | 498 |
| 499 for (m = BUF_MARKERS (b); m; m = m->next) | |
|
5170
5ddbab03b0e6
various fixes to memory-usage stats
Ben Wing <ben@xemacs.org>
parents:
5169
diff
changeset
|
500 total += lisp_object_memory_usage (wrap_marker (m)); |
|
5160
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5157
diff
changeset
|
501 return total; |
| 428 | 502 } |
| 503 | |
| 504 #endif /* MEMORY_USAGE_STATS */ | |
| 505 | |
| 506 | |
| 507 void | |
| 508 syms_of_marker (void) | |
| 509 { | |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
510 INIT_LISP_OBJECT (marker); |
| 442 | 511 |
| 428 | 512 DEFSUBR (Fmarker_position); |
| 513 DEFSUBR (Fmarker_buffer); | |
| 514 DEFSUBR (Fset_marker); | |
| 515 DEFSUBR (Fcopy_marker); | |
| 516 DEFSUBR (Fmarker_insertion_type); | |
| 517 DEFSUBR (Fset_marker_insertion_type); | |
| 518 #if 0 /* FSFmacs crock */ | |
| 519 DEFSUBR (Fbuffer_has_markers_at); | |
| 520 #endif | |
| 521 } | |
| 522 | |
| 523 void | |
| 524 init_buffer_markers (struct buffer *b) | |
| 525 { | |
| 793 | 526 Lisp_Object buf = wrap_buffer (b); |
| 428 | 527 |
| 528 b->mark = Fmake_marker (); | |
| 529 BUF_MARKERS (b) = 0; | |
| 530 b->point_marker = Fmake_marker (); | |
| 531 Fset_marker (b->point_marker, | |
| 532 /* For indirect buffers, point is already set. */ | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
533 b->base_buffer ? make_fixnum (BUF_PT (b)) : make_fixnum (1), |
| 428 | 534 buf); |
| 535 } | |
| 536 | |
| 537 void | |
| 538 uninit_buffer_markers (struct buffer *b) | |
| 539 { | |
| 540 /* Unchain all markers of this buffer | |
| 541 and leave them pointing nowhere. */ | |
| 440 | 542 REGISTER Lisp_Marker *m, *next; |
| 428 | 543 for (m = BUF_MARKERS (b); m; m = next) |
| 544 { | |
| 545 m->buffer = 0; | |
| 546 next = marker_next (m); | |
| 547 marker_next (m) = 0; | |
| 548 marker_prev (m) = 0; | |
| 549 } | |
| 550 BUF_MARKERS (b) = 0; | |
| 551 } |