Mercurial > hg > xemacs-beta
diff src/glyphs.c @ 5191:71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
tests/ChangeLog addition:
2010-04-05 Aidan Kehoe <kehoea@parhasard.net>
* automated/hash-table-tests.el:
Test the new built-in #'equalp hash table test. Test
#'define-hash-table-test.
* automated/lisp-tests.el:
When asserting that two objects are #'equalp, also assert that
their #'equalp-hash is identical.
man/ChangeLog addition:
2010-04-03 Aidan Kehoe <kehoea@parhasard.net>
* lispref/hash-tables.texi (Introduction to Hash Tables):
Document that we now support #'equalp as a hash table test by
default, and mention #'define-hash-table-test.
(Working With Hash Tables): Document #'define-hash-table-test.
src/ChangeLog addition:
2010-04-05 Aidan Kehoe <kehoea@parhasard.net>
* elhash.h:
* elhash.c (struct Hash_Table_Test, lisp_object_eql_equal)
(lisp_object_eql_hash, lisp_object_equal_equal)
(lisp_object_equal_hash, lisp_object_equalp_hash)
(lisp_object_equalp_equal, lisp_object_general_hash)
(lisp_object_general_equal, Feq_hash, Feql_hash, Fequal_hash)
(Fequalp_hash, define_hash_table_test, Fdefine_hash_table_test)
(init_elhash_once_early, mark_hash_table_tests, string_equalp_hash):
* glyphs.c (vars_of_glyphs):
Add a new hash table test in C, #'equalp.
Make it possible to specify new hash table tests with functions
define_hash_table_test, #'define-hash-table-test.
Use define_hash_table_test() in glyphs.c.
Expose the hash functions (besides that used for #'equal) to Lisp,
for people writing functions to be used with #'define-hash-table-test.
Call define_hash_table_test() very early in temacs, to create the
built-in hash table tests.
* ui-gtk.c (emacs_gtk_boxed_hash):
* specifier.h (struct specifier_methods):
* specifier.c (specifier_hash):
* rangetab.c (range_table_entry_hash, range_table_hash):
* number.c (bignum_hash, ratio_hash, bigfloat_hash):
* marker.c (marker_hash):
* lrecord.h (struct lrecord_implementation):
* keymap.c (keymap_hash):
* gui.c (gui_item_id_hash, gui_item_hash):
* glyphs.c (image_instance_hash, glyph_hash):
* glyphs-x.c (x_image_instance_hash):
* glyphs-msw.c (mswindows_image_instance_hash):
* glyphs-gtk.c (gtk_image_instance_hash):
* frame-msw.c (mswindows_set_title_from_ibyte):
* fontcolor.c (color_instance_hash, font_instance_hash):
* fontcolor-x.c (x_color_instance_hash):
* fontcolor-tty.c (tty_color_instance_hash):
* fontcolor-msw.c (mswindows_color_instance_hash):
* fontcolor-gtk.c (gtk_color_instance_hash):
* fns.c (bit_vector_hash):
* floatfns.c (float_hash):
* faces.c (face_hash):
* extents.c (extent_hash):
* events.c (event_hash):
* data.c (weak_list_hash, weak_box_hash):
* chartab.c (char_table_entry_hash, char_table_hash):
* bytecode.c (compiled_function_hash):
* alloc.c (vector_hash):
Change the various object hash methods to take a new EQUALP
parameter, hashing appropriately for #'equalp if it is true.
author | Aidan Kehoe <kehoea@parhasard.net> |
---|---|
date | Mon, 05 Apr 2010 13:03:35 +0100 |
parents | 97eb4942aec8 |
children | acc4a6c9f5f9 |
line wrap: on
line diff
--- a/src/glyphs.c Mon Apr 05 00:18:49 2010 -0500 +++ b/src/glyphs.c Mon Apr 05 13:03:35 2010 +0100 @@ -94,6 +94,7 @@ Lisp_Object Vglyph_type_list; int disable_animated_pixmaps; +static Lisp_Object Vimage_instance_hash_table_test; DEFINE_IMAGE_INSTANTIATOR_FORMAT (nothing); DEFINE_IMAGE_INSTANTIATOR_FORMAT (inherit); @@ -1259,7 +1260,7 @@ } static Hashcode -image_instance_hash (Lisp_Object obj, int depth) +image_instance_hash (Lisp_Object obj, int depth, Boolint UNUSED (equalp)) { Lisp_Image_Instance *i = XIMAGE_INSTANCE (obj); Hashcode hash = HASH5 (LISP_HASH (IMAGE_INSTANCE_DOMAIN (i)), @@ -1267,7 +1268,7 @@ IMAGE_INSTANCE_MARGIN_WIDTH (i), IMAGE_INSTANCE_HEIGHT (i), internal_hash (IMAGE_INSTANCE_INSTANTIATOR (i), - depth + 1)); + depth + 1, 0)); ERROR_CHECK_IMAGE_INSTANCE (obj); @@ -1278,7 +1279,7 @@ case IMAGE_TEXT: hash = HASH2 (hash, internal_hash (IMAGE_INSTANCE_TEXT_STRING (i), - depth + 1)); + depth + 1, 0)); break; case IMAGE_MONO_PIXMAP: @@ -1287,7 +1288,7 @@ hash = HASH4 (hash, IMAGE_INSTANCE_PIXMAP_DEPTH (i), IMAGE_INSTANCE_PIXMAP_SLICE (i), internal_hash (IMAGE_INSTANCE_PIXMAP_FILENAME (i), - depth + 1)); + depth + 1, 0)); break; case IMAGE_WIDGET: @@ -1295,10 +1296,12 @@ displayed. */ hash = HASH5 (hash, LISP_HASH (IMAGE_INSTANCE_WIDGET_TYPE (i)), - internal_hash (IMAGE_INSTANCE_WIDGET_PROPS (i), depth + 1), - internal_hash (IMAGE_INSTANCE_WIDGET_ITEMS (i), depth + 1), + internal_hash (IMAGE_INSTANCE_WIDGET_PROPS (i), + depth + 1, 0), + internal_hash (IMAGE_INSTANCE_WIDGET_ITEMS (i), + depth + 1, 0), internal_hash (IMAGE_INSTANCE_LAYOUT_CHILDREN (i), - depth + 1)); + depth + 1, 0)); case IMAGE_SUBWINDOW: hash = HASH2 (hash, (EMACS_INT) IMAGE_INSTANCE_SUBWINDOW_ID (i)); break; @@ -3202,29 +3205,29 @@ } static int -instantiator_eq_equal (Lisp_Object obj1, Lisp_Object obj2) +instantiator_eq_equal (const Hash_Table_Test *UNUSED (http), + Lisp_Object obj1, Lisp_Object obj2) { if (EQ (obj1, obj2)) return 1; else if (CONSP (obj1) && CONSP (obj2)) { - return instantiator_eq_equal (XCAR (obj1), XCAR (obj2)) - && - instantiator_eq_equal (XCDR (obj1), XCDR (obj2)); + return instantiator_eq_equal (NULL, XCAR (obj1), XCAR (obj2)) + && instantiator_eq_equal (NULL, XCDR (obj1), XCDR (obj2)); } return 0; } static Hashcode -instantiator_eq_hash (Lisp_Object obj) +instantiator_eq_hash (const Hash_Table_Test *UNUSED (http), Lisp_Object obj) { if (CONSP (obj)) { /* no point in worrying about tail recursion, since we're not going very deep */ - return HASH2 (instantiator_eq_hash (XCAR (obj)), - instantiator_eq_hash (XCDR (obj))); + return HASH2 (instantiator_eq_hash (NULL, XCAR (obj)), + instantiator_eq_hash (NULL, XCDR (obj))); } return LISP_HASH (obj); } @@ -3233,10 +3236,9 @@ Lisp_Object make_image_instance_cache_hash_table (void) { - return make_general_lisp_hash_table - (instantiator_eq_hash, instantiator_eq_equal, - 30, -1.0, -1.0, - HASH_TABLE_KEY_CAR_VALUE_WEAK); + return make_general_lisp_hash_table (Vimage_instance_hash_table_test, 30, + -1.0, -1.0, + HASH_TABLE_KEY_CAR_VALUE_WEAK); } static Lisp_Object @@ -3737,14 +3739,14 @@ } static Hashcode -glyph_hash (Lisp_Object obj, int depth) +glyph_hash (Lisp_Object obj, int depth, Boolint UNUSED (equalp)) { depth++; /* No need to hash all of the elements; that would take too long. Just hash the most common ones. */ - return HASH2 (internal_hash (XGLYPH (obj)->image, depth), - internal_hash (XGLYPH (obj)->face, depth)); + return HASH2 (internal_hash (XGLYPH (obj)->image, depth, 0), + internal_hash (XGLYPH (obj)->face, depth, 0)); } static Lisp_Object @@ -4759,7 +4761,8 @@ we might need. We can get better hashing by making the depth negative - currently it will recurse down 7 levels.*/ IMAGE_INSTANCE_DISPLAY_HASH (ii) = internal_hash (subwindow, - IMAGE_INSTANCE_HASH_DEPTH); + IMAGE_INSTANCE_HASH_DEPTH, + 0); unbind_to (count); } @@ -4778,7 +4781,7 @@ { Lisp_Image_Instance* ii = XIMAGE_INSTANCE (subwindow); - if (internal_hash (subwindow, IMAGE_INSTANCE_HASH_DEPTH) != + if (internal_hash (subwindow, IMAGE_INSTANCE_HASH_DEPTH, 0) != IMAGE_INSTANCE_DISPLAY_HASH (ii)) return 1; /* #### I think there is probably a bug here. This gets called for @@ -5524,6 +5527,12 @@ Qpointer, Qsubwindow, Qwidget)); staticpro (&Vimage_instance_type_list); + /* The Qunbound name means this test is not available from Lisp. */ + Vimage_instance_hash_table_test + = define_hash_table_test (Qunbound, instantiator_eq_equal, + instantiator_eq_hash, Qunbound, Qunbound); + staticpro (&Vimage_instance_hash_table_test); + /* glyphs */ Vglyph_type_list = list3 (Qbuffer, Qpointer, Qicon);