Mercurial > hg > xemacs-beta

comparison src/marker.c @ 412:697ef44129c6 r21-2-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-14
author cvs
date Mon, 13 Aug 2007 11:20:41 +0200
parents a86b2b5e0111
children 41dbb7a9d5f2
comparison
equal deleted inserted replaced
411:12e008d41344 412:697ef44129c6
34 #include "lisp.h" 34 #include "lisp.h"
35 35
36 #include "buffer.h" 36 #include "buffer.h"
37 37
38 static Lisp_Object 38 static Lisp_Object
39 mark_marker (Lisp_Object obj) 39 mark_marker (Lisp_Object obj, void (*markobj) (Lisp_Object))
40 { 40 {
41 Lisp_Marker *marker = XMARKER (obj); 41 struct Lisp_Marker *marker = XMARKER (obj);
42 Lisp_Object buf; 42 Lisp_Object buf;
43 /* DO NOT mark through the marker's chain. 43 /* DO NOT mark through the marker's chain.
44 The buffer's markers chain does not preserve markers from gc; 44 The buffer's markers chain does not preserve markers from gc;
45 Instead, markers are removed from the chain when they are freed 45 Instead, markers are removed from the chain when they are freed
46 by gc. 46 by gc.
53 } 53 }
54 54
55 static void 55 static void
56 print_marker (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) 56 print_marker (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
57 { 57 {
58 Lisp_Marker *marker = XMARKER (obj); 58 struct Lisp_Marker *marker = XMARKER (obj);
59 char buf[200]; 59 char buf[200];
60 60
61 if (print_readably) 61 if (print_readably)
62 error ("printing unreadable object #<marker 0x%lx>", (long) marker); 62 error ("printing unreadable object #<marker 0x%lx>", (long) marker);
63 63
64 write_c_string (GETTEXT ("#<marker "), printcharfun); 64 write_c_string (GETTEXT ("#<marker "), printcharfun);
65 if (!marker->buffer) 65 if (!marker->buffer)
66 write_c_string (GETTEXT ("in no buffer"), printcharfun); 66 write_c_string (GETTEXT ("in no buffer"), printcharfun);
67 else 67 else
68 { 68 {
69 sprintf (buf, "at %ld in ", (long) marker_position (obj)); 69 sprintf (buf, "at %d in ", marker_position (obj));
70 write_c_string (buf, printcharfun); 70 write_c_string (buf, printcharfun);
71 print_internal (marker->buffer->name, printcharfun, 0); 71 print_internal (marker->buffer->name, printcharfun, 0);
72 } 72 }
73 sprintf (buf, " 0x%lx>", (long) marker); 73 sprintf (buf, " 0x%lx>", (long) marker);
74 write_c_string (buf, printcharfun); 74 write_c_string (buf, printcharfun);
75 } 75 }
76 76
77 static int 77 static int
78 marker_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) 78 marker_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
79 { 79 {
80 Lisp_Marker *marker1 = XMARKER (obj1); 80 struct Lisp_Marker *marker1 = XMARKER (obj1);
81 Lisp_Marker *marker2 = XMARKER (obj2); 81 struct Lisp_Marker *marker2 = XMARKER (obj2);
82 82
83 return ((marker1->buffer == marker2->buffer) && 83 return ((marker1->buffer == marker2->buffer) &&
84 (marker1->memind == marker2->memind || 84 (marker1->memind == marker2->memind ||
85 /* All markers pointing nowhere are equal */ 85 /* All markers pointing nowhere are equal */
86 !marker1->buffer)); 86 !marker1->buffer));
93 if (hash) 93 if (hash)
94 hash = HASH2 (hash, XMARKER (obj)->memind); 94 hash = HASH2 (hash, XMARKER (obj)->memind);
95 return hash; 95 return hash;
96 } 96 }
97 97
98 static const struct lrecord_description marker_description[] = {
99 { XD_LISP_OBJECT, offsetof (Lisp_Marker, next) },
100 { XD_LISP_OBJECT, offsetof (Lisp_Marker, prev) },
101 { XD_LISP_OBJECT, offsetof (Lisp_Marker, buffer) },
102 { XD_END }
103 };
104
105 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("marker", marker, 98 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("marker", marker,
106 mark_marker, print_marker, 0, 99 mark_marker, print_marker, 0,
107 marker_equal, marker_hash, marker_description, 100 marker_equal, marker_hash,
108 Lisp_Marker); 101 struct Lisp_Marker);
109 102
110 /* Operations on markers. */ 103 /* Operations on markers. */
111 104
112 DEFUN ("marker-buffer", Fmarker_buffer, 1, 1, 0, /* 105 DEFUN ("marker-buffer", Fmarker_buffer, 1, 1, 0, /*
113 Return the buffer that MARKER points into, or nil if none. 106 Return the buffer that MARKER points into, or nil if none.
140 #if 0 /* useful debugging function */ 133 #if 0 /* useful debugging function */
141 134
142 static void 135 static void
143 check_marker_circularities (struct buffer *buf) 136 check_marker_circularities (struct buffer *buf)
144 { 137 {
145 Lisp_Marker *tortoise, *hare; 138 struct Lisp_Marker *tortoise, *hare;
146 139
147 tortoise = BUF_MARKERS (buf); 140 tortoise = BUF_MARKERS (buf);
148 hare = tortoise; 141 hare = tortoise;
149 142
150 if (!tortoise) 143 if (!tortoise)
171 set_marker_internal (Lisp_Object marker, Lisp_Object pos, Lisp_Object buffer, 164 set_marker_internal (Lisp_Object marker, Lisp_Object pos, Lisp_Object buffer,
172 int restricted_p) 165 int restricted_p)
173 { 166 {
174 Bufpos charno; 167 Bufpos charno;
175 struct buffer *b; 168 struct buffer *b;
176 Lisp_Marker *m; 169 struct Lisp_Marker *m;
177 int point_p; 170 int point_p;
178 171
179 CHECK_MARKER (marker); 172 CHECK_MARKER (marker);
180 173
181 point_p = POINT_MARKER_P (marker); 174 point_p = POINT_MARKER_P (marker);
287 including those in chain fields of markers. */ 280 including those in chain fields of markers. */
288 281
289 void 282 void
290 unchain_marker (Lisp_Object m) 283 unchain_marker (Lisp_Object m)
291 { 284 {
292 Lisp_Marker *marker = XMARKER (m); 285 struct Lisp_Marker *marker = XMARKER (m);
293 struct buffer *b = marker->buffer; 286 struct buffer *b = marker->buffer;
294 287
295 if (b == 0) 288 if (b == 0)
296 return; 289 return;
297 290
314 } 307 }
315 308
316 Bytind 309 Bytind
317 bi_marker_position (Lisp_Object marker) 310 bi_marker_position (Lisp_Object marker)
318 { 311 {
319 Lisp_Marker *m = XMARKER (marker); 312 struct Lisp_Marker *m = XMARKER (marker);
320 struct buffer *buf = m->buffer; 313 struct buffer *buf = m->buffer;
321 Bytind pos; 314 Bytind pos;
322 315
323 if (!buf) 316 if (!buf)
324 error ("Marker does not point anywhere"); 317 error ("Marker does not point anywhere");
351 } 344 }
352 345
353 void 346 void
354 set_bi_marker_position (Lisp_Object marker, Bytind pos) 347 set_bi_marker_position (Lisp_Object marker, Bytind pos)
355 { 348 {
356 Lisp_Marker *m = XMARKER (marker); 349 struct Lisp_Marker *m = XMARKER (marker);
357 struct buffer *buf = m->buffer; 350 struct buffer *buf = m->buffer;
358 351
359 if (!buf) 352 if (!buf)
360 error ("Marker does not point anywhere"); 353 error ("Marker does not point anywhere");
361 354
458 xxDEFUN ("buffer-has-markers-at", Fbuffer_has_markers_at, 1, 1, 0, /* 451 xxDEFUN ("buffer-has-markers-at", Fbuffer_has_markers_at, 1, 1, 0, /*
459 Return t if there are markers pointing at POSITION in the current buffer. 452 Return t if there are markers pointing at POSITION in the current buffer.
460 */ 453 */
461 (position)) 454 (position))
462 { 455 {
463 Lisp_Marker *marker; 456 struct Lisp_Marker *marker;
464 Memind pos; 457 Memind pos;
465 458
466 /* A small optimization trick: convert POS to memind now, rather 459 /* A small optimization trick: convert POS to memind now, rather
467 than converting every marker's memory index to bufpos. */ 460 than converting every marker's memory index to bufpos. */
468 pos = bytind_to_memind (current_buffer, 461 pos = bytind_to_memind (current_buffer,
487 #ifdef MEMORY_USAGE_STATS 480 #ifdef MEMORY_USAGE_STATS
488 481
489 int 482 int
490 compute_buffer_marker_usage (struct buffer *b, struct overhead_stats *ovstats) 483 compute_buffer_marker_usage (struct buffer *b, struct overhead_stats *ovstats)
491 { 484 {
492 Lisp_Marker *m; 485 struct Lisp_Marker *m;
493 int total = 0; 486 int total = 0;
494 int overhead; 487 int overhead;
495 488
496 for (m = BUF_MARKERS (b); m; m = m->next) 489 for (m = BUF_MARKERS (b); m; m = m->next)
497 total += sizeof (Lisp_Marker); 490 total += sizeof (struct Lisp_Marker);
498 ovstats->was_requested += total; 491 ovstats->was_requested += total;
499 overhead = fixed_type_block_overhead (total); 492 overhead = fixed_type_block_overhead (total);
500 /* #### claiming this is all malloc overhead is not really right, 493 /* #### claiming this is all malloc overhead is not really right,
501 but it has to go somewhere. */ 494 but it has to go somewhere. */
502 ovstats->malloc_overhead += overhead; 495 ovstats->malloc_overhead += overhead;
507 500
508 501
509 void 502 void
510 syms_of_marker (void) 503 syms_of_marker (void)
511 { 504 {
512 INIT_LRECORD_IMPLEMENTATION (marker);
513
514 DEFSUBR (Fmarker_position); 505 DEFSUBR (Fmarker_position);
515 DEFSUBR (Fmarker_buffer); 506 DEFSUBR (Fmarker_buffer);
516 DEFSUBR (Fset_marker); 507 DEFSUBR (Fset_marker);
517 DEFSUBR (Fcopy_marker); 508 DEFSUBR (Fcopy_marker);
518 DEFSUBR (Fmarker_insertion_type); 509 DEFSUBR (Fmarker_insertion_type);
540 void 531 void
541 uninit_buffer_markers (struct buffer *b) 532 uninit_buffer_markers (struct buffer *b)
542 { 533 {
543 /* Unchain all markers of this buffer 534 /* Unchain all markers of this buffer
544 and leave them pointing nowhere. */ 535 and leave them pointing nowhere. */
545 REGISTER Lisp_Marker *m, *next; 536 REGISTER struct Lisp_Marker *m, *next;
546 for (m = BUF_MARKERS (b); m; m = next) 537 for (m = BUF_MARKERS (b); m; m = next)
547 { 538 {
548 m->buffer = 0; 539 m->buffer = 0;
549 next = marker_next (m); 540 next = marker_next (m);
550 marker_next (m) = 0; 541 marker_next (m) = 0;