Mercurial > hg > xemacs-beta
annotate src/marker.c @ 5043:d0c14ea98592
various frame-geometry fixes
-------------------- ChangeLog entries follow: --------------------
src/ChangeLog addition:
2010-02-15 Ben Wing <ben@xemacs.org>
* EmacsFrame.c:
* EmacsFrame.c (EmacsFrameResize):
* console-msw-impl.h:
* console-msw-impl.h (struct mswindows_frame):
* console-msw-impl.h (FRAME_MSWINDOWS_TARGET_RECT):
* device-tty.c:
* device-tty.c (tty_asynch_device_change):
* event-msw.c:
* event-msw.c (mswindows_wnd_proc):
* faces.c (Fface_list):
* faces.h:
* frame-gtk.c:
* frame-gtk.c (gtk_set_initial_frame_size):
* frame-gtk.c (gtk_set_frame_size):
* frame-msw.c:
* frame-msw.c (mswindows_init_frame_1):
* frame-msw.c (mswindows_set_frame_size):
* frame-msw.c (mswindows_size_frame_internal):
* frame-msw.c (msprinter_init_frame_3):
* frame.c:
* frame.c (enum):
* frame.c (Fmake_frame):
* frame.c (adjust_frame_size):
* frame.c (store_minibuf_frame_prop):
* frame.c (Fframe_property):
* frame.c (Fframe_properties):
* frame.c (Fframe_displayable_pixel_height):
* frame.c (Fframe_displayable_pixel_width):
* frame.c (internal_set_frame_size):
* frame.c (Fset_frame_height):
* frame.c (Fset_frame_pixel_height):
* frame.c (Fset_frame_displayable_pixel_height):
* frame.c (Fset_frame_width):
* frame.c (Fset_frame_pixel_width):
* frame.c (Fset_frame_displayable_pixel_width):
* frame.c (Fset_frame_size):
* frame.c (Fset_frame_pixel_size):
* frame.c (Fset_frame_displayable_pixel_size):
* frame.c (frame_conversion_internal_1):
* frame.c (get_frame_displayable_pixel_size):
* frame.c (change_frame_size_1):
* frame.c (change_frame_size):
* frame.c (generate_title_string):
* frame.h:
* gtk-xemacs.c:
* gtk-xemacs.c (gtk_xemacs_size_request):
* gtk-xemacs.c (gtk_xemacs_size_allocate):
* gtk-xemacs.c (gtk_xemacs_paint):
* gutter.c:
* gutter.c (update_gutter_geometry):
* redisplay.c (end_hold_frame_size_changes):
* redisplay.c (redisplay_frame):
* toolbar.c:
* toolbar.c (update_frame_toolbars_geometry):
* window.c:
* window.c (frame_pixsize_valid_p):
* window.c (check_frame_size):
Various fixes to frame geometry to make it a bit easier to understand
and fix some bugs.
1. IMPORTANT: Some renamings. Will need to be applied carefully to
the carbon repository, in the following order:
-- pixel_to_char_size -> pixel_to_frame_unit_size
-- char_to_pixel_size -> frame_unit_to_pixel_size
-- pixel_to_real_char_size -> pixel_to_char_size
-- char_to_real_pixel_size -> char_to_pixel_size
-- Reverse second and third arguments of change_frame_size() and
change_frame_size_1() to try to make functions consistent in
putting width before height.
-- Eliminate old round_size_to_char, because it didn't really
do anything differently from round_size_to_real_char()
-- round_size_to_real_char -> round_size_to_char; any places that
called the old round_size_to_char should just call the new one.
2. IMPORTANT FOR CARBON: The set_frame_size() method is now passed
sizes in "frame units", like all other frame-sizing functions,
rather than some hacked-up combination of char-cell units and
total pixel size. This only affects window systems that use
"pixelated geometry", and I'm not sure if Carbon is one of them.
MS Windows is pixelated, X and GTK are not. For pixelated-geometry
systems, the size in set_frame_size() is in displayable pixels
rather than total pixels and needs to be converted appropriately;
take a look at the changes made to mswindows_set_frame_size()
method if necessary.
3. Add a big long comment in frame.c describing how frame geometry
works.
4. Remove MS Windows-specific character height and width fields,
duplicative and unused.
5. frame-displayable-pixel-* and set-frame-displayable-pixel-*
didn't use to work on MS Windows, but they do now.
6. In general, clean up the handling of "pixelated geometry" so
that fewer functions have to worry about this. This is really
an abomination that should be removed entirely but that will
have to happen later. Fix some buggy code in
frame_conversion_internal() that happened to "work" because it
was countered by oppositely buggy code in change_frame_size().
7. Clean up some frame-size code in toolbar.c and use functions
already provided in frame.c instead of rolling its own.
8. Fix check_frame_size() in window.c, which formerly didn't take
pixelated geometry into account.
| author | Ben Wing <ben@xemacs.org> |
|---|---|
| date | Mon, 15 Feb 2010 22:14:11 -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 } |