Index: src/elhash.c =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/elhash.c,v retrieving revision 1.14.2.23 diff -u -r1.14.2.23 elhash.c --- src/elhash.c 2000/02/26 11:39:50 1.14.2.23 +++ src/elhash.c 2000/05/30 10:54:52 @@ -29,13 +29,14 @@ Lisp_Object Qhash_tablep; static Lisp_Object Qhashtable, Qhash_table; -static Lisp_Object Qweakness, Qvalue; +static Lisp_Object Qweakness, Qvalue, Qkey_value; static Lisp_Object Vall_weak_hash_tables; static Lisp_Object Qrehash_size, Qrehash_threshold; static Lisp_Object Q_size, Q_test, Q_weakness, Q_rehash_size, Q_rehash_threshold; /* obsolete as of 19990901 in xemacs-21.2 */ -static Lisp_Object Qweak, Qkey_weak, Qvalue_weak, Qnon_weak, Q_type; +static Lisp_Object Qweak, Qkey_weak, Qvalue_weak, Qkey_value_weak; +static Lisp_Object Qnon_weak, Q_type; typedef struct hentry { @@ -354,6 +355,7 @@ (ht->weakness == HASH_TABLE_WEAK ? "t" : ht->weakness == HASH_TABLE_KEY_WEAK ? "key" : ht->weakness == HASH_TABLE_VALUE_WEAK ? "value" : + ht->weakness == HASH_TABLE_KEY_VALUE_WEAK ? "key-value" : "you-d-better-not-see-this")); write_c_string (buf, printcharfun); } @@ -542,12 +544,14 @@ if (EQ (value, Qnil)) return 1; if (EQ (value, Qt)) return 1; if (EQ (value, Qkey)) return 1; + if (EQ (value, Qkey_value)) return 1; if (EQ (value, Qvalue)) return 1; /* Following values are obsolete as of 19990901 in xemacs-21.2 */ if (EQ (value, Qnon_weak)) return 1; if (EQ (value, Qweak)) return 1; if (EQ (value, Qkey_weak)) return 1; + if (EQ (value, Qkey_value_weak)) return 1; if (EQ (value, Qvalue_weak)) return 1; maybe_signal_simple_error ("Invalid hash table weakness", @@ -561,12 +565,14 @@ if (EQ (obj, Qnil)) return HASH_TABLE_NON_WEAK; if (EQ (obj, Qt)) return HASH_TABLE_WEAK; if (EQ (obj, Qkey)) return HASH_TABLE_KEY_WEAK; + if (EQ (obj, Qkey_value)) return HASH_TABLE_KEY_VALUE_WEAK; if (EQ (obj, Qvalue)) return HASH_TABLE_VALUE_WEAK; /* Following values are obsolete as of 19990901 in xemacs-21.2 */ if (EQ (obj, Qnon_weak)) return HASH_TABLE_NON_WEAK; if (EQ (obj, Qweak)) return HASH_TABLE_WEAK; if (EQ (obj, Qkey_weak)) return HASH_TABLE_KEY_WEAK; + if (EQ (obj, Qkey_value_weak)) return HASH_TABLE_KEY_VALUE_WEAK; if (EQ (obj, Qvalue_weak)) return HASH_TABLE_VALUE_WEAK; signal_simple_error ("Invalid hash table weakness", obj); @@ -800,7 +806,8 @@ Keyword :rehash-threshold must be a float between 0.0 and 1.0, and specifies the load factor of the hash table which triggers enlarging. -Non-standard keyword :weakness can be `nil' (default), `t', `key' or `value'. +Non-standard keyword :weakness can be `nil' (default), `t', `key', `value' +or `key-value'. A weak hash table is one whose pointers do not count as GC referents: for any key-value pair in the hash table, if the only remaining pointer @@ -820,6 +827,12 @@ unmarked outside of weak hash tables. The pair will remain in the hash table if the value is pointed to by something other than a weak hash table, even if the key is not. + +A key-value-weak hash table is similar to a fully-weak hash table except +that a key-value pair will be removed only if the value and the key remain +unmarked outside of weak hash tables. The pair will remain in the +hash table if the value or key are pointed to by something other than a weak +hash table, even if the other is not. */ (int nargs, Lisp_Object *args)) { @@ -1117,6 +1130,7 @@ { case HASH_TABLE_WEAK: return Qt; case HASH_TABLE_KEY_WEAK: return Qkey; + case HASH_TABLE_KEY_VALUE_WEAK: return Qkey_value; case HASH_TABLE_VALUE_WEAK: return Qvalue; default: return Qnil; } @@ -1133,6 +1147,7 @@ { case HASH_TABLE_WEAK: return Qweak; case HASH_TABLE_KEY_WEAK: return Qkey_weak; + case HASH_TABLE_KEY_VALUE_WEAK: return Qkey_value_weak; case HASH_TABLE_VALUE_WEAK: return Qvalue_weak; default: return Qnon_weak; } @@ -1266,6 +1281,15 @@ MARK_OBJ (e->key); break; + case HASH_TABLE_KEY_VALUE_WEAK: + for (; e < sentinel; e++) + if (!HENTRY_CLEAR_P (e)) + if (marked_p (e->value)) + MARK_OBJ (e->key); + else if (marked_p (e->key)) + MARK_OBJ (e->value); + break; + case HASH_TABLE_KEY_CAR_WEAK: for (; e < sentinel; e++) if (!HENTRY_CLEAR_P (e)) @@ -1458,11 +1482,13 @@ defsymbol (&Qhashtable, "hashtable"); defsymbol (&Qweakness, "weakness"); defsymbol (&Qvalue, "value"); + defsymbol (&Qkey_value, "key-value"); defsymbol (&Qrehash_size, "rehash-size"); defsymbol (&Qrehash_threshold, "rehash-threshold"); defsymbol (&Qweak, "weak"); /* obsolete */ defsymbol (&Qkey_weak, "key-weak"); /* obsolete */ + defsymbol (&Qkey_value_weak, "key-value-weak"); /* obsolete */ defsymbol (&Qvalue_weak, "value-weak"); /* obsolete */ defsymbol (&Qnon_weak, "non-weak"); /* obsolete */ Index: src/elhash.h =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/elhash.h,v retrieving revision 1.6.2.7 diff -u -r1.6.2.7 elhash.h --- src/elhash.h 2000/02/07 07:59:31 1.6.2.7 +++ src/elhash.h 2000/05/30 10:54:53 @@ -38,6 +38,7 @@ HASH_TABLE_NON_WEAK, HASH_TABLE_KEY_WEAK, HASH_TABLE_VALUE_WEAK, + HASH_TABLE_KEY_VALUE_WEAK, HASH_TABLE_KEY_CAR_WEAK, HASH_TABLE_VALUE_CAR_WEAK, HASH_TABLE_WEAK Index: src/glyphs-widget.c =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/Attic/glyphs-widget.c,v retrieving revision 1.1.2.42 diff -u -r1.1.2.42 glyphs-widget.c --- src/glyphs-widget.c 2000/05/22 09:52:54 1.1.2.42 +++ src/glyphs-widget.c 2000/05/30 10:55:22 @@ -375,7 +375,7 @@ provided then use the widget text to calculate sizes. */ static void widget_query_geometry (Lisp_Object image_instance, - unsigned int* width, unsigned int* height, + int* width, int* height, enum image_instance_geometry disp, Lisp_Object domain) { Lisp_Image_Instance* ii = XIMAGE_INSTANCE (image_instance); @@ -442,7 +442,7 @@ static int widget_layout (Lisp_Object image_instance, - unsigned int width, unsigned int height, Lisp_Object domain) + int width, int height, Lisp_Object domain) { Lisp_Image_Instance* ii = XIMAGE_INSTANCE (image_instance); struct image_instantiator_methods* meths; @@ -698,7 +698,7 @@ depending on the type of button. */ static void button_query_geometry (Lisp_Object image_instance, - unsigned int* width, unsigned int* height, + int* width, int* height, enum image_instance_geometry disp, Lisp_Object domain) { Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); @@ -724,7 +724,7 @@ /* tree-view geometry - get the height right */ static void tree_view_query_geometry (Lisp_Object image_instance, - unsigned int* width, unsigned int* height, + int* width, int* height, enum image_instance_geometry disp, Lisp_Object domain) { Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); @@ -751,7 +751,7 @@ items and text therin in the tab control. */ static void tab_control_query_geometry (Lisp_Object image_instance, - unsigned int* width, unsigned int* height, + int* width, int* height, enum image_instance_geometry disp, Lisp_Object domain) { Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); @@ -995,14 +995,14 @@ /* Query the geometry of a layout widget. We assume that we can only get here if the size is not already fixed. */ static void -layout_query_geometry (Lisp_Object image_instance, unsigned int* width, - unsigned int* height, enum image_instance_geometry disp, +layout_query_geometry (Lisp_Object image_instance, int* width, + int* height, enum image_instance_geometry disp, Lisp_Object domain) { Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); Lisp_Object items = IMAGE_INSTANCE_LAYOUT_CHILDREN (ii), rest; int maxph = 0, maxpw = 0, nitems = 0, ph_adjust = 0; - unsigned int gheight, gwidth; + int gheight, gwidth; /* If we are not initialized then we won't have any children. */ if (!IMAGE_INSTANCE_INITIALIZED (ii)) @@ -1082,14 +1082,14 @@ int layout_layout (Lisp_Object image_instance, - unsigned int width, unsigned int height, Lisp_Object domain) + int width, int height, Lisp_Object domain) { Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); Lisp_Object rest; Lisp_Object items = IMAGE_INSTANCE_LAYOUT_CHILDREN (ii); int x, y, maxph = 0, maxpw = 0, nitems = 0, horiz_spacing, vert_spacing, ph_adjust = 0; - unsigned int gheight, gwidth; + int gheight, gwidth; /* If we are not initialized then we won't have any children. */ if (!IMAGE_INSTANCE_INITIALIZED (ii)) @@ -1215,7 +1215,7 @@ /* Layout subwindows if they are real subwindows. */ static int native_layout_layout (Lisp_Object image_instance, - unsigned int width, unsigned int height, + int width, int height, Lisp_Object domain) { Lisp_Image_Instance* ii = XIMAGE_INSTANCE (image_instance); Index: src/glyphs.c =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/glyphs.c,v retrieving revision 1.23.2.72 diff -u -r1.23.2.72 glyphs.c --- src/glyphs.c 2000/05/23 10:53:41 1.23.2.72 +++ src/glyphs.c 2000/05/30 10:55:37 @@ -724,10 +724,8 @@ IMAGE_INSTANCE_LAYOUT_CHANGED (p) = 0; IMAGE_INSTANCE_DIRTYP (p) = 0; - assert ( XIMAGE_INSTANCE_HEIGHT (ii) - != IMAGE_UNSPECIFIED_GEOMETRY - && XIMAGE_INSTANCE_WIDTH (ii) - != IMAGE_UNSPECIFIED_GEOMETRY); + assert ( XIMAGE_INSTANCE_HEIGHT (ii) >= 0 + && XIMAGE_INSTANCE_WIDTH (ii) >= 0 ); ERROR_CHECK_IMAGE_INSTANCE (ii); @@ -1895,7 +1893,7 @@ special function then just return the width and / or height. */ void image_instance_query_geometry (Lisp_Object image_instance, - unsigned int* width, unsigned int* height, + int* width, int* height, enum image_instance_geometry disp, Lisp_Object domain) { @@ -1930,8 +1928,7 @@ want to specifiy something (layout widgets). */ void image_instance_layout (Lisp_Object image_instance, - unsigned int width, unsigned int height, - Lisp_Object domain) + int width, int height, Lisp_Object domain) { Lisp_Image_Instance* ii = XIMAGE_INSTANCE (image_instance); Lisp_Object type; @@ -1951,8 +1948,8 @@ || height == IMAGE_UNSPECIFIED_GEOMETRY) { - unsigned int dwidth = IMAGE_UNSPECIFIED_GEOMETRY, - dheight = IMAGE_UNSPECIFIED_GEOMETRY; + int dwidth = IMAGE_UNSPECIFIED_GEOMETRY; + int dheight = IMAGE_UNSPECIFIED_GEOMETRY; /* Get the desired geometry. */ if (meths && HAS_IIFORMAT_METH_P (meths, query_geometry)) @@ -2161,8 +2158,7 @@ helper that is used elsewhere for calculating text geometry. */ void query_string_geometry (Lisp_Object string, Lisp_Object face, - unsigned int* width, unsigned int* height, - unsigned int* descent, Lisp_Object domain) + int* width, int* height, int* descent, Lisp_Object domain) { struct font_metric_info fm; unsigned char charsets[NUM_LEADING_BYTES]; @@ -2250,7 +2246,7 @@ static void text_query_geometry (Lisp_Object image_instance, - unsigned int* width, unsigned int* height, + int* width, int* height, enum image_instance_geometry disp, Lisp_Object domain) { Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); @@ -3015,13 +3011,16 @@ } else { - Lisp_Object instance; - Lisp_Object subtable; + Lisp_Object instance = Qnil; + Lisp_Object subtable = Qnil; Lisp_Object ls3 = Qnil; Lisp_Object pointer_fg = Qnil; Lisp_Object pointer_bg = Qnil; Lisp_Object governing_domain = get_image_instantiator_governing_domain (instantiator, domain); + struct gcpro gcpro1; + + GCPRO1 (instance); /* We have to put subwindow, widget and text image instances in a per-window cache so that we can see the same glyph in @@ -3146,7 +3145,7 @@ DOMAIN_FRAME (domain))); #endif ERROR_CHECK_IMAGE_INSTANCE (instance); - return instance; + RETURN_UNGCPRO (instance); } abort (); @@ -4150,8 +4149,7 @@ cache_subwindow_instance_in_frame_maybe (Lisp_Object instance) { Lisp_Image_Instance* ii = XIMAGE_INSTANCE (instance); - if (image_instance_type_to_mask (IMAGE_INSTANCE_TYPE (ii)) - & (IMAGE_WIDGET_MASK | IMAGE_SUBWINDOW_MASK)) + if (!NILP (DOMAIN_FRAME (IMAGE_INSTANCE_DOMAIN (ii)))) { struct frame* f = DOMAIN_XFRAME (IMAGE_INSTANCE_DOMAIN (ii)); XWEAK_LIST_LIST (FRAME_SUBWINDOW_CACHE (f)) @@ -4531,8 +4529,8 @@ /* This is just a backup in case no-one has assigned a suitable geometry. #### It should really query the enclose window for geometry. */ static void -subwindow_query_geometry (Lisp_Object image_instance, unsigned int* width, - unsigned int* height, enum image_instance_geometry disp, +subwindow_query_geometry (Lisp_Object image_instance, int* width, + int* height, enum image_instance_geometry disp, Lisp_Object domain) { if (width) *width = 20; Index: src/glyphs.h =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/glyphs.h,v retrieving revision 1.18.2.50 diff -u -r1.18.2.50 glyphs.h --- src/glyphs.h 2000/05/11 18:23:24 1.18.2.50 +++ src/glyphs.h 2000/05/30 10:55:41 @@ -92,9 +92,10 @@ IMAGE_DESIRED_GEOMETRY, IMAGE_MIN_GEOMETRY, IMAGE_MAX_GEOMETRY, - IMAGE_UNSPECIFIED_GEOMETRY = ~0 }; +#define IMAGE_UNSPECIFIED_GEOMETRY -1 + #define WIDGET_BORDER_HEIGHT 4 #define WIDGET_BORDER_WIDTH 4 @@ -168,15 +169,14 @@ instance. Actual geometry is stored in the appropriate slots in the image instance. */ void (*query_geometry_method) (Lisp_Object image_instance, - unsigned int* width, unsigned int* height, + int* width, int* height, enum image_instance_geometry disp, Lisp_Object domain); /* Layout the instance and its children bounded by the provided dimensions. Returns success or failure. */ int (*layout_method) (Lisp_Object image_instance, - unsigned int width, unsigned int height, - Lisp_Object domain); + int width, int height, Lisp_Object domain); }; /***** Calling an image-instantiator method *****/ @@ -359,14 +359,14 @@ Lisp_Object pointer_fg, Lisp_Object pointer_bg, int dest_mask, Lisp_Object domain); void image_instance_query_geometry (Lisp_Object image_instance, - unsigned int* width, unsigned int* height, + int* width, int* height, enum image_instance_geometry disp, Lisp_Object domain); void image_instance_layout (Lisp_Object image_instance, - unsigned int width, unsigned int height, + int width, int height, Lisp_Object domain); int layout_layout (Lisp_Object image_instance, - unsigned int width, unsigned int height, + int width, int height, Lisp_Object domain); int invalidate_glyph_geometry_maybe (Lisp_Object glyph_or_ii, struct window* w); @@ -530,7 +530,7 @@ Lisp_Object parent; enum image_instance_type type; unsigned int x_offset, y_offset; /* for layout purposes */ - unsigned int width, height, margin_width; + int width, height, margin_width; unsigned long display_hash; /* Hash value representing the structure of the image_instance when it was last displayed. */ @@ -980,8 +980,8 @@ Lisp_Object property, Lisp_Object locale)); void query_string_geometry ( Lisp_Object string, Lisp_Object face, - unsigned int* width, unsigned int* height, - unsigned int* descent, Lisp_Object domain); + int* width, int* height, int* descent, + Lisp_Object domain); Lisp_Object query_string_font (Lisp_Object string, Lisp_Object face, Lisp_Object domain); Lisp_Object add_glyph_animated_timeout (EMACS_INT tickms, Lisp_Object device); Index: src/lisp.h =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/lisp.h,v retrieving revision 1.38.2.64 diff -u -r1.38.2.64 lisp.h --- src/lisp.h 2000/05/21 01:40:39 1.38.2.64 +++ src/lisp.h 2000/05/30 10:55:51 @@ -1388,7 +1388,10 @@ /* element disappears if it's a cons and its car is unmarked. */ WEAK_LIST_KEY_ASSOC, /* element disappears if it's a cons and its cdr is unmarked. */ - WEAK_LIST_VALUE_ASSOC + WEAK_LIST_VALUE_ASSOC, + /* element disappears if it's a cons and neither its car nor + its cdr is marked. */ + WEAK_LIST_FULL_ASSOC }; struct weak_list @@ -2826,7 +2829,7 @@ extern Lisp_Object Qfile_name, Qfile_error; extern Lisp_Object Qfont, Qforce_g0_on_output, Qforce_g1_on_output; extern Lisp_Object Qforce_g2_on_output, Qforce_g3_on_output, Qforeground; -extern Lisp_Object Qformat, Qframe, Qframe_live_p, Qfuncall, Qfunction; +extern Lisp_Object Qformat, Qframe, Qframe_live_p, Qfull_assoc, Qfuncall, Qfunction; extern Lisp_Object Qgap_overhead, Qgeneric, Qgeometry, Qglobal, Qheight; extern Lisp_Object Qhelp, Qhighlight, Qhorizontal, Qicon; extern Lisp_Object Qicon_glyph_p, Qid, Qidentity, Qignore, Qimage, Qinfo; Index: src/window.c =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/window.c,v retrieving revision 1.41.2.52 diff -u -r1.41.2.52 window.c --- src/window.c 2000/05/11 10:29:37 1.41.2.52 +++ src/window.c 2000/05/30 10:56:15 @@ -282,7 +282,7 @@ p->glyph_cachels = Dynarr_new (glyph_cachel); p->line_start_cache = Dynarr_new (line_start_cache); p->subwindow_instance_cache = make_lisp_hash_table (30, - HASH_TABLE_KEY_WEAK, + HASH_TABLE_KEY_VALUE_WEAK, HASH_TABLE_EQUAL); p->line_cache_last_updated = Qzero; INIT_DISP_VARIABLE (last_point_x, 0); @@ -3519,7 +3519,7 @@ p->glyph_cachels = Dynarr_new (glyph_cachel); p->subwindow_instance_cache = make_lisp_hash_table (30, - HASH_TABLE_KEY_WEAK, + HASH_TABLE_KEY_VALUE_WEAK, HASH_TABLE_EQUAL); /* Put new into window structure in place of window */ @@ -5369,7 +5369,7 @@ it up as needed. */ w->subwindow_instance_cache = make_lisp_hash_table (30, - HASH_TABLE_KEY_WEAK, + HASH_TABLE_KEY_VALUE_WEAK, HASH_TABLE_EQUAL); SET_LAST_MODIFIED (w, 1); SET_LAST_FACECHANGE (w);