Mercurial > hg > xemacs-beta

comparison src/glyphs.c @ 5191:71ee43b8a74d

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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
comparison
equal deleted inserted replaced
5190:1c1d8843de5e 5191:71ee43b8a74d
92 Lisp_Object Vimage_instantiator_format_list; 92 Lisp_Object Vimage_instantiator_format_list;
93 Lisp_Object Vimage_instance_type_list; 93 Lisp_Object Vimage_instance_type_list;
94 Lisp_Object Vglyph_type_list; 94 Lisp_Object Vglyph_type_list;
95 95
96 int disable_animated_pixmaps; 96 int disable_animated_pixmaps;
97 static Lisp_Object Vimage_instance_hash_table_test;
97 98
98 DEFINE_IMAGE_INSTANTIATOR_FORMAT (nothing); 99 DEFINE_IMAGE_INSTANTIATOR_FORMAT (nothing);
99 DEFINE_IMAGE_INSTANTIATOR_FORMAT (inherit); 100 DEFINE_IMAGE_INSTANTIATOR_FORMAT (inherit);
100 DEFINE_IMAGE_INSTANTIATOR_FORMAT (string); 101 DEFINE_IMAGE_INSTANTIATOR_FORMAT (string);
101 DEFINE_IMAGE_INSTANTIATOR_FORMAT (formatted_string); 102 DEFINE_IMAGE_INSTANTIATOR_FORMAT (formatted_string);
1257 { 1258 {
1258 return DOMAIN_LIVE_P (XIMAGE_INSTANCE_DOMAIN (instance)); 1259 return DOMAIN_LIVE_P (XIMAGE_INSTANCE_DOMAIN (instance));
1259 } 1260 }
1260 1261
1261 static Hashcode 1262 static Hashcode
1262 image_instance_hash (Lisp_Object obj, int depth) 1263 image_instance_hash (Lisp_Object obj, int depth, Boolint UNUSED (equalp))
1263 { 1264 {
1264 Lisp_Image_Instance *i = XIMAGE_INSTANCE (obj); 1265 Lisp_Image_Instance *i = XIMAGE_INSTANCE (obj);
1265 Hashcode hash = HASH5 (LISP_HASH (IMAGE_INSTANCE_DOMAIN (i)), 1266 Hashcode hash = HASH5 (LISP_HASH (IMAGE_INSTANCE_DOMAIN (i)),
1266 IMAGE_INSTANCE_WIDTH (i), 1267 IMAGE_INSTANCE_WIDTH (i),
1267 IMAGE_INSTANCE_MARGIN_WIDTH (i), 1268 IMAGE_INSTANCE_MARGIN_WIDTH (i),
1268 IMAGE_INSTANCE_HEIGHT (i), 1269 IMAGE_INSTANCE_HEIGHT (i),
1269 internal_hash (IMAGE_INSTANCE_INSTANTIATOR (i), 1270 internal_hash (IMAGE_INSTANCE_INSTANTIATOR (i),
1270 depth + 1)); 1271 depth + 1, 0));
1271 1272
1272 ERROR_CHECK_IMAGE_INSTANCE (obj); 1273 ERROR_CHECK_IMAGE_INSTANCE (obj);
1273 1274
1274 switch (IMAGE_INSTANCE_TYPE (i)) 1275 switch (IMAGE_INSTANCE_TYPE (i))
1275 { 1276 {
1276 case IMAGE_NOTHING: 1277 case IMAGE_NOTHING:
1277 break; 1278 break;
1278 1279
1279 case IMAGE_TEXT: 1280 case IMAGE_TEXT:
1280 hash = HASH2 (hash, internal_hash (IMAGE_INSTANCE_TEXT_STRING (i), 1281 hash = HASH2 (hash, internal_hash (IMAGE_INSTANCE_TEXT_STRING (i),
1281 depth + 1)); 1282 depth + 1, 0));
1282 break; 1283 break;
1283 1284
1284 case IMAGE_MONO_PIXMAP: 1285 case IMAGE_MONO_PIXMAP:
1285 case IMAGE_COLOR_PIXMAP: 1286 case IMAGE_COLOR_PIXMAP:
1286 case IMAGE_POINTER: 1287 case IMAGE_POINTER:
1287 hash = HASH4 (hash, IMAGE_INSTANCE_PIXMAP_DEPTH (i), 1288 hash = HASH4 (hash, IMAGE_INSTANCE_PIXMAP_DEPTH (i),
1288 IMAGE_INSTANCE_PIXMAP_SLICE (i), 1289 IMAGE_INSTANCE_PIXMAP_SLICE (i),
1289 internal_hash (IMAGE_INSTANCE_PIXMAP_FILENAME (i), 1290 internal_hash (IMAGE_INSTANCE_PIXMAP_FILENAME (i),
1290 depth + 1)); 1291 depth + 1, 0));
1291 break; 1292 break;
1292 1293
1293 case IMAGE_WIDGET: 1294 case IMAGE_WIDGET:
1294 /* We need the hash to be equivalent to what should be 1295 /* We need the hash to be equivalent to what should be
1295 displayed. */ 1296 displayed. */
1296 hash = HASH5 (hash, 1297 hash = HASH5 (hash,
1297 LISP_HASH (IMAGE_INSTANCE_WIDGET_TYPE (i)), 1298 LISP_HASH (IMAGE_INSTANCE_WIDGET_TYPE (i)),
1298 internal_hash (IMAGE_INSTANCE_WIDGET_PROPS (i), depth + 1), 1299 internal_hash (IMAGE_INSTANCE_WIDGET_PROPS (i),
1299 internal_hash (IMAGE_INSTANCE_WIDGET_ITEMS (i), depth + 1), 1300 depth + 1, 0),
1301 internal_hash (IMAGE_INSTANCE_WIDGET_ITEMS (i),
1302 depth + 1, 0),
1300 internal_hash (IMAGE_INSTANCE_LAYOUT_CHILDREN (i), 1303 internal_hash (IMAGE_INSTANCE_LAYOUT_CHILDREN (i),
1301 depth + 1)); 1304 depth + 1, 0));
1302 case IMAGE_SUBWINDOW: 1305 case IMAGE_SUBWINDOW:
1303 hash = HASH2 (hash, (EMACS_INT) IMAGE_INSTANCE_SUBWINDOW_ID (i)); 1306 hash = HASH2 (hash, (EMACS_INT) IMAGE_INSTANCE_SUBWINDOW_ID (i));
1304 break; 1307 break;
1305 1308
1306 default: 1309 default:
3200 mark_object (IMAGE_SPECIFIER_ATTACHEE (image)); 3203 mark_object (IMAGE_SPECIFIER_ATTACHEE (image));
3201 mark_object (IMAGE_SPECIFIER_ATTACHEE_PROPERTY (image)); 3204 mark_object (IMAGE_SPECIFIER_ATTACHEE_PROPERTY (image));
3202 } 3205 }
3203 3206
3204 static int 3207 static int
3205 instantiator_eq_equal (Lisp_Object obj1, Lisp_Object obj2) 3208 instantiator_eq_equal (const Hash_Table_Test *UNUSED (http),
3209 Lisp_Object obj1, Lisp_Object obj2)
3206 { 3210 {
3207 if (EQ (obj1, obj2)) 3211 if (EQ (obj1, obj2))
3208 return 1; 3212 return 1;
3209 3213
3210 else if (CONSP (obj1) && CONSP (obj2)) 3214 else if (CONSP (obj1) && CONSP (obj2))
3211 { 3215 {
3212 return instantiator_eq_equal (XCAR (obj1), XCAR (obj2)) 3216 return instantiator_eq_equal (NULL, XCAR (obj1), XCAR (obj2))
3213 && 3217 && instantiator_eq_equal (NULL, XCDR (obj1), XCDR (obj2));
3214 instantiator_eq_equal (XCDR (obj1), XCDR (obj2));
3215 } 3218 }
3216 return 0; 3219 return 0;
3217 } 3220 }
3218 3221
3219 static Hashcode 3222 static Hashcode
3220 instantiator_eq_hash (Lisp_Object obj) 3223 instantiator_eq_hash (const Hash_Table_Test *UNUSED (http), Lisp_Object obj)
3221 { 3224 {
3222 if (CONSP (obj)) 3225 if (CONSP (obj))
3223 { 3226 {
3224 /* no point in worrying about tail recursion, since we're not 3227 /* no point in worrying about tail recursion, since we're not
3225 going very deep */ 3228 going very deep */
3226 return HASH2 (instantiator_eq_hash (XCAR (obj)), 3229 return HASH2 (instantiator_eq_hash (NULL, XCAR (obj)),
3227 instantiator_eq_hash (XCDR (obj))); 3230 instantiator_eq_hash (NULL, XCDR (obj)));
3228 } 3231 }
3229 return LISP_HASH (obj); 3232 return LISP_HASH (obj);
3230 } 3233 }
3231 3234
3232 /* We need a special hash table for storing image instances. */ 3235 /* We need a special hash table for storing image instances. */
3233 Lisp_Object 3236 Lisp_Object
3234 make_image_instance_cache_hash_table (void) 3237 make_image_instance_cache_hash_table (void)
3235 { 3238 {
3236 return make_general_lisp_hash_table 3239 return make_general_lisp_hash_table (Vimage_instance_hash_table_test, 30,
3237 (instantiator_eq_hash, instantiator_eq_equal, 3240 -1.0, -1.0,
3238 30, -1.0, -1.0, 3241 HASH_TABLE_KEY_CAR_VALUE_WEAK);
3239 HASH_TABLE_KEY_CAR_VALUE_WEAK);
3240 } 3242 }
3241 3243
3242 static Lisp_Object 3244 static Lisp_Object
3243 image_instantiate_cache_result (Lisp_Object locative) 3245 image_instantiate_cache_result (Lisp_Object locative)
3244 { 3246 {
3735 internal_equal (g1->face, g2->face, depth) && 3737 internal_equal (g1->face, g2->face, depth) &&
3736 !plists_differ (g1->plist, g2->plist, 0, 0, depth + 1, 0)); 3738 !plists_differ (g1->plist, g2->plist, 0, 0, depth + 1, 0));
3737 } 3739 }
3738 3740
3739 static Hashcode 3741 static Hashcode
3740 glyph_hash (Lisp_Object obj, int depth) 3742 glyph_hash (Lisp_Object obj, int depth, Boolint UNUSED (equalp))
3741 { 3743 {
3742 depth++; 3744 depth++;
3743 3745
3744 /* No need to hash all of the elements; that would take too long. 3746 /* No need to hash all of the elements; that would take too long.
3745 Just hash the most common ones. */ 3747 Just hash the most common ones. */
3746 return HASH2 (internal_hash (XGLYPH (obj)->image, depth), 3748 return HASH2 (internal_hash (XGLYPH (obj)->image, depth, 0),
3747 internal_hash (XGLYPH (obj)->face, depth)); 3749 internal_hash (XGLYPH (obj)->face, depth, 0));
3748 } 3750 }
3749 3751
3750 static Lisp_Object 3752 static Lisp_Object
3751 glyph_getprop (Lisp_Object obj, Lisp_Object prop) 3753 glyph_getprop (Lisp_Object obj, Lisp_Object prop)
3752 { 3754 {
4757 visual appearance. However, we would rather that then the other 4759 visual appearance. However, we would rather that then the other
4758 way round - it simply means that we will get more displays than 4760 way round - it simply means that we will get more displays than
4759 we might need. We can get better hashing by making the depth 4761 we might need. We can get better hashing by making the depth
4760 negative - currently it will recurse down 7 levels.*/ 4762 negative - currently it will recurse down 7 levels.*/
4761 IMAGE_INSTANCE_DISPLAY_HASH (ii) = internal_hash (subwindow, 4763 IMAGE_INSTANCE_DISPLAY_HASH (ii) = internal_hash (subwindow,
4762 IMAGE_INSTANCE_HASH_DEPTH); 4764 IMAGE_INSTANCE_HASH_DEPTH,
4765 0);
4763 4766
4764 unbind_to (count); 4767 unbind_to (count);
4765 } 4768 }
4766 4769
4767 /* Determine whether an image_instance has changed structurally and 4770 /* Determine whether an image_instance has changed structurally and
4776 int 4779 int
4777 image_instance_changed (Lisp_Object subwindow) 4780 image_instance_changed (Lisp_Object subwindow)
4778 { 4781 {
4779 Lisp_Image_Instance* ii = XIMAGE_INSTANCE (subwindow); 4782 Lisp_Image_Instance* ii = XIMAGE_INSTANCE (subwindow);
4780 4783
4781 if (internal_hash (subwindow, IMAGE_INSTANCE_HASH_DEPTH) != 4784 if (internal_hash (subwindow, IMAGE_INSTANCE_HASH_DEPTH, 0) !=
4782 IMAGE_INSTANCE_DISPLAY_HASH (ii)) 4785 IMAGE_INSTANCE_DISPLAY_HASH (ii))
4783 return 1; 4786 return 1;
4784 /* #### I think there is probably a bug here. This gets called for 4787 /* #### I think there is probably a bug here. This gets called for
4785 layouts - and yet the pending items are always nil for 4788 layouts - and yet the pending items are always nil for
4786 layouts. We are saved by layout optimization, but I'm undecided 4789 layouts. We are saved by layout optimization, but I'm undecided
5522 Vimage_instance_type_list = Fcons (Qnothing, 5525 Vimage_instance_type_list = Fcons (Qnothing,
5523 list6 (Qtext, Qmono_pixmap, Qcolor_pixmap, 5526 list6 (Qtext, Qmono_pixmap, Qcolor_pixmap,
5524 Qpointer, Qsubwindow, Qwidget)); 5527 Qpointer, Qsubwindow, Qwidget));
5525 staticpro (&Vimage_instance_type_list); 5528 staticpro (&Vimage_instance_type_list);
5526 5529
5530 /* The Qunbound name means this test is not available from Lisp. */
5531 Vimage_instance_hash_table_test
5532 = define_hash_table_test (Qunbound, instantiator_eq_equal,
5533 instantiator_eq_hash, Qunbound, Qunbound);
5534 staticpro (&Vimage_instance_hash_table_test);
5535
5527 /* glyphs */ 5536 /* glyphs */
5528 5537
5529 Vglyph_type_list = list3 (Qbuffer, Qpointer, Qicon); 5538 Vglyph_type_list = list3 (Qbuffer, Qpointer, Qicon);
5530 staticpro (&Vglyph_type_list); 5539 staticpro (&Vglyph_type_list);
5531 5540