Mercurial > hg > xemacs-beta

comparison src/rangetab.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 501cfd01ee6d
children 41dbb7a9d5f2
comparison
equal deleted inserted replaced
411:12e008d41344 412:697ef44129c6
39 39
40 #### We should be using the gap array stuff from extents.c. This 40 #### We should be using the gap array stuff from extents.c. This
41 is not hard but just requires moving that stuff out of that file. */ 41 is not hard but just requires moving that stuff out of that file. */
42 42
43 static Lisp_Object 43 static Lisp_Object
44 mark_range_table (Lisp_Object obj) 44 mark_range_table (Lisp_Object obj, void (*markobj) (Lisp_Object))
45 { 45 {
46 Lisp_Range_Table *rt = XRANGE_TABLE (obj); 46 struct Lisp_Range_Table *rt = XRANGE_TABLE (obj);
47 int i; 47 int i;
48 48
49 for (i = 0; i < Dynarr_length (rt->entries); i++) 49 for (i = 0; i < Dynarr_length (rt->entries); i++)
50 mark_object (Dynarr_at (rt->entries, i).val); 50 markobj (Dynarr_at (rt->entries, i).val);
51 return Qnil; 51 return Qnil;
52 } 52 }
53 53
54 static void 54 static void
55 print_range_table (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) 55 print_range_table (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
56 { 56 {
57 Lisp_Range_Table *rt = XRANGE_TABLE (obj); 57 struct Lisp_Range_Table *rt = XRANGE_TABLE (obj);
58 char buf[200]; 58 char buf[200];
59 int i; 59 int i;
60 60
61 write_c_string ("#s(range-table data (", printcharfun); 61 write_c_string ("#s(range-table data (", printcharfun);
62 for (i = 0; i < Dynarr_length (rt->entries); i++) 62 for (i = 0; i < Dynarr_length (rt->entries); i++)
75 } 75 }
76 76
77 static int 77 static int
78 range_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) 78 range_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
79 { 79 {
80 Lisp_Range_Table *rt1 = XRANGE_TABLE (obj1); 80 struct Lisp_Range_Table *rt1 = XRANGE_TABLE (obj1);
81 Lisp_Range_Table *rt2 = XRANGE_TABLE (obj2); 81 struct Lisp_Range_Table *rt2 = XRANGE_TABLE (obj2);
82 int i; 82 int i;
83 83
84 if (Dynarr_length (rt1->entries) != Dynarr_length (rt2->entries)) 84 if (Dynarr_length (rt1->entries) != Dynarr_length (rt2->entries))
85 return 0; 85 return 0;
86 86
105 } 105 }
106 106
107 static unsigned long 107 static unsigned long
108 range_table_hash (Lisp_Object obj, int depth) 108 range_table_hash (Lisp_Object obj, int depth)
109 { 109 {
110 Lisp_Range_Table *rt = XRANGE_TABLE (obj); 110 struct Lisp_Range_Table *rt = XRANGE_TABLE (obj);
111 int i; 111 int i;
112 int size = Dynarr_length (rt->entries); 112 int size = Dynarr_length (rt->entries);
113 unsigned long hash = size; 113 unsigned long hash = size;
114 114
115 /* approach based on internal_array_hash(). */ 115 /* approach based on internal_array_hash(). */
130 i*size/5), 130 i*size/5),
131 depth)); 131 depth));
132 return hash; 132 return hash;
133 } 133 }
134 134
135 static const struct lrecord_description rte_description_1[] = {
136 { XD_LISP_OBJECT, offsetof (range_table_entry, val) },
137 { XD_END }
138 };
139
140 static const struct struct_description rte_description = {
141 sizeof (range_table_entry),
142 rte_description_1
143 };
144
145 static const struct lrecord_description rted_description_1[] = {
146 XD_DYNARR_DESC (range_table_entry_dynarr, &rte_description),
147 { XD_END }
148 };
149
150 static const struct struct_description rted_description = {
151 sizeof (range_table_entry_dynarr),
152 rted_description_1
153 };
154
155 static const struct lrecord_description range_table_description[] = {
156 { XD_STRUCT_PTR, offsetof (Lisp_Range_Table, entries), 1, &rted_description },
157 { XD_END }
158 };
159
160 DEFINE_LRECORD_IMPLEMENTATION ("range-table", range_table, 135 DEFINE_LRECORD_IMPLEMENTATION ("range-table", range_table,
161 mark_range_table, print_range_table, 0, 136 mark_range_table, print_range_table, 0,
162 range_table_equal, range_table_hash, 137 range_table_equal, range_table_hash,
163 range_table_description, 138 struct Lisp_Range_Table);
164 Lisp_Range_Table);
165 139
166 /************************************************************************/ 140 /************************************************************************/
167 /* Range table operations */ 141 /* Range table operations */
168 /************************************************************************/ 142 /************************************************************************/
169 143
170 #ifdef ERROR_CHECK_TYPECHECK 144 #ifdef ERROR_CHECK_TYPECHECK
171 145
172 static void 146 static void
173 verify_range_table (Lisp_Range_Table *rt) 147 verify_range_table (struct Lisp_Range_Table *rt)
174 { 148 {
175 int i; 149 int i;
176 150
177 for (i = 0; i < Dynarr_length (rt->entries); i++) 151 for (i = 0; i < Dynarr_length (rt->entries); i++)
178 { 152 {
231 `remove-range-table', and `clear-range-table'. 205 `remove-range-table', and `clear-range-table'.
232 */ 206 */
233 ()) 207 ())
234 { 208 {
235 Lisp_Object obj; 209 Lisp_Object obj;
236 Lisp_Range_Table *rt = alloc_lcrecord_type (Lisp_Range_Table, 210 struct Lisp_Range_Table *rt = alloc_lcrecord_type (struct Lisp_Range_Table,
237 &lrecord_range_table); 211 &lrecord_range_table);
238 rt->entries = Dynarr_new (range_table_entry); 212 rt->entries = Dynarr_new (range_table_entry);
239 XSETRANGE_TABLE (obj, rt); 213 XSETRANGE_TABLE (obj, rt);
240 return obj; 214 return obj;
241 } 215 }
242 216
244 Make a new range table which contains the same values for the same 218 Make a new range table which contains the same values for the same
245 ranges as the given table. The values will not themselves be copied. 219 ranges as the given table. The values will not themselves be copied.
246 */ 220 */
247 (old_table)) 221 (old_table))
248 { 222 {
249 Lisp_Range_Table *rt, *rtnew; 223 struct Lisp_Range_Table *rt, *rtnew;
250 Lisp_Object obj; 224 Lisp_Object obj;
251 225
252 CHECK_RANGE_TABLE (old_table); 226 CHECK_RANGE_TABLE (old_table);
253 rt = XRANGE_TABLE (old_table); 227 rt = XRANGE_TABLE (old_table);
254 228
255 rtnew = alloc_lcrecord_type (Lisp_Range_Table, &lrecord_range_table); 229 rtnew = alloc_lcrecord_type (struct Lisp_Range_Table, &lrecord_range_table);
256 rtnew->entries = Dynarr_new (range_table_entry); 230 rtnew->entries = Dynarr_new (range_table_entry);
257 231
258 Dynarr_add_many (rtnew->entries, Dynarr_atp (rt->entries, 0), 232 Dynarr_add_many (rtnew->entries, Dynarr_atp (rt->entries, 0),
259 Dynarr_length (rt->entries)); 233 Dynarr_length (rt->entries));
260 XSETRANGE_TABLE (obj, rtnew); 234 XSETRANGE_TABLE (obj, rtnew);
265 Find value for position POS in TABLE. 239 Find value for position POS in TABLE.
266 If there is no corresponding value, return DEFAULT (defaults to nil). 240 If there is no corresponding value, return DEFAULT (defaults to nil).
267 */ 241 */
268 (pos, table, default_)) 242 (pos, table, default_))
269 { 243 {
270 Lisp_Range_Table *rt; 244 struct Lisp_Range_Table *rt;
271 245
272 CHECK_RANGE_TABLE (table); 246 CHECK_RANGE_TABLE (table);
273 rt = XRANGE_TABLE (table); 247 rt = XRANGE_TABLE (table);
274 248
275 CHECK_INT_COERCE_CHAR (pos); 249 CHECK_INT_COERCE_CHAR (pos);
282 put_range_table (Lisp_Object table, EMACS_INT first, 256 put_range_table (Lisp_Object table, EMACS_INT first,
283 EMACS_INT last, Lisp_Object val) 257 EMACS_INT last, Lisp_Object val)
284 { 258 {
285 int i; 259 int i;
286 int insert_me_here = -1; 260 int insert_me_here = -1;
287 Lisp_Range_Table *rt = XRANGE_TABLE (table); 261 struct Lisp_Range_Table *rt = XRANGE_TABLE (table);
288 262
289 /* Now insert in the proper place. This gets tricky because 263 /* Now insert in the proper place. This gets tricky because
290 we may be overlapping one or more existing ranges and need 264 we may be overlapping one or more existing ranges and need
291 to fix them up. */ 265 to fix them up. */
292 266
441 } 415 }
442 416
443 DEFUN ("map-range-table", Fmap_range_table, 2, 2, 0, /* 417 DEFUN ("map-range-table", Fmap_range_table, 2, 2, 0, /*
444 Map FUNCTION over entries in TABLE, calling it with three args, 418 Map FUNCTION over entries in TABLE, calling it with three args,
445 the beginning and end of the range and the corresponding value. 419 the beginning and end of the range and the corresponding value.
446
447 Results are guaranteed to be correct (i.e. each entry processed
448 exactly once) if FUNCTION modifies or deletes the current entry
449 (i.e. passes the current range to `put-range-table' or
450 `remove-range-table'), but not otherwise.
451 */ 420 */
452 (function, table)) 421 (function, table))
453 { 422 {
454 Lisp_Range_Table *rt; 423 error ("not yet implemented");
455 int i;
456
457 CHECK_RANGE_TABLE (table);
458 CHECK_FUNCTION (function);
459
460 rt = XRANGE_TABLE (table);
461
462 /* Do not "optimize" by pulling out the length computation below!
463 FUNCTION may have changed the table. */
464 for (i = 0; i < Dynarr_length (rt->entries); i++)
465 {
466 struct range_table_entry *entry = Dynarr_atp (rt->entries, i);
467 EMACS_INT first, last;
468 Lisp_Object args[4];
469 int oldlen;
470
471 again:
472 first = entry->first;
473 last = entry->last;
474 oldlen = Dynarr_length (rt->entries);
475 args[0] = function;
476 args[1] = make_int (first);
477 args[2] = make_int (last);
478 args[3] = entry->val;
479 Ffuncall (countof (args), args);
480 /* Has FUNCTION removed the entry? */
481 if (oldlen > Dynarr_length (rt->entries)
482 && i < Dynarr_length (rt->entries)
483 && (first != entry->first || last != entry->last))
484 goto again;
485 }
486
487 return Qnil; 424 return Qnil;
488 } 425 }
489 426
490 427
491 /************************************************************************/ 428 /************************************************************************/
739 /************************************************************************/ 676 /************************************************************************/
740 677
741 void 678 void
742 syms_of_rangetab (void) 679 syms_of_rangetab (void)
743 { 680 {
744 INIT_LRECORD_IMPLEMENTATION (range_table);
745
746 defsymbol (&Qrange_tablep, "range-table-p"); 681 defsymbol (&Qrange_tablep, "range-table-p");
747 defsymbol (&Qrange_table, "range-table"); 682 defsymbol (&Qrange_table, "range-table");
748 683
749 DEFSUBR (Frange_table_p); 684 DEFSUBR (Frange_table_p);
750 DEFSUBR (Fmake_range_table); 685 DEFSUBR (Fmake_range_table);