RCS file: /usr/CVSroot/XEmacs/xemacs/configure.in,v retrieving revision 1.111.2.91 diff -u -r1.111.2.91 configure.in --- configure.in 2000/03/16 07:04:40 1.111.2.91 +++ configure.in 2000/03/24 19:18:05 @@ -711,14 +711,17 @@ byte_code ) error_check_byte_code=yes ;; nobyte_code ) error_check_byte_code=no ;; + glyphs ) error_check_glyphs=yes ;; + noglyphs ) error_check_glyphs=no ;; + * ) bogus_error_check=yes ;; esac if test "$bogus_error_check" -o \ \( -n "$new_default" -a -n "$echeck_notfirst" \) ; then if test "$error_check_default" = yes ; then - types="\`all' (default), \`none', \`noextents', \`notypecheck', \`nobufpos', \`nogc', \`nomalloc', and \`nobyte-code'." + types="\`all' (default), \`none', \`noextents', \`notypecheck', \`nobufpos', \`nogc', \`nomalloc', \`noglyphs' and \`nobyte-code'." else - types="\`all', \`none' (default), \`extents', \`typecheck', \`bufpos', \`gc', \`malloc', and \`byte-code'." + types="\`all', \`none' (default), \`extents', \`typecheck', \`bufpos', \`gc', \`malloc', \`glyphs' and \`byte-code'." fi USAGE_ERROR(["Valid types for the \`--$optname' option are: $types."]) @@ -729,6 +732,7 @@ error_check_gc=$new_default error_check_malloc=$new_default error_check_byte_code=$new_default + error_check_glyphs=$new_default new_default= # reset this fi echeck_notfirst=true @@ -1017,6 +1021,7 @@ test "${error_check_gc=$beta}" = yes && AC_DEFINE(ERROR_CHECK_GC) test "${error_check_malloc=$beta}" = yes && AC_DEFINE(ERROR_CHECK_MALLOC) test "${error_check_byte_code=$beta}" = yes && AC_DEFINE(ERROR_CHECK_BYTE_CODE) +test "${error_check_glyphs=$beta}" = yes && AC_DEFINE(ERROR_CHECK_GLYPHS) dnl debug=yes must be set when error checking is present. This should be dnl fixed up. dnl debug implies other options @@ -4599,7 +4604,7 @@ test "$pdump" = yes && echo " Using the new portable dumper." test "$debug" = yes && echo " Compiling in extra code for debugging." test "$usage_tracking" = yes && echo " Compiling with usage tracking active (Sun internal)." -if test "$error_check_extents $error_check_typecheck $error_check_bufpos $error_check_gc $error_check_malloc" \ +if test "$error_check_extents $error_check_typecheck $error_check_bufpos $error_check_gc $error_check_malloc $error_check_glyphs" \ != "no no no no no"; then echo " WARNING: ---------------------------------------------------------" echo " WARNING: Compiling in support for runtime error checking." Index: lisp/gutter-items.el =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/lisp/Attic/gutter-items.el,v retrieving revision 1.1.2.37 diff -u -r1.1.2.37 gutter-items.el --- lisp/gutter-items.el 2000/03/20 17:02:42 1.1.2.37 +++ lisp/gutter-items.el 2000/03/24 19:18:15 @@ -125,7 +125,8 @@ :group 'buffers-tab :type 'boolean :set #'(lambda (var val) - (set-gutter-element-visible-p default-gutter-visible-p 'buffers-tab val) + (set-gutter-element-visible-p default-gutter-visible-p + 'buffers-tab val) (setq gutter-buffers-tab-visible-p val))) (defvar gutter-buffers-tab-orientation 'top @@ -345,7 +346,7 @@ (defun add-tab-to-gutter () "Put a tab control in the gutter area to hold the most recent buffers." (setq gutter-buffers-tab-orientation (default-gutter-position)) - (let ((gutter-string "\n")) + (let ((gutter-string (copy-sequence "\n"))) (unless gutter-buffers-tab-extent (setq gutter-buffers-tab-extent (make-extent 0 1 gutter-string))) (set-extent-begin-glyph @@ -435,9 +436,9 @@ #'(lambda (frame) (when gutter-buffers-tab (update-tab-in-gutter frame t)))) (add-hook 'record-buffer-hook 'update-tab-in-gutter) -(add-hook 'default-gutter-position-changed - #'(lambda (arg) - (when gutter-buffers-tab (update-tab-in-gutter arg)))) +(add-hook 'default-gutter-position-changed-hook + #'(lambda () + (when gutter-buffers-tab (update-tab-in-gutter)))) (add-hook 'gutter-element-visibility-changed-hook #'(lambda (prop visible-p) (when (and (eq prop 'buffers-tab) visible-p) @@ -503,7 +504,8 @@ (vector 'button :pixel-height (- progress-glyph-height 8) :descriptor " Stop " - :callback '(funcall progress-display-stop-callback))))))))) + :callback + '(funcall progress-display-stop-callback))))))))) (defvar progress-abort-glyph (make-glyph @@ -514,9 +516,6 @@ :pixel-height progress-glyph-height :orientation 'horizontal)))))) -(defvar progress-extent-text "\n") -(defvar progress-extent nil) - (defun progress-displayed-p (&optional return-string frame) "Return a non-nil value if a progress gauge is presently displayed in the gutter area. If optional argument RETURN-STRING is non-nil, @@ -579,6 +578,24 @@ (setcdr s (cdr (cdr s)))) (setq s (cdr s))))))) +(defun progress-display-dispatch-command-events () + ;; don't allow errors to hose things + (condition-case t + ;; processing command events is error-prone so we won't do it + ;; until we can figure out a better way. +; (when (input-pending-p) +; (dispatch-event (next-command-event))) + nil + nil)) + +(defun progress-display-dispatch-non-command-events () + ;; don't allow errors to hose things + (condition-case t + ;; (sit-for 0) is too agressive and cause more display than we + ;; want. + (dispatch-non-command-events) + nil)) + (defun append-progress-display (label message &optional value frame) (or frame (setq frame (selected-frame))) ;; Add a new entry to the message-stack, or modify an existing one @@ -589,17 +606,17 @@ (setcdr top message) (if (equal tmsg message) (set-image-instance-property - (glyph-image-instance progress-gauge-glyph) - :percent value) + (glyph-image-instance progress-gauge-glyph + (frame-selected-window frame)) + :value value) (raw-append-progress-display message value frame)) (redisplay-gutter-area)) (push (cons label message) progress-stack) (raw-append-progress-display message value frame)) - (dispatch-non-command-events) + (progress-display-dispatch-non-command-events) ;; either get command events or sit waiting for them (if (not (eq value 100)) - (when (input-pending-p) - (dispatch-event (next-command-event))) + (progress-display-dispatch-command-events) (sit-for progress-display-popup-period nil) (clear-progress-display label)))) @@ -617,18 +634,16 @@ (push (cons label message) progress-stack)) (unless (equal message "") (insert-string message (get-buffer-create " *Gutter Area*")) - ;; Do what the device is able to cope with. - ;; do some funky display here. - (unless progress-extent - (setq progress-extent (make-extent 0 1 progress-extent-text))) - (let ((bglyph (extent-begin-glyph progress-extent))) - (set-extent-begin-glyph progress-extent progress-abort-glyph) + (let* ((gutter-string (copy-sequence "\n")) + (ext (make-extent 0 1 gutter-string))) + ;; do some funky display here. + (set-extent-begin-glyph ext progress-abort-glyph) ;; fixup the gutter specifiers - (set-gutter-element bottom-gutter - 'progress progress-extent-text frame) + (set-gutter-element bottom-gutter 'progress ext frame) (set-specifier bottom-gutter-border-width 2 frame) (set-image-instance-property - (glyph-image-instance progress-text-glyph) :data message) + (glyph-image-instance progress-text-glyph + (frame-selected-window frame)) :data message) (set-specifier bottom-gutter-height 'autodetect frame) (set-gutter-element-visible-p bottom-gutter-visible-p 'progress t frame) @@ -636,38 +651,41 @@ ;; redisplay-gutter-area performs optimally. (redisplay-gutter-area) (sit-for progress-display-popup-period nil) - (clear-progress-display label) - (set-extent-begin-glyph progress-extent bglyph) + (clear-progress-display label frame) + (set-extent-begin-glyph ext progress-layout-glyph) + (set-gutter-element bottom-gutter 'progress ext frame) ))))) (defun raw-append-progress-display (message &optional value frame) (unless (equal message "") - (let ((inhibit-read-only t) + (let* ((inhibit-read-only t) (zmacs-region-stays zmacs-region-stays) - (val (or value 0))) + (val (or value 0)) + (gutter-string (copy-sequence "\n")) + (ext (make-extent 0 1 gutter-string))) (insert-string message (get-buffer-create " *Gutter Area*")) ;; do some funky display here. - (unless progress-extent - (setq progress-extent (make-extent 0 1 progress-extent-text)) - (set-extent-begin-glyph progress-extent progress-layout-glyph)) + (set-extent-begin-glyph ext progress-layout-glyph) ;; fixup the gutter specifiers - (set-gutter-element bottom-gutter 'progress progress-extent-text frame) + (set-gutter-element bottom-gutter 'progress gutter-string frame) (set-specifier bottom-gutter-border-width 2 frame) (set-image-instance-property - (glyph-image-instance progress-gauge-glyph) :percent val) + (glyph-image-instance progress-gauge-glyph + (frame-selected-window frame)) + :value val) (set-image-instance-property - (glyph-image-instance progress-text-glyph) :data message) + (glyph-image-instance progress-text-glyph (frame-selected-window frame)) + :data message) (if (and (eq (specifier-instance bottom-gutter-height frame) 'autodetect) (gutter-element-visible-p bottom-gutter-visible-p 'progress frame)) + ;; if the gauge is already visible then just draw the gutter + ;; checking for user events (progn - ;; if the gauge is already visible then just draw the gutter - ;; checking for user events (redisplay-gutter-area) - (dispatch-non-command-events) - (when (input-pending-p) - (dispatch-event (next-command-event)))) + (progress-display-dispatch-non-command-events) + (progress-display-dispatch-command-events)) ;; otherwise make the gutter visible and redraw the frame (set-specifier bottom-gutter-height 'autodetect frame) (set-gutter-element-visible-p bottom-gutter-visible-p @@ -675,8 +693,8 @@ ;; we have to do this so redisplay is up-to-date and so ;; redisplay-gutter-area performs optimally. This may also ;; make sure the frame geometry looks ok. - (dispatch-non-command-events) - (redisplay-frame) + (progress-display-dispatch-non-command-events) + (redisplay-frame frame) )))) (defun display-progress-display (label message &optional value frame) Index: src/config.h.in =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/config.h.in,v retrieving revision 1.49.2.30 diff -u -r1.49.2.30 config.h.in --- src/config.h.in 2000/03/16 07:04:47 1.49.2.30 +++ src/config.h.in 2000/03/24 19:18:21 @@ -460,6 +460,10 @@ debugging the byte compiler. */ #undef ERROR_CHECK_BYTE_CODE +/* Minor sanity checking of glyphs, especially subwindows and + widgets. */ +#undef ERROR_CHECK_GLYPHS + /* Define DEBUG_XEMACS if you want extra debugging code compiled in. This is mainly intended for use by developers. */ #undef DEBUG_XEMACS Index: src/glyphs-msw.c =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/glyphs-msw.c,v retrieving revision 1.21.2.52 diff -u -r1.21.2.52 glyphs-msw.c --- src/glyphs-msw.c 2000/03/19 14:14:42 1.21.2.52 +++ src/glyphs-msw.c 2000/03/24 19:18:29 @@ -2726,13 +2726,8 @@ /* delete the pre-existing items */ SendMessage (wnd, TCM_DELETEALLITEMS, 0, 0); - /* Pick up the items we recorded earlier. We do this here so - that the callbacks get set up with the new items. */ - IMAGE_INSTANCE_WIDGET_ITEMS (ii) = - IMAGE_INSTANCE_WIDGET_PENDING_ITEMS (ii); - IMAGE_INSTANCE_WIDGET_PENDING_ITEMS (ii) = Qnil; /* add items to the tab */ - LIST_LOOP (rest, XCDR (IMAGE_INSTANCE_WIDGET_ITEMS (ii))) + LIST_LOOP (rest, XCDR (IMAGE_INSTANCE_WIDGET_PENDING_ITEMS (ii))) { add_tab_item (image_instance, wnd, XCAR (rest), IMAGE_INSTANCE_SUBWINDOW_FRAME (ii), i); @@ -2881,11 +2876,18 @@ { Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); - if (IMAGE_INSTANCE_WIDGET_PERCENT_CHANGED (ii)) + if (IMAGE_INSTANCE_WIDGET_ITEMS_CHANGED (ii)) { - /* #### I'm not convinced we should store this in the plist. */ - Lisp_Object val = Fplist_get (IMAGE_INSTANCE_WIDGET_PROPS (ii), - Q_percent, Qnil); + Lisp_Object val; +#ifdef ERROR_CHECK_GLYPHS + assert (GUI_ITEMP (IMAGE_INSTANCE_WIDGET_PENDING_ITEMS (ii))); +#endif + val = XGUI_ITEM (IMAGE_INSTANCE_WIDGET_PENDING_ITEMS (ii))->value; +#ifdef DEBUG_WIDGET_OUTPUT + printf ("progress gauge displayed value on %p updated to %ld\n", + WIDGET_INSTANCE_MSWINDOWS_HANDLE (ii), + XINT(val)); +#endif CHECK_INT (val); SendMessage (WIDGET_INSTANCE_MSWINDOWS_HANDLE (ii), PBM_SETPOS, (WPARAM)XINT (val), 0); Index: src/glyphs-widget.c =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/Attic/glyphs-widget.c,v retrieving revision 1.1.2.32 diff -u -r1.1.2.32 glyphs-widget.c --- src/glyphs-widget.c 2000/03/19 14:14:43 1.1.2.32 +++ src/glyphs-widget.c 2000/03/24 19:18:33 @@ -57,7 +57,7 @@ Lisp_Object Qlayout; Lisp_Object Q_descriptor, Q_height, Q_width, Q_properties, Q_items; -Lisp_Object Q_image, Q_text, Q_percent, Q_orientation, Q_justify, Q_border; +Lisp_Object Q_image, Q_text, Q_orientation, Q_justify, Q_border; Lisp_Object Qetched_in, Qetched_out, Qbevel_in, Qbevel_out; #ifdef DEBUG_WIDGETS @@ -356,6 +356,14 @@ IMAGE_INSTANCE_WIDGET_TYPE (ii), ERROR_ME_NOT); MAYBE_IIFORMAT_METH (meths, update, (widget)); + + /* Pick up the items we recorded earlier. */ + if (IMAGE_INSTANCE_WIDGET_ITEMS_CHANGED (ii)) + { + IMAGE_INSTANCE_WIDGET_ITEMS (ii) = + IMAGE_INSTANCE_WIDGET_PENDING_ITEMS (ii); + IMAGE_INSTANCE_WIDGET_PENDING_ITEMS (ii) = Qnil; + } } /* Query for a widgets desired geometry. If no type specific method is @@ -598,7 +606,7 @@ XIMAGE_INSTANCE_PARENT (gii) = image_instance; children = Fcons (gii, children); /* Make sure elements in the layout are in the order the - user expected. */ + user expected. */ children = Fnreverse (children); } IMAGE_INSTANCE_LAYOUT_CHILDREN (ii) = children; @@ -816,12 +824,21 @@ { Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); - if (EQ (prop, Q_percent)) + if (EQ (prop, Q_value)) { CHECK_INT (val); - IMAGE_INSTANCE_WIDGET_PROPS (ii) - = Fplist_put (IMAGE_INSTANCE_WIDGET_PROPS (ii), prop, val); - IMAGE_INSTANCE_WIDGET_PERCENT_CHANGED (ii) = 1; +#ifdef DEBUG_WIDGET_OUTPUT + printf ("progress gauge value set to %ld\n", XINT (val)); +#endif + IMAGE_INSTANCE_WIDGET_PENDING_ITEMS (ii) = + copy_gui_item_tree (IMAGE_INSTANCE_WIDGET_ITEMS (ii)); +#ifdef ERROR_CHECK_GLYPHS + assert (GUI_ITEMP (IMAGE_INSTANCE_WIDGET_PENDING_ITEMS (ii))); +#endif + if (GUI_ITEMP (IMAGE_INSTANCE_WIDGET_PENDING_ITEMS (ii))) + XGUI_ITEM (IMAGE_INSTANCE_WIDGET_PENDING_ITEMS (ii))->value = val; + + IMAGE_INSTANCE_WIDGET_ITEMS_CHANGED (ii) = 1; return Qt; } @@ -1107,7 +1124,6 @@ defkeyword (&Q_properties, ":properties"); defkeyword (&Q_items, ":items"); defkeyword (&Q_image, ":image"); - defkeyword (&Q_percent, ":percent"); defkeyword (&Q_text, ":text"); defkeyword (&Q_orientation, ":orientation"); defkeyword (&Q_justify, ":justify"); Index: src/glyphs-x.c =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/glyphs-x.c,v retrieving revision 1.49.2.61 diff -u -r1.49.2.61 glyphs-x.c --- src/glyphs-x.c 2000/03/19 14:14:44 1.49.2.61 +++ src/glyphs-x.c 2000/03/24 19:18:42 @@ -2189,14 +2189,8 @@ need to update most other things after the items have changed.*/ if (IMAGE_INSTANCE_WIDGET_ITEMS_CHANGED (p)) { - /* Pick up the items we recorded earlier. We do this here so - that the callbacks get set up with the new items. */ - IMAGE_INSTANCE_WIDGET_ITEMS (p) = - IMAGE_INSTANCE_WIDGET_PENDING_ITEMS (p); - IMAGE_INSTANCE_WIDGET_PENDING_ITEMS (p) = Qnil; - wv = gui_items_to_widget_values - (IMAGE_INSTANCE_WIDGET_ITEMS (p)); + (IMAGE_INSTANCE_WIDGET_PENDING_ITEMS (p)); wv->change = STRUCTURAL_CHANGE; /* now modify the widget */ lw_modify_all_widgets (IMAGE_INSTANCE_X_WIDGET_LWID (p), @@ -2623,12 +2617,14 @@ { Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); - if (IMAGE_INSTANCE_WIDGET_PERCENT_CHANGED (ii)) + if (IMAGE_INSTANCE_WIDGET_ITEMS_CHANGED (ii)) { Arg al [1]; - /* #### I'm not convinced we should store this in the plist. */ - Lisp_Object val = Fplist_get (IMAGE_INSTANCE_WIDGET_PROPS (ii), - Q_percent, Qnil); + Lisp_Object val; +#ifdef ERROR_CHECK_GLYPHS + assert (GUI_ITEMP (IMAGE_INSTANCE_WIDGET_PENDING_ITEMS (ii))); +#endif + val = XGUI_ITEM (IMAGE_INSTANCE_WIDGET_PENDING_ITEMS (ii))->value; XtSetArg (al[0], XtNvalue, XINT (val)); XtSetValues (IMAGE_INSTANCE_X_WIDGET_ID (ii), al, 1); } Index: src/glyphs.c =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/glyphs.c,v retrieving revision 1.23.2.60 diff -u -r1.23.2.60 glyphs.c --- src/glyphs.c 2000/03/21 08:11:56 1.23.2.60 +++ src/glyphs.c 2000/03/24 19:18:56 @@ -934,10 +934,10 @@ return DEVMETH_OR_GIVEN (d1, image_instance_equal, (i1, i2, depth), 1); } +#if 0 /* internal_hash will not go very far down a list because of the way its written. For items we need to hash all elements so we provide our own list hashing function. */ - static unsigned long full_list_hash (Lisp_Object obj, int depth) { @@ -954,6 +954,7 @@ } return hash; } +#endif static unsigned long image_instance_hash (Lisp_Object obj, int depth) @@ -989,12 +990,8 @@ displayed. */ hash = HASH4 (hash, LISP_HASH (IMAGE_INSTANCE_WIDGET_TYPE (i)), - full_list_hash (IMAGE_INSTANCE_WIDGET_PROPS (i), depth + 1), - full_list_hash - (NILP (IMAGE_INSTANCE_WIDGET_PENDING_ITEMS (i)) - ? IMAGE_INSTANCE_WIDGET_ITEMS (i) - : IMAGE_INSTANCE_WIDGET_PENDING_ITEMS (i), - depth + 1)); + internal_hash (IMAGE_INSTANCE_WIDGET_PROPS (i), depth + 1), + internal_hash (IMAGE_INSTANCE_WIDGET_ITEMS (i), depth + 1)); case IMAGE_SUBWINDOW: hash = HASH2 (hash, (int) IMAGE_INSTANCE_SUBWINDOW_ID (i)); break; @@ -2789,18 +2786,11 @@ Lisp_Object pointer_fg = Qnil; Lisp_Object pointer_bg = Qnil; - if (dest_mask & (IMAGE_SUBWINDOW_MASK - | IMAGE_WIDGET_MASK - | IMAGE_TEXT_MASK)) - { - if (!WINDOWP (domain)) - signal_simple_error ("Can't instantiate text or subwindow outside a window", - instantiator); - else if ((dest_mask & (IMAGE_SUBWINDOW_MASK - | IMAGE_WIDGET_MASK)) - && MINI_WINDOW_P (XWINDOW (domain))) - domain = Fnext_window (domain, Qnil, Qnil, Qnil); - } + /* We have to put subwindow, widget and text image instances in + a per-window cache so that we can see the same glyph in + different windows. Unfortunately we do not know the type of + image_instance until after it has been created. We thus need + to be really careful how we place things. */ if (pointerp) { @@ -2855,7 +2845,9 @@ && dest_mask & (IMAGE_SUBWINDOW_MASK | IMAGE_WIDGET_MASK - | IMAGE_TEXT_MASK)) + | IMAGE_LAYOUT_MASK + | IMAGE_TEXT_MASK) + && WINDOWP (domain)) { instance = Fgethash (instantiator, XWINDOW (domain)->subwindow_instance_cache, @@ -2894,11 +2886,36 @@ & (IMAGE_SUBWINDOW_MASK | IMAGE_WIDGET_MASK + | IMAGE_LAYOUT_MASK | IMAGE_TEXT_MASK )) { +#ifdef ERROR_CHECK_GLYPHS + if (XIMAGE_INSTANCE_TYPE (instance) != IMAGE_TEXT) + assert (EQ (XIMAGE_INSTANCE_SUBWINDOW_FRAME (instance), + FW_FRAME (domain))); +#endif + if (!WINDOWP (domain)) + signal_simple_error ("Can't instantiate text or subwindow outside a window", + instantiator); +#ifdef ERROR_CHECK_GLYPHS + if (XIMAGE_INSTANCE_TYPE (instance) != IMAGE_TEXT) + assert (EQ (XIMAGE_INSTANCE_SUBWINDOW_FRAME (instance), + FW_FRAME (domain))); +#endif Fsetcdr (XCDR (locative), XWINDOW (domain)->subwindow_instance_cache); } unbind_to (speccount, Qnil); +#ifdef ERROR_CHECK_GLYPHS + if (image_instance_type_to_mask (XIMAGE_INSTANCE_TYPE (instance)) + & + (IMAGE_SUBWINDOW_MASK + | IMAGE_WIDGET_MASK + | IMAGE_LAYOUT_MASK + | IMAGE_TEXT_MASK )) + assert (EQ (Fgethash (instantiator, + XWINDOW (domain)->subwindow_instance_cache, + Qunbound), instance)); +#endif } else free_list (ls3); @@ -2906,6 +2923,12 @@ if (NILP (instance)) signal_simple_error ("Can't instantiate image (probably cached)", instantiator); +#ifdef ERROR_CHECK_GLYPHS + if (image_instance_type_to_mask (XIMAGE_INSTANCE_TYPE (instance)) + & (IMAGE_SUBWINDOW_MASK | IMAGE_WIDGET_MASK)) + assert (EQ (XIMAGE_INSTANCE_SUBWINDOW_FRAME (instance), + FW_FRAME (domain))); +#endif return instance; } @@ -4323,8 +4346,6 @@ { Lisp_Image_Instance* ii = XIMAGE_INSTANCE (subwindow); int count = specpdl_depth (); - unsigned long display_hash = internal_hash (subwindow, - IMAGE_INSTANCE_HASH_DEPTH); /* The update method is allowed to call eval. Since it is quite common for this function to get called from somewhere in @@ -4336,17 +4357,10 @@ || IMAGE_INSTANCE_TYPE (ii) == IMAGE_LAYOUT) { - if (IMAGE_INSTANCE_TYPE (ii) == IMAGE_WIDGET - && - (display_hash != IMAGE_INSTANCE_DISPLAY_HASH (ii) - || - IMAGE_INSTANCE_DISPLAY_HASH (ii) == 0)) - { - update_widget (subwindow); - } + if (image_instance_changed (subwindow)) + update_widget (subwindow); /* Reset the changed flags. */ IMAGE_INSTANCE_WIDGET_FACE_CHANGED (ii) = 0; - IMAGE_INSTANCE_WIDGET_PERCENT_CHANGED (ii) = 0; IMAGE_INSTANCE_WIDGET_ITEMS_CHANGED (ii) = 0; IMAGE_INSTANCE_TEXT_CHANGED (ii) = 0; } @@ -4366,12 +4380,30 @@ visual appearance. However, we would rather that then the other way round - it simply means that we will get more displays than we might need. We can get better hashing by making the depth - negative - currently it will recurse down 5 levels.*/ - IMAGE_INSTANCE_DISPLAY_HASH (ii) = display_hash; + negative - currently it will recurse down 7 levels.*/ + IMAGE_INSTANCE_DISPLAY_HASH (ii) = internal_hash (subwindow, + IMAGE_INSTANCE_HASH_DEPTH); unbind_to (count, Qnil); } +int +image_instance_changed (Lisp_Object subwindow) +{ + Lisp_Image_Instance* ii = XIMAGE_INSTANCE (subwindow); + + if (internal_hash (subwindow, IMAGE_INSTANCE_HASH_DEPTH) != + IMAGE_INSTANCE_DISPLAY_HASH (ii)) + return 1; + else if ((WIDGET_IMAGE_INSTANCEP (subwindow) + || LAYOUT_IMAGE_INSTANCEP (subwindow)) + && !internal_equal (IMAGE_INSTANCE_WIDGET_ITEMS (ii), + IMAGE_INSTANCE_WIDGET_PENDING_ITEMS (ii), 0)) + return 1; + else + return 0; +} + /* Update all the subwindows on a frame. */ DEFUN ("update-widget-instances", Fupdate_widget_instances,1, 1, 0, /* Given a FRAME, re-evaluate the display hash code for all widgets in the frame. @@ -4391,18 +4423,10 @@ Dynarr_atp (f->subwindow_cachels, elt); if (cachel->being_displayed && - XIMAGE_INSTANCE_TYPE (cachel->subwindow) - == IMAGE_WIDGET) + image_instance_changed (cachel->subwindow)) { - /* If a subwindow hash changed mark it so that redisplay - will fix it. */ - if (internal_hash (cachel->subwindow, - IMAGE_INSTANCE_HASH_DEPTH) != - XIMAGE_INSTANCE_DISPLAY_HASH (cachel->subwindow)) - { - set_image_instance_dirty_p (cachel->subwindow, 1); - MARK_FRAME_GLYPHS_CHANGED (f); - } + set_image_instance_dirty_p (cachel->subwindow, 1); + MARK_FRAME_GLYPHS_CHANGED (f); } } return Qnil; Index: src/glyphs.h =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/glyphs.h,v retrieving revision 1.18.2.43 diff -u -r1.18.2.43 glyphs.h --- src/glyphs.h 2000/03/19 14:14:46 1.18.2.43 +++ src/glyphs.h 2000/03/24 19:19:00 @@ -550,7 +550,6 @@ /* Change flags to augment dirty. */ unsigned int face_changed : 1; unsigned int items_changed : 1; - unsigned int percent_changed : 1; } subwindow; } u; @@ -566,7 +565,7 @@ #define LAYOUT_JUSTIFY_RIGHT 1 #define LAYOUT_JUSTIFY_CENTER 2 -#define IMAGE_INSTANCE_HASH_DEPTH -2 +#define IMAGE_INSTANCE_HASH_DEPTH 0 /* Accessor macros. */ #define IMAGE_INSTANCE_DEVICE(i) ((i)->device) @@ -596,8 +595,6 @@ ((i)->u.subwindow.face_changed) #define IMAGE_INSTANCE_WIDGET_ITEMS_CHANGED(i) \ ((i)->u.subwindow.items_changed) -#define IMAGE_INSTANCE_WIDGET_PERCENT_CHANGED(i) \ - ((i)->u.subwindow.percent_changed) #define IMAGE_INSTANCE_LAYOUT_CHANGED(i) ((i)->layout_changed) #define IMAGE_INSTANCE_OPTIMIZE_OUTPUT(i) ((i)->optimize_output) @@ -885,7 +882,7 @@ extern Lisp_Object Q_mask_file, Q_mask_data, Q_hotspot_x, Q_hotspot_y; extern Lisp_Object Q_foreground, Q_background, Q_face, Q_descriptor, Q_group; extern Lisp_Object Q_width, Q_height, Q_pixel_width, Q_pixel_height, Q_text; -extern Lisp_Object Q_items, Q_properties, Q_image, Q_percent, Qimage_conversion_error; +extern Lisp_Object Q_items, Q_properties, Q_image, Qimage_conversion_error; extern Lisp_Object Q_orientation, Qupdate_widget_instances; extern Lisp_Object Vcontinuation_glyph, Vcontrol_arrow_glyph, Vhscroll_glyph; extern Lisp_Object Vinvisible_text_glyph, Voctal_escape_glyph, Vtruncation_glyph; @@ -1013,6 +1010,7 @@ void update_widget (Lisp_Object widget); void update_subwindow (Lisp_Object subwindow); Lisp_Object image_instance_parent_glyph (struct Lisp_Image_Instance*); +int image_instance_changed (Lisp_Object image); struct expose_ignore { Index: src/gui.c =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/gui.c,v retrieving revision 1.10.2.23 diff -u -r1.10.2.23 gui.c --- src/gui.c 2000/03/19 14:14:46 1.10.2.23 +++ src/gui.c 2000/03/24 19:19:02 @@ -32,7 +32,7 @@ Lisp_Object Q_active, Q_suffix, Q_keys, Q_style, Q_selected; Lisp_Object Q_filter, Q_config, Q_included, Q_key_sequence; -Lisp_Object Q_accelerator, Q_label, Q_callback; +Lisp_Object Q_accelerator, Q_label, Q_callback, Q_value; Lisp_Object Qtoggle, Qradio; static Lisp_Object parse_gui_item_tree_list (Lisp_Object list); @@ -123,6 +123,7 @@ else if (EQ (key, Q_selected)) pgui_item->selected = val; else if (EQ (key, Q_keys)) pgui_item->keys = val; else if (EQ (key, Q_callback)) pgui_item->callback = val; + else if (EQ (key, Q_value)) pgui_item->value = val; else if (EQ (key, Q_key_sequence)) ; /* ignored for FSF compatibility */ else if (EQ (key, Q_label)) ; /* ignored for 21.0 implement in 21.2 */ else if (EQ (key, Q_accelerator)) @@ -153,6 +154,7 @@ lp->selected = Qnil; lp->keys = Qnil; lp->accelerator = Qnil; + lp->value = Qnil; } Lisp_Object @@ -275,6 +277,8 @@ Fplist_put (plist, Q_keys, pgui_item->keys); if (!NILP (pgui_item->accelerator)) Fplist_put (plist, Q_accelerator, pgui_item->accelerator); + if (!NILP (pgui_item->value)) + Fplist_put (plist, Q_value, pgui_item->value); } /* @@ -492,12 +496,13 @@ mark_object (p->selected); mark_object (p->keys); mark_object (p->accelerator); + mark_object (p->value); return Qnil; } static unsigned long -gui_item_hash_internal (Lisp_Object obj, int depth) +gui_item_hash (Lisp_Object obj, int depth) { Lisp_Gui_Item *p = XGUI_ITEM (obj); @@ -506,36 +511,18 @@ internal_hash (p->suffix, depth + 1), internal_hash (p->active, depth + 1), internal_hash (p->included, depth + 1)), - HASH5 (internal_hash (p->config, depth + 1), + HASH6 (internal_hash (p->config, depth + 1), internal_hash (p->filter, depth + 1), internal_hash (p->style, depth + 1), internal_hash (p->selected, depth + 1), - internal_hash (p->keys, depth + 1))); + internal_hash (p->keys, depth + 1), + internal_hash (p->value, depth + 1))); } -static unsigned long -gui_item_hash (Lisp_Object obj, int depth) -{ - Lisp_Gui_Item *p = XGUI_ITEM (obj); - - /* Note that this evaluates the active and selected slots so that - the hash changes when the result of these changes. */ - return HASH2 (HASH5 (internal_hash (p->name, depth + 1), - internal_hash (p->callback, depth + 1), - internal_hash (p->suffix, depth + 1), - gui_item_active_p (obj), - internal_hash (p->included, depth + 1)), - HASH5 (internal_hash (p->config, depth + 1), - internal_hash (p->filter, depth + 1), - internal_hash (p->style, depth + 1), - gui_item_selected_p (obj), - internal_hash (p->keys, depth + 1))); -} - int gui_item_id_hash (Lisp_Object hashtable, Lisp_Object gitem, int slot) { - int hashid = gui_item_hash_internal (gitem, 0); + int hashid = gui_item_hash (gitem, 0); int id = GUI_ITEM_ID_BITS (hashid, slot); while (!NILP (Fgethash (make_int (id), hashtable, Qnil))) @@ -570,8 +557,10 @@ EQ (p1->selected, p2->selected) && EQ (p1->accelerator, p2->accelerator) + && + EQ (p1->keys, p2->keys) && - EQ (p1->keys, p2->keys))) + EQ (p1->value, p2->value))) return 0; return 1; } @@ -590,6 +579,47 @@ write_c_string (buf, printcharfun); } +static Lisp_Object +copy_gui_item (Lisp_Object gui_item) +{ + Lisp_Object ret = allocate_gui_item (); + Lisp_Gui_Item *lp, *g = XGUI_ITEM (gui_item); + + lp = XGUI_ITEM (ret); + lp->name = g->name; + lp->callback = g->callback; + lp->suffix = g->suffix; + lp->active = g->active; + lp->included = g->included; + lp->config = g->config; + lp->filter = g->filter; + lp->style = g->style; + lp->selected = g->selected; + lp->keys = g->keys; + lp->accelerator = g->accelerator; + lp->value = g->value; + + return ret; +} + +Lisp_Object +copy_gui_item_tree (Lisp_Object arg) +{ + if (CONSP (arg)) + { + Lisp_Object rest = arg = Fcopy_sequence (arg); + while (CONSP (rest)) + { + XCAR (rest) = copy_gui_item_tree (XCAR (rest)); + rest = XCDR (rest); + } + } + else if (GUI_ITEMP (arg)) + return copy_gui_item (arg); + else + return arg; +} + /* parse a glyph descriptor into a tree of gui items. The gui_item slot of an image instance can be a single item or an @@ -681,6 +711,7 @@ defkeyword (&Q_accelerator, ":accelerator"); defkeyword (&Q_label, ":label"); defkeyword (&Q_callback, ":callback"); + defkeyword (&Q_value, ":value"); defsymbol (&Qtoggle, "toggle"); defsymbol (&Qradio, "radio"); Index: src/gui.h =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/gui.h,v retrieving revision 1.6.2.13 diff -u -r1.6.2.13 gui.h --- src/gui.h 2000/02/16 02:07:06 1.6.2.13 +++ src/gui.h 2000/03/24 19:19:02 @@ -52,6 +52,7 @@ Lisp_Object selected; /* Form */ Lisp_Object keys; /* String */ Lisp_Object accelerator; /* Char or Symbol */ + Lisp_Object value; /* Anything you like */ }; DECLARE_LRECORD (gui_item, Lisp_Gui_Item); @@ -63,7 +64,7 @@ extern Lisp_Object Q_accelerator, Q_active, Q_config, Q_filter, Q_included; extern Lisp_Object Q_keys, Q_selected, Q_suffix, Qradio, Qtoggle; -extern Lisp_Object Q_key_sequence, Q_label, Q_callback; +extern Lisp_Object Q_key_sequence, Q_label, Q_callback, Q_value; void gui_item_add_keyval_pair (Lisp_Object, Lisp_Object key, Lisp_Object val, @@ -85,6 +86,7 @@ Lisp_Object allocate_gui_item (void); void gui_item_init (Lisp_Object gui_item); Lisp_Object parse_gui_item_tree_children (Lisp_Object list); +Lisp_Object copy_gui_item_tree (Lisp_Object arg); /* this is mswindows biased but reasonably safe I think */ #define GUI_ITEM_ID_SLOTS 8 Index: src/gutter.c =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/Attic/gutter.c,v retrieving revision 1.1.2.29 diff -u -r1.1.2.29 gutter.c --- src/gutter.c 2000/03/17 17:34:41 1.1.2.29 +++ src/gutter.c 2000/03/24 19:19:06 @@ -1047,8 +1047,8 @@ defsymbol (&Qgutter_size, "gutter-size"); defsymbol (&Qgutter_visible, "gutter-visible"); - defsymbol (&Qdefault_gutter_position_changed_hook, - "default-gutter-position-changed"); + defsymbol (&Qdefault_gutter_position_changed_hook, + "default-gutter-position-changed-hook"); } void Index: src/redisplay-output.c =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/redisplay-output.c,v retrieving revision 1.11.2.33 diff -u -r1.11.2.33 redisplay-output.c --- src/redisplay-output.c 2000/03/16 11:21:55 1.11.2.33 +++ src/redisplay-output.c 2000/03/24 19:19:14 @@ -233,8 +233,7 @@ return 0; /* Only check dirtiness if we know something has changed. */ else if (crb->type == RUNE_DGLYPH && - ((XFRAME (w->frame)->glyphs_changed && - XGLYPH_DIRTYP (crb->object.dglyph.glyph)) || + (XGLYPH_DIRTYP (crb->object.dglyph.glyph) || crb->findex != drb->findex)) { /* We need some way of telling redisplay_output_layout () that the @@ -262,10 +261,9 @@ cases they will actually be the same object. This does not mean, however, that nothing has changed. We therefore need to check the current hash of the glyph against the last recorded - display hash. See update_subwindow (). */ - if (IMAGE_INSTANCE_DISPLAY_HASH (ii) == 0 || - IMAGE_INSTANCE_DISPLAY_HASH (ii) != - internal_hash (image, IMAGE_INSTANCE_HASH_DEPTH) || + display hash and the pending display items. See + update_subwindow (). */ + if (image_instance_changed (image) || crb->findex != drb->findex || WINDOW_FACE_CACHEL_DIRTY (w, drb->findex)) { @@ -283,7 +281,13 @@ return 0; } else - return 1; + { +#ifdef DEBUG_WIDGET_OUTPUT + if (XIMAGE_INSTANCE_TYPE (image) == IMAGE_LAYOUT) + printf ("glyph layout %p considered unchanged\n", ii); +#endif + return 1; + } } /* We now do this last so that glyph checks can do their own thing for face changes. Face changes quite often happen when we are @@ -1301,7 +1305,9 @@ dga->height = layout_height; dga->width = layout_width; - +#ifdef DEBUG_WIDGET_OUTPUT + printf ("outputing layout glyph %p\n", p); +#endif /* This makes the glyph area fit into the display area. */ if (!redisplay_normalize_glyph_area (db, dga)) return; Index: tests/glyph-test.el =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/tests/Attic/glyph-test.el,v retrieving revision 1.1.2.19 diff -u -r1.1.2.19 glyph-test.el --- tests/glyph-test.el 2000/03/19 14:14:48 1.1.2.19 +++ tests/glyph-test.el 2000/03/24 19:19:16 @@ -82,7 +82,7 @@ ;; progress the progress ... (let ((x 0)) (while (<= x 100) - (set-image-instance-property (glyph-image-instance pgauge) :percent x) + (set-image-instance-property (glyph-image-instance pgauge) :value x) (setq x (+ x 5)) (sit-for 0.1))) @@ -95,7 +95,7 @@ ;; progress the progress ... (let ((x 0)) (while (<= x 100) - (set-image-instance-property (glyph-image-instance pg) :percent x) + (set-image-instance-property (glyph-image-instance pg) :value x) (setq x (+ x 5)) (sit-for 0.1)))