Mercurial > hg > xemacs-beta
annotate src/marker.c @ 5887:6eca500211f4
Prototype for X509_check_host() has changed, detect this in configure.ac
ChangeLog addition:
2015-04-09 Aidan Kehoe <kehoea@parhasard.net>
* configure.ac:
If X509_check_host() is available, check the number of arguments
it takes. Don't use it if it takes any number of arguments other
than five. Also don't use it if <openssl/x509v3.h> does not
declare it, since if that is so there is no portable way to tell
how many arguments it should take, and so we would end up smashing
the stack.
* configure: Regenerate.
src/ChangeLog addition:
2015-04-09 Aidan Kehoe <kehoea@parhasard.net>
* tls.c:
#include <openssl/x509v3.h> for its prototype for
X509_check_host().
* tls.c (tls_open):
Pass the new fifth argument to X509_check_host().
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Thu, 09 Apr 2015 14:27:02 +0100 |
| 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 } |