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