Mercurial > hg > xemacs-beta

comparison src/marker.c @ 398:74fd4e045ea6 r21-2-29

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-29
author cvs
date Mon, 13 Aug 2007 11:13:30 +0200
parents 8626e4521993
children a86b2b5e0111
comparison
equal deleted inserted replaced
397:f4aeb21a5bad 398:74fd4e045ea6
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, void (*markobj) (Lisp_Object)) 39 mark_marker (Lisp_Object obj)
40 { 40 {
41 struct Lisp_Marker *marker = XMARKER (obj); 41 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 struct Lisp_Marker *marker = XMARKER (obj); 58 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 %d in ", marker_position (obj)); 69 sprintf (buf, "at %ld in ", (long) 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 struct Lisp_Marker *marker1 = XMARKER (obj1); 80 Lisp_Marker *marker1 = XMARKER (obj1);
81 struct Lisp_Marker *marker2 = XMARKER (obj2); 81 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
98 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("marker", marker, 105 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("marker", marker,
99 mark_marker, print_marker, 0, 106 mark_marker, print_marker, 0,
100 marker_equal, marker_hash, 107 marker_equal, marker_hash, marker_description,
101 struct Lisp_Marker); 108 Lisp_Marker);
102 109
103 /* Operations on markers. */ 110 /* Operations on markers. */
104 111
105 DEFUN ("marker-buffer", Fmarker_buffer, 1, 1, 0, /* 112 DEFUN ("marker-buffer", Fmarker_buffer, 1, 1, 0, /*
106 Return the buffer that MARKER points into, or nil if none. 113 Return the buffer that MARKER points into, or nil if none.
133 #if 0 /* useful debugging function */ 140 #if 0 /* useful debugging function */
134 141
135 static void 142 static void
136 check_marker_circularities (struct buffer *buf) 143 check_marker_circularities (struct buffer *buf)
137 { 144 {
138 struct Lisp_Marker *tortoise, *hare; 145 Lisp_Marker *tortoise, *hare;
139 146
140 tortoise = BUF_MARKERS (buf); 147 tortoise = BUF_MARKERS (buf);
141 hare = tortoise; 148 hare = tortoise;
142 149
143 if (!tortoise) 150 if (!tortoise)
164 set_marker_internal (Lisp_Object marker, Lisp_Object pos, Lisp_Object buffer, 171 set_marker_internal (Lisp_Object marker, Lisp_Object pos, Lisp_Object buffer,
165 int restricted_p) 172 int restricted_p)
166 { 173 {
167 Bufpos charno; 174 Bufpos charno;
168 struct buffer *b; 175 struct buffer *b;
169 struct Lisp_Marker *m; 176 Lisp_Marker *m;
170 int point_p; 177 int point_p;
171 178
172 CHECK_MARKER (marker); 179 CHECK_MARKER (marker);
173 180
174 point_p = POINT_MARKER_P (marker); 181 point_p = POINT_MARKER_P (marker);
280 including those in chain fields of markers. */ 287 including those in chain fields of markers. */
281 288
282 void 289 void
283 unchain_marker (Lisp_Object m) 290 unchain_marker (Lisp_Object m)
284 { 291 {
285 struct Lisp_Marker *marker = XMARKER (m); 292 Lisp_Marker *marker = XMARKER (m);
286 struct buffer *b = marker->buffer; 293 struct buffer *b = marker->buffer;
287 294
288 if (b == 0) 295 if (b == 0)
289 return; 296 return;
290 297
307 } 314 }
308 315
309 Bytind 316 Bytind
310 bi_marker_position (Lisp_Object marker) 317 bi_marker_position (Lisp_Object marker)
311 { 318 {
312 struct Lisp_Marker *m = XMARKER (marker); 319 Lisp_Marker *m = XMARKER (marker);
313 struct buffer *buf = m->buffer; 320 struct buffer *buf = m->buffer;
314 Bytind pos; 321 Bytind pos;
315 322
316 if (!buf) 323 if (!buf)
317 error ("Marker does not point anywhere"); 324 error ("Marker does not point anywhere");
344 } 351 }
345 352
346 void 353 void
347 set_bi_marker_position (Lisp_Object marker, Bytind pos) 354 set_bi_marker_position (Lisp_Object marker, Bytind pos)
348 { 355 {
349 struct Lisp_Marker *m = XMARKER (marker); 356 Lisp_Marker *m = XMARKER (marker);
350 struct buffer *buf = m->buffer; 357 struct buffer *buf = m->buffer;
351 358
352 if (!buf) 359 if (!buf)
353 error ("Marker does not point anywhere"); 360 error ("Marker does not point anywhere");
354 361
451 xxDEFUN ("buffer-has-markers-at", Fbuffer_has_markers_at, 1, 1, 0, /* 458 xxDEFUN ("buffer-has-markers-at", Fbuffer_has_markers_at, 1, 1, 0, /*
452 Return t if there are markers pointing at POSITION in the current buffer. 459 Return t if there are markers pointing at POSITION in the current buffer.
453 */ 460 */
454 (position)) 461 (position))
455 { 462 {
456 struct Lisp_Marker *marker; 463 Lisp_Marker *marker;
457 Memind pos; 464 Memind pos;
458 465
459 /* A small optimization trick: convert POS to memind now, rather 466 /* A small optimization trick: convert POS to memind now, rather
460 than converting every marker's memory index to bufpos. */ 467 than converting every marker's memory index to bufpos. */
461 pos = bytind_to_memind (current_buffer, 468 pos = bytind_to_memind (current_buffer,
480 #ifdef MEMORY_USAGE_STATS 487 #ifdef MEMORY_USAGE_STATS
481 488
482 int 489 int
483 compute_buffer_marker_usage (struct buffer *b, struct overhead_stats *ovstats) 490 compute_buffer_marker_usage (struct buffer *b, struct overhead_stats *ovstats)
484 { 491 {
485 struct Lisp_Marker *m; 492 Lisp_Marker *m;
486 int total = 0; 493 int total = 0;
487 int overhead; 494 int overhead;
488 495
489 for (m = BUF_MARKERS (b); m; m = m->next) 496 for (m = BUF_MARKERS (b); m; m = m->next)
490 total += sizeof (struct Lisp_Marker); 497 total += sizeof (Lisp_Marker);
491 ovstats->was_requested += total; 498 ovstats->was_requested += total;
492 overhead = fixed_type_block_overhead (total); 499 overhead = fixed_type_block_overhead (total);
493 /* #### claiming this is all malloc overhead is not really right, 500 /* #### claiming this is all malloc overhead is not really right,
494 but it has to go somewhere. */ 501 but it has to go somewhere. */
495 ovstats->malloc_overhead += overhead; 502 ovstats->malloc_overhead += overhead;
531 void 538 void
532 uninit_buffer_markers (struct buffer *b) 539 uninit_buffer_markers (struct buffer *b)
533 { 540 {
534 /* Unchain all markers of this buffer 541 /* Unchain all markers of this buffer
535 and leave them pointing nowhere. */ 542 and leave them pointing nowhere. */
536 REGISTER struct Lisp_Marker *m, *next; 543 REGISTER Lisp_Marker *m, *next;
537 for (m = BUF_MARKERS (b); m; m = next) 544 for (m = BUF_MARKERS (b); m; m = next)
538 { 545 {
539 m->buffer = 0; 546 m->buffer = 0;
540 next = marker_next (m); 547 next = marker_next (m);
541 marker_next (m) = 0; 548 marker_next (m) = 0;