Mercurial > hg > xemacs-beta
annotate src/rangetab.c @ 5773:94a6b8fbd56e
Use a face, show more context around open parenthesis, #'blink-matching-open
lisp/ChangeLog addition:
2013-12-17 Aidan Kehoe <kehoea@parhasard.net>
* simple.el (blink-matching-open):
When showing the opening parenthesis in the minibiffer, use the
isearch face for it, in case there are multiple parentheses in the
text shown.
When writing moderately involved macros, it's often not enough
just to show the backquote context before the parenthesis
(e.g. @,.`). Skip over that when searching for useful context in
the same way we skip over space and tab.
* simple.el (message):
* simple.el (lmessage):
If there are no ARGS, don't call #'format. This allows extent
information to be passed through to the minibuffer.
It's probably better still to update #'format to preserve extent
info.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Tue, 17 Dec 2013 20:49:52 +0200 |
| parents | 56144c8593a8 |
| children |
| rev | line source |
|---|---|
| 428 | 1 /* XEmacs routines to deal with range tables. |
| 2 Copyright (C) 1995 Sun Microsystems, Inc. | |
|
4831
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
3 Copyright (C) 1995, 2002, 2004, 2005, 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:
5222
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:
5222
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:
5222
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:
5222
diff
changeset
|
18 along with XEmacs. If not, see <http://www.gnu.org/licenses/>. */ |
| 428 | 19 |
| 20 /* Synched up with: Not in FSF. */ | |
| 21 | |
| 22 /* Written by Ben Wing, August 1995. */ | |
| 23 | |
| 24 #include <config.h> | |
| 25 #include "lisp.h" | |
| 26 #include "rangetab.h" | |
| 27 | |
| 28 Lisp_Object Qrange_tablep; | |
| 29 Lisp_Object Qrange_table; | |
| 30 | |
| 2421 | 31 Lisp_Object Qstart_closed_end_open; |
| 32 Lisp_Object Qstart_open_end_open; | |
| 33 Lisp_Object Qstart_closed_end_closed; | |
| 34 Lisp_Object Qstart_open_end_closed; | |
| 35 | |
| 428 | 36 |
| 37 /************************************************************************/ | |
| 38 /* Range table object */ | |
| 39 /************************************************************************/ | |
| 40 | |
| 2421 | 41 static enum range_table_type |
| 42 range_table_symbol_to_type (Lisp_Object symbol) | |
| 43 { | |
| 44 if (NILP (symbol)) | |
| 45 return RANGE_START_CLOSED_END_OPEN; | |
| 46 | |
| 47 CHECK_SYMBOL (symbol); | |
| 48 if (EQ (symbol, Qstart_closed_end_open)) | |
| 49 return RANGE_START_CLOSED_END_OPEN; | |
| 50 if (EQ (symbol, Qstart_closed_end_closed)) | |
| 51 return RANGE_START_CLOSED_END_CLOSED; | |
| 52 if (EQ (symbol, Qstart_open_end_open)) | |
| 53 return RANGE_START_OPEN_END_OPEN; | |
| 54 if (EQ (symbol, Qstart_open_end_closed)) | |
| 55 return RANGE_START_OPEN_END_CLOSED; | |
| 56 | |
| 57 invalid_constant ("Unknown range table type", symbol); | |
| 58 RETURN_NOT_REACHED (RANGE_START_CLOSED_END_OPEN); | |
| 59 } | |
| 60 | |
| 61 static Lisp_Object | |
| 62 range_table_type_to_symbol (enum range_table_type type) | |
| 63 { | |
| 64 switch (type) | |
| 65 { | |
| 66 case RANGE_START_CLOSED_END_OPEN: | |
| 67 return Qstart_closed_end_open; | |
| 68 case RANGE_START_CLOSED_END_CLOSED: | |
| 69 return Qstart_closed_end_closed; | |
| 70 case RANGE_START_OPEN_END_OPEN: | |
| 71 return Qstart_open_end_open; | |
| 72 case RANGE_START_OPEN_END_CLOSED: | |
| 73 return Qstart_open_end_closed; | |
| 74 } | |
| 75 | |
| 2500 | 76 ABORT (); |
| 2421 | 77 return Qnil; |
| 78 } | |
| 79 | |
| 428 | 80 /* We use a sorted array of ranges. |
| 81 | |
| 82 #### We should be using the gap array stuff from extents.c. This | |
| 83 is not hard but just requires moving that stuff out of that file. */ | |
| 84 | |
| 85 static Lisp_Object | |
| 86 mark_range_table (Lisp_Object obj) | |
| 87 { | |
| 440 | 88 Lisp_Range_Table *rt = XRANGE_TABLE (obj); |
| 428 | 89 int i; |
| 90 | |
|
5168
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
91 for (i = 0; i < gap_array_length (rt->entries); i++) |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
92 mark_object (rangetab_gap_array_at (rt->entries, i).val); |
|
4690
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4391
diff
changeset
|
93 |
| 428 | 94 return Qnil; |
| 95 } | |
| 96 | |
| 97 static void | |
| 2286 | 98 print_range_table (Lisp_Object obj, Lisp_Object printcharfun, |
| 99 int UNUSED (escapeflag)) | |
| 428 | 100 { |
| 440 | 101 Lisp_Range_Table *rt = XRANGE_TABLE (obj); |
| 428 | 102 int i; |
| 103 | |
| 2421 | 104 if (print_readably) |
|
5222
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
105 write_fmt_string_lisp (printcharfun, "#s(range-table :type %s :data (", |
| 2421 | 106 1, range_table_type_to_symbol (rt->type)); |
| 107 else | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4831
diff
changeset
|
108 write_ascstring (printcharfun, "#<range-table "); |
|
5168
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
109 for (i = 0; i < gap_array_length (rt->entries); i++) |
| 428 | 110 { |
|
5168
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
111 struct range_table_entry rte = rangetab_gap_array_at (rt->entries, i); |
| 2421 | 112 int so, ec; |
| 428 | 113 if (i > 0) |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4831
diff
changeset
|
114 write_ascstring (printcharfun, " "); |
| 2421 | 115 switch (rt->type) |
| 116 { | |
| 117 case RANGE_START_CLOSED_END_OPEN: so = 0, ec = 0; break; | |
| 118 case RANGE_START_CLOSED_END_CLOSED: so = 0, ec = 1; break; | |
| 119 case RANGE_START_OPEN_END_OPEN: so = 1, ec = 0; break; | |
| 120 case RANGE_START_OPEN_END_CLOSED: so = 1; ec = 1; break; | |
| 2500 | 121 default: ABORT (); so = 0, ec = 0; break; |
| 2421 | 122 } |
| 123 write_fmt_string (printcharfun, "%c%ld %ld%c ", | |
| 124 print_readably ? '(' : so ? '(' : '[', | |
|
5168
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
125 (long) (rte.first - so), |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
126 (long) (rte.last - ec), |
| 2421 | 127 print_readably ? ')' : ec ? ']' : ')' |
| 128 ); | |
|
5168
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
129 print_internal (rte.val, printcharfun, 1); |
| 428 | 130 } |
| 2421 | 131 if (print_readably) |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4831
diff
changeset
|
132 write_ascstring (printcharfun, "))"); |
| 2421 | 133 else |
|
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
|
134 write_fmt_string (printcharfun, " 0x%x>", LISP_OBJECT_UID (obj)); |
| 428 | 135 } |
| 136 | |
|
5560
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
137 static void |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
138 range_table_print_preprocess (Lisp_Object object, |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
139 Lisp_Object print_number_table, |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
140 Elemcount *seen_object_count) |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
141 { |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
142 Lisp_Range_Table *rt = XRANGE_TABLE (object); |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
143 Elemcount ii; |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
144 |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
145 for (ii = 0; ii < gap_array_length (rt->entries); ii++) |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
146 { |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
147 struct range_table_entry *entry |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
148 = gap_array_atp (rt->entries, ii, struct range_table_entry); |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
149 PRINT_PREPROCESS (entry->val, print_number_table, seen_object_count); |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
150 } |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
151 } |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
152 |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
153 static void |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
154 range_table_nsubst_structures_descend (Lisp_Object new_, Lisp_Object old, |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
155 Lisp_Object object, |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
156 Lisp_Object number_table, |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
157 Boolint test_not_unboundp) |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
158 { |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
159 Lisp_Range_Table *rt = XRANGE_TABLE (object); |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
160 Elemcount ii; |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
161 |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
162 /* We don't have to worry about the range table START and END values if |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
163 we're limiting nsubst_descend to the Lisp reader; it's a similar case |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
164 to the hash table test. */ |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
165 for (ii = 0; ii < gap_array_length (rt->entries); ii++) |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
166 { |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
167 struct range_table_entry *entry |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
168 = gap_array_atp (rt->entries, ii, struct range_table_entry); |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
169 |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
170 if (EQ (old, entry->val) == test_not_unboundp) |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
171 { |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
172 entry->val = new_; |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
173 } |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
174 else if (LRECORDP (entry->val) && |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
175 HAS_OBJECT_METH_P (entry->val, nsubst_structures_descend)) |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
176 { |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
177 nsubst_structures_descend (new_, old, entry->val, number_table, |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
178 test_not_unboundp); |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
179 } |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
180 } |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
181 } |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
182 |
| 428 | 183 static int |
|
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4831
diff
changeset
|
184 range_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth, int foldcase) |
| 428 | 185 { |
| 440 | 186 Lisp_Range_Table *rt1 = XRANGE_TABLE (obj1); |
| 187 Lisp_Range_Table *rt2 = XRANGE_TABLE (obj2); | |
| 428 | 188 int i; |
| 189 | |
|
5168
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
190 if (gap_array_length (rt1->entries) != gap_array_length (rt2->entries)) |
| 428 | 191 return 0; |
| 192 | |
|
5168
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
193 for (i = 0; i < gap_array_length (rt1->entries); i++) |
| 428 | 194 { |
|
5168
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
195 struct range_table_entry *rte1 = |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
196 rangetab_gap_array_atp (rt1->entries, i); |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
197 struct range_table_entry *rte2 = |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
198 rangetab_gap_array_atp (rt2->entries, i); |
| 428 | 199 |
| 200 if (rte1->first != rte2->first | |
| 201 || rte1->last != rte2->last | |
|
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4831
diff
changeset
|
202 || !internal_equal_0 (rte1->val, rte2->val, depth + 1, foldcase)) |
| 428 | 203 return 0; |
| 204 } | |
| 205 | |
| 206 return 1; | |
| 207 } | |
| 208 | |
| 2515 | 209 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:
5169
diff
changeset
|
210 range_table_entry_hash (struct range_table_entry *rte, int depth, |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
211 Boolint equalp) |
| 428 | 212 { |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
213 return HASH3 (rte->first, rte->last, |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
214 internal_hash (rte->val, depth + 1, equalp)); |
| 428 | 215 } |
| 216 | |
| 2515 | 217 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:
5169
diff
changeset
|
218 range_table_hash (Lisp_Object obj, int depth, Boolint equalp) |
| 428 | 219 { |
| 440 | 220 Lisp_Range_Table *rt = XRANGE_TABLE (obj); |
| 428 | 221 int i; |
|
5168
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
222 int size = gap_array_length (rt->entries); |
| 2515 | 223 Hashcode hash = size; |
| 428 | 224 |
| 225 /* approach based on internal_array_hash(). */ | |
| 226 if (size <= 5) | |
| 227 { | |
| 228 for (i = 0; i < size; i++) | |
| 229 hash = HASH2 (hash, | |
|
5168
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
230 range_table_entry_hash |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
231 (rangetab_gap_array_atp (rt->entries, i), depth, equalp)); |
| 428 | 232 return hash; |
| 233 } | |
| 234 | |
| 235 /* just pick five elements scattered throughout the array. | |
| 236 A slightly better approach would be to offset by some | |
| 237 noise factor from the points chosen below. */ | |
| 238 for (i = 0; i < 5; i++) | |
|
5168
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
239 hash = HASH2 (hash, |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
240 range_table_entry_hash |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
241 (rangetab_gap_array_atp (rt->entries, i*size/5), |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
242 depth, equalp)); |
| 428 | 243 return hash; |
| 244 } | |
| 245 | |
|
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:
5168
diff
changeset
|
246 #ifndef NEW_GC |
|
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:
5168
diff
changeset
|
247 |
|
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:
5168
diff
changeset
|
248 /* #### This leaks memory under NEW_GC. To fix this, convert to Lisp object |
|
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:
5168
diff
changeset
|
249 gap array. */ |
|
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:
5168
diff
changeset
|
250 |
|
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:
5168
diff
changeset
|
251 static void |
|
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:
5168
diff
changeset
|
252 finalize_range_table (Lisp_Object obj) |
|
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:
5168
diff
changeset
|
253 { |
|
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:
5168
diff
changeset
|
254 Lisp_Range_Table *rt = XRANGE_TABLE (obj); |
|
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:
5168
diff
changeset
|
255 if (rt->entries) |
|
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:
5168
diff
changeset
|
256 { |
|
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:
5168
diff
changeset
|
257 if (!DUMPEDP (rt->entries)) |
|
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:
5168
diff
changeset
|
258 free_gap_array (rt->entries); |
|
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:
5168
diff
changeset
|
259 rt->entries = 0; |
|
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:
5168
diff
changeset
|
260 } |
|
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:
5168
diff
changeset
|
261 } |
|
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:
5168
diff
changeset
|
262 |
|
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:
5168
diff
changeset
|
263 #endif /* not NEW_GC */ |
|
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:
5168
diff
changeset
|
264 |
| 1204 | 265 static const struct memory_description rte_description_1[] = { |
| 440 | 266 { XD_LISP_OBJECT, offsetof (range_table_entry, val) }, |
| 428 | 267 { XD_END } |
| 268 }; | |
| 269 | |
| 1204 | 270 static const struct sized_memory_description rte_description = { |
| 440 | 271 sizeof (range_table_entry), |
| 428 | 272 rte_description_1 |
| 273 }; | |
| 274 | |
|
5168
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
275 static const struct memory_description rtega_description_1[] = { |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
276 XD_GAP_ARRAY_DESC (&rte_description), |
| 428 | 277 { XD_END } |
| 278 }; | |
| 279 | |
|
5168
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
280 static const struct sized_memory_description rtega_description = { |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
281 0, rtega_description_1 |
| 428 | 282 }; |
| 283 | |
| 1204 | 284 static const struct memory_description range_table_description[] = { |
| 2551 | 285 { XD_BLOCK_PTR, offsetof (Lisp_Range_Table, entries), 1, |
|
5168
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
286 { &rtega_description } }, |
| 428 | 287 { XD_END } |
| 288 }; | |
| 289 | |
|
5118
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
290 DEFINE_DUMPABLE_LISP_OBJECT ("range-table", range_table, |
|
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:
5168
diff
changeset
|
291 mark_range_table, print_range_table, |
|
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:
5168
diff
changeset
|
292 IF_OLD_GC (finalize_range_table), |
|
5118
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
293 range_table_equal, range_table_hash, |
|
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
294 range_table_description, |
|
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
295 Lisp_Range_Table); |
| 428 | 296 |
| 297 /************************************************************************/ | |
| 298 /* Range table operations */ | |
| 299 /************************************************************************/ | |
| 300 | |
| 800 | 301 #ifdef ERROR_CHECK_STRUCTURES |
| 428 | 302 |
| 303 static void | |
| 440 | 304 verify_range_table (Lisp_Range_Table *rt) |
| 428 | 305 { |
| 306 int i; | |
| 307 | |
|
5168
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
308 for (i = 0; i < gap_array_length (rt->entries); i++) |
| 428 | 309 { |
|
5168
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
310 struct range_table_entry *rte = rangetab_gap_array_atp (rt->entries, i); |
| 428 | 311 assert (rte->last >= rte->first); |
| 312 if (i > 0) | |
|
5168
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
313 assert (rangetab_gap_array_at (rt->entries, i - 1).last <= rte->first); |
| 428 | 314 } |
| 315 } | |
| 316 | |
| 317 #else | |
| 318 | |
| 319 #define verify_range_table(rt) | |
| 320 | |
| 321 #endif | |
| 322 | |
|
5168
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
323 /* Locate the range table entry corresponding to the value POS, and return |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
324 it. If found, FOUNDP is set to 1 and the return value specifies an entry |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
325 that encloses POS. Otherwise, FOUNDP is set to 0 and the return value |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
326 specifies where an entry that encloses POS would be inserted. */ |
| 428 | 327 |
|
5168
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
328 static Elemcount |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
329 get_range_table_pos (Elemcount pos, Elemcount nentries, |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
330 struct range_table_entry *tab, |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
331 Elemcount gappos, Elemcount gapsize, |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
332 int *foundp) |
| 428 | 333 { |
|
5168
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
334 Elemcount left = 0, right = nentries; |
| 428 | 335 |
| 336 /* binary search for the entry. Based on similar code in | |
| 337 extent_list_locate(). */ | |
| 338 while (left != right) | |
| 339 { | |
| 340 /* RIGHT might not point to a valid entry (i.e. it's at the end | |
| 341 of the list), so NEWPOS must round down. */ | |
|
5168
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
342 Elemcount newpos = (left + right) >> 1; |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
343 struct range_table_entry *entry = |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
344 tab + GAP_ARRAY_ARRAY_TO_MEMORY_POS_1 (newpos, gappos, gapsize); |
| 2421 | 345 if (pos >= entry->last) |
| 346 left = newpos + 1; | |
| 428 | 347 else if (pos < entry->first) |
| 348 right = newpos; | |
| 349 else | |
|
5168
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
350 { |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
351 *foundp = 1; |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
352 return newpos; |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
353 } |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
354 } |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
355 |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
356 *foundp = 0; |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
357 return left; |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
358 } |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
359 |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
360 /* Look up in a range table without the gap array wrapper. |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
361 Used also by the unified range table format. */ |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
362 |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
363 static Lisp_Object |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
364 get_range_table (Elemcount pos, Elemcount nentries, |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
365 struct range_table_entry *tab, |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
366 Elemcount gappos, Elemcount gapsize, |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
367 Lisp_Object default_) |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
368 { |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
369 int foundp; |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
370 Elemcount entrypos = get_range_table_pos (pos, nentries, tab, gappos, |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
371 gapsize, &foundp); |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
372 if (foundp) |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
373 { |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
374 struct range_table_entry *entry = |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
375 tab + GAP_ARRAY_ARRAY_TO_MEMORY_POS_1 (entrypos, gappos, gapsize); |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
376 return entry->val; |
| 428 | 377 } |
| 378 | |
| 379 return default_; | |
| 380 } | |
| 381 | |
| 382 DEFUN ("range-table-p", Frange_table_p, 1, 1, 0, /* | |
| 383 Return non-nil if OBJECT is a range table. | |
| 384 */ | |
| 385 (object)) | |
| 386 { | |
| 387 return RANGE_TABLEP (object) ? Qt : Qnil; | |
| 388 } | |
| 389 | |
| 2421 | 390 DEFUN ("range-table-type", Frange_table_type, 1, 1, 0, /* |
|
4713
312503644bc3
Correct the docstring for #'range-table-type.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4690
diff
changeset
|
391 Return the type of RANGE-TABLE. |
|
312503644bc3
Correct the docstring for #'range-table-type.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4690
diff
changeset
|
392 |
|
312503644bc3
Correct the docstring for #'range-table-type.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4690
diff
changeset
|
393 This will be a symbol describing how ranges in RANGE-TABLE function at their |
|
312503644bc3
Correct the docstring for #'range-table-type.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4690
diff
changeset
|
394 ends; see `make-range-table'. |
| 2421 | 395 */ |
| 396 (range_table)) | |
| 397 { | |
| 398 CHECK_RANGE_TABLE (range_table); | |
| 399 return range_table_type_to_symbol (XRANGE_TABLE (range_table)->type); | |
| 400 } | |
| 401 | |
| 402 DEFUN ("make-range-table", Fmake_range_table, 0, 1, 0, /* | |
| 428 | 403 Return a new, empty range table. |
| 404 You can manipulate it using `put-range-table', `get-range-table', | |
| 405 `remove-range-table', and `clear-range-table'. | |
| 2421 | 406 Range tables allow you to efficiently set values for ranges of integers. |
| 407 | |
| 408 TYPE is a symbol indicating how ranges are assumed to function at their | |
| 409 ends. It can be one of | |
| 410 | |
| 411 SYMBOL RANGE-START RANGE-END | |
| 412 ------ ----------- --------- | |
| 413 `start-closed-end-open' (the default) closed open | |
| 414 `start-closed-end-closed' closed closed | |
| 415 `start-open-end-open' open open | |
| 416 `start-open-end-closed' open closed | |
| 417 | |
| 418 A `closed' endpoint of a range means that the number at that end is included | |
| 419 in the range. For an `open' endpoint, the number would not be included. | |
| 420 | |
| 421 For example, a closed-open range from 5 to 20 would be indicated as [5, | |
| 422 20) where a bracket indicates a closed end and a parenthesis an open end, | |
| 423 and would mean `all the numbers between 5 and 20', including 5 but not 20. | |
| 424 This seems a little strange at first but is in fact extremely common in | |
| 425 the outside world as well as in computers and makes things work sensibly. | |
| 426 For example, if I say "there are seven days between today and next week | |
| 427 today", I'm including today but not next week today; if I included both, | |
| 428 there would be eight days. Similarly, there are 15 (= 20 - 5) elements in | |
| 429 the range [5, 20), but 16 in the range [5, 20]. | |
| 428 | 430 */ |
| 2421 | 431 (type)) |
| 428 | 432 { |
|
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5125
diff
changeset
|
433 Lisp_Object obj = ALLOC_NORMAL_LISP_OBJECT (range_table); |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3017
diff
changeset
|
434 Lisp_Range_Table *rt = XRANGE_TABLE (obj); |
|
5168
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
435 rt->entries = make_gap_array (sizeof (struct range_table_entry), 0); |
| 2421 | 436 rt->type = range_table_symbol_to_type (type); |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3017
diff
changeset
|
437 return obj; |
| 428 | 438 } |
| 439 | |
| 440 DEFUN ("copy-range-table", Fcopy_range_table, 1, 1, 0, /* | |
| 444 | 441 Return a new range table which is a copy of RANGE-TABLE. |
| 442 It will contain the same values for the same ranges as RANGE-TABLE. | |
| 443 The values will not themselves be copied. | |
| 428 | 444 */ |
| 444 | 445 (range_table)) |
| 428 | 446 { |
| 440 | 447 Lisp_Range_Table *rt, *rtnew; |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3017
diff
changeset
|
448 Lisp_Object obj; |
|
5168
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
449 Elemcount i; |
| 428 | 450 |
| 444 | 451 CHECK_RANGE_TABLE (range_table); |
| 452 rt = XRANGE_TABLE (range_table); | |
| 428 | 453 |
|
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5125
diff
changeset
|
454 obj = ALLOC_NORMAL_LISP_OBJECT (range_table); |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3017
diff
changeset
|
455 rtnew = XRANGE_TABLE (obj); |
|
5168
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
456 rtnew->entries = make_gap_array (sizeof (struct range_table_entry), 0); |
| 2421 | 457 rtnew->type = rt->type; |
| 428 | 458 |
|
5168
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
459 for (i = 0; i < gap_array_length (rt->entries); i++) |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
460 rtnew->entries = |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
461 gap_array_insert_els (rtnew->entries, i, |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
462 rangetab_gap_array_atp (rt->entries, i), 1); |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3017
diff
changeset
|
463 return obj; |
| 428 | 464 } |
| 465 | |
| 466 DEFUN ("get-range-table", Fget_range_table, 2, 3, 0, /* | |
| 444 | 467 Find value for position POS in RANGE-TABLE. |
| 428 | 468 If there is no corresponding value, return DEFAULT (defaults to nil). |
| 469 */ | |
| 444 | 470 (pos, range_table, default_)) |
| 428 | 471 { |
| 440 | 472 Lisp_Range_Table *rt; |
| 428 | 473 |
| 444 | 474 CHECK_RANGE_TABLE (range_table); |
| 475 rt = XRANGE_TABLE (range_table); | |
| 428 | 476 |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5560
diff
changeset
|
477 CHECK_FIXNUM_COERCE_CHAR (pos); |
| 428 | 478 |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5560
diff
changeset
|
479 return get_range_table (XFIXNUM (pos), gap_array_length (rt->entries), |
|
5168
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
480 gap_array_begin (rt->entries, |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
481 struct range_table_entry), |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
482 gap_array_gappos (rt->entries), |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
483 gap_array_gapsize (rt->entries), |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
484 default_); |
| 428 | 485 } |
| 486 | |
|
4831
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
487 static void |
|
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
488 external_to_internal_adjust_ends (enum range_table_type type, |
|
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
489 EMACS_INT *first, EMACS_INT *last) |
|
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
490 { |
|
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
491 /* Fix up the numbers in accordance with the open/closedness to make |
|
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
492 them behave like default open/closed. */ |
|
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
493 switch (type) |
|
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
494 { |
|
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
495 case RANGE_START_CLOSED_END_OPEN: break; |
|
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
496 case RANGE_START_CLOSED_END_CLOSED: (*last)++; break; |
|
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
497 case RANGE_START_OPEN_END_OPEN: (*first)++; break; |
|
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
498 case RANGE_START_OPEN_END_CLOSED: (*first)++, (*last)++; break; |
|
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
499 } |
|
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
500 } |
|
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
501 |
|
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
502 static void |
|
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
503 internal_to_external_adjust_ends (enum range_table_type type, |
|
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
504 EMACS_INT *first, EMACS_INT *last) |
|
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
505 { |
|
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
506 /* Reverse the changes made in external_to_internal_adjust_ends(). |
|
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
507 */ |
|
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
508 switch (type) |
|
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
509 { |
|
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
510 case RANGE_START_CLOSED_END_OPEN: break; |
|
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
511 case RANGE_START_CLOSED_END_CLOSED: (*last)--; break; |
|
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
512 case RANGE_START_OPEN_END_OPEN: (*first)--; break; |
|
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
513 case RANGE_START_OPEN_END_CLOSED: (*first)--, (*last)--; break; |
|
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
514 } |
|
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
515 } |
|
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
516 |
| 428 | 517 void |
| 518 put_range_table (Lisp_Object table, EMACS_INT first, | |
| 519 EMACS_INT last, Lisp_Object val) | |
| 520 { | |
| 521 int i; | |
| 522 int insert_me_here = -1; | |
| 440 | 523 Lisp_Range_Table *rt = XRANGE_TABLE (table); |
|
5168
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
524 int foundp; |
| 428 | 525 |
|
4831
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
526 external_to_internal_adjust_ends (rt->type, &first, &last); |
| 2421 | 527 if (first == last) |
| 528 return; | |
| 529 if (first > last) | |
| 530 /* This will happen if originally first == last and both ends are | |
| 531 open. #### Should we signal an error? */ | |
| 532 return; | |
| 533 | |
|
5168
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
534 if (DUMPEDP (rt->entries)) |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
535 rt->entries = gap_array_clone (rt->entries); |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
536 |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
537 i = get_range_table_pos (first, gap_array_length (rt->entries), |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
538 gap_array_begin (rt->entries, |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
539 struct range_table_entry), |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
540 gap_array_gappos (rt->entries), |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
541 gap_array_gapsize (rt->entries), &foundp); |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
542 |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
543 #ifdef ERROR_CHECK_TYPES |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
544 if (foundp) |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
545 { |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
546 if (i < gap_array_length (rt->entries)) |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
547 { |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
548 struct range_table_entry *entry = |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
549 rangetab_gap_array_atp (rt->entries, i); |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
550 assert (first >= entry->first && first < entry->last); |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
551 } |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
552 } |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
553 else |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
554 { |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
555 if (i < gap_array_length (rt->entries)) |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
556 { |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
557 struct range_table_entry *entry = |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
558 rangetab_gap_array_atp (rt->entries, i); |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
559 assert (first < entry->first); |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
560 } |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
561 if (i > 0) |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
562 { |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
563 struct range_table_entry *entry = |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
564 rangetab_gap_array_atp (rt->entries, i - 1); |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
565 assert (first >= entry->last); |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
566 } |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
567 } |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
568 #endif /* ERROR_CHECK_TYPES */ |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
569 |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
570 /* If the beginning of the new range isn't within any existing range, |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
571 it might still be just grazing the end of an end-open range (remember, |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
572 internally all ranges are start-close end-open); so back up one |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
573 so we consider this range. */ |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
574 if (!foundp && i > 0) |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
575 i--; |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
576 |
| 428 | 577 /* Now insert in the proper place. This gets tricky because |
| 578 we may be overlapping one or more existing ranges and need | |
| 579 to fix them up. */ | |
| 580 | |
| 581 /* First delete all sections of any existing ranges that overlap | |
| 582 the new range. */ | |
|
5168
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
583 for (; i < gap_array_length (rt->entries); i++) |
| 428 | 584 { |
|
5168
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
585 struct range_table_entry *entry = |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
586 rangetab_gap_array_atp (rt->entries, i); |
| 428 | 587 /* We insert before the first range that begins at or after the |
| 588 new range. */ | |
| 589 if (entry->first >= first && insert_me_here < 0) | |
| 590 insert_me_here = i; | |
| 591 if (entry->last < first) | |
| 592 /* completely before the new range. */ | |
| 593 continue; | |
| 594 if (entry->first > last) | |
| 595 /* completely after the new range. No more possibilities of | |
| 596 finding overlapping ranges. */ | |
| 597 break; | |
| 2421 | 598 /* At this point the existing ENTRY overlaps or touches the new one. */ |
| 428 | 599 if (entry->first < first && entry->last <= last) |
| 600 { | |
| 601 /* looks like: | |
| 602 | |
| 2421 | 603 [ NEW ) |
| 604 [ EXISTING ) | |
| 605 | |
| 606 or | |
| 607 | |
| 608 [ NEW ) | |
| 609 [ EXISTING ) | |
| 428 | 610 |
| 611 */ | |
| 612 /* truncate the end off of it. */ | |
| 2421 | 613 entry->last = first; |
| 428 | 614 } |
| 615 else if (entry->first < first && entry->last > last) | |
| 616 /* looks like: | |
| 617 | |
| 2421 | 618 [ NEW ) |
| 619 [ EXISTING ) | |
| 428 | 620 |
| 621 */ | |
| 622 /* need to split this one in two. */ | |
| 623 { | |
| 624 struct range_table_entry insert_me_too; | |
| 625 | |
| 2421 | 626 insert_me_too.first = last; |
| 428 | 627 insert_me_too.last = entry->last; |
| 628 insert_me_too.val = entry->val; | |
| 2421 | 629 entry->last = first; |
|
5168
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
630 rt->entries = |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
631 gap_array_insert_els (rt->entries, i + 1, &insert_me_too, 1); |
| 428 | 632 } |
| 2421 | 633 else if (entry->last >= last) |
| 428 | 634 { |
| 635 /* looks like: | |
| 636 | |
| 2421 | 637 [ NEW ) |
| 638 [ EXISTING ) | |
| 639 | |
| 640 or | |
| 641 | |
| 642 [ NEW ) | |
| 643 [ EXISTING ) | |
| 428 | 644 |
| 645 */ | |
| 646 /* truncate the start off of it. */ | |
| 2421 | 647 entry->first = last; |
| 428 | 648 } |
| 649 else | |
| 650 { | |
| 651 /* existing is entirely within new. */ | |
|
5168
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
652 gap_array_delete_els (rt->entries, i, 1); |
| 428 | 653 i--; /* back up since everything shifted one to the left. */ |
| 654 } | |
| 655 } | |
| 656 | |
| 657 /* Someone asked us to delete the range, not insert it. */ | |
| 658 if (UNBOUNDP (val)) | |
| 659 return; | |
| 660 | |
| 661 /* Now insert the new entry, maybe at the end. */ | |
| 662 | |
| 663 if (insert_me_here < 0) | |
| 664 insert_me_here = i; | |
| 665 | |
| 666 { | |
| 667 struct range_table_entry insert_me; | |
| 668 | |
| 669 insert_me.first = first; | |
| 670 insert_me.last = last; | |
| 671 insert_me.val = val; | |
| 672 | |
|
5168
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
673 rt->entries = |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
674 gap_array_insert_els (rt->entries, insert_me_here, &insert_me, 1); |
| 428 | 675 } |
| 676 | |
| 677 /* Now see if we can combine this entry with adjacent ones just | |
| 678 before or after. */ | |
| 679 | |
| 680 if (insert_me_here > 0) | |
| 681 { | |
|
5168
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
682 struct range_table_entry *entry = |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
683 rangetab_gap_array_atp (rt->entries, insert_me_here - 1); |
| 2421 | 684 if (EQ (val, entry->val) && entry->last == first) |
| 428 | 685 { |
| 686 entry->last = last; | |
|
5168
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
687 gap_array_delete_els (rt->entries, insert_me_here, 1); |
| 428 | 688 insert_me_here--; |
| 689 /* We have morphed into a larger range. Update our records | |
| 690 in case we also combine with the one after. */ | |
| 691 first = entry->first; | |
| 692 } | |
| 693 } | |
| 694 | |
|
5168
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
695 if (insert_me_here < gap_array_length (rt->entries) - 1) |
| 428 | 696 { |
|
5168
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
697 struct range_table_entry *entry = |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
698 rangetab_gap_array_atp (rt->entries, insert_me_here + 1); |
| 2421 | 699 if (EQ (val, entry->val) && entry->first == last) |
| 428 | 700 { |
| 701 entry->first = first; | |
|
5168
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
702 gap_array_delete_els (rt->entries, insert_me_here, 1); |
| 428 | 703 } |
| 704 } | |
| 705 } | |
| 706 | |
| 707 DEFUN ("put-range-table", Fput_range_table, 4, 4, 0, /* | |
| 2421 | 708 Set the value for range START .. END to be VALUE in RANGE-TABLE. |
| 428 | 709 */ |
| 444 | 710 (start, end, value, range_table)) |
| 428 | 711 { |
| 712 EMACS_INT first, last; | |
| 713 | |
| 444 | 714 CHECK_RANGE_TABLE (range_table); |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5560
diff
changeset
|
715 CHECK_FIXNUM_COERCE_CHAR (start); |
|
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5560
diff
changeset
|
716 first = XFIXNUM (start); |
|
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5560
diff
changeset
|
717 CHECK_FIXNUM_COERCE_CHAR (end); |
|
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5560
diff
changeset
|
718 last = XFIXNUM (end); |
| 428 | 719 if (first > last) |
| 563 | 720 invalid_argument_2 ("start must be <= end", start, end); |
| 428 | 721 |
| 444 | 722 put_range_table (range_table, first, last, value); |
| 723 verify_range_table (XRANGE_TABLE (range_table)); | |
| 428 | 724 return Qnil; |
| 725 } | |
| 726 | |
| 727 DEFUN ("remove-range-table", Fremove_range_table, 3, 3, 0, /* | |
| 2421 | 728 Remove the value for range START .. END in RANGE-TABLE. |
| 428 | 729 */ |
| 444 | 730 (start, end, range_table)) |
| 428 | 731 { |
| 444 | 732 return Fput_range_table (start, end, Qunbound, range_table); |
| 428 | 733 } |
| 734 | |
| 735 DEFUN ("clear-range-table", Fclear_range_table, 1, 1, 0, /* | |
| 444 | 736 Flush RANGE-TABLE. |
| 428 | 737 */ |
| 444 | 738 (range_table)) |
| 428 | 739 { |
| 444 | 740 CHECK_RANGE_TABLE (range_table); |
|
5168
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
741 gap_array_delete_all_els (XRANGE_TABLE (range_table)->entries); |
| 428 | 742 return Qnil; |
| 743 } | |
| 744 | |
| 745 DEFUN ("map-range-table", Fmap_range_table, 2, 2, 0, /* | |
| 444 | 746 Map FUNCTION over entries in RANGE-TABLE, calling it with three args, |
| 428 | 747 the beginning and end of the range and the corresponding value. |
| 442 | 748 |
| 749 Results are guaranteed to be correct (i.e. each entry processed | |
| 750 exactly once) if FUNCTION modifies or deletes the current entry | |
| 444 | 751 \(i.e. passes the current range to `put-range-table' or |
|
4391
cbf129b005df
Clarify #'map-range-table docstring.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3017
diff
changeset
|
752 `remove-range-table'). If FUNCTION modifies or deletes any other entry, |
|
cbf129b005df
Clarify #'map-range-table docstring.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3017
diff
changeset
|
753 this guarantee doesn't hold. |
| 428 | 754 */ |
| 444 | 755 (function, range_table)) |
| 428 | 756 { |
| 442 | 757 Lisp_Range_Table *rt; |
| 758 int i; | |
| 759 | |
| 444 | 760 CHECK_RANGE_TABLE (range_table); |
| 442 | 761 CHECK_FUNCTION (function); |
| 762 | |
| 444 | 763 rt = XRANGE_TABLE (range_table); |
| 442 | 764 |
| 765 /* Do not "optimize" by pulling out the length computation below! | |
| 766 FUNCTION may have changed the table. */ | |
|
5168
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
767 for (i = 0; i < gap_array_length (rt->entries); i++) |
| 442 | 768 { |
|
5168
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
769 struct range_table_entry entry = |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
770 rangetab_gap_array_at (rt->entries, i); |
| 442 | 771 EMACS_INT first, last; |
| 772 Lisp_Object args[4]; | |
| 773 int oldlen; | |
| 774 | |
| 775 again: | |
|
5168
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
776 first = entry.first; |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
777 last = entry.last; |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
778 oldlen = gap_array_length (rt->entries); |
| 442 | 779 args[0] = function; |
| 2952 | 780 /* Fix up the numbers in accordance with the open/closedness of the |
| 781 table. */ | |
| 782 { | |
| 783 EMACS_INT premier = first, dernier = last; | |
|
4831
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
784 internal_to_external_adjust_ends (rt->type, &premier, &dernier); |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5560
diff
changeset
|
785 args[1] = make_fixnum (premier); |
|
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5560
diff
changeset
|
786 args[2] = make_fixnum (dernier); |
| 2952 | 787 } |
|
5168
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
788 args[3] = entry.val; |
| 442 | 789 Ffuncall (countof (args), args); |
| 790 /* Has FUNCTION removed the entry? */ | |
|
5168
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
791 if (oldlen > gap_array_length (rt->entries) |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
792 && i < gap_array_length (rt->entries) |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
793 && (first != entry.first || last != entry.last)) |
| 442 | 794 goto again; |
| 795 } | |
| 796 | |
| 428 | 797 return Qnil; |
| 798 } | |
| 799 | |
| 800 | |
| 801 /************************************************************************/ | |
| 802 /* Range table read syntax */ | |
| 803 /************************************************************************/ | |
| 804 | |
| 805 static int | |
| 2421 | 806 rangetab_type_validate (Lisp_Object UNUSED (keyword), Lisp_Object value, |
| 807 Error_Behavior UNUSED (errb)) | |
| 808 { | |
| 809 /* #### should deal with ERRB */ | |
| 810 range_table_symbol_to_type (value); | |
| 811 return 1; | |
| 812 } | |
| 813 | |
| 814 static int | |
| 2286 | 815 rangetab_data_validate (Lisp_Object UNUSED (keyword), Lisp_Object value, |
| 816 Error_Behavior UNUSED (errb)) | |
| 428 | 817 { |
| 2367 | 818 /* #### should deal with ERRB */ |
| 819 EXTERNAL_PROPERTY_LIST_LOOP_3 (range, data, value) | |
| 428 | 820 { |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5560
diff
changeset
|
821 if (!FIXNUMP (range) && !CHARP (range) |
| 428 | 822 && !(CONSP (range) && CONSP (XCDR (range)) |
| 823 && NILP (XCDR (XCDR (range))) | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5560
diff
changeset
|
824 && (FIXNUMP (XCAR (range)) || CHARP (XCAR (range))) |
|
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5560
diff
changeset
|
825 && (FIXNUMP (XCAR (XCDR (range))) || CHARP (XCAR (XCDR (range)))))) |
| 563 | 826 sferror ("Invalid range format", range); |
| 428 | 827 } |
| 828 | |
| 829 return 1; | |
| 830 } | |
| 831 | |
| 832 static Lisp_Object | |
| 2421 | 833 rangetab_instantiate (Lisp_Object plist) |
| 428 | 834 { |
| 2425 | 835 Lisp_Object data = Qnil, type = Qnil, rangetab; |
| 428 | 836 |
|
5222
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
837 if (KEYWORDP (Fcar (plist))) |
| 428 | 838 { |
|
5222
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
839 PROPERTY_LIST_LOOP_3 (key, value, plist) |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
840 { |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
841 if (EQ (key, Q_type)) type = value; |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
842 else if (EQ (key, Q_data)) data = value; |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
843 else if (!KEYWORDP (key)) |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
844 signal_error |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
845 (Qinvalid_read_syntax, |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
846 "can't mix keyword and non-keyword structure syntax", |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
847 key); |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
848 else |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
849 ABORT (); |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
850 } |
| 2421 | 851 } |
|
5222
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
852 #ifdef NEED_TO_HANDLE_21_4_CODE |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
853 else |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
854 { |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
855 PROPERTY_LIST_LOOP_3 (key, value, plist) |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
856 { |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
857 if (EQ (key, Qtype)) type = value; |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
858 else if (EQ (key, Qdata)) data = value; |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
859 else if (KEYWORDP (key)) |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
860 signal_error |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
861 (Qinvalid_read_syntax, |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
862 "can't mix keyword and non-keyword structure syntax", |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
863 key); |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
864 else |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
865 ABORT (); |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
866 } |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
867 } |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
868 #endif /* NEED_TO_HANDLE_21_4_CODE */ |
| 2421 | 869 |
| 2425 | 870 rangetab = Fmake_range_table (type); |
| 428 | 871 |
| 2421 | 872 { |
| 873 PROPERTY_LIST_LOOP_3 (range, val, data) | |
| 874 { | |
| 875 if (CONSP (range)) | |
| 876 Fput_range_table (Fcar (range), Fcar (Fcdr (range)), val, | |
| 877 rangetab); | |
| 878 else | |
| 879 Fput_range_table (range, range, val, rangetab); | |
| 880 } | |
| 881 } | |
| 428 | 882 |
| 883 return rangetab; | |
| 884 } | |
| 885 | |
| 886 | |
| 887 /************************************************************************/ | |
| 888 /* Unified range tables */ | |
| 889 /************************************************************************/ | |
| 890 | |
| 891 /* A "unified range table" is a format for storing range tables | |
| 892 as contiguous blocks of memory. This is used by the regexp | |
| 893 code, which needs to use range tables to properly handle [] | |
| 894 constructs in the presence of extended characters but wants to | |
| 895 store an entire compiled pattern as a contiguous block of memory. | |
| 896 | |
| 897 Unified range tables are designed so that they can be placed | |
| 898 at an arbitrary (possibly mis-aligned) place in memory. | |
| 899 (Dealing with alignment is a pain in the ass.) | |
| 900 | |
| 901 WARNING: No provisions for garbage collection are currently made. | |
| 902 This means that there must not be any Lisp objects in a unified | |
| 903 range table that need to be marked for garbage collection. | |
| 904 Good candidates for objects that can go into a range table are | |
| 905 | |
| 906 -- numbers and characters (do not need to be marked) | |
| 907 -- nil, t (marked elsewhere) | |
| 908 -- charsets and coding systems (automatically marked because | |
| 909 they are in a marked list, | |
| 910 and can't be removed) | |
| 911 | |
| 912 Good but slightly less so: | |
| 913 | |
| 914 -- symbols (could be uninterned, but that is not likely) | |
| 915 | |
| 916 Somewhat less good: | |
| 917 | |
| 918 -- buffers, frames, devices (could get deleted) | |
| 919 | |
| 920 | |
| 921 It is expected that you work with range tables in the normal | |
| 922 format and then convert to unified format when you are done | |
| 923 making modifications. As such, no functions are provided | |
| 924 for modifying a unified range table. The only operations | |
| 925 you can do to unified range tables are | |
| 926 | |
| 927 -- look up a value | |
| 928 -- retrieve all the ranges in an iterative fashion | |
| 929 | |
| 930 */ | |
| 931 | |
| 932 /* The format of a unified range table is as follows: | |
| 933 | |
| 934 -- The first byte contains the number of bytes to skip to find the | |
| 935 actual start of the table. This deals with alignment constraints, | |
| 936 since the table might want to go at any arbitrary place in memory. | |
| 937 -- The next three bytes contain the number of bytes to skip (from the | |
| 938 *first* byte) to find the stuff after the table. It's stored in | |
| 939 little-endian format because that's how God intended things. We don't | |
| 940 necessarily start the stuff at the very end of the table because | |
| 941 we want to have at least ALIGNOF (EMACS_INT) extra space in case | |
| 942 we have to move the range table around. (It appears that some | |
| 943 architectures don't maintain alignment when reallocing.) | |
| 944 -- At the prescribed offset is a struct unified_range_table, containing | |
| 945 some number of `struct range_table_entry' entries. */ | |
| 946 | |
| 947 struct unified_range_table | |
| 948 { | |
| 949 int nentries; | |
|
4831
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
950 enum range_table_type type; |
| 428 | 951 struct range_table_entry first; |
| 952 }; | |
| 953 | |
| 954 /* Return size in bytes needed to store the data in a range table. */ | |
| 955 | |
| 956 int | |
| 957 unified_range_table_bytes_needed (Lisp_Object rangetab) | |
| 958 { | |
| 959 return (sizeof (struct range_table_entry) * | |
|
5168
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
960 (gap_array_length (XRANGE_TABLE (rangetab)->entries) - 1) + |
| 428 | 961 sizeof (struct unified_range_table) + |
| 962 /* ALIGNOF a struct may be too big. */ | |
| 963 /* We have four bytes for the size numbers, and an extra | |
| 964 four or eight bytes for making sure we get the alignment | |
| 965 OK. */ | |
| 966 ALIGNOF (EMACS_INT) + 4); | |
| 967 } | |
| 968 | |
| 969 /* Convert a range table into unified format and store in DEST, | |
| 970 which must be able to hold the number of bytes returned by | |
| 971 range_table_bytes_needed(). */ | |
| 972 | |
| 973 void | |
| 974 unified_range_table_copy_data (Lisp_Object rangetab, void *dest) | |
| 975 { | |
| 976 /* We cast to the above structure rather than just casting to | |
| 977 char * and adding sizeof(int), because that will lead to | |
| 978 mis-aligned data on the Alpha machines. */ | |
| 979 struct unified_range_table *un; | |
|
5168
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
980 Gap_Array *rtega = XRANGE_TABLE (rangetab)->entries; |
| 428 | 981 int total_needed = unified_range_table_bytes_needed (rangetab); |
| 826 | 982 void *new_dest = ALIGN_PTR ((char *) dest + 4, EMACS_INT); |
|
5168
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
983 Elemcount i; |
| 428 | 984 |
| 985 * (char *) dest = (char) ((char *) new_dest - (char *) dest); | |
| 986 * ((unsigned char *) dest + 1) = total_needed & 0xFF; | |
| 987 total_needed >>= 8; | |
| 988 * ((unsigned char *) dest + 2) = total_needed & 0xFF; | |
| 989 total_needed >>= 8; | |
| 990 * ((unsigned char *) dest + 3) = total_needed & 0xFF; | |
| 991 un = (struct unified_range_table *) new_dest; | |
|
5168
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
992 un->nentries = gap_array_length (rtega); |
|
4831
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
993 un->type = XRANGE_TABLE (rangetab)->type; |
|
5168
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
994 for (i = 0; i < gap_array_length (rtega); i++) |
|
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
995 (&un->first)[i] = rangetab_gap_array_at (rtega, i); |
| 428 | 996 } |
| 997 | |
| 998 /* Return number of bytes actually used by a unified range table. */ | |
| 999 | |
| 1000 int | |
| 1001 unified_range_table_bytes_used (void *unrangetab) | |
| 1002 { | |
| 1003 return ((* ((unsigned char *) unrangetab + 1)) | |
| 1004 + ((* ((unsigned char *) unrangetab + 2)) << 8) | |
| 1005 + ((* ((unsigned char *) unrangetab + 3)) << 16)); | |
| 1006 } | |
| 1007 | |
| 1008 /* Make sure the table is aligned, and move it around if it's not. */ | |
| 1009 static void | |
| 1010 align_the_damn_table (void *unrangetab) | |
| 1011 { | |
| 1012 void *cur_dest = (char *) unrangetab + * (char *) unrangetab; | |
| 826 | 1013 if (cur_dest != ALIGN_PTR (cur_dest, EMACS_INT)) |
| 428 | 1014 { |
| 1015 int count = (unified_range_table_bytes_used (unrangetab) - 4 | |
| 1016 - ALIGNOF (EMACS_INT)); | |
| 1017 /* Find the proper location, just like above. */ | |
| 826 | 1018 void *new_dest = ALIGN_PTR ((char *) unrangetab + 4, EMACS_INT); |
| 428 | 1019 /* memmove() works in the presence of overlapping data. */ |
| 1020 memmove (new_dest, cur_dest, count); | |
| 1021 * (char *) unrangetab = (char) ((char *) new_dest - (char *) unrangetab); | |
| 1022 } | |
| 1023 } | |
| 1024 | |
| 1025 /* Look up a value in a unified range table. */ | |
| 1026 | |
| 1027 Lisp_Object | |
| 1028 unified_range_table_lookup (void *unrangetab, EMACS_INT pos, | |
| 1029 Lisp_Object default_) | |
| 1030 { | |
| 1031 void *new_dest; | |
| 1032 struct unified_range_table *un; | |
| 1033 | |
| 1034 align_the_damn_table (unrangetab); | |
| 1035 new_dest = (char *) unrangetab + * (char *) unrangetab; | |
| 1036 un = (struct unified_range_table *) new_dest; | |
| 1037 | |
|
5168
cf900a2f1fa3
extract gap array from extents.c, use in range tables
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
1038 return get_range_table (pos, un->nentries, &un->first, 0, 0, default_); |
| 428 | 1039 } |
| 1040 | |
| 1041 /* Return number of entries in a unified range table. */ | |
| 1042 | |
| 1043 int | |
| 1044 unified_range_table_nentries (void *unrangetab) | |
| 1045 { | |
| 1046 void *new_dest; | |
| 1047 struct unified_range_table *un; | |
| 1048 | |
| 1049 align_the_damn_table (unrangetab); | |
| 1050 new_dest = (char *) unrangetab + * (char *) unrangetab; | |
| 1051 un = (struct unified_range_table *) new_dest; | |
| 1052 return un->nentries; | |
| 1053 } | |
| 1054 | |
| 1055 /* Return the OFFSETth range (counting from 0) in UNRANGETAB. */ | |
| 1056 void | |
| 1057 unified_range_table_get_range (void *unrangetab, int offset, | |
| 1058 EMACS_INT *min, EMACS_INT *max, | |
| 1059 Lisp_Object *val) | |
| 1060 { | |
| 1061 void *new_dest; | |
| 1062 struct unified_range_table *un; | |
| 1063 struct range_table_entry *tab; | |
| 1064 | |
| 1065 align_the_damn_table (unrangetab); | |
| 1066 new_dest = (char *) unrangetab + * (char *) unrangetab; | |
| 1067 un = (struct unified_range_table *) new_dest; | |
| 1068 | |
| 1069 assert (offset >= 0 && offset < un->nentries); | |
| 1070 tab = (&un->first) + offset; | |
| 1071 *min = tab->first; | |
| 1072 *max = tab->last; | |
| 1073 *val = tab->val; | |
|
4831
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
1074 |
|
2e15c29cc2b3
fix bug in returning range table ends in unified range table code
Ben Wing <ben@xemacs.org>
parents:
4713
diff
changeset
|
1075 internal_to_external_adjust_ends (un->type, min, max); |
| 428 | 1076 } |
| 1077 | |
| 1078 | |
| 1079 /************************************************************************/ | |
| 1080 /* Initialization */ | |
| 1081 /************************************************************************/ | |
|
5560
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
1082 void |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
1083 rangetab_objects_create (void) |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
1084 { |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
1085 OBJECT_HAS_METHOD (range_table, print_preprocess); |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
1086 OBJECT_HAS_METHOD (range_table, nsubst_structures_descend); |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
1087 } |
| 428 | 1088 |
| 1089 void | |
| 1090 syms_of_rangetab (void) | |
| 1091 { | |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3017
diff
changeset
|
1092 INIT_LISP_OBJECT (range_table); |
| 442 | 1093 |
| 563 | 1094 DEFSYMBOL_MULTIWORD_PREDICATE (Qrange_tablep); |
| 1095 DEFSYMBOL (Qrange_table); | |
| 428 | 1096 |
| 2421 | 1097 DEFSYMBOL (Qstart_closed_end_open); |
| 1098 DEFSYMBOL (Qstart_open_end_open); | |
| 1099 DEFSYMBOL (Qstart_closed_end_closed); | |
| 1100 DEFSYMBOL (Qstart_open_end_closed); | |
| 1101 | |
| 428 | 1102 DEFSUBR (Frange_table_p); |
| 2421 | 1103 DEFSUBR (Frange_table_type); |
| 428 | 1104 DEFSUBR (Fmake_range_table); |
| 1105 DEFSUBR (Fcopy_range_table); | |
| 1106 DEFSUBR (Fget_range_table); | |
| 1107 DEFSUBR (Fput_range_table); | |
| 1108 DEFSUBR (Fremove_range_table); | |
| 1109 DEFSUBR (Fclear_range_table); | |
| 1110 DEFSUBR (Fmap_range_table); | |
| 1111 } | |
| 1112 | |
| 1113 void | |
| 1114 structure_type_create_rangetab (void) | |
| 1115 { | |
| 1116 struct structure_type *st; | |
| 1117 | |
| 1118 st = define_structure_type (Qrange_table, 0, rangetab_instantiate); | |
| 1119 | |
|
5222
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1120 define_structure_type_keyword (st, Q_data, rangetab_data_validate); |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1121 define_structure_type_keyword (st, Q_type, rangetab_type_validate); |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1122 #ifdef NEED_TO_HANDLE_21_4_CODE |
| 428 | 1123 define_structure_type_keyword (st, Qdata, rangetab_data_validate); |
| 2421 | 1124 define_structure_type_keyword (st, Qtype, rangetab_type_validate); |
|
5222
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1125 #endif /* NEED_TO_HANDLE_21_4_CODE */ |
| 428 | 1126 } |