Mercurial > hg > xemacs-beta
comparison src/alloc.c @ 4906:6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
-------------------- ChangeLog entries follow: --------------------
lisp/ChangeLog addition:
2010-02-01 Ben Wing <ben@xemacs.org>
* cl-extra.el:
* cl-extra.el (cl-string-vector-equalp): Removed.
* cl-extra.el (cl-bit-vector-vector-equalp): Removed.
* cl-extra.el (cl-vector-array-equalp): Removed.
* cl-extra.el (cl-hash-table-contents-equalp): Removed.
* cl-extra.el (equalp): Removed.
* cl-extra.el (cl-mapcar-many):
Comment out the whole `equalp' implementation for the moment;
remove once we're sure the C implementation works.
* cl-macs.el:
* cl-macs.el (equalp):
Simplify the compiler-macro for `equalp' -- once it's in C,
we don't need to try so hard to expand it.
src/ChangeLog addition:
2010-02-01 Ben Wing <ben@xemacs.org>
* abbrev.c (abbrev_match_mapper):
* buffer.h (CANON_TABLE_OF):
* buffer.h:
* editfns.c (Fchar_equal):
* minibuf.c (scmp_1):
* text.c (qxestrcasecmp_i18n):
* text.c (qxestrncasecmp_i18n):
* text.c (qxetextcasecmp):
* text.c (qxetextcasecmp_matching):
Create new macro CANONCASE that converts to a canonical mapping
and use it to do caseless comparisons instead of DOWNCASE.
* alloc.c:
* alloc.c (cons_equal):
* alloc.c (vector_equal):
* alloc.c (string_equal):
* bytecode.c (compiled_function_equal):
* chartab.c (char_table_entry_equal):
* chartab.c (char_table_equal):
* data.c (weak_list_equal):
* data.c (weak_box_equal):
* data.c (ephemeron_equal):
* device-msw.c (equal_devmode):
* elhash.c (hash_table_equal):
* events.c (event_equal):
* extents.c (properties_equal):
* extents.c (extent_equal):
* faces.c:
* faces.c (face_equal):
* faces.c (face_hash):
* floatfns.c (float_equal):
* fns.c:
* fns.c (bit_vector_equal):
* fns.c (plists_differ):
* fns.c (Fplists_eq):
* fns.c (Fplists_equal):
* fns.c (Flax_plists_eq):
* fns.c (Flax_plists_equal):
* fns.c (internal_equal):
* fns.c (internal_equalp):
* fns.c (internal_equal_0):
* fns.c (syms_of_fns):
* glyphs.c (image_instance_equal):
* glyphs.c (glyph_equal):
* glyphs.c (glyph_hash):
* gui.c (gui_item_equal):
* lisp.h:
* lrecord.h (struct lrecord_implementation):
* marker.c (marker_equal):
* number.c (bignum_equal):
* number.c (ratio_equal):
* number.c (bigfloat_equal):
* objects.c (color_instance_equal):
* objects.c (font_instance_equal):
* opaque.c (equal_opaque):
* opaque.c (equal_opaque_ptr):
* rangetab.c (range_table_equal):
* specifier.c (specifier_equal):
Add a `foldcase' param to the equal() method and use it to implement
`equalp' comparisons. Also add to plists_differ(), although we
don't currently use it here.
Rewrite internal_equalp(). Implement cross-type vector comparisons.
Don't implement our own handling of numeric promotion -- just use
the `=' primitive.
Add internal_equal_0(), which takes a `foldcase' param and calls
either internal_equal() or internal_equalp().
* buffer.h:
When given a 0 for buffer (which is the norm when functions don't
have a specific buffer available), use the current buffer's table,
not `standard-case-table'; otherwise the current settings are
ignored.
* casetab.c:
* casetab.c (set_case_table):
When handling old-style vectors of 256 in `set-case-table' don't
overwrite the existing table! Instead create a new table and
populate.
* device-msw.c (sync_printer_with_devmode):
* lisp.h:
* text.c (lisp_strcasecmp_ascii):
Rename lisp_strcasecmp to lisp_strcasecmp_ascii and use
lisp_strcasecmp_i18n for caseless comparisons in some places.
* elhash.c:
Delete unused lisp_string_hash and lisp_string_equal().
* events.h:
* keymap-buttons.h:
* keymap.h:
* keymap.c (keymap_lookup_directly):
* keymap.c (keymap_store):
* keymap.c (FROB):
* keymap.c (key_desc_list_to_event):
* keymap.c (describe_map_mapper):
* keymap.c (INCLUDE_BUTTON_ZERO):
New file keymap-buttons.h; use to handle buttons 1-26 in place of
duplicating code 26 times.
* frame-gtk.c (allocate_gtk_frame_struct):
* frame-msw.c (mswindows_init_frame_1):
Fix some comments about internal_equal() in redisplay that don't
apply any more.
* keymap-slots.h:
* keymap.c:
New file keymap-slots.h. Use it to notate the slots in a keymap
structure, similar to frameslots.h or coding-system-slots.h.
* keymap.c (MARKED_SLOT):
* keymap.c (keymap_equal):
* keymap.c (keymap_hash):
Implement.
tests/ChangeLog addition:
2010-02-01 Ben Wing <ben@xemacs.org>
* automated/case-tests.el:
* automated/case-tests.el (uni-mappings):
* automated/search-tests.el:
Delete old pristine-case-table code. Rewrite the Unicode torture
test to take into account whether overlapping mappings exist for
more than one character, and not doing the upcase/downcase
comparisons in such cases.
* automated/lisp-tests.el (foo):
* automated/lisp-tests.el (string-variable):
* automated/lisp-tests.el (featurep):
Replace Assert (equal ... with Assert-equal; same for other types
of equality. Replace some awkward equivalents of Assert-equalp
with Assert-equalp. Add lots of equalp tests.
* automated/case-tests.el:
* automated/regexp-tests.el:
* automated/search-tests.el:
Fix up the comments at the top of the files. Move rules about where
to put tests into case-tests.el.
* automated/test-harness.el:
* automated/test-harness.el (test-harness-aborted-summary-template): New.
* automated/test-harness.el (test-harness-from-buffer):
* automated/test-harness.el (batch-test-emacs):
Fix Assert-test-not. Create Assert-not-equal and variants.
Delete the doc strings from all these convenience functions to avoid
excessive repetition; instead use one copy in a comment.
author | Ben Wing <ben@xemacs.org> |
---|---|
date | Mon, 01 Feb 2010 01:02:40 -0600 |
parents | ae81a2c00f4f |
children | 17362f371cc2 e813cf16c015 |
comparison
equal
deleted
inserted
replaced
4903:70089046adef | 4906:6ef8256a020a |
---|---|
1221 mark_object (XCAR (obj)); | 1221 mark_object (XCAR (obj)); |
1222 return XCDR (obj); | 1222 return XCDR (obj); |
1223 } | 1223 } |
1224 | 1224 |
1225 static int | 1225 static int |
1226 cons_equal (Lisp_Object ob1, Lisp_Object ob2, int depth) | 1226 cons_equal (Lisp_Object ob1, Lisp_Object ob2, int depth, int foldcase) |
1227 { | 1227 { |
1228 depth++; | 1228 depth++; |
1229 while (internal_equal (XCAR (ob1), XCAR (ob2), depth)) | 1229 while (internal_equal_0 (XCAR (ob1), XCAR (ob2), depth, foldcase)) |
1230 { | 1230 { |
1231 ob1 = XCDR (ob1); | 1231 ob1 = XCDR (ob1); |
1232 ob2 = XCDR (ob2); | 1232 ob2 = XCDR (ob2); |
1233 if (! CONSP (ob1) || ! CONSP (ob2)) | 1233 if (! CONSP (ob1) || ! CONSP (ob2)) |
1234 return internal_equal (ob1, ob2, depth); | 1234 return internal_equal_0 (ob1, ob2, depth, foldcase); |
1235 } | 1235 } |
1236 return 0; | 1236 return 0; |
1237 } | 1237 } |
1238 | 1238 |
1239 static const struct memory_description cons_description[] = { | 1239 static const struct memory_description cons_description[] = { |
1545 return FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_Vector, Lisp_Object, contents, | 1545 return FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_Vector, Lisp_Object, contents, |
1546 ((Lisp_Vector *) lheader)->size); | 1546 ((Lisp_Vector *) lheader)->size); |
1547 } | 1547 } |
1548 | 1548 |
1549 static int | 1549 static int |
1550 vector_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) | 1550 vector_equal (Lisp_Object obj1, Lisp_Object obj2, int depth, int foldcase) |
1551 { | 1551 { |
1552 int len = XVECTOR_LENGTH (obj1); | 1552 int len = XVECTOR_LENGTH (obj1); |
1553 if (len != XVECTOR_LENGTH (obj2)) | 1553 if (len != XVECTOR_LENGTH (obj2)) |
1554 return 0; | 1554 return 0; |
1555 | 1555 |
1556 { | 1556 { |
1557 Lisp_Object *ptr1 = XVECTOR_DATA (obj1); | 1557 Lisp_Object *ptr1 = XVECTOR_DATA (obj1); |
1558 Lisp_Object *ptr2 = XVECTOR_DATA (obj2); | 1558 Lisp_Object *ptr2 = XVECTOR_DATA (obj2); |
1559 while (len--) | 1559 while (len--) |
1560 if (!internal_equal (*ptr1++, *ptr2++, depth + 1)) | 1560 if (!internal_equal_0 (*ptr1++, *ptr2++, depth + 1, foldcase)) |
1561 return 0; | 1561 return 0; |
1562 } | 1562 } |
1563 return 1; | 1563 return 1; |
1564 } | 1564 } |
1565 | 1565 |
2249 flush_cached_extent_info (XCAR (XSTRING_PLIST (obj))); | 2249 flush_cached_extent_info (XCAR (XSTRING_PLIST (obj))); |
2250 return XSTRING_PLIST (obj); | 2250 return XSTRING_PLIST (obj); |
2251 } | 2251 } |
2252 | 2252 |
2253 static int | 2253 static int |
2254 string_equal (Lisp_Object obj1, Lisp_Object obj2, int UNUSED (depth)) | 2254 string_equal (Lisp_Object obj1, Lisp_Object obj2, int UNUSED (depth), |
2255 int foldcase) | |
2255 { | 2256 { |
2256 Bytecount len; | 2257 Bytecount len; |
2257 return (((len = XSTRING_LENGTH (obj1)) == XSTRING_LENGTH (obj2)) && | 2258 if (foldcase) |
2258 !memcmp (XSTRING_DATA (obj1), XSTRING_DATA (obj2), len)); | 2259 return !lisp_strcasecmp_i18n (obj1, obj2); |
2260 else | |
2261 return (((len = XSTRING_LENGTH (obj1)) == XSTRING_LENGTH (obj2)) && | |
2262 !memcmp (XSTRING_DATA (obj1), XSTRING_DATA (obj2), len)); | |
2259 } | 2263 } |
2260 | 2264 |
2261 static const struct memory_description string_description[] = { | 2265 static const struct memory_description string_description[] = { |
2262 #ifdef NEW_GC | 2266 #ifdef NEW_GC |
2263 { XD_LISP_OBJECT, offsetof (Lisp_String, data_object) }, | 2267 { XD_LISP_OBJECT, offsetof (Lisp_String, data_object) }, |