Index: lisp/dialog-items.el =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/lisp/Attic/dialog-items.el,v retrieving revision 1.1.2.1 diff -u -r1.1.2.1 dialog-items.el --- lisp/dialog-items.el 2000/07/21 10:15:14 1.1.2.1 +++ lisp/dialog-items.el 2000/07/22 19:24:31 @@ -31,21 +31,21 @@ ;; Simple search dialog ;; (defvar search-dialog-direction t) -(defvar search-dialog-text - (make-glyph - [edit-field :width 15 :descriptor "" :active t :face default])) +(defvar search-dialog nil) (defun search-dialog-callback (parent image-instance event) (save-selected-frame (select-frame parent) - (funcall (if search-dialog-direction - 'search-forward 'search-backward) - (image-instance-property - (glyph-image-instance search-dialog-text - (frame-selected-window - (event-channel event))) :text)) - (isearch-highlight (match-beginning 0) (match-end 0)))) - + (let ((domain (frame-selected-window (event-channel event)))) + (funcall (if search-dialog-direction + 'search-forward 'search-backward) + (glyph-image-property + (car (glyph-image-property + (nth 1 (glyph-image-property + search-dialog :items domain)) + :items domain)) :text domain)) + (isearch-highlight (match-beginning 0) (match-end 0))))) + (defun make-search-dialog () "Popup a search dialog box." (interactive) @@ -55,40 +55,42 @@ :parent parent :title "Search" :spec - `[layout - :orientation horizontal :justify left - :height 10 :width 40 - :border [string :data "Search"] - :items - ([layout :orientation vertical :justify left - :items - ([string :data "Search for:"] - [button :descriptor "Match case" - :style toggle - :selected (not case-fold-search) - :callback (setq case-fold-search - (not case-fold-search))] - [button :descriptor "Forward" - :style radio - :selected search-dialog-direction - :callback (setq search-dialog-direction t)] - [button :descriptor "Backward" - :style radio - :selected (not search-dialog-direction) - :callback (setq search-dialog-direction nil)] - )] - [layout :orientation vertical :justify left - :items - (search-dialog-text - [button :width 10 :descriptor "Find Next" - :callback-ex - (lambda (image-instance event) - (search-dialog-callback ,parent - image-instance event))] - [button :width 10 :descriptor "Cancel" - :callback-ex - (lambda (image-instance event) - (isearch-dehighlight) - (delete-frame - (event-channel event)))])])] + (setq search-dialog + (make-glyph + `[layout + :orientation horizontal :justify left + :height 10 :width 40 + :border [string :data "Search"] + :items + ([layout :orientation vertical :justify left + :items + ([string :data "Search for:"] + [button :descriptor "Match case" + :style toggle + :selected (not case-fold-search) + :callback (setq case-fold-search + (not case-fold-search))] + [button :descriptor "Forwards" + :style radio + :selected search-dialog-direction + :callback (setq search-dialog-direction t)] + [button :descriptor "Backwards" + :style radio + :selected (not search-dialog-direction) + :callback (setq search-dialog-direction nil)] + )] + [layout :orientation vertical :justify left + :items + ([edit-field :width 15 :descriptor "" :active t :face default] + [button :width 10 :descriptor "Find Next" + :callback-ex + (lambda (image-instance event) + (search-dialog-callback ,parent + image-instance event))] + [button :width 10 :descriptor "Cancel" + :callback-ex + (lambda (image-instance event) + (isearch-dehighlight) + (delete-frame + (event-channel event)))])])])) :properties '(height 10 width 40)))) Index: lisp/glyphs.el =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/lisp/glyphs.el,v retrieving revision 1.6.2.2 diff -u -r1.6.2.2 glyphs.el --- lisp/glyphs.el 2000/05/09 11:54:49 1.6.2.2 +++ lisp/glyphs.el 2000/07/22 19:24:35 @@ -543,6 +543,14 @@ See `glyph-property-instance' for more information." (glyph-property-instance glyph 'image domain default no-fallback)) +(defun glyph-image-property (glyph prop &optional domain default no-fallback) + "Return property PROP of the instance of GLYPH's image in DOMAIN. + +Normally DOMAIN will be a window or nil (meaning the selected window). +The value returned is dependent on the image instance type." + (image-instance-property + (glyph-image-instance glyph domain default no-fallback) prop)) + (defun set-glyph-image (glyph spec &optional locale tag-set how-to-add) "Change the image of GLYPH in LOCALE. Index: lisp/gutter-items.el =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/lisp/Attic/gutter-items.el,v retrieving revision 1.1.2.51 diff -u -r1.1.2.51 gutter-items.el --- lisp/gutter-items.el 2000/07/21 10:15:15 1.1.2.51 +++ lisp/gutter-items.el 2000/07/22 19:24:36 @@ -155,9 +155,6 @@ ;; that the current buffer is at the front of the buffers list. ;; for example, select an item and then do M-C-l ;; (switch-to-other-buffer). Things get way confused. - ;; - ;; Andy, if you want to maintain the current look, you must - ;; *uncouple* the gutter order and buffers order. (if (> (length (windows-of-buffer buffer)) 0) (select-window (car (windows-of-buffer buffer))) (switch-to-buffer buffer)))) @@ -371,54 +368,6 @@ (defvar progress-feedback-popup-period 0.5 "The time that the progress gauge should remain up after completion") -;; private variables -(defvar progress-text-glyph - (make-glyph [string :data ""])) - -(defvar progress-layout-glyph nil) -(defvar progress-gauge-glyph - (make-glyph - `[progress-gauge - :pixel-height (eval progress-glyph-height) - :pixel-width 250 - :descriptor "Progress"])) - -(defun set-progress-feedback-style (style) - "Control the appearance of the progress gauge. -If STYLE is 'large, the default, then the progress-feedback text is -displayed above the gauge itself. If STYLE is 'small then the gauge -and text are arranged side-by-side." - (cond - ((eq style 'small) - (setq progress-glyph-height 16) - (setq progress-layout-glyph - (make-glyph - `[layout - :orientation horizontal - :margin-width 4 - :items (,progress-gauge-glyph - [button - :pixel-height (eval progress-glyph-height) - ;; 'quit is special and acts "asynchronously". - :descriptor "Stop" :callback 'quit] - ,progress-text-glyph)]))) - (t - (setq progress-glyph-height 24) - (setq progress-layout-glyph - (make-glyph - `[layout - :orientation vertical :justify left - :margin-width 4 - :items (,progress-text-glyph - [layout - :orientation horizontal - :items (,progress-gauge-glyph - [button - :pixel-height (eval progress-glyph-height) - :descriptor " Stop " - ;; 'quit is special and acts "asynchronously". - :callback 'quit])])]))))) - (defcustom progress-feedback-style 'large "*Control the appearance of the progress gauge. If 'large, the default, then the progress-feedback text is displayed @@ -426,10 +375,52 @@ side-by-side." :group 'gutter :type '(choice (const :tag "large" large) - (const :tag "small" small)) - :set #'(lambda (var val) - (set-progress-feedback-style val))) + (const :tag "small" small))) +;; private variables +(defvar progress-text-instantiator [string :data ""]) +(defvar progress-layout-glyph (make-glyph)) +(defvar progress-layout-instantiator nil) + +(defvar progress-gauge-instantiator + [progress-gauge + :value 0 + :pixel-height (eval progress-glyph-height) + :pixel-width 250 + :descriptor "Progress"]) + +(defun set-progress-feedback-instantiator (&optional locale) + (cond + ((eq progress-feedback-style 'small) + (setq progress-glyph-height 16) + (setq progress-layout-instantiator + `[layout + :orientation horizontal + :margin-width 4 + :items (,progress-gauge-instantiator + [button + :pixel-height (eval progress-glyph-height) + ;; 'quit is special and acts "asynchronously". + :descriptor "Stop" :callback 'quit] + ,progress-text-instantiator)]) + (set-glyph-image progress-layout-glyph progress-layout-instantiator locale)) + (t + (setq progress-glyph-height 24) + (setq progress-layout-instantiator + `[layout + :orientation vertical :justify left + :margin-width 4 + :items (,progress-text-instantiator + [layout + :orientation horizontal + :items (,progress-gauge-instantiator + [button + :pixel-height (eval progress-glyph-height) + :descriptor " Stop " + ;; 'quit is special and acts "asynchronously". + :callback 'quit])])]) + (set-glyph-image progress-layout-glyph progress-layout-instantiator locale)))) + (defvar progress-stack nil "An alist of label/string pairs representing active progress gauges. The first element in the list is currently displayed in the gutter area. @@ -439,7 +430,7 @@ (defvar progress-abort-glyph (make-glyph `[layout :orientation vertical :justify left - :items (,progress-text-glyph + :items (,progress-text-instantiator [layout :margin-width 4 :pixel-height progress-glyph-height @@ -522,12 +513,9 @@ (progn (setcdr top message) (if (equal tmsg message) - ;; #### use of set-image-instance-property is wrong. - ;; use set-glyph-image instead. - (set-image-instance-property - (glyph-image-instance progress-gauge-glyph - (frame-selected-window frame)) - :value value) + (progn + (set-instantiator-property progress-gauge-instantiator :value value) + (set-progress-feedback-instantiator (frame-selected-window frame))) (raw-append-progress-feedback message value frame)) (redisplay-gutter-area)) (push (cons label message) progress-stack) @@ -559,11 +547,8 @@ ;; fixup the gutter specifiers (set-gutter-element bottom-gutter 'progress gutter-string frame) (set-specifier bottom-gutter-border-width 2 frame) - ;; #### use of set-image-instance-property is wrong. - ;; use set-glyph-image instead. - (set-image-instance-property - (glyph-image-instance progress-text-glyph - (frame-selected-window frame)) :data message) + (set-instantiator-property progress-text-instantiator :datat message) + (set-progress-feedback-instantiator (frame-selected-window frame)) (set-specifier bottom-gutter-height 'autodetect frame) (set-gutter-element-visible-p bottom-gutter-visible-p 'progress t frame) @@ -589,15 +574,11 @@ ;; fixup the gutter specifiers (set-gutter-element bottom-gutter 'progress gutter-string frame) (set-specifier bottom-gutter-border-width 2 frame) - ;; #### use of set-image-instance-property is wrong. - ;; use set-glyph-image instead. - (set-image-instance-property - (glyph-image-instance progress-gauge-glyph - (frame-selected-window frame)) - :value val) - (set-image-instance-property - (glyph-image-instance progress-text-glyph (frame-selected-window frame)) - :data message) + (set-instantiator-property progress-gauge-instantiator :value val) + (set-progress-feedback-instantiator (frame-selected-window frame)) + + (set-instantiator-property progress-text-instantiator :data message) + (set-progress-feedback-instantiator (frame-selected-window frame)) (if (and (eq (specifier-instance bottom-gutter-height frame) 'autodetect) (gutter-element-visible-p bottom-gutter-visible-p Index: src/console.h =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/console.h,v retrieving revision 1.22.2.27 diff -u -r1.22.2.27 console.h --- src/console.h 2000/07/21 10:15:52 1.22.2.27 +++ src/console.h 2000/07/22 19:24:46 @@ -234,8 +234,8 @@ void (*map_subwindow_method) (Lisp_Image_Instance *, int x, int y, struct display_glyph_area* dga); void (*resize_subwindow_method) (Lisp_Image_Instance *, int w, int h); - void (*update_subwindow_method) (Lisp_Image_Instance *); - void (*update_widget_method) (Lisp_Image_Instance *); + void (*redisplay_subwindow_method) (Lisp_Image_Instance *); + void (*redisplay_widget_method) (Lisp_Image_Instance *); int (*image_instance_equal_method) (Lisp_Image_Instance *, Lisp_Image_Instance *, int depth); Index: src/device-msw.c =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/device-msw.c,v retrieving revision 1.20.2.23 diff -u -r1.20.2.23 device-msw.c --- src/device-msw.c 2000/07/21 10:15:55 1.20.2.23 +++ src/device-msw.c 2000/07/22 19:24:48 @@ -40,13 +40,10 @@ #include "frame.h" #include "sysdep.h" -/* #### Andy, these includes might break cygwin compilation - kkm*/ #include -#include -#include #if !(defined (CYGWIN) || defined(MINGW)) -# include /* For CoInitialize */ +#include /* For CoInitialize */ #endif /* win32 DDE management library globals */ @@ -413,9 +410,10 @@ if (name[0] == '\0') return Qnil; + /* This used to use _tcstok. We really should be using ANSI + functions wherever possible, even in windows-only sources. */ + strtok (name, _T(",")); - _tcstok (name, _T(",")); - return build_ext_string (name, Qmswindows_tstr); #undef bufsize } @@ -1203,9 +1201,8 @@ { int have_nt, ok; BYTE *data_buf, dummy_byte; - size_t enum_entry_size, bytes_needed; - DWORD enum_flags, enum_level; - int num_printers; + size_t enum_entry_size; + DWORD enum_flags, enum_level, bytes_needed, num_printers; struct gcpro gcpro1, gcpro2; Lisp_Object result = Qnil, def_printer = Qnil; Index: src/elhash.c =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/elhash.c,v retrieving revision 1.14.2.25 diff -u -r1.14.2.25 elhash.c --- src/elhash.c 2000/06/12 04:18:10 1.14.2.25 +++ src/elhash.c 2000/07/22 19:24:52 @@ -29,13 +29,13 @@ Lisp_Object Qhash_tablep; static Lisp_Object Qhashtable, Qhash_table; -static Lisp_Object Qweakness, Qvalue, Qkey_value; +static Lisp_Object Qweakness, Qvalue, Qkey_or_value, Qkey_and_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, Qkey_value_weak; +static Lisp_Object Qweak, Qkey_weak, Qvalue_weak, Qkey_or_value_weak; static Lisp_Object Qnon_weak, Q_type; typedef struct hentry @@ -355,7 +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" : + ht->weakness == HASH_TABLE_KEY_VALUE_WEAK ? "key-or-value" : "you-d-better-not-see-this")); write_c_string (buf, printcharfun); } @@ -544,14 +544,15 @@ 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, Qkey_and_value)) return 1; + if (EQ (value, Qkey_or_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, Qkey_or_value_weak)) return 1; if (EQ (value, Qvalue_weak)) return 1; maybe_signal_simple_error ("Invalid hash table weakness", @@ -564,15 +565,16 @@ { if (EQ (obj, Qnil)) return HASH_TABLE_NON_WEAK; if (EQ (obj, Qt)) return HASH_TABLE_WEAK; + if (EQ (obj, Qkey_and_value)) 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, Qkey_or_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, Qkey_or_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); @@ -806,8 +808,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', `value' -or `key-value'. +Non-standard keyword :weakness can be `nil' (default), `t', `key-and-value', +`key', `value' or `key-or-value'. `t' is an alias for `key-and-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 @@ -1122,15 +1124,15 @@ DEFUN ("hash-table-weakness", Fhash_table_weakness, 1, 1, 0, /* Return the weakness of HASH-TABLE. -This can be one of `nil', `t', `key' or `value'. +This can be one of `nil', `key-and-value', `key-or-value', `key' or `value'. */ (hash_table)) { switch (xhash_table (hash_table)->weakness) { - case HASH_TABLE_WEAK: return Qt; + case HASH_TABLE_WEAK: return Qkey_and_value; case HASH_TABLE_KEY_WEAK: return Qkey; - case HASH_TABLE_KEY_VALUE_WEAK: return Qkey_value; + case HASH_TABLE_KEY_VALUE_WEAK: return Qkey_or_value; case HASH_TABLE_VALUE_WEAK: return Qvalue; default: return Qnil; } @@ -1147,7 +1149,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_KEY_VALUE_WEAK: return Qkey_or_value_weak; case HASH_TABLE_VALUE_WEAK: return Qvalue_weak; default: return Qnon_weak; } @@ -1484,13 +1486,14 @@ defsymbol (&Qhashtable, "hashtable"); defsymbol (&Qweakness, "weakness"); defsymbol (&Qvalue, "value"); - defsymbol (&Qkey_value, "key-value"); + defsymbol (&Qkey_or_value, "key-or-value"); + defsymbol (&Qkey_and_value, "key-and-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 (&Qkey_or_value_weak, "key-or-value-weak"); /* obsolete */ defsymbol (&Qvalue_weak, "value-weak"); /* obsolete */ defsymbol (&Qnon_weak, "non-weak"); /* obsolete */ Index: src/emacs.c =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/emacs.c,v retrieving revision 1.82.2.70 diff -u -r1.82.2.70 emacs.c --- src/emacs.c 2000/07/21 10:15:58 1.82.2.70 +++ src/emacs.c 2000/07/22 19:25:01 @@ -1309,13 +1309,16 @@ #ifdef HAVE_SCROLLBARS syms_of_scrollbar_mswindows (); #endif +#endif /* HAVE_MS_WINDOWS */ #ifdef HAVE_MSW_C_DIRED syms_of_dired_mswindows (); #endif #ifdef WIN32_NATIVE syms_of_ntproc (); #endif -#endif /* HAVE_MS_WINDOWS */ +#if defined (WIN32_NATIVE) || defined (CYGWIN) + syms_of_win32 (); +#endif #ifdef MULE syms_of_mule (); Index: src/glyphs-eimage.c =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/glyphs-eimage.c,v retrieving revision 1.3.2.18 diff -u -r1.3.2.18 glyphs-eimage.c --- src/glyphs-eimage.c 2000/07/21 10:16:31 1.3.2.18 +++ src/glyphs-eimage.c 2000/07/22 19:25:05 @@ -119,7 +119,8 @@ } static Lisp_Object -jpeg_normalize (Lisp_Object inst, Lisp_Object console_type) +jpeg_normalize (Lisp_Object inst, Lisp_Object console_type, + Lisp_Object dest_mask) { return simple_image_type_normalize (inst, console_type, Qjpeg); } @@ -515,7 +516,8 @@ } static Lisp_Object -gif_normalize (Lisp_Object inst, Lisp_Object console_type) +gif_normalize (Lisp_Object inst, Lisp_Object console_type, + Lisp_Object dest_mask) { return simple_image_type_normalize (inst, console_type, Qgif); } @@ -757,7 +759,8 @@ } static Lisp_Object -png_normalize (Lisp_Object inst, Lisp_Object console_type) +png_normalize (Lisp_Object inst, Lisp_Object console_type, + Lisp_Object dest_mask) { return simple_image_type_normalize (inst, console_type, Qpng); } @@ -1043,7 +1046,8 @@ } static Lisp_Object -tiff_normalize (Lisp_Object inst, Lisp_Object console_type) +tiff_normalize (Lisp_Object inst, Lisp_Object console_type, + Lisp_Object dest_mask) { return simple_image_type_normalize (inst, console_type, Qtiff); } Index: src/glyphs-msw.c =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/glyphs-msw.c,v retrieving revision 1.21.2.60 diff -u -r1.21.2.60 glyphs-msw.c --- src/glyphs-msw.c 2000/07/21 10:16:32 1.21.2.60 +++ src/glyphs-msw.c 2000/07/22 19:25:12 @@ -1019,7 +1019,8 @@ } static Lisp_Object -bmp_normalize (Lisp_Object inst, Lisp_Object console_type) +bmp_normalize (Lisp_Object inst, Lisp_Object console_type, + Lisp_Object dest_mask) { return simple_image_type_normalize (inst, console_type, Qbmp); } @@ -1086,7 +1087,8 @@ } static Lisp_Object -mswindows_resource_normalize (Lisp_Object inst, Lisp_Object console_type) +mswindows_resource_normalize (Lisp_Object inst, Lisp_Object console_type, + Lisp_Object dest_mask) { /* This function can call lisp */ Lisp_Object file = Qnil; @@ -2163,8 +2165,10 @@ static HDWP begin_defer_window_pos (struct frame *f) { +#ifdef DEFER_WINDOW_POS if (FRAME_MSWINDOWS_DATA (f)->hdwp == 0) FRAME_MSWINDOWS_DATA (f)->hdwp = BeginDeferWindowPos (10); +#endif return FRAME_MSWINDOWS_DATA (f)->hdwp; } @@ -2175,6 +2179,7 @@ { if (IMAGE_INSTANCE_SUBWINDOW_ID (p)) { +#ifdef DEFER_WINDOW_POS struct frame *f = XFRAME (IMAGE_INSTANCE_FRAME (p)); HDWP hdwp = begin_defer_window_pos (f); HDWP new_hdwp; @@ -2195,6 +2200,13 @@ else hdwp = new_hdwp; FRAME_MSWINDOWS_DATA (f)->hdwp = hdwp; +#else + SetWindowPos (IMAGE_INSTANCE_MSWINDOWS_CLIPWINDOW (p), + NULL, + 0, 0, 0, 0, + SWP_HIDEWINDOW | SWP_NOACTIVATE | + SWP_NOMOVE | SWP_NOSIZE | SWP_NOZORDER ); +#endif if (GetFocus() == WIDGET_INSTANCE_MSWINDOWS_HANDLE (p)) SetFocus (GetParent (IMAGE_INSTANCE_MSWINDOWS_CLIPWINDOW (p))); } @@ -2206,9 +2218,11 @@ mswindows_map_subwindow (Lisp_Image_Instance *p, int x, int y, struct display_glyph_area* dga) { +#ifdef DEFER_WINDOW_POS struct frame *f = XFRAME (IMAGE_INSTANCE_FRAME (p)); HDWP hdwp = begin_defer_window_pos (f); HDWP new_hdwp; +#endif /* move the window before mapping it ... */ SetWindowPos (IMAGE_INSTANCE_MSWINDOWS_CLIPWINDOW (p), NULL, @@ -2222,6 +2236,7 @@ SWP_NOZORDER | SWP_NOSIZE | SWP_NOCOPYBITS | SWP_NOSENDCHANGING); /* ... now map it - we are not allowed to move it at the same time. */ +#ifdef DEFER_WINDOW_POS new_hdwp = DeferWindowPos (hdwp, IMAGE_INSTANCE_MSWINDOWS_CLIPWINDOW (p), NULL, 0, 0, 0, 0, @@ -2240,6 +2255,13 @@ else hdwp = new_hdwp; FRAME_MSWINDOWS_DATA (f)->hdwp = hdwp; +#else + SetWindowPos (IMAGE_INSTANCE_MSWINDOWS_CLIPWINDOW (p), + NULL, + 0, 0, 0, 0, + SWP_NOZORDER | SWP_NOSIZE | SWP_NOMOVE + | SWP_SHOWWINDOW | SWP_NOCOPYBITS | SWP_NOACTIVATE); +#endif } /* resize the subwindow instance */ @@ -2257,7 +2279,7 @@ /* Simply resize the window here. */ static void -mswindows_update_subwindow (Lisp_Image_Instance *p) +mswindows_redisplay_subwindow (Lisp_Image_Instance *p) { mswindows_resize_subwindow (p, IMAGE_INSTANCE_WIDTH (p), @@ -2267,7 +2289,7 @@ /* when you click on a widget you may activate another widget this needs to be checked and all appropriate widgets updated */ static void -mswindows_update_widget (Lisp_Image_Instance *p) +mswindows_redisplay_widget (Lisp_Image_Instance *p) { /* Possibly update the face font and colors. */ if (!NILP (IMAGE_INSTANCE_WIDGET_TEXT (p)) @@ -2631,7 +2653,7 @@ /* Update the state of a button. */ static void -mswindows_button_update (Lisp_Object image_instance) +mswindows_button_redisplay (Lisp_Object image_instance) { /* This function can GC if IN_REDISPLAY is false. */ Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); @@ -2665,6 +2687,7 @@ { HWND wnd; Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); + Lisp_Object val; mswindows_widget_instantiate (image_instance, instantiator, pointer_fg, pointer_bg, dest_mask, domain, PROGRESS_CLASS, WS_BORDER | PBS_SMOOTH, WS_EX_CLIENTEDGE); @@ -2686,6 +2709,10 @@ (XIMAGE_INSTANCE_WIDGET_FACE (ii), XIMAGE_INSTANCE_FRAME (ii)))))); #endif + val = XGUI_ITEM (IMAGE_INSTANCE_WIDGET_ITEMS (ii))->value; + CHECK_INT (val); + SendMessage (WIDGET_INSTANCE_MSWINDOWS_HANDLE (ii), + PBM_SETPOS, (WPARAM)XINT (val), 0); } /* instantiate a tree view widget */ @@ -2775,6 +2802,39 @@ } } +/* Set the properties of a tree view. */ +static void +mswindows_tree_view_redisplay (Lisp_Object image_instance) +{ + /* This function can GC if IN_REDISPLAY is false. */ + Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); + + if (IMAGE_INSTANCE_WIDGET_ITEMS_CHANGED (ii)) + { + HWND wnd = WIDGET_INSTANCE_MSWINDOWS_HANDLE (ii); + Lisp_Object rest; + HTREEITEM parent; + /* Delete previous items. */ + SendMessage (wnd, TVM_DELETEITEM, 0, (LPARAM)TVI_ROOT); + /* define a root */ + parent = add_tree_item (image_instance, wnd, NULL, + XCAR (IMAGE_INSTANCE_WIDGET_PENDING_ITEMS (ii)), + TRUE, IMAGE_INSTANCE_DOMAIN (ii)); + + /* recursively add items to the tree view */ + /* add items to the tab */ + LIST_LOOP (rest, XCDR (IMAGE_INSTANCE_WIDGET_PENDING_ITEMS (ii))) + { + if (LISTP (XCAR (rest))) + add_tree_item_list (image_instance, wnd, parent, XCAR (rest), + IMAGE_INSTANCE_DOMAIN (ii)); + else + add_tree_item (image_instance, wnd, parent, XCAR (rest), FALSE, + IMAGE_INSTANCE_DOMAIN (ii)); + } + } +} + /* instantiate a tab control */ static TC_ITEM* add_tab_item (Lisp_Object image_instance, HWND wnd, Lisp_Object item, @@ -2848,9 +2908,9 @@ SendMessage (wnd, TCM_SETCURSEL, selected, 0); } -/* set the properties of a tab control */ +/* Set the properties of a tab control. */ static void -mswindows_tab_control_update (Lisp_Object image_instance) +mswindows_tab_control_redisplay (Lisp_Object image_instance) { /* This function can GC if IN_REDISPLAY is false. */ Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); @@ -2858,22 +2918,65 @@ if (IMAGE_INSTANCE_WIDGET_ITEMS_CHANGED (ii)) { HWND wnd = WIDGET_INSTANCE_MSWINDOWS_HANDLE (ii); - int i = 0, selected = 0; - Lisp_Object rest; + int i = 0, selected = 0, found = 0; + Lisp_Object rest, xrest; - /* delete the pre-existing items */ - SendMessage (wnd, TCM_DELETEALLITEMS, 0, 0); + /* See whether we just need a change in order. */ + LIST_LOOP (rest, XCDR (IMAGE_INSTANCE_WIDGET_ITEMS (ii))) + { + found = 0; + LIST_LOOP (xrest, + XCDR (IMAGE_INSTANCE_WIDGET_PENDING_ITEMS (ii))) + { + if (internal_equal (XCAR (rest), XCAR (xrest), 0)) + { + found = 1; + break; + } + } + if (!found) + break; + } - /* add items to the tab */ - LIST_LOOP (rest, XCDR (IMAGE_INSTANCE_WIDGET_PENDING_ITEMS (ii))) + /* If only the order has changed then simply select the first + one. This stops horrendous rebuilding of the tabs each time + you click on one. + + #### Ideally this should be generalized so that it isn't + duplicated both here and in glyphs-x.c. */ + if (found) { - add_tab_item (image_instance, wnd, XCAR (rest), - IMAGE_INSTANCE_FRAME (ii), i); - if (gui_item_selected_p (XCAR (rest))) - selected = i; - i++; + LIST_LOOP (rest, XCDR (IMAGE_INSTANCE_WIDGET_ITEMS (ii))) + { + if (internal_equal + (XCAR (rest), + XCAR (XCDR (IMAGE_INSTANCE_WIDGET_PENDING_ITEMS (ii))), 0)) + { + SendMessage (wnd, TCM_SETCURSEL, i, 0); + break; + } + i++; + } + /* We're not actually changing the items. */ + IMAGE_INSTANCE_WIDGET_ITEMS_CHANGED (ii) = 0; + IMAGE_INSTANCE_WIDGET_PENDING_ITEMS (ii) = Qnil; + } + else + { + /* delete the pre-existing items */ + SendMessage (wnd, TCM_DELETEALLITEMS, 0, 0); + + /* add items to the tab */ + LIST_LOOP (rest, XCDR (IMAGE_INSTANCE_WIDGET_PENDING_ITEMS (ii))) + { + add_tab_item (image_instance, wnd, XCAR (rest), + IMAGE_INSTANCE_FRAME (ii), i); + if (gui_item_selected_p (XCAR (rest))) + selected = i; + i++; + } + SendMessage (wnd, TCM_SETCURSEL, selected, 0); } - SendMessage (wnd, TCM_SETCURSEL, selected, 0); } } @@ -2939,6 +3042,8 @@ image_instance_layout (image_instance, IMAGE_UNSPECIFIED_GEOMETRY, IMAGE_UNSPECIFIED_GEOMETRY, + IMAGE_UNCHANGED_GEOMETRY, + IMAGE_UNCHANGED_GEOMETRY, domain); wnd = WIDGET_INSTANCE_MSWINDOWS_HANDLE (ii); @@ -3010,7 +3115,7 @@ /* set the properties of a progres guage */ static void -mswindows_progress_gauge_update (Lisp_Object image_instance) +mswindows_progress_gauge_redisplay (Lisp_Object image_instance) { Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); @@ -3074,9 +3179,9 @@ CONSOLE_HAS_METHOD (mswindows, finalize_image_instance); CONSOLE_HAS_METHOD (mswindows, unmap_subwindow); CONSOLE_HAS_METHOD (mswindows, map_subwindow); - CONSOLE_HAS_METHOD (mswindows, update_subwindow); + CONSOLE_HAS_METHOD (mswindows, redisplay_subwindow); CONSOLE_HAS_METHOD (mswindows, resize_subwindow); - CONSOLE_HAS_METHOD (mswindows, update_widget); + CONSOLE_HAS_METHOD (mswindows, redisplay_widget); CONSOLE_HAS_METHOD (mswindows, image_instance_equal); CONSOLE_HAS_METHOD (mswindows, image_instance_hash); CONSOLE_HAS_METHOD (mswindows, init_image_instance_from_eimage); @@ -3138,7 +3243,7 @@ INITIALIZE_DEVICE_IIFORMAT (mswindows, button); IIFORMAT_HAS_DEVMETHOD (mswindows, button, property); IIFORMAT_HAS_DEVMETHOD (mswindows, button, instantiate); - IIFORMAT_HAS_DEVMETHOD (mswindows, button, update); + IIFORMAT_HAS_DEVMETHOD (mswindows, button, redisplay); /* edit-field widget */ INITIALIZE_DEVICE_IIFORMAT (mswindows, edit_field); IIFORMAT_HAS_DEVMETHOD (mswindows, edit_field, instantiate); @@ -3157,16 +3262,16 @@ IIFORMAT_HAS_DEVMETHOD (mswindows, scrollbar, instantiate); /* progress gauge */ INITIALIZE_DEVICE_IIFORMAT (mswindows, progress_gauge); - IIFORMAT_HAS_DEVMETHOD (mswindows, progress_gauge, update); + IIFORMAT_HAS_DEVMETHOD (mswindows, progress_gauge, redisplay); IIFORMAT_HAS_DEVMETHOD (mswindows, progress_gauge, instantiate); /* tree view widget */ INITIALIZE_DEVICE_IIFORMAT (mswindows, tree_view); - /* IIFORMAT_HAS_DEVMETHOD (mswindows, progress, set_property);*/ IIFORMAT_HAS_DEVMETHOD (mswindows, tree_view, instantiate); + IIFORMAT_HAS_DEVMETHOD (mswindows, tree_view, redisplay); /* tab control widget */ INITIALIZE_DEVICE_IIFORMAT (mswindows, tab_control); IIFORMAT_HAS_DEVMETHOD (mswindows, tab_control, instantiate); - IIFORMAT_HAS_DEVMETHOD (mswindows, tab_control, update); + IIFORMAT_HAS_DEVMETHOD (mswindows, tab_control, redisplay); #endif /* windows bitmap format */ INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (bmp, "bmp"); Index: src/glyphs-widget.c =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/Attic/glyphs-widget.c,v retrieving revision 1.1.2.45 diff -u -r1.1.2.45 glyphs-widget.c --- src/glyphs-widget.c 2000/07/21 10:16:34 1.1.2.45 +++ src/glyphs-widget.c 2000/07/22 19:25:15 @@ -59,6 +59,7 @@ Lisp_Object Qnative_layout; Lisp_Object Qetched_in, Qetched_out, Qbevel_in, Qbevel_out; +Lisp_Object Qmake_glyph, Qset_glyph_image; #ifdef DEBUG_WIDGETS int debug_widget_instances; @@ -82,16 +83,14 @@ } static void -check_valid_glyph_or_instantiator (Lisp_Object data) +check_valid_instantiator (Lisp_Object data) { Lisp_Object glyph = data; if (SYMBOLP (data)) glyph = XSYMBOL (data)->value; - if (IMAGE_INSTANCEP (glyph)) - CHECK_IMAGE_INSTANCE (glyph); - else if (!CONSP (glyph) && !VECTORP (glyph)) - CHECK_BUFFER_GLYPH (glyph); + if (!CONSP (glyph) && !VECTORP (glyph)) + signal_simple_error ("instantiator item must be a vector", data); } static void @@ -199,14 +198,14 @@ } static void -check_valid_glyph_or_instantiator_list (Lisp_Object data) +check_valid_instantiator_list (Lisp_Object data) { Lisp_Object rest; CHECK_LIST (data); EXTERNAL_LIST_LOOP (rest, data) { - check_valid_glyph_or_instantiator (XCAR (rest)); + check_valid_instantiator (XCAR (rest)); } } @@ -228,7 +227,7 @@ /* Be really helpful to the user. */ if (VECTORP (glyph)) { - glyph = call1 (intern ("make-glyph"), glyph); + glyph = call1 (Qmake_glyph, glyph); } /* substitute the new glyph */ @@ -266,11 +265,11 @@ { Lisp_Image_Instance* ii = XIMAGE_INSTANCE (image_instance); struct image_instantiator_methods* meths; - +#if 0 /* The usefulness of this is dubious. */ /* first see if its a general property ... */ if (!NILP (Fplist_member (IMAGE_INSTANCE_WIDGET_PROPS (ii), prop))) return Fplist_get (IMAGE_INSTANCE_WIDGET_PROPS (ii), prop, Qnil); - +#endif /* .. then try device specific methods ... */ meths = decode_device_ii_format (image_instance_device (image_instance), IMAGE_INSTANCE_WIDGET_TYPE (ii), @@ -286,18 +285,33 @@ return Qunbound; } -static Lisp_Object -widget_set_property (Lisp_Object image_instance, Lisp_Object prop, Lisp_Object val) +/* Update the displayed properties of a widget. + + #### This has been adapted from the original set_property functions + and thus reuses the state management of that. A better solution is + to simply re-parse the instantiator when items need updating. This + make comparing differences much simpler and obviates the need for a + lot of the state variables. + + #### property is still a valid function since we have to be able to + extract information from the actual widget. + + #### update_widget should probably be re-written to use the + instantiator. We probably want to keep a record of the differences + also to make this easy. We would also need a pending_instantiator + so that changes could be delayed. */ +static void +widget_update (Lisp_Object image_instance, Lisp_Object instantiator) { Lisp_Image_Instance* ii = XIMAGE_INSTANCE (image_instance); struct image_instantiator_methods* meths; - Lisp_Object ret; + Lisp_Object text = find_keyword_in_vector (instantiator, Q_text); /* PIck up any generic properties that we might need to keep hold of. */ - if (EQ (prop, Q_text)) + if (!NILP (text)) { - IMAGE_INSTANCE_WIDGET_TEXT (ii) = val; + IMAGE_INSTANCE_WIDGET_TEXT (ii) = text; IMAGE_INSTANCE_TEXT_CHANGED (ii) = 1; } @@ -305,27 +319,16 @@ meths = decode_device_ii_format (image_instance_device (image_instance), IMAGE_INSTANCE_WIDGET_TYPE (ii), ERROR_ME_NOT); - if (meths && HAS_IIFORMAT_METH_P (meths, set_property) - && - !UNBOUNDP (ret = - IIFORMAT_METH (meths, set_property, (image_instance, prop, val)))) - { - return ret; - } + MAYBE_IIFORMAT_METH (meths, update, (image_instance, instantiator)); /* ... then format specific methods ... */ meths = decode_device_ii_format (Qnil, IMAGE_INSTANCE_WIDGET_TYPE (ii), ERROR_ME_NOT); - if (meths && HAS_IIFORMAT_METH_P (meths, set_property) - && - !UNBOUNDP (ret = - IIFORMAT_METH (meths, set_property, (image_instance, prop, val)))) - { - return ret; - } - /* we didn't do any device specific properties, so shove the property in our plist */ + MAYBE_IIFORMAT_METH (meths, update, (image_instance, instantiator)); +#if 0 /* The usefulness of this is dubious. */ + /* we didn't do any device specific properties, so shove the property in our plist. */ IMAGE_INSTANCE_WIDGET_PROPS (ii) = Fplist_put (IMAGE_INSTANCE_WIDGET_PROPS (ii), prop, val); - return val; +#endif } /* Like the rest of redisplay, we want widget updates to occur @@ -335,9 +338,10 @@ function actually implements it. We want to be slightly clever about this however by supplying format specific functions for the updates instead of lumping them all into this function. Note that - there is no need for format generic functions. */ + there is no need for format generic functions. This is not the same + as widget_update! */ void -update_widget (Lisp_Object widget) +redisplay_widget (Lisp_Object widget) { Lisp_Image_Instance* ii = XIMAGE_INSTANCE (widget); struct image_instantiator_methods* meths; @@ -347,17 +351,19 @@ || EQ (IMAGE_INSTANCE_WIDGET_TYPE (ii), Qnative_layout)) return; - /* Device generic methods. We must update the widget's size as it - may have been changed by the the layout routines. We also do this - here so that explicit resizing from lisp does not result in - synchronous updates. */ - MAYBE_DEVMETH (DOMAIN_XDEVICE (ii->domain), update_widget, (ii)); - /* Device-format specific methods */ meths = decode_device_ii_format (image_instance_device (widget), IMAGE_INSTANCE_WIDGET_TYPE (ii), ERROR_ME_NOT); - MAYBE_IIFORMAT_METH (meths, update, (widget)); + MAYBE_IIFORMAT_METH (meths, redisplay, (widget)); + + /* Device generic methods. We must update the widget's size as it + may have been changed by the the layout routines. We also do this + here so that explicit resizing from lisp does not result in + synchronous updates. Do this last so that format-specific methods + have an opportunity to prevent wholesale changes - + e.g. rebuilding tabs. */ + MAYBE_DEVMETH (DOMAIN_XDEVICE (ii->domain), redisplay_widget, (ii)); /* Pick up the items we recorded earlier. */ if (IMAGE_INSTANCE_WIDGET_ITEMS_CHANGED (ii)) @@ -439,7 +445,8 @@ static int widget_layout (Lisp_Object image_instance, - int width, int height, Lisp_Object domain) + int width, int height, int xoffset, int yoffset, + Lisp_Object domain) { Lisp_Image_Instance* ii = XIMAGE_INSTANCE (image_instance); struct image_instantiator_methods* meths; @@ -450,7 +457,8 @@ ERROR_ME_NOT); if (meths && HAS_IIFORMAT_METH_P (meths, layout)) return IIFORMAT_METH (meths, layout, (image_instance, - width, height, domain)); + width, height, xoffset, yoffset, + domain)); else { /* ... then format specific methods ... */ @@ -458,7 +466,8 @@ ERROR_ME_NOT); if (meths && HAS_IIFORMAT_METH_P (meths, layout)) return IIFORMAT_METH (meths, layout, (image_instance, - width, height, domain)); + width, height, xoffset, yoffset, + domain)); } return 1; } @@ -494,13 +503,16 @@ /* we need to convert things like glyphs to images, eval expressions etc.*/ static Lisp_Object -widget_normalize (Lisp_Object inst, Lisp_Object console_type) +widget_normalize (Lisp_Object inst, Lisp_Object console_type, + Lisp_Object dest_mask) { /* This function can call lisp */ Lisp_Object glyph = find_keyword_in_vector (inst, Q_image); /* we need to eval glyph if its an expression, we do this for the - same reasons we normalize file to data. */ + same reasons we normalize file to data. + + #### should just normalize the data. */ if (!NILP (glyph)) { substitute_keyword_value (inst, Q_image, glyph_instantiator_to_glyph (glyph)); @@ -538,6 +550,9 @@ Lisp_Object pointer_fg, Lisp_Object pointer_bg, int dest_mask, Lisp_Object domain) { + /* #### practically all of this should be moved to widget_update() + so that users can dynamically change all possible widget + properties. */ Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); Lisp_Object face = find_keyword_in_vector (instantiator, Q_face); Lisp_Object height = find_keyword_in_vector (instantiator, Q_height); @@ -659,9 +674,9 @@ if (!NILP (glyph)) { if (!pw) - pw = glyph_width (glyph, domain) + 2 * WIDGET_BORDER_WIDTH; + pw = glyph_width (glyph, image_instance) + 2 * WIDGET_BORDER_WIDTH; if (!ph) - ph = glyph_height (glyph, domain) + 2 * WIDGET_BORDER_HEIGHT; + ph = glyph_height (glyph, image_instance) + 2 * WIDGET_BORDER_HEIGHT; IMAGE_INSTANCE_SUBWINDOW_V_RESIZEP (ii) = 0; IMAGE_INSTANCE_SUBWINDOW_H_RESIZEP (ii) = 0; } @@ -754,7 +769,7 @@ Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); Lisp_Object items = XCDR (IMAGE_INSTANCE_WIDGET_ITEMS (ii)); Lisp_Object rest; - unsigned int tw = 0, th = 0; + int tw = 0, th = 0; LIST_LOOP (rest, items) { @@ -781,20 +796,18 @@ } } -/* Get the geometry of a tab control. This is based on the number of - items and text therin in the tab control. */ -static Lisp_Object -tab_control_set_property (Lisp_Object image_instance, - Lisp_Object prop, - Lisp_Object val) +/* Update the contents of a tab control. */ +static void +tab_control_update (Lisp_Object image_instance, + Lisp_Object instantiator) { + Lisp_Object items = find_keyword_in_vector (instantiator, Q_items); /* Record new items for update. *_tab_control_update will do the rest. */ - if (EQ (prop, Q_items)) + if (!NILP (items)) { Lisp_Image_Instance* ii = XIMAGE_INSTANCE (image_instance); - - check_valid_item_list_1 (val); + check_valid_item_list_1 (items); /* Don't set the actual items since we might decide not to use the new ones (because nothing has really changed). If we did @@ -802,27 +815,24 @@ heaps of trouble when the old items get GC'd. */ IMAGE_INSTANCE_WIDGET_PENDING_ITEMS (ii) = Fcons (XCAR (IMAGE_INSTANCE_WIDGET_ITEMS (ii)), - parse_gui_item_tree_children (val)); + parse_gui_item_tree_children (items)); IMAGE_INSTANCE_WIDGET_ITEMS_CHANGED (ii) = 1; - - return Qt; } - return Qunbound; } -/* set the properties of a progres guage */ -static Lisp_Object -progress_gauge_set_property (Lisp_Object image_instance, - Lisp_Object prop, - Lisp_Object val) +/* Set the properties of a progress guage */ +static void +progress_gauge_update (Lisp_Object image_instance, + Lisp_Object instantiator) { Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); + Lisp_Object value = find_keyword_in_vector (instantiator, Q_value); - if (EQ (prop, Q_value)) + if (!NILP (value)) { - CHECK_INT (val); + CHECK_INT (value); #ifdef DEBUG_WIDGET_OUTPUT - printf ("progress gauge value set to %ld\n", XINT (val)); + printf ("progress gauge value set to %ld\n", XINT (value)); #endif IMAGE_INSTANCE_WIDGET_PENDING_ITEMS (ii) = copy_gui_item_tree (IMAGE_INSTANCE_WIDGET_ITEMS (ii)); @@ -830,46 +840,147 @@ 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; + XGUI_ITEM (IMAGE_INSTANCE_WIDGET_PENDING_ITEMS (ii))->value = value; IMAGE_INSTANCE_WIDGET_ITEMS_CHANGED (ii) = 1; - - return Qt; } - return Qunbound; } /***************************************************************************** * widget layout * *****************************************************************************/ -/* we need to convert things like glyphs to images, eval expressions - etc.*/ +/* We need to cascade normalization.*/ static Lisp_Object -layout_normalize (Lisp_Object inst, Lisp_Object console_type) +layout_normalize (Lisp_Object inst, Lisp_Object console_type, + Lisp_Object dest_mask) { /* This function can call lisp */ - Lisp_Object items = find_keyword_in_vector (inst, Q_items); - Lisp_Object border = find_keyword_in_vector (inst, Q_border); - /* we need to eval glyph if its an expression, we do this for the - same reasons we normalize file to data. */ + struct gcpro gcpro1, gcpro2; + Lisp_Object alist = Qnil, new_items = Qnil, border; + /* This function can call lisp */ + Lisp_Object items; + + GCPRO2 (alist, new_items); + alist = tagged_vector_to_alist (inst); + items = assq_no_quit (Q_items, alist); + + /* We need to normalize sub-objects. */ if (!NILP (items)) { Lisp_Object rest; - LIST_LOOP (rest, items) + LIST_LOOP (rest, XCDR (items)) { - /* substitute the new glyph */ - Fsetcar (rest, glyph_instantiator_to_glyph (XCAR (rest))); + /* Substitute the new instantiator */ + new_items = Fcons (normalize_image_instantiator (XCAR (rest), + console_type, dest_mask), + new_items); } + new_items = Fnreverse (new_items); + Fsetcdr (items, new_items); } - /* normalize the border spec. */ - if (VECTORP (border) || CONSP (border)) + /* Normalize the border spec. */ + border = assq_no_quit (Q_border, alist); + if (!NILP (border) && VECTORP (XCDR (border))) { - substitute_keyword_value (inst, Q_border, glyph_instantiator_to_glyph (border)); + Fsetcdr (border, normalize_image_instantiator (XCDR (border), + console_type, dest_mask)); } - return inst; + + { + Lisp_Object result = alist_to_tagged_vector (XVECTOR_DATA (inst)[0], + alist); + free_alist (alist); + RETURN_UNGCPRO (result); + } } +/* Update the instances in the layout. */ +static void +layout_update (Lisp_Object image_instance, Lisp_Object instantiator) +{ + Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); + Lisp_Object items = find_keyword_in_vector (instantiator, Q_items); + Lisp_Object border_inst = find_keyword_in_vector (instantiator, Q_border); + Lisp_Object border = Qnil; + Lisp_Object children = IMAGE_INSTANCE_LAYOUT_CHILDREN (ii); + int structure_changed = 0; + struct gcpro gcpro1; + + /* We want to avoid consing if we can. This is quite awkward because + we have to deal with the border as well as the items. */ + + GCPRO1 (border); + + if (INTP (IMAGE_INSTANCE_LAYOUT_BORDER (ii))) + { + border = XCAR (children); + children = XCDR (children); + } + +#ifdef DEBUG_WIDGET_OUTPUT + printf ("layout updated\n"); +#endif + /* Update the border. */ + if (!NILP (border_inst)) + { + if (VECTORP (border_inst)) + { + /* We are going to be sneaky here and add the border text as + just another child, the layout and output routines don't know + this and will just display at the offsets we prescribe. */ + if (!NILP (border)) + call2 (Qset_glyph_image, border, border_inst); + else + { + border = Fcons (call1 (Qmake_glyph, border_inst), Qnil); + structure_changed = 1; + } + IMAGE_INSTANCE_LAYOUT_BORDER (ii) = make_int (0); + } + else + { + if (!NILP (border)) + { + border = Qnil; + structure_changed = 1; + } + if (EQ (border_inst, Qt)) + IMAGE_INSTANCE_LAYOUT_BORDER (ii) = Qetched_in; + else + IMAGE_INSTANCE_LAYOUT_BORDER (ii) = border_inst; + } + } + + /* Pick up the sub-widgets. */ + if (!NILP (items)) + { + int len1, len2; + GET_LIST_LENGTH (items, len1); + GET_LIST_LENGTH (children, len2); + /* The structure hasn't changed so just update the images. */ + if (!structure_changed && len1 == len2) + { + /* Pick up the sub-widgets. */ + for (; !NILP (children); children = XCDR (children), items = XCDR (items)) + { + call2 (Qset_glyph_image, XCAR (children), XCAR (items)); + } + } + /* The structure has changed so start over. */ + else + { + /* Instantiate any new glyphs. */ + for (; !NILP (items); items = XCDR (items)) + { + border = Fcons (call1 (Qmake_glyph, XCAR (items)), border); + } + IMAGE_INSTANCE_LAYOUT_CHILDREN (ii) = Fnreverse (border); + } + } + UNGCPRO; +} + static void layout_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, Lisp_Object pointer_fg, Lisp_Object pointer_bg, @@ -877,8 +988,10 @@ { Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); Lisp_Object orient = find_keyword_in_vector (instantiator, Q_orientation); - Lisp_Object border = find_keyword_in_vector (instantiator, Q_border); +#ifdef DEBUG_WIDGET_OUTPUT + printf ("layout instantiated\n"); +#endif /* Do widget type instantiation first. */ widget_instantiate (image_instance, instantiator, pointer_fg, pointer_bg, dest_mask, domain); @@ -888,22 +1001,17 @@ IMAGE_INSTANCE_SUBWINDOW_ORIENT (ii) = LAYOUT_VERTICAL; } - if (EQ (border, Qt)) - { - IMAGE_INSTANCE_LAYOUT_BORDER (ii) = Qetched_in; - } - else - { - IMAGE_INSTANCE_LAYOUT_BORDER (ii) = border; - } - /* We don't do the children yet as we might not have a containing + /* Get child glyphs and finish instantiation. We can't do image + instance children yet as we might not have a containing window. */ + layout_update (image_instance, instantiator); } static void layout_post_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, Lisp_Object domain) { +#if 0 Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); Lisp_Object items = find_keyword_in_vector (instantiator, Q_items); Lisp_Object rest, children = Qnil; @@ -941,6 +1049,7 @@ user expected. */ children = Fnreverse (children); IMAGE_INSTANCE_LAYOUT_CHILDREN (ii) = children; +#endif } /* Layout widget. Sizing commentary: we have a number of problems that @@ -1018,7 +1127,8 @@ /* Pick up the border text if we have one. */ if (INTP (IMAGE_INSTANCE_LAYOUT_BORDER (ii))) { - image_instance_query_geometry (XCAR (items), &gwidth, &gheight, disp, domain); + glyph_query_geometry (XCAR (items), &gwidth, &gheight, disp, + image_instance); ph_adjust = gheight / 2; items = XCDR (items); } @@ -1027,10 +1137,10 @@ LIST_LOOP (rest, items) { Lisp_Object glyph = XCAR (rest); - image_instance_query_geometry (glyph, &gwidth, &gheight, disp, domain); + glyph_query_geometry (glyph, &gwidth, &gheight, disp, image_instance); nitems ++; - if (IMAGE_INSTANCE_SUBWINDOW_ORIENT (ii) + if (IMAGE_INSTANCE_SUBWINDOW_ORIENT (ii) == LAYOUT_HORIZONTAL) { maxph = max (maxph, gheight); @@ -1079,7 +1189,8 @@ int layout_layout (Lisp_Object image_instance, - int width, int height, Lisp_Object domain) + int width, int height, int xoffset, int yoffset, + Lisp_Object domain) { Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); Lisp_Object rest; @@ -1097,15 +1208,14 @@ { Lisp_Object border = XCAR (items); items = XCDR (items); - image_instance_query_geometry (border, &gwidth, &gheight, - IMAGE_DESIRED_GEOMETRY, domain); - /* #### Really, what should this be? */ - XIMAGE_INSTANCE_XOFFSET (border) = 10; - XIMAGE_INSTANCE_YOFFSET (border) = 0; + glyph_query_geometry (border, &gwidth, &gheight, + IMAGE_DESIRED_GEOMETRY, image_instance); ph_adjust = gheight / 2; IMAGE_INSTANCE_LAYOUT_BORDER (ii) = make_int (ph_adjust); - image_instance_layout (border, gwidth, gheight, domain); + /* #### Really, what should this be? */ + glyph_do_layout (border, gwidth, gheight, 10, 0, + image_instance); } /* Flip through the items to work out how much stuff we have to display. */ @@ -1113,8 +1223,8 @@ { Lisp_Object glyph = XCAR (rest); - image_instance_query_geometry (glyph, &gwidth, &gheight, - IMAGE_DESIRED_GEOMETRY, domain); + glyph_query_geometry (glyph, &gwidth, &gheight, + IMAGE_DESIRED_GEOMETRY, image_instance); nitems ++; if (IMAGE_INSTANCE_SUBWINDOW_ORIENT (ii) == LAYOUT_HORIZONTAL) @@ -1167,8 +1277,8 @@ { Lisp_Object glyph = XCAR (rest); - image_instance_query_geometry (glyph, &gwidth, &gheight, - IMAGE_DESIRED_GEOMETRY, domain); + glyph_query_geometry (glyph, &gwidth, &gheight, + IMAGE_DESIRED_GEOMETRY, image_instance); if (IMAGE_INSTANCE_SUBWINDOW_ORIENT (ii) == LAYOUT_HORIZONTAL) @@ -1190,8 +1300,8 @@ x = (width - gwidth) / 2; } - XIMAGE_INSTANCE_XOFFSET (glyph) = x; - XIMAGE_INSTANCE_YOFFSET (glyph) = y; + /* Now layout subwidgets if they require it. */ + glyph_do_layout (glyph, gwidth, gheight, x, y, image_instance); if (IMAGE_INSTANCE_SUBWINDOW_ORIENT (ii) == LAYOUT_HORIZONTAL) @@ -1203,16 +1313,38 @@ y += (gheight + vert_spacing); } - /* Now layout subwidgets if they require it. */ - image_instance_layout (glyph, gwidth, gheight, domain); } return 1; } +/* Get the glyphs that comprise a layout. These are created internally + and so are otherwise inaccessible to lisp. We need some way of getting + properties from the widgets that comprise a layout and this is the + simplest way of doing it. + + #### Eventually we should allow some more intelligent access to + sub-widgets. */ +static Lisp_Object +layout_property (Lisp_Object image_instance, Lisp_Object prop) +{ + /* This function can GC. */ + Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); + if (EQ (prop, Q_items)) + { + if (INTP (IMAGE_INSTANCE_LAYOUT_BORDER (ii)) && + CONSP (IMAGE_INSTANCE_LAYOUT_CHILDREN (ii))) + return Fcopy_sequence (XCDR + (IMAGE_INSTANCE_LAYOUT_CHILDREN (ii))); + else + return Fcopy_sequence (IMAGE_INSTANCE_LAYOUT_CHILDREN (ii)); + } + return Qunbound; +} + /* Layout subwindows if they are real subwindows. */ static int native_layout_layout (Lisp_Object image_instance, - int width, int height, + int width, int height, int xoffset, int yoffset, Lisp_Object domain) { Lisp_Image_Instance* ii = XIMAGE_INSTANCE (image_instance); @@ -1226,7 +1358,7 @@ /* Defining this overrides the default layout_layout so we first have to call that to get suitable instances and values set up. */ - layout_layout (image_instance, width, height, domain); + layout_layout (image_instance, width, height, xoffset, yoffset, domain); LIST_LOOP (rest, IMAGE_INSTANCE_LAYOUT_CHILDREN (ii)) { @@ -1255,6 +1387,8 @@ defsymbol (&Qetched_out, "etched-out"); defsymbol (&Qbevel_in, "bevel-in"); defsymbol (&Qbevel_out, "bevel-out"); + defsymbol (&Qmake_glyph, "make-glyph"); + defsymbol (&Qset_glyph_image, "set-glyph-image"); } #define VALID_GUI_KEYWORDS(type) do { \ @@ -1287,7 +1421,7 @@ { /* we only do this for properties */ INITIALIZE_IMAGE_INSTANTIATOR_FORMAT_NO_SYM (widget, "widget"); IIFORMAT_HAS_METHOD (widget, property); - IIFORMAT_HAS_METHOD (widget, set_property); + IIFORMAT_HAS_METHOD (widget, update); IIFORMAT_HAS_METHOD (widget, query_geometry); IIFORMAT_HAS_METHOD (widget, layout); } @@ -1303,7 +1437,7 @@ IIFORMAT_HAS_SHARED_METHOD (button, governing_domain, subwindow); IIFORMAT_HAS_METHOD (button, query_geometry); IIFORMAT_VALID_KEYWORD (button, - Q_image, check_valid_glyph_or_instantiator); + Q_image, check_valid_instantiator); VALID_WIDGET_KEYWORDS (button); VALID_GUI_KEYWORDS (button); } @@ -1359,9 +1493,11 @@ IIFORMAT_HAS_SHARED_METHOD (progress_gauge, instantiate, widget); IIFORMAT_HAS_SHARED_METHOD (progress_gauge, post_instantiate, widget); IIFORMAT_HAS_SHARED_METHOD (progress_gauge, governing_domain, subwindow); - IIFORMAT_HAS_METHOD (progress_gauge, set_property); + IIFORMAT_HAS_METHOD (progress_gauge, update); VALID_WIDGET_KEYWORDS (progress_gauge); VALID_GUI_KEYWORDS (progress_gauge); + + IIFORMAT_VALID_KEYWORD (progress_gauge, Q_value, check_valid_int); } static void image_instantiator_tree_view (void) @@ -1372,6 +1508,7 @@ IIFORMAT_HAS_SHARED_METHOD (tree_view, instantiate, widget); IIFORMAT_HAS_SHARED_METHOD (tree_view, post_instantiate, widget); IIFORMAT_HAS_SHARED_METHOD (tree_view, governing_domain, subwindow); + IIFORMAT_HAS_SHARED_METHOD (tree_view, update, tab_control); IIFORMAT_HAS_METHOD (tree_view, query_geometry); VALID_WIDGET_KEYWORDS (tree_view); VALID_GUI_KEYWORDS (tree_view); @@ -1387,7 +1524,7 @@ IIFORMAT_HAS_SHARED_METHOD (tab_control, post_instantiate, widget); IIFORMAT_HAS_SHARED_METHOD (tab_control, governing_domain, subwindow); IIFORMAT_HAS_METHOD (tab_control, query_geometry); - IIFORMAT_HAS_METHOD (tab_control, set_property); + IIFORMAT_HAS_METHOD (tab_control, update); VALID_WIDGET_KEYWORDS (tab_control); VALID_GUI_KEYWORDS (tab_control); IIFORMAT_VALID_KEYWORD (tab_control, Q_orientation, check_valid_tab_orientation); @@ -1412,7 +1549,7 @@ IIFORMAT_VALID_KEYWORD (layout, Q_border, check_valid_border); \ IIFORMAT_VALID_KEYWORD (layout, Q_margin_width, check_valid_int); \ IIFORMAT_VALID_KEYWORD (layout, Q_items, \ - check_valid_glyph_or_instantiator_list) + check_valid_instantiator_list) static void image_instantiator_layout (void) { @@ -1424,6 +1561,8 @@ IIFORMAT_HAS_METHOD (layout, normalize); IIFORMAT_HAS_METHOD (layout, query_geometry); IIFORMAT_HAS_METHOD (layout, layout); + IIFORMAT_HAS_METHOD (layout, update); + IIFORMAT_HAS_METHOD (layout, property); VALID_GUI_KEYWORDS (layout); VALID_LAYOUT_KEYWORDS (layout); @@ -1440,6 +1579,7 @@ IIFORMAT_HAS_SHARED_METHOD (native_layout, normalize, layout); IIFORMAT_HAS_SHARED_METHOD (native_layout, query_geometry, layout); IIFORMAT_HAS_SHARED_METHOD (native_layout, layout, layout); + IIFORMAT_HAS_SHARED_METHOD (native_layout, property, layout); VALID_GUI_KEYWORDS (native_layout); VALID_LAYOUT_KEYWORDS (native_layout); Index: src/glyphs-x.c =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/glyphs-x.c,v retrieving revision 1.49.2.73 diff -u -r1.49.2.73 glyphs-x.c --- src/glyphs-x.c 2000/07/21 10:16:35 1.49.2.73 +++ src/glyphs-x.c 2000/07/22 19:25:22 @@ -17,7 +17,6 @@ ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. - You should have received a copy of the GNU General Public License along with XEmacs; see the file COPYING. If not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, @@ -1739,7 +1738,8 @@ static Lisp_Object autodetect_normalize (Lisp_Object instantiator, - Lisp_Object console_type) + Lisp_Object console_type, + Lisp_Object dest_mask) { Lisp_Object file = find_keyword_in_vector (instantiator, Q_data); Lisp_Object filename = Qnil; @@ -2165,7 +2165,7 @@ /* when you click on a widget you may activate another widget this needs to be checked and all appropriate widgets updated */ static void -x_update_subwindow (Lisp_Image_Instance *p) +x_redisplay_subwindow (Lisp_Image_Instance *p) { /* Update the subwindow size if necessary. */ if (IMAGE_INSTANCE_SIZE_CHANGED (p)) @@ -2180,7 +2180,7 @@ /* Update all attributes that have changed. Lwlib actually does most of this for us. */ static void -x_update_widget (Lisp_Image_Instance *p) +x_redisplay_widget (Lisp_Image_Instance *p) { /* This function can GC if IN_REDISPLAY is false. */ #ifdef HAVE_WIDGETS @@ -2591,7 +2591,7 @@ i.e. although the arg contents may be the same the args look different and so are re-applied to the widget. */ static void -x_button_update (Lisp_Object image_instance) +x_button_redisplay (Lisp_Object image_instance) { /* This function can GC if IN_REDISPLAY is false. */ Lisp_Image_Instance *p = XIMAGE_INSTANCE (image_instance); @@ -2639,7 +2639,7 @@ /* set the properties of a progres guage */ static void -x_progress_gauge_update (Lisp_Object image_instance) +x_progress_gauge_redisplay (Lisp_Object image_instance) { Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); @@ -2709,12 +2709,65 @@ pointer_bg, dest_mask, domain, "tab-control", wv); } -/* set the properties of a tab control */ +/* Set the properties of a tab control */ static void -x_tab_control_update (Lisp_Object image_instance) +x_tab_control_redisplay (Lisp_Object image_instance) { Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); + if (IMAGE_INSTANCE_WIDGET_ITEMS_CHANGED (ii)) + { + int found = 0; + Lisp_Object rest, xrest; + + /* See whether we just need a change in order. */ + LIST_LOOP (rest, XCDR (IMAGE_INSTANCE_WIDGET_ITEMS (ii))) + { + found = 0; + LIST_LOOP (xrest, + XCDR (IMAGE_INSTANCE_WIDGET_PENDING_ITEMS (ii))) + { + if (internal_equal (XCAR (rest), XCAR (xrest), 0)) + { + found = 1; + break; + } + } + if (!found) + break; + } + /* If only the order has changed then simply select the first + one of the pending set. This stops horrendous rebuilding - + and hence flicker - of the tabs each time you click on + one. */ + if (found) + { + widget_value* wv = lw_get_all_values + (IMAGE_INSTANCE_X_WIDGET_LWID (ii)); + widget_value* cur = wv->contents; + LIST_LOOP (rest, XCDR (IMAGE_INSTANCE_WIDGET_ITEMS (ii))) + { + if (internal_equal + (XCAR (rest), + XCAR (XCDR (IMAGE_INSTANCE_WIDGET_PENDING_ITEMS (ii))), 0)) + { + /* There may be an encapsulated way of doing this, + but I couldn't find it. */ + Arg al [1]; + Widget child = XtNameToWidget + (IMAGE_INSTANCE_X_WIDGET_ID (ii), + cur->name); + XtSetArg (al [0], XtNtopWidget, child); + XtSetValues (IMAGE_INSTANCE_X_WIDGET_ID (ii), al, 1); + break; + } + cur = cur->next; + } + /* We're not actually changing the items anymore. */ + IMAGE_INSTANCE_WIDGET_ITEMS_CHANGED (ii) = 0; + IMAGE_INSTANCE_WIDGET_PENDING_ITEMS (ii) = Qnil; + } + } /* Possibly update the face. */ if (IMAGE_INSTANCE_WIDGET_FACE_CHANGED (ii) || @@ -2777,8 +2830,8 @@ CONSOLE_HAS_METHOD (x, locate_pixmap_file); CONSOLE_HAS_METHOD (x, unmap_subwindow); CONSOLE_HAS_METHOD (x, map_subwindow); - CONSOLE_HAS_METHOD (x, update_widget); - CONSOLE_HAS_METHOD (x, update_subwindow); + CONSOLE_HAS_METHOD (x, redisplay_widget); + CONSOLE_HAS_METHOD (x, redisplay_subwindow); } void @@ -2820,13 +2873,13 @@ INITIALIZE_DEVICE_IIFORMAT (x, button); IIFORMAT_HAS_DEVMETHOD (x, button, property); IIFORMAT_HAS_DEVMETHOD (x, button, instantiate); - IIFORMAT_HAS_DEVMETHOD (x, button, update); + IIFORMAT_HAS_DEVMETHOD (x, button, redisplay); /* general widget methods. */ INITIALIZE_DEVICE_IIFORMAT (x, widget); IIFORMAT_HAS_DEVMETHOD (x, widget, property); /* progress gauge */ INITIALIZE_DEVICE_IIFORMAT (x, progress_gauge); - IIFORMAT_HAS_DEVMETHOD (x, progress_gauge, update); + IIFORMAT_HAS_DEVMETHOD (x, progress_gauge, redisplay); IIFORMAT_HAS_DEVMETHOD (x, progress_gauge, instantiate); /* text field */ INITIALIZE_DEVICE_IIFORMAT (x, edit_field); @@ -2835,12 +2888,12 @@ /* combo box */ INITIALIZE_DEVICE_IIFORMAT (x, combo_box); IIFORMAT_HAS_DEVMETHOD (x, combo_box, instantiate); - IIFORMAT_HAS_SHARED_DEVMETHOD (x, combo_box, update, tab_control); + IIFORMAT_HAS_SHARED_DEVMETHOD (x, combo_box, redisplay, tab_control); #endif /* tab control widget */ INITIALIZE_DEVICE_IIFORMAT (x, tab_control); IIFORMAT_HAS_DEVMETHOD (x, tab_control, instantiate); - IIFORMAT_HAS_DEVMETHOD (x, tab_control, update); + IIFORMAT_HAS_DEVMETHOD (x, tab_control, redisplay); /* label */ INITIALIZE_DEVICE_IIFORMAT (x, label); IIFORMAT_HAS_DEVMETHOD (x, label, instantiate); Index: src/glyphs.c =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/glyphs.c,v retrieving revision 1.23.2.75 diff -u -r1.23.2.75 glyphs.c --- src/glyphs.c 2000/07/21 10:16:39 1.23.2.75 +++ src/glyphs.c 2000/07/22 19:25:34 @@ -126,7 +126,8 @@ the_image_instantiator_format_entry_dynarr; static Lisp_Object allocate_image_instance (Lisp_Object governing_domain, - Lisp_Object glyph); + Lisp_Object parent, + Lisp_Object instantiator); static void image_validate (Lisp_Object instantiator); static void glyph_property_was_changed (Lisp_Object glyph, Lisp_Object property, @@ -134,6 +135,8 @@ static void set_image_instance_dirty_p (Lisp_Object instance, int dirty); static void register_ignored_expose (struct frame* f, int x, int y, int width, int height); static void cache_subwindow_instance_in_frame_maybe (Lisp_Object instance); +static void update_image_instance (Lisp_Object image_instance, + Lisp_Object instantiator); /* Unfortunately windows and X are different. In windows BeginPaint() will prevent WM_PAINT messages being generated so it is unnecessary to register exposures as they will not occur. Under X they will @@ -433,6 +436,85 @@ return find_keyword_in_vector_or_given (vector, keyword, Qnil); } +static Lisp_Object +find_instantiator_differences (Lisp_Object new, Lisp_Object old) +{ + Lisp_Object alist = Qnil; + Lisp_Object *elt = XVECTOR_DATA (new); + Lisp_Object *old_elt = XVECTOR_DATA (old); + int len = XVECTOR_LENGTH (new); + struct gcpro gcpro1; + + /* If the vector length has changed then consider everything + changed. We could try and figure out what properties have + disappeared or been added, but this code is only used as an + optimization anyway so lets not bother. */ + if (len != XVECTOR_LENGTH (old)) + return new; + + GCPRO1 (alist); + + for (len -= 2; len >= 1; len -= 2) + { + /* Keyword comparisons can be done with eq, the value must be + done with equal. + #### Note that this does not optimize re-ordering. */ + if (!EQ (elt[len], old_elt[len]) + || !internal_equal (elt[len+1], old_elt[len+1], 0)) + alist = Fcons (Fcons (elt[len], elt[len+1]), alist); + } + + { + Lisp_Object result = alist_to_tagged_vector (elt[0], alist); + free_alist (alist); + RETURN_UNGCPRO (result); + } +} + +DEFUN ("set-instantiator-property", Fset_instantiator_property, + 3, 3, 0, /* +Destructively set the property KEYWORD of INSTANTIATOR to VAL. +If the property is not set then it is added to a copy of the +instantiator and the new instantiator returned. +Use `set-glyph-image' on glyphs to register instantiator changes. */ + (instantiator, keyword, val)) +{ + Lisp_Object *elt; + int len; + + CHECK_VECTOR (instantiator); + if (!KEYWORDP (keyword)) + signal_simple_error ("instantiator property must be a keyword", keyword); + + elt = XVECTOR_DATA (instantiator); + len = XVECTOR_LENGTH (instantiator); + + for (len -= 2; len >= 1; len -= 2) + { + if (EQ (elt[len], keyword)) + { + elt[len+1] = val; + break; + } + } + + /* Didn't find it so add it. */ + if (len < 1) + { + Lisp_Object alist = Qnil, result; + struct gcpro gcpro1; + + GCPRO1 (alist); + alist = tagged_vector_to_alist (instantiator); + alist = Fcons (Fcons (keyword, val), alist); + result = alist_to_tagged_vector (elt[0], alist); + free_alist (alist); + RETURN_UNGCPRO (result); + } + + return instantiator; +} + void check_valid_string (Lisp_Object data) { @@ -587,7 +669,10 @@ /* Weird nothing images exist at startup when the console is deleted. */ if (!NOTHING_IMAGE_INSTANCEP (instance)) - assert (DOMAIN_LIVE_P (instance)); + { + assert (DOMAIN_LIVE_P (instance)); + assert (VECTORP (XIMAGE_INSTANCE_INSTANTIATOR (instance))); + } if (WINDOWP (XIMAGE_INSTANCE_DOMAIN (instance))) check_window_subwindow_cache (XWINDOW (XIMAGE_INSTANCE_DOMAIN (instance))); @@ -631,7 +716,7 @@ return domain; } -static Lisp_Object +Lisp_Object normalize_image_instantiator (Lisp_Object instantiator, Lisp_Object contype, Lisp_Object dest_mask) @@ -642,8 +727,9 @@ if (STRINGP (instantiator)) instantiator = process_image_string_instantiator (instantiator, contype, XINT (dest_mask)); - - assert (VECTORP (instantiator)); + /* Subsequent validation will pick this up. */ + if (!VECTORP (instantiator)) + return instantiator; /* We have to always store the actual pixmap data and not the filename even though this is a potential memory pig. We have to do this because it is quite possible that we will need to @@ -659,7 +745,7 @@ meths = decode_image_instantiator_format (XVECTOR_DATA (instantiator)[0], ERROR_ME); RETURN_UNGCPRO (IIFORMAT_METH_OR_GIVEN (meths, normalize, - (instantiator, contype), + (instantiator, contype, dest_mask), instantiator)); } } @@ -671,7 +757,9 @@ Lisp_Object pointer_fg, Lisp_Object pointer_bg, int dest_mask, Lisp_Object glyph) { - Lisp_Object ii = allocate_image_instance (governing_domain, glyph); + Lisp_Object ii = allocate_image_instance (governing_domain, + IMAGE_INSTANCEP (domain) ? + domain : glyph, instantiator); Lisp_Image_Instance* p = XIMAGE_INSTANCE (ii); struct image_instantiator_methods *meths, *device_meths; struct gcpro gcpro1; @@ -703,7 +791,9 @@ geometry values, thus the instance needs to have been laid-out before they get called. */ image_instance_layout (ii, XIMAGE_INSTANCE_WIDTH (ii), - XIMAGE_INSTANCE_HEIGHT (ii), domain); + XIMAGE_INSTANCE_HEIGHT (ii), + IMAGE_UNCHANGED_GEOMETRY, + IMAGE_UNCHANGED_GEOMETRY, domain); MAYBE_IIFORMAT_METH (device_meths, instantiate, (ii, instantiator, pointer_fg, pointer_bg, dest_mask, domain)); @@ -715,8 +805,10 @@ IMAGE_INSTANCE_INITIALIZED (p) = 1; /* Now that we're done verify that we really are laid out. */ if (IMAGE_INSTANCE_LAYOUT_CHANGED (p)) - image_instance_layout (ii, XIMAGE_INSTANCE_WIDTH (ii), - XIMAGE_INSTANCE_HEIGHT (ii), domain); + image_instance_layout (ii, XIMAGE_INSTANCE_WIDTH (ii), + XIMAGE_INSTANCE_HEIGHT (ii), + IMAGE_UNCHANGED_GEOMETRY, + IMAGE_UNCHANGED_GEOMETRY, domain); /* We *must* have a clean image at this point. */ IMAGE_INSTANCE_TEXT_CHANGED (p) = 0; @@ -753,6 +845,7 @@ #endif mark_object (i->name); + mark_object (i->instantiator); /* Is this legal in marking? We may get in the situation where the domain has been deleted - making the instance unusable. It seems better to remove the domain so that it can be finalized. */ @@ -762,7 +855,7 @@ mark_object (i->domain); /* We don't mark the glyph reference since that would create a - circularity preventing GC. */ + circularity preventing GC. Ditto the instantiator. */ switch (IMAGE_INSTANCE_TYPE (i)) { case IMAGE_TEXT: @@ -781,7 +874,7 @@ case IMAGE_WIDGET: mark_object (IMAGE_INSTANCE_WIDGET_TYPE (i)); mark_object (IMAGE_INSTANCE_WIDGET_PROPS (i)); - mark_object (IMAGE_INSTANCE_WIDGET_FACE (i)); + mark_object (IMAGE_INSTANCE_SUBWINDOW_FACE (i)); mark_object (IMAGE_INSTANCE_WIDGET_ITEMS (i)); mark_object (IMAGE_INSTANCE_LAYOUT_CHILDREN (i)); mark_object (IMAGE_INSTANCE_WIDGET_PENDING_ITEMS (i)); @@ -991,6 +1084,10 @@ if (!internal_equal (IMAGE_INSTANCE_NAME (i1), IMAGE_INSTANCE_NAME (i2), depth + 1)) return 0; + if (!internal_equal (IMAGE_INSTANCE_INSTANTIATOR (i1), + IMAGE_INSTANCE_INSTANTIATOR (i2), + depth + 1)) + return 0; switch (IMAGE_INSTANCE_TYPE (i1)) { @@ -1095,10 +1192,12 @@ image_instance_hash (Lisp_Object obj, int depth) { Lisp_Image_Instance *i = XIMAGE_INSTANCE (obj); - unsigned long hash = HASH4 (LISP_HASH (IMAGE_INSTANCE_DOMAIN (i)), + unsigned long hash = HASH5 (LISP_HASH (IMAGE_INSTANCE_DOMAIN (i)), IMAGE_INSTANCE_WIDTH (i), IMAGE_INSTANCE_MARGIN_WIDTH (i), - IMAGE_INSTANCE_HEIGHT (i)); + IMAGE_INSTANCE_HEIGHT (i), + internal_hash (IMAGE_INSTANCE_INSTANTIATOR (i), + depth + 1)); ERROR_CHECK_IMAGE_INSTANCE (obj); @@ -1151,7 +1250,8 @@ Lisp_Image_Instance); static Lisp_Object -allocate_image_instance (Lisp_Object governing_domain, Lisp_Object glyph) +allocate_image_instance (Lisp_Object governing_domain, Lisp_Object parent, + Lisp_Object instantiator) { Lisp_Image_Instance *lp = alloc_lcrecord_type (Lisp_Image_Instance, &lrecord_image_instance); @@ -1177,7 +1277,8 @@ lp->width = IMAGE_UNSPECIFIED_GEOMETRY; lp->margin_width = 0; lp->height = IMAGE_UNSPECIFIED_GEOMETRY; - lp->parent = glyph; + lp->parent = parent; + lp->instantiator = instantiator; /* So that layouts get done. */ lp->layout_changed = 1; lp->initialized = 0; @@ -1576,67 +1677,6 @@ return Qnil; } -DEFUN ("set-image-instance-property", Fset_image_instance_property, 3, 3, 0, /* -Set the given property of the given image instance. -Does nothing if the property or the property method do not exist for -the image instance in the domain. - -WARNING: If you are thinking about using this function, think again. -You probably want to be using `set-glyph-image' to change the glyph's -specifier. Be especially wary if you are thinking of calling this -function after having called `glyph-image-instance'. Unless you are -absolutely sure what you're doing, pretty much the only legitimate -uses for this function are setting user-specified info in a widget, -such as text in a text field. */ - (image_instance, prop, val)) -{ - Lisp_Image_Instance* ii; - Lisp_Object type, ret; - struct image_instantiator_methods* meths; - - CHECK_IMAGE_INSTANCE (image_instance); - ERROR_CHECK_IMAGE_INSTANCE (image_instance); - CHECK_SYMBOL (prop); - ii = XIMAGE_INSTANCE (image_instance); - type = encode_image_instance_type (IMAGE_INSTANCE_TYPE (ii)); - /* try device specific methods first ... */ - meths = decode_device_ii_format (image_instance_device (image_instance), - type, ERROR_ME_NOT); - if (meths && HAS_IIFORMAT_METH_P (meths, set_property) - && - !UNBOUNDP (ret = - IIFORMAT_METH (meths, set_property, (image_instance, prop, val)))) - { - val = ret; - } - else - { - /* ... then format specific methods ... */ - meths = decode_device_ii_format (Qnil, type, ERROR_ME_NOT); - if (meths && HAS_IIFORMAT_METH_P (meths, set_property) - && - !UNBOUNDP (ret = - IIFORMAT_METH (meths, set_property, (image_instance, prop, val)))) - { - val = ret; - } - else - { - val = Qnil; - } - } - - /* Make sure the image instance gets redisplayed. */ - set_image_instance_dirty_p (image_instance, 1); - /* Force the glyph to be laid out again. */ - IMAGE_INSTANCE_LAYOUT_CHANGED (ii) = 1; - - MARK_SUBWINDOWS_STATE_CHANGED; - MARK_GLYPHS_CHANGED; - - return val; -} - DEFUN ("image-instance-file-name", Fimage_instance_file_name, 1, 1, 0, /* Return the file name from which IMAGE-INSTANCE was read, if known. */ @@ -1873,7 +1913,7 @@ /* #### There should be a copy_image_instance(), which calls a device-specific method to copy the window-system subobject. */ new = allocate_image_instance (XIMAGE_INSTANCE_DOMAIN (image_instance), - Qnil); + Qnil, Qnil); copy_lcrecord (XIMAGE_INSTANCE (new), XIMAGE_INSTANCE (image_instance)); /* note that if this method returns non-zero, this method MUST copy any window-system resources, so that when one image instance is @@ -1928,7 +1968,9 @@ want to specifiy something (layout widgets). */ void image_instance_layout (Lisp_Object image_instance, - int width, int height, Lisp_Object domain) + int width, int height, + int xoffset, int yoffset, + Lisp_Object domain) { Lisp_Image_Instance* ii = XIMAGE_INSTANCE (image_instance); Lisp_Object type; @@ -1940,6 +1982,16 @@ if (NOTHING_IMAGE_INSTANCEP (image_instance)) return; + /* We don't want carefully calculated offsets to be mucked up by + random layouts. */ + if (xoffset != IMAGE_UNCHANGED_GEOMETRY) + XIMAGE_INSTANCE_XOFFSET (image_instance) = xoffset; + if (yoffset != IMAGE_UNCHANGED_GEOMETRY) + XIMAGE_INSTANCE_YOFFSET (image_instance) = yoffset; + + assert (XIMAGE_INSTANCE_YOFFSET (image_instance) >= 0 + && XIMAGE_INSTANCE_XOFFSET (image_instance) >= 0); + type = encode_image_instance_type (IMAGE_INSTANCE_TYPE (ii)); meths = decode_device_ii_format (Qnil, type, ERROR_ME_NOT); @@ -1991,12 +2043,72 @@ IMAGE_INSTANCE_HEIGHT (ii) = height; if (IIFORMAT_METH_OR_GIVEN (meths, layout, - (image_instance, width, height, domain), 1)) + (image_instance, width, height, xoffset, yoffset, + domain), 1)) /* Do not clear the dirty flag here - redisplay will do this for us at the end. */ IMAGE_INSTANCE_LAYOUT_CHANGED (ii) = 0; } +/* Update an image instance from its changed instantiator. */ +static void +update_image_instance (Lisp_Object image_instance, + Lisp_Object instantiator) +{ + struct image_instantiator_methods* meths; + Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); + + ERROR_CHECK_IMAGE_INSTANCE (image_instance); + + if (NOTHING_IMAGE_INSTANCEP (image_instance)) + return; + + assert (!internal_equal (IMAGE_INSTANCE_INSTANTIATOR (ii), instantiator, 0) + || (internal_equal (IMAGE_INSTANCE_INSTANTIATOR (ii), instantiator, 0) + && internal_equal (IMAGE_INSTANCE_INSTANTIATOR (ii), instantiator, -10))); + + /* If the instantiator is identical then do nothing. We must use + equal here because the specifier code copies the instantiator. */ + if (!internal_equal (IMAGE_INSTANCE_INSTANTIATOR (ii), instantiator, 0)) + { + /* Extract the changed properties so that device / format + methods only have to cope wiuth these. We assume that + normalization has already been done. */ + Lisp_Object diffs = find_instantiator_differences + (instantiator, + IMAGE_INSTANCE_INSTANTIATOR (ii)); + Lisp_Object type = encode_image_instance_type + (IMAGE_INSTANCE_TYPE (ii)); + struct gcpro gcpro1; + GCPRO1 (diffs); + + /* try device specific methods first ... */ + meths = decode_device_ii_format (image_instance_device (image_instance), + type, ERROR_ME_NOT); + MAYBE_IIFORMAT_METH (meths, update, (image_instance, diffs)); + /* ... then format specific methods ... */ + meths = decode_device_ii_format (Qnil, type, ERROR_ME_NOT); + MAYBE_IIFORMAT_METH (meths, update, (image_instance, diffs)); + + /* Instance and therefore glyph has changed so mark as dirty. + If we don't do this output optimizations will assume the + glyph is unchanged. */ + set_image_instance_dirty_p (image_instance, 1); + /* Structure has changed. */ + IMAGE_INSTANCE_LAYOUT_CHANGED (ii) = 1; + + UNGCPRO; + } + /* We should now have a consistent instantiator so keep a record of + it. It is important that we don't actually update the window + system widgets here - we must do that when redisplay tells us + to. + + #### should we delay doing this until the display is up-to-date + also? */ + IMAGE_INSTANCE_INSTANTIATOR (ii) = instantiator; +} + /* * Mark image instance in W as dirty if (a) W's faces have changed and * (b) GLYPH_OR_II instance in W is a string. @@ -2088,7 +2200,8 @@ } static Lisp_Object -inherit_normalize (Lisp_Object inst, Lisp_Object console_type) +inherit_normalize (Lisp_Object inst, Lisp_Object console_type, + Lisp_Object dest_mask) { Lisp_Object face; @@ -2262,20 +2375,16 @@ } /* set the properties of a string */ -static Lisp_Object -text_set_property (Lisp_Object image_instance, Lisp_Object prop, - Lisp_Object val) +static void +text_update (Lisp_Object image_instance, Lisp_Object instantiator) { - Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); + Lisp_Object val = find_keyword_in_vector (instantiator, Q_data); - if (EQ (prop, Q_data)) + if (!NILP (val)) { CHECK_STRING (val); - IMAGE_INSTANCE_TEXT_STRING (ii) = val; - - return Qt; + XIMAGE_INSTANCE_TEXT_STRING (image_instance) = val; } - return Qunbound; } @@ -2558,7 +2667,8 @@ /* Normalize method for XBM's. */ static Lisp_Object -xbm_normalize (Lisp_Object inst, Lisp_Object console_type) +xbm_normalize (Lisp_Object inst, Lisp_Object console_type, + Lisp_Object dest_mask) { Lisp_Object file = Qnil, mask_file = Qnil; struct gcpro gcpro1, gcpro2, gcpro3; @@ -2641,7 +2751,8 @@ } static Lisp_Object -xface_normalize (Lisp_Object inst, Lisp_Object console_type) +xface_normalize (Lisp_Object inst, Lisp_Object console_type, + Lisp_Object dest_mask) { /* This function can call lisp */ Lisp_Object file = Qnil, mask_file = Qnil; @@ -2848,7 +2959,8 @@ } static Lisp_Object -xpm_normalize (Lisp_Object inst, Lisp_Object console_type) +xpm_normalize (Lisp_Object inst, Lisp_Object console_type, + Lisp_Object dest_mask) { Lisp_Object file = Qnil; Lisp_Object color_symbols; @@ -3027,7 +3139,7 @@ { pointer_fg = FACE_FOREGROUND (Vpointer_face, domain); pointer_bg = FACE_BACKGROUND (Vpointer_face, domain); - ls3 = list3 (instantiator, pointer_fg, pointer_bg); + ls3 = list3 (glyph, pointer_fg, pointer_bg); } /* First look in the device cache. */ @@ -3067,7 +3179,7 @@ } else { - instance = Fgethash (pointerp ? ls3 : instantiator, + instance = Fgethash (pointerp ? ls3 : glyph, subtable, Qunbound); } } @@ -3076,7 +3188,7 @@ /* Subwindows have a per-window cache and have to be treated differently. */ instance = - Fgethash (instantiator, + Fgethash (pointerp ? ls3 : glyph, XWINDOW (governing_domain)->subwindow_instance_cache, Qunbound); } @@ -3089,7 +3201,7 @@ { Lisp_Object locative = noseeum_cons (Qnil, - noseeum_cons (pointerp ? ls3 : instantiator, + noseeum_cons (pointerp ? ls3 : glyph, DEVICEP (governing_domain) ? subtable : XWINDOW (governing_domain) ->subwindow_instance_cache)); @@ -3122,18 +3234,33 @@ #ifdef ERROR_CHECK_GLYPHS if (image_instance_type_to_mask (XIMAGE_INSTANCE_TYPE (instance)) & (IMAGE_SUBWINDOW_MASK | IMAGE_WIDGET_MASK)) - assert (EQ (Fgethash ((pointerp ? ls3 : instantiator), + assert (EQ (Fgethash ((pointerp ? ls3 : glyph), XWINDOW (governing_domain) ->subwindow_instance_cache, Qunbound), instance)); #endif } - else - free_list (ls3); - - if (NILP (instance)) + else if (NILP (instance)) signal_simple_error ("Can't instantiate image (probably cached)", instantiator); + /* We found an instance. However, because we are using the glyph + as the hash key instead of the instantiator, the current + instantiator may not be the same as the original. Thus we + must update the instance based on the new + instantiator. Preserving instance identity like this is + important to stop excessive window system widget creation and + deletion - and hence flashing. */ + else + { + /* #### This function should be able to cope with *all* + changes to the instantiator, but currently only copes + with the most used properties. This means that it is + possible to make changes that don't get reflected in the + display. */ + update_image_instance (instance, instantiator); + free_list (ls3); + } + #ifdef ERROR_CHECK_GLYPHS if (image_instance_type_to_mask (XIMAGE_INSTANCE_TYPE (instance)) & (IMAGE_SUBWINDOW_MASK | IMAGE_WIDGET_MASK)) @@ -3611,7 +3738,7 @@ } DEFUN ("make-glyph-internal", Fmake_glyph_internal, 0, 1, 0, /* -Create and return a new uninitialized glyph or type TYPE. +Create and return a new uninitialized glyph of type TYPE. TYPE specifies the type of the glyph; this should be one of `buffer', `pointer', or `icon', and defaults to `buffer'. The type of the glyph @@ -3714,7 +3841,9 @@ if (XIMAGE_INSTANCE_NEEDS_LAYOUT (instance)) image_instance_layout (instance, IMAGE_UNSPECIFIED_GEOMETRY, - IMAGE_UNSPECIFIED_GEOMETRY, domain); + IMAGE_UNSPECIFIED_GEOMETRY, + IMAGE_UNCHANGED_GEOMETRY, + IMAGE_UNCHANGED_GEOMETRY, domain); return XIMAGE_INSTANCE_WIDTH (instance); } @@ -3742,7 +3871,9 @@ if (XIMAGE_INSTANCE_NEEDS_LAYOUT (instance)) image_instance_layout (instance, IMAGE_UNSPECIFIED_GEOMETRY, - IMAGE_UNSPECIFIED_GEOMETRY, domain); + IMAGE_UNSPECIFIED_GEOMETRY, + IMAGE_UNCHANGED_GEOMETRY, + IMAGE_UNCHANGED_GEOMETRY, domain); if (XIMAGE_INSTANCE_TYPE (instance) == IMAGE_TEXT) return XIMAGE_INSTANCE_TEXT_ASCENT (instance); @@ -3760,7 +3891,9 @@ if (XIMAGE_INSTANCE_NEEDS_LAYOUT (instance)) image_instance_layout (instance, IMAGE_UNSPECIFIED_GEOMETRY, - IMAGE_UNSPECIFIED_GEOMETRY, domain); + IMAGE_UNSPECIFIED_GEOMETRY, + IMAGE_UNCHANGED_GEOMETRY, + IMAGE_UNCHANGED_GEOMETRY, domain); if (XIMAGE_INSTANCE_TYPE (instance) == IMAGE_TEXT) return XIMAGE_INSTANCE_TEXT_DESCENT (instance); @@ -3780,7 +3913,9 @@ if (XIMAGE_INSTANCE_NEEDS_LAYOUT (instance)) image_instance_layout (instance, IMAGE_UNSPECIFIED_GEOMETRY, - IMAGE_UNSPECIFIED_GEOMETRY, domain); + IMAGE_UNSPECIFIED_GEOMETRY, + IMAGE_UNCHANGED_GEOMETRY, + IMAGE_UNCHANGED_GEOMETRY, domain); return XIMAGE_INSTANCE_HEIGHT (instance); } @@ -3916,32 +4051,29 @@ (XGLYPH (glyph)->after_change) (glyph, property, locale); } -#if 0 /* Not used for now */ -static void -glyph_query_geometry (Lisp_Object glyph_or_image, Lisp_Object window, - unsigned int* width, unsigned int* height, +void +glyph_query_geometry (Lisp_Object glyph_or_image, int* width, int* height, enum image_instance_geometry disp, Lisp_Object domain) { Lisp_Object instance = glyph_or_image; if (GLYPHP (glyph_or_image)) - instance = glyph_image_instance (glyph_or_image, window, ERROR_ME_NOT, 1); + instance = glyph_image_instance (glyph_or_image, domain, ERROR_ME_NOT, 1); image_instance_query_geometry (instance, width, height, disp, domain); } -static void -glyph_layout (Lisp_Object glyph_or_image, Lisp_Object window, - unsigned int width, unsigned int height, Lisp_Object domain) +void +glyph_do_layout (Lisp_Object glyph_or_image, int width, int height, + int xoffset, int yoffset, Lisp_Object domain) { Lisp_Object instance = glyph_or_image; if (GLYPHP (glyph_or_image)) - instance = glyph_image_instance (glyph_or_image, window, ERROR_ME_NOT, 1); + instance = glyph_image_instance (glyph_or_image, domain, ERROR_ME_NOT, 1); - image_instance_layout (instance, width, height, domain); + image_instance_layout (instance, width, height, xoffset, yoffset, domain); } -#endif /***************************************************************************** @@ -4313,7 +4445,7 @@ should generally only get called if the subwindow is actually dirty. */ void -update_subwindow (Lisp_Object subwindow) +redisplay_subwindow (Lisp_Object subwindow) { Lisp_Image_Instance* ii = XIMAGE_INSTANCE (subwindow); int count = specpdl_depth (); @@ -4329,7 +4461,7 @@ if (WIDGET_IMAGE_INSTANCEP (subwindow)) { if (image_instance_changed (subwindow)) - update_widget (subwindow); + redisplay_widget (subwindow); /* Reset the changed flags. */ IMAGE_INSTANCE_WIDGET_FACE_CHANGED (ii) = 0; IMAGE_INSTANCE_WIDGET_ITEMS_CHANGED (ii) = 0; @@ -4340,7 +4472,7 @@ !NILP (IMAGE_INSTANCE_FRAME (ii))) { MAYBE_DEVMETH (DOMAIN_XDEVICE (ii->domain), - update_subwindow, (ii)); + redisplay_subwindow, (ii)); } IMAGE_INSTANCE_SIZE_CHANGED (ii) = 0; @@ -4359,6 +4491,15 @@ unbind_to (count, Qnil); } +/* Determine whether an image_instance has changed structurally and + hence needs redisplaying in some way. + + #### This should just look at the instantiator differences when we + get rid of the stored items altogether. In fact we should probably + store the new instantiator as well as the old - as we do with + gui_items currently - and then pick-up the new on the next + redisplay. This would obviate the need for any of this trickery + with hashcodes. */ int image_instance_changed (Lisp_Object subwindow) { @@ -4822,7 +4963,6 @@ DEFSUBR (Fimage_instance_foreground); DEFSUBR (Fimage_instance_background); DEFSUBR (Fimage_instance_property); - DEFSUBR (Fset_image_instance_property); DEFSUBR (Fcolorize_image_instance); /* subwindows */ DEFSUBR (Fsubwindowp); @@ -4858,6 +4998,7 @@ DEFSUBR (Fglyph_ascent); DEFSUBR (Fglyph_descent); DEFSUBR (Fglyph_height); + DEFSUBR (Fset_instantiator_property); /* Qbuffer defined in general.c. */ /* Qpointer defined above */ @@ -4995,7 +5136,7 @@ /* #### Andy, what is this? This is a bogus format and should not be visible to the user. */ INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (text, "text"); - IIFORMAT_HAS_METHOD (text, set_property); + IIFORMAT_HAS_METHOD (text, update); IIFORMAT_HAS_METHOD (text, query_geometry); INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (formatted_string, "formatted-string"); Index: src/glyphs.h =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/glyphs.h,v retrieving revision 1.18.2.52 diff -u -r1.18.2.52 glyphs.h --- src/glyphs.h 2000/06/17 07:53:27 1.18.2.52 +++ src/glyphs.h 2000/07/22 19:25:37 @@ -95,6 +95,7 @@ }; #define IMAGE_UNSPECIFIED_GEOMETRY -1 +#define IMAGE_UNCHANGED_GEOMETRY -2 #define WIDGET_BORDER_HEIGHT 4 #define WIDGET_BORDER_WIDTH 4 @@ -128,7 +129,8 @@ that should be used in a glyph, for devices of type CONSOLE_TYPE. Signal an error if conversion fails. */ Lisp_Object (*normalize_method) (Lisp_Object instantiator, - Lisp_Object console_type); + Lisp_Object console_type, + Lisp_Object dest_mask); /* Governing domain method: Return an int indicating what type of domain an instance in this format is governed by. */ @@ -163,7 +165,9 @@ Lisp_Object property, Lisp_Object val); /* Asynchronously update properties. */ - void (*update_method) (Lisp_Object image_instance); + void (*update_method) (Lisp_Object image_instance, + Lisp_Object instantiator); + void (*redisplay_method) (Lisp_Object image_instance); /* Find out the desired geometry, as given by disp, of this image instance. Actual geometry is stored in the appropriate slots in the @@ -176,7 +180,8 @@ /* Layout the instance and its children bounded by the provided dimensions. Returns success or failure. */ int (*layout_method) (Lisp_Object image_instance, - int width, int height, Lisp_Object domain); + int width, int height, int xoffset, int yoffset, + Lisp_Object domain); }; /***** Calling an image-instantiator method *****/ @@ -363,10 +368,10 @@ enum image_instance_geometry disp, Lisp_Object domain); void image_instance_layout (Lisp_Object image_instance, - int width, int height, + int width, int height, int xoffset, int yoffset, Lisp_Object domain); int layout_layout (Lisp_Object image_instance, - int width, int height, + int width, int height, int xoffset, int yoffset, Lisp_Object domain); int invalidate_glyph_geometry_maybe (Lisp_Object glyph_or_ii, struct window* w); @@ -528,6 +533,8 @@ /* The glyph from which we were instantiated. This is a weak reference. */ Lisp_Object parent; + /* The instantiator from which we were instantiated. */ + Lisp_Object instantiator; enum image_instance_type type; unsigned int x_offset, y_offset; /* for layout purposes */ int width, height, margin_width; @@ -616,6 +623,7 @@ #define IMAGE_INSTANCE_FRAME(i) (DOMAIN_FRAME ((i)->domain)) #define IMAGE_INSTANCE_NAME(i) ((i)->name) #define IMAGE_INSTANCE_PARENT(i) ((i)->parent) +#define IMAGE_INSTANCE_INSTANTIATOR(i) ((i)->instantiator) #define IMAGE_INSTANCE_GLYPH(i) (image_instance_parent_glyph(i)) #define IMAGE_INSTANCE_TYPE(i) ((i)->type) #define IMAGE_INSTANCE_XOFFSET(i) ((i)->x_offset) @@ -694,6 +702,8 @@ ((i)->u.subwindow.orientation) #define IMAGE_INSTANCE_SUBWINDOW_JUSTIFY(i) \ ((i)->u.subwindow.justification) +#define IMAGE_INSTANCE_SUBWINDOW_FACE(i) \ +((i)->u.subwindow.face) /* Widget properties */ #define IMAGE_INSTANCE_WIDGET_WIDTH(i) \ @@ -737,6 +747,8 @@ IMAGE_INSTANCE_GLYPH (XIMAGE_INSTANCE (i)) #define XIMAGE_INSTANCE_PARENT(i) \ IMAGE_INSTANCE_PARENT (XIMAGE_INSTANCE (i)) +#define XIMAGE_INSTANCE_INSTANTIATOR(i) \ + IMAGE_INSTANCE_INSTANTIATOR (XIMAGE_INSTANCE (i)) #define XIMAGE_INSTANCE_TYPE(i) \ IMAGE_INSTANCE_TYPE (XIMAGE_INSTANCE (i)) #define XIMAGE_INSTANCE_DISPLAY_HASH(i) \ @@ -844,6 +856,8 @@ IMAGE_INSTANCE_SUBWINDOW_ORIENT (XIMAGE_INSTANCE (i)) #define XIMAGE_INSTANCE_SUBWINDOW_JUSTIFY(i) \ IMAGE_INSTANCE_SUBWINDOW_JUSTIFY (XIMAGE_INSTANCE (i)) +#define XIMAGE_INSTANCE_SUBWINDOW_FACE(i) \ + IMAGE_INSTANCE_SUBWINDOW_FACE (XIMAGE_INSTANCE (i)) #define MARK_IMAGE_INSTANCE_CHANGED(i) \ (IMAGE_INSTANCE_DIRTYP (i) = 1); @@ -979,6 +993,15 @@ void (*after_change) (Lisp_Object glyph, Lisp_Object property, Lisp_Object locale)); +Lisp_Object normalize_image_instantiator (Lisp_Object instantiator, + Lisp_Object contype, + Lisp_Object dest_mask); +void glyph_query_geometry (Lisp_Object glyph_or_image, int* width, int* height, + enum image_instance_geometry disp, + Lisp_Object domain); +void glyph_do_layout (Lisp_Object glyph_or_image, int width, int height, + int xoffset, int yoffset, + Lisp_Object domain); void query_string_geometry ( Lisp_Object string, Lisp_Object face, int* width, int* height, int* descent, Lisp_Object domain); @@ -1093,9 +1116,9 @@ void map_subwindow (Lisp_Object subwindow, int x, int y, struct display_glyph_area *dga); int find_matching_subwindow (struct frame* f, int x, int y, int width, int height); -void update_widget (Lisp_Object widget); +void redisplay_widget (Lisp_Object widget); void update_widget_instances (Lisp_Object frame); -void update_subwindow (Lisp_Object subwindow); +void redisplay_subwindow (Lisp_Object subwindow); Lisp_Object image_instance_parent_glyph (struct Lisp_Image_Instance*); int image_instance_changed (Lisp_Object image); void free_frame_subwindow_instance_cache (struct frame* f); Index: src/gui-msw.c =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/Attic/gui-msw.c,v retrieving revision 1.1.2.13 diff -u -r1.1.2.13 gui-msw.c --- src/gui-msw.c 2000/06/12 04:18:16 1.1.2.13 +++ src/gui-msw.c 2000/07/22 19:25:37 @@ -89,98 +89,7 @@ return Qt; } -DEFUN ("mswindows-shell-execute", Fmswindows_shell_execute, 2, 4, 0, /* -Get Windows to perform OPERATION on DOCUMENT. -This is a wrapper around the ShellExecute system function, which -invokes the application registered to handle OPERATION for DOCUMENT. -OPERATION is typically \"open\", \"print\" or \"explore\" (but can be -nil for the default action), and DOCUMENT is typically the name of a -document file or URL, but can also be a program executable to run or -a directory to open in the Windows Explorer. - -If DOCUMENT is a program executable, PARAMETERS can be a string -containing command line parameters, but otherwise should be nil. - -SHOW-FLAG can be used to control whether the invoked application is hidden -or minimized. If SHOW-FLAG is nil, the application is displayed normally, -otherwise it is an integer representing a ShowWindow flag: - - 0 - start hidden - 1 - start normally - 3 - start maximized - 6 - start minimized -*/ - (operation, document, parameters, show_flag)) -{ - /* Encode filename and current directory. */ - Lisp_Object current_dir = Ffile_name_directory (document); - char* path = NULL; - char* doc = NULL; - Extbyte* f=0; - int ret; - struct gcpro gcpro1, gcpro2; - - CHECK_STRING (document); - - if (NILP (current_dir)) - current_dir = current_buffer->directory; - - GCPRO2 (current_dir, document); - - /* Use mule and cygwin-safe APIs top get at file data. */ - if (STRINGP (current_dir)) - { - TO_EXTERNAL_FORMAT (LISP_STRING, current_dir, - C_STRING_ALLOCA, f, - Qfile_name); -#ifdef CYGWIN - CYGWIN_WIN32_PATH (f, path); -#else - path = f; -#endif - } - - if (STRINGP (document)) - { - TO_EXTERNAL_FORMAT (LISP_STRING, document, - C_STRING_ALLOCA, f, - Qfile_name); -#ifdef CYGWIN - CYGWIN_WIN32_PATH (f, doc); -#else - doc = f; -#endif - } - - UNGCPRO; - - ret = (int) ShellExecute (NULL, - (STRINGP (operation) ? - XSTRING_DATA (operation) : NULL), - doc, - (STRINGP (parameters) ? - XSTRING_DATA (parameters) : NULL), - path, - (INTP (show_flag) ? - XINT (show_flag) : SW_SHOWDEFAULT)); - - if (ret > 32) - return Qt; - - if (ret == ERROR_FILE_NOT_FOUND) - signal_simple_error ("file not found", document); - else if (ret == ERROR_PATH_NOT_FOUND) - signal_simple_error ("path not found", current_dir); - else if (ret == ERROR_BAD_FORMAT) - signal_simple_error ("bad executable format", document); - else - error ("internal error"); - - return Qnil; -} - void syms_of_gui_mswindows (void) { - DEFSUBR (Fmswindows_shell_execute); } Index: src/inline.c =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/inline.c,v retrieving revision 1.12.2.5 diff -u -r1.12.2.5 inline.c --- src/inline.c 2000/07/09 11:47:38 1.12.2.5 +++ src/inline.c 2000/07/22 19:25:38 @@ -85,6 +85,10 @@ #include "gui-x.h" #endif +#ifdef HAVE_MS_WINDOWS +#include "console-msw.h" +#endif + #ifdef FILE_CODING #include "file-coding.h" #endif Index: src/lisp.h =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/lisp.h,v retrieving revision 1.38.2.71 diff -u -r1.38.2.71 lisp.h --- src/lisp.h 2000/07/21 10:16:51 1.38.2.71 +++ src/lisp.h 2000/07/22 19:25:46 @@ -2967,6 +2967,7 @@ EXFUN (Fkey_description, 1); EXFUN (Fkill_emacs, 1); EXFUN (Fkill_local_variable, 1); +EXFUN (Flast, 2); EXFUN (Flax_plist_get, 3); EXFUN (Flax_plist_remprop, 2); EXFUN (Flength, 1); Index: src/redisplay-msw.c =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/redisplay-msw.c,v retrieving revision 1.28.2.27 diff -u -r1.28.2.27 redisplay-msw.c --- src/redisplay-msw.c 2000/07/11 23:44:33 1.28.2.27 +++ src/redisplay-msw.c 2000/07/22 19:25:49 @@ -974,6 +974,7 @@ static void mswindows_frame_output_end (struct frame *f) { +#ifdef DEFER_WINDOW_POS HDWP hdwp = FRAME_MSWINDOWS_DATA (f)->hdwp; if (hdwp != 0) @@ -981,7 +982,7 @@ EndDeferWindowPos (hdwp); FRAME_MSWINDOWS_DATA (f)->hdwp = 0; } - +#endif GdiFlush(); } @@ -1176,7 +1177,7 @@ if (EQ (XIMAGE_INSTANCE_WIDGET_TYPE (instance), Qlayout)) { - redisplay_output_layout (w, instance, &dbox, &dga, findex, + redisplay_output_layout (window, instance, &dbox, &dga, findex, cursor_start, cursor_width, cursor_height); if (rb->cursor_type == CURSOR_ON) Index: src/redisplay-output.c =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/redisplay-output.c,v retrieving revision 1.11.2.39 diff -u -r1.11.2.39 redisplay-output.c --- src/redisplay-output.c 2000/05/22 09:52:57 1.11.2.39 +++ src/redisplay-output.c 2000/07/22 19:25:54 @@ -260,7 +260,7 @@ WINDOW_FACE_CACHEL_DIRTY (w, drb->findex))) return 0; - /* It is quite common of the two glyphs to be EQ since in many + /* It is quite common for the two glyphs to be EQ since in many 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 @@ -1236,7 +1236,7 @@ /* The first thing we are going to do is update the display characteristics of the subwindow. This also clears the dirty flags as a side effect. */ - update_subwindow (image_instance); + redisplay_subwindow (image_instance); /* This makes the glyph area fit into the display area. */ if (!redisplay_normalize_glyph_area (db, dga)) @@ -1300,23 +1300,21 @@ implemented, Viva la revolution! ****************************************************************************/ void -redisplay_output_layout (struct window *w, +redisplay_output_layout (Lisp_Object domain, Lisp_Object image_instance, struct display_box* db, struct display_glyph_area* dga, face_index findex, int cursor_start, int cursor_width, int cursor_height) { Lisp_Image_Instance *p = XIMAGE_INSTANCE (image_instance); - Lisp_Object window, rest; + Lisp_Object rest, window = DOMAIN_WINDOW (domain); Emchar_dynarr *buf = Dynarr_new (Emchar); - struct frame *f = XFRAME (w->frame); - struct device *d = XDEVICE (f->device); + struct window *w = XWINDOW (window); + struct device *d = DOMAIN_XDEVICE (domain); int layout_height, layout_width; - - XSETWINDOW (window, w); - layout_height = glyph_height (image_instance, window); - layout_width = glyph_width (image_instance, window); + layout_height = glyph_height (image_instance, domain); + layout_width = glyph_width (image_instance, domain); dga->height = layout_height; dga->width = layout_width; @@ -1389,7 +1387,8 @@ /* Flip through the widgets in the layout displaying as necessary */ LIST_LOOP (rest, IMAGE_INSTANCE_LAYOUT_CHILDREN (p)) { - Lisp_Object child = XCAR (rest); + Lisp_Object child = glyph_image_instance (XCAR (rest), image_instance, + ERROR_ME_NOT, 1); struct display_box cdb; /* For losing HP-UX */ @@ -1407,8 +1406,8 @@ struct display_glyph_area cdga; cdga.xoffset = IMAGE_INSTANCE_XOFFSET (childii) - dga->xoffset; cdga.yoffset = IMAGE_INSTANCE_YOFFSET (childii) - dga->yoffset; - cdga.width = glyph_width (child, window); - cdga.height = glyph_height (child, window); + cdga.width = glyph_width (child, image_instance); + cdga.height = glyph_height (child, image_instance); IMAGE_INSTANCE_OPTIMIZE_OUTPUT (childii) = IMAGE_INSTANCE_OPTIMIZE_OUTPUT (p); @@ -1462,9 +1461,9 @@ xzero (dl); /* Munge boxes into display lines. */ dl.ypos = (cdb.ypos - cdga.yoffset) - + glyph_ascent (child, window); - dl.ascent = glyph_ascent (child, window); - dl.descent = glyph_descent (child, window); + + glyph_ascent (child, image_instance); + dl.ascent = glyph_ascent (child, image_instance); + dl.descent = glyph_descent (child, image_instance); dl.top_clip = cdga.yoffset; dl.clip = (dl.ypos + dl.descent) - (cdb.ypos + cdb.height); /* output_string doesn't understand offsets in @@ -1491,7 +1490,7 @@ case IMAGE_WIDGET: if (EQ (IMAGE_INSTANCE_WIDGET_TYPE (childii), Qlayout)) { - redisplay_output_layout (w, child, &cdb, &cdga, findex, + redisplay_output_layout (image_instance, child, &cdb, &cdga, findex, 0, 0, 0); break; } @@ -1517,7 +1516,7 @@ /* Update any display properties. I'm not sure whether this actually does anything for layouts except clear the changed flags. */ - update_subwindow (image_instance); + redisplay_subwindow (image_instance); Dynarr_free (buf); } Index: src/redisplay-x.c =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/redisplay-x.c,v retrieving revision 1.23.2.26 diff -u -r1.23.2.26 redisplay-x.c --- src/redisplay-x.c 2000/05/16 09:08:32 1.23.2.26 +++ src/redisplay-x.c 2000/07/22 19:25:59 @@ -463,7 +463,7 @@ if (EQ (XIMAGE_INSTANCE_WIDGET_TYPE (instance), Qlayout)) { - redisplay_output_layout (w, instance, &dbox, &dga, findex, + redisplay_output_layout (window, instance, &dbox, &dga, findex, cursor_start, cursor_width, cursor_height); break; Index: src/symsinit.h =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/symsinit.h,v retrieving revision 1.31.2.28 diff -u -r1.31.2.28 symsinit.h --- src/symsinit.h 2000/07/21 10:17:22 1.31.2.28 +++ src/symsinit.h 2000/07/22 19:26:00 @@ -155,6 +155,7 @@ void syms_of_eldap (void); void syms_of_postgresql (void); void syms_of_gpmevent (void); +void syms_of_win32 (void); /* Initialize the console types (dump-time but for reinit_). */ Index: src/win32.c =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/Attic/win32.c,v retrieving revision 1.1.2.1 diff -u -r1.1.2.1 win32.c --- src/win32.c 2000/07/21 10:17:27 1.1.2.1 +++ src/win32.c 2000/07/22 19:26:02 @@ -22,27 +22,46 @@ #include "lisp.h" #include "buffer.h" -#include "nt.h" +#include "syswindows.h" -BOOL (WINAPI *xSwitchToThread) (VOID); +typedef BOOL (WINAPI *pfSwitchToThread_t) (VOID); +pfSwitchToThread_t xSwitchToThread; -HKL (WINAPI *xGetKeyboardLayout) (DWORD); -BOOL (WINAPI *xSetMenuDefaultItem) (HMENU, UINT, UINT); -BOOL (WINAPI *xInsertMenuItemA) (HMENU, UINT, BOOL, LPCMENUITEMINFOA); -BOOL (WINAPI *xInsertMenuItemW) (HMENU, UINT, BOOL, LPCMENUITEMINFOW); -HANDLE (WINAPI *xLoadImageA) (HINSTANCE, LPCSTR, UINT, int, int, UINT); -HANDLE (WINAPI *xLoadImageW) (HINSTANCE, LPCWSTR, UINT, int, int, UINT); -ATOM (WINAPI *xRegisterClassExA) (CONST WNDCLASSEXA *); -ATOM (WINAPI *xRegisterClassExW) (CONST WNDCLASSEXW *); - -int (WINAPI *xEnumFontFamiliesExA) (HDC, LPLOGFONTA, FONTENUMPROCA, LPARAM, - DWORD); -int (WINAPI *xEnumFontFamiliesExW) (HDC, LPLOGFONTW, FONTENUMPROCW, LPARAM, - DWORD); +typedef HKL (WINAPI *pfGetKeyboardLayout_t) (DWORD); +pfGetKeyboardLayout_t xGetKeyboardLayout; +typedef BOOL (WINAPI *pfSetMenuDefaultItem_t) (HMENU, UINT, UINT); +pfSetMenuDefaultItem_t xSetMenuDefaultItem; +typedef BOOL (WINAPI *pfInsertMenuItemA_t) + (HMENU, UINT, BOOL, LPCMENUITEMINFOA); +pfInsertMenuItemA_t xInsertMenuItemA; +typedef BOOL (WINAPI *pfInsertMenuItemW_t) + (HMENU, UINT, BOOL, LPCMENUITEMINFOW); +pfInsertMenuItemW_t xInsertMenuItemW; +typedef HANDLE (WINAPI *pfLoadImageA_t) + (HINSTANCE, LPCSTR, UINT, int, int, UINT); +pfLoadImageA_t xLoadImageA; +typedef HANDLE (WINAPI *pfLoadImageW_t) + (HINSTANCE, LPCWSTR, UINT, int, int, UINT); +pfLoadImageW_t xLoadImageW; +typedef ATOM (WINAPI *pfRegisterClassExA_t) (CONST WNDCLASSEXA *); +pfRegisterClassExA_t xRegisterClassExA; +typedef ATOM (WINAPI *pfRegisterClassExW_t) (CONST WNDCLASSEXW *); +pfRegisterClassExW_t xRegisterClassExW; + +typedef int (WINAPI *pfEnumFontFamiliesExA_t) + (HDC, LPLOGFONTA, FONTENUMPROCA, LPARAM, DWORD); +pfEnumFontFamiliesExA_t xEnumFontFamiliesExA; +typedef int (WINAPI *pfEnumFontFamiliesExW_t) + (HDC, LPLOGFONTW, FONTENUMPROCW, LPARAM, DWORD); +pfEnumFontFamiliesExW_t xEnumFontFamiliesExW; + +typedef DWORD (WINAPI *pfSHGetFileInfoA_t) + (LPCSTR, DWORD, SHFILEINFOA FAR *, UINT, UINT); +pfSHGetFileInfoA_t xSHGetFileInfoA; +typedef DWORD (WINAPI *pfSHGetFileInfoW_t) + (LPCWSTR, DWORD, SHFILEINFOW FAR *, UINT, UINT); +pfSHGetFileInfoW_t xSHGetFileInfoW; -DWORD (WINAPI *xSHGetFileInfoA) (LPCSTR, DWORD, SHFILEINFOA FAR *, UINT, UINT); -DWORD (WINAPI *xSHGetFileInfoW) (LPCWSTR, DWORD, SHFILEINFOW FAR *, UINT, UINT); - Lisp_Object tstr_to_local_file_format (Extbyte *pathout) { @@ -66,57 +85,140 @@ if (h_kernel) { xSwitchToThread = - (BOOL (WINAPI *) (VOID)) - GetProcAddress (h_kernel, "SwitchToThread"); + (pfSwitchToThread_t) GetProcAddress (h_kernel, "SwitchToThread"); } if (h_user) { xGetKeyboardLayout = - (HKL (WINAPI *) (DWORD)) - GetProcAddress (h_user, "GetKeyboardLayout"); + (pfGetKeyboardLayout_t) GetProcAddress (h_user, "GetKeyboardLayout"); xSetMenuDefaultItem = - (BOOL (WINAPI *) (HMENU, UINT, UINT)) - GetProcAddress (h_user, "SetMenuDefaultItem"); + (pfSetMenuDefaultItem_t) GetProcAddress (h_user, "SetMenuDefaultItem"); xInsertMenuItemA = - (BOOL (WINAPI *) (HMENU, UINT, BOOL, LPCMENUITEMINFOA)) - GetProcAddress (h_user, "InsertMenuItemA"); + (pfInsertMenuItemA_t) GetProcAddress (h_user, "InsertMenuItemA"); xInsertMenuItemW = - (BOOL (WINAPI *) (HMENU, UINT, BOOL, LPCMENUITEMINFOW)) - GetProcAddress (h_user, "InsertMenuItemW"); + (pfInsertMenuItemW_t) GetProcAddress (h_user, "InsertMenuItemW"); xLoadImageA = - (HANDLE (WINAPI *) (HINSTANCE, LPCSTR, UINT, int, int, UINT)) - GetProcAddress (h_user, "LoadImageA"); + (pfLoadImageA_t) GetProcAddress (h_user, "LoadImageA"); xLoadImageW = - (HANDLE (WINAPI *) (HINSTANCE, LPCWSTR, UINT, int, int, UINT)) - GetProcAddress (h_user, "LoadImageW"); + (pfLoadImageW_t) GetProcAddress (h_user, "LoadImageW"); xRegisterClassExA = - (ATOM (WINAPI *) (CONST WNDCLASSEXA *)) - GetProcAddress (h_user, "RegisterClassExA"); + (pfRegisterClassExA_t) GetProcAddress (h_user, "RegisterClassExA"); xRegisterClassExW = - (ATOM (WINAPI *) (CONST WNDCLASSEXW *)) - GetProcAddress (h_user, "RegisterClassExW"); + (pfRegisterClassExW_t) GetProcAddress (h_user, "RegisterClassExW"); } if (h_gdi) { xEnumFontFamiliesExA = - (int (WINAPI *) (HDC, LPLOGFONTA, FONTENUMPROCA, LPARAM, DWORD)) - GetProcAddress (h_gdi, "EnumFontFamiliesExA"); + (pfEnumFontFamiliesExA_t) GetProcAddress (h_gdi, "EnumFontFamiliesExA"); xEnumFontFamiliesExW = - (int (WINAPI *) (HDC, LPLOGFONTW, FONTENUMPROCW, LPARAM, DWORD)) - GetProcAddress (h_gdi, "EnumFontFamiliesExW"); + (pfEnumFontFamiliesExW_t) GetProcAddress (h_gdi, "EnumFontFamiliesExW"); } if (h_shell) { xSHGetFileInfoA = - (DWORD (WINAPI *) (LPCSTR, DWORD, SHFILEINFOA FAR *, UINT, UINT)) - GetProcAddress (h_shell, "SHGetFileInfoA"); + (pfSHGetFileInfoA_t) GetProcAddress (h_shell, "SHGetFileInfoA"); xSHGetFileInfoW = - (DWORD (WINAPI *) (LPCWSTR, DWORD, SHFILEINFOW FAR *, UINT, UINT)) - GetProcAddress (h_shell, "SHGetFileInfoW"); + (pfSHGetFileInfoW_t) GetProcAddress (h_shell, "SHGetFileInfoW"); + } +} + +DEFUN ("mswindows-shell-execute", Fmswindows_shell_execute, 2, 4, 0, /* +Get Windows to perform OPERATION on DOCUMENT. +This is a wrapper around the ShellExecute system function, which +invokes the application registered to handle OPERATION for DOCUMENT. +OPERATION is typically \"open\", \"print\" or \"explore\" (but can be +nil for the default action), and DOCUMENT is typically the name of a +document file or URL, but can also be a program executable to run or +a directory to open in the Windows Explorer. + +If DOCUMENT is a program executable, PARAMETERS can be a string +containing command line parameters, but otherwise should be nil. + +SHOW-FLAG can be used to control whether the invoked application is hidden +or minimized. If SHOW-FLAG is nil, the application is displayed normally, +otherwise it is an integer representing a ShowWindow flag: + + 0 - start hidden + 1 - start normally + 3 - start maximized + 6 - start minimized +*/ + (operation, document, parameters, show_flag)) +{ + /* Encode filename and current directory. */ + Lisp_Object current_dir = Ffile_name_directory (document); + char* path = NULL; + char* doc = NULL; + Extbyte* f=0; + int ret; + struct gcpro gcpro1, gcpro2; + + CHECK_STRING (document); + + if (NILP (current_dir)) + current_dir = current_buffer->directory; + + GCPRO2 (current_dir, document); + + /* Use mule and cygwin-safe APIs top get at file data. */ + if (STRINGP (current_dir)) + { + TO_EXTERNAL_FORMAT (LISP_STRING, current_dir, + C_STRING_ALLOCA, f, + Qfile_name); +#ifdef CYGWIN + CYGWIN_WIN32_PATH (f, path); +#else + path = f; +#endif } + + if (STRINGP (document)) + { + TO_EXTERNAL_FORMAT (LISP_STRING, document, + C_STRING_ALLOCA, f, + Qfile_name); +#ifdef CYGWIN + CYGWIN_WIN32_PATH (f, doc); +#else + doc = f; +#endif + } + + UNGCPRO; + + ret = (int) ShellExecute (NULL, + (STRINGP (operation) ? + XSTRING_DATA (operation) : NULL), + doc, + (STRINGP (parameters) ? + XSTRING_DATA (parameters) : NULL), + path, + (INTP (show_flag) ? + XINT (show_flag) : SW_SHOWDEFAULT)); + + if (ret > 32) + return Qt; + + if (ret == ERROR_FILE_NOT_FOUND) + signal_simple_error ("file not found", document); + else if (ret == ERROR_PATH_NOT_FOUND) + signal_simple_error ("path not found", current_dir); + else if (ret == ERROR_BAD_FORMAT) + signal_simple_error ("bad executable format", document); + else + error ("internal error"); + + return Qnil; +} + +void +syms_of_win32 (void) +{ + DEFSUBR (Fmswindows_shell_execute); } void Index: src/window.c =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/window.c,v retrieving revision 1.41.2.53 diff -u -r1.41.2.53 window.c --- src/window.c 2000/05/30 11:14:51 1.41.2.53 +++ src/window.c 2000/07/22 19:26:16 @@ -5366,7 +5366,12 @@ /* The subwindow instance cache isn't preserved across window configurations, and in fact doing so would be wrong. We just reset to zero and then redisplay will fill - it up as needed. */ + it up as needed. + + #### This is a bit of a pain for tabs, since for some + reason finding a file will cause the configuration to be + set. We should investigate preserving the cache across + config changes. */ w->subwindow_instance_cache = make_lisp_hash_table (30, HASH_TABLE_KEY_VALUE_WEAK, Index: tests/glyph-test.el =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/tests/Attic/glyph-test.el,v retrieving revision 1.1.2.22 diff -u -r1.1.2.22 glyph-test.el --- tests/glyph-test.el 2000/05/03 14:47:23 1.1.2.22 +++ tests/glyph-test.el 2000/07/22 19:26:17 @@ -1,6 +1,6 @@ (set-extent-begin-glyph (make-extent (point) (point)) - (setq im (make-glyph [xpm :file "xemacs-icon.xpm"]))) + (setq im (make-glyph [xbm :file "xemacsicon.xbm"]))) (set-extent-begin-glyph (make-extent (point) (point)) @@ -16,17 +16,17 @@ (setq ok-select nil) (set-extent-begin-glyph (make-extent (point) (point)) - (setq radio-button1 - (make-glyph + (make-glyph + (setq radio-button1 [button :face widget :descriptor ["ok1" (setq ok-select t) :style radio :selected ok-select]]))) ;; button in a group (set-extent-begin-glyph (make-extent (point) (point)) - (setq radio-button2 - (make-glyph -` [button :descriptor ["ok2" (setq ok-select nil) :style radio + (make-glyph + (setq radio-button2 + [button :descriptor ["ok2" (setq ok-select nil) :style radio :selected (not ok-select)]]))) ;; toggle button (set-extent-begin-glyph @@ -37,11 +37,12 @@ :selected (not ok-select)]]))) (set-extent-begin-glyph (make-extent (point) (point)) - (setq toggle-button - (make-glyph [button :descriptor ["ok4" :style toggle - :callback - (setq ok-select (not ok-select)) - :selected ok-select]]))) + (make-glyph + (setq toggle-button + [button :descriptor ["ok4" :style toggle + :callback + (setq ok-select (not ok-select)) + :selected ok-select]]))) ;; normal pushbutton (set-extent-begin-glyph @@ -78,12 +79,13 @@ (set-extent-begin-glyph (make-extent (point) (point)) (setq pgauge (make-glyph - [progress-gauge :width 10 :height 2 + [progress-gauge :width 10 :height 2 :value 0 :descriptor "ok"]))) ;; progress the progress ... (let ((x 0)) (while (<= x 100) - (set-image-instance-property (glyph-image-instance pgauge) :value x) + (set-glyph-image pgauge `[progress-gauge :width 10 :height 2 + :descriptor "ok" :value ,x]) (setq x (+ x 5)) (sit-for 0.1))) @@ -96,7 +98,9 @@ ;; progress the progress ... (let ((x 0)) (while (<= x 100) - (set-image-instance-property (glyph-image-instance pg) :value x) + (set-glyph-image pg + `[progress-gauge :width 5 :pixel-height 16 + :descriptor "ok" :value ,x]) (setq x (+ x 5)) (sit-for 0.1))) @@ -116,25 +120,27 @@ ;; edit box (set-extent-begin-glyph (make-extent (point) (point)) - (setq edit-field (make-glyph [edit-field :pixel-width 50 :pixel-height 30 + (make-glyph (setq edit-field [edit-field :pixel-width 50 :pixel-height 30 :face bold-italic :descriptor ["Hello"]]))) ;; combo box (set-extent-begin-glyph (make-extent (point) (point)) - (setq combo-box (make-glyph - [combo-box :width 10 :descriptor ["Hello"] - :properties (:items ("One" "Two" "Three"))]))) + (make-glyph (setq combo-box + [combo-box :width 10 :descriptor ["Hello"] + :properties (:items ("One" "Two" "Three"))]))) ;; label (set-extent-begin-glyph (make-extent (point) (point)) - (setq label (make-glyph [label :pixel-width 150 :descriptor "Hello"]))) + (make-glyph (setq label [label :pixel-width 150 :descriptor "Hello"]))) ;; string (set-extent-begin-glyph (make-extent (point) (point)) - (setq str (make-glyph [string :data "Hello There"]))) + (make-glyph + (setq str + [string :data "Hello There"]))) ;; scrollbar ;(set-extent-begin-glyph @@ -148,16 +154,32 @@ ;; layout (setq layout (make-glyph - [layout :descriptor "The Layout" - :orientation vertical - :justify left - :border [string :data "Hello There Mrs"] - :items ([native-layout :orientation horizontal - :items (radio-button1 radio-button2)] - edit-field toggle-button label str)])) -(set-glyph-face layout 'gui-element) + `[layout :descriptor "The Layout" + :orientation vertical + :justify left + :border [string :data "Hello There Mrs"] + :items ([layout :orientation horizontal + :items (,radio-button1 ,radio-button2)] + ,edit-field ,toggle-button ,label ,str)])) +;(set-glyph-face layout 'gui-element) (set-extent-begin-glyph (make-extent (point) (point)) layout) + +;; another test layout +(setq pgauge-2 (make-glyph + [progress-gauge :value 0 :width 10 :height 2 + :descriptor "ok"])) +(setq layout-2 + (make-glyph `[layout :descriptor "The Layout" + :orientation vertical + :items (,pgauge-2)])) +(set-extent-begin-glyph + (make-extent (point) (point)) layout-2) +(set-glyph-image pgauge-2 [progress-gauge :value 4 :width 10 :height 2 + :descriptor "ok"]) +(set-glyph-image layout-2 `[layout :descriptor "The Layout" + :orientation vertical + :items (,pgauge-2)]) (setq test-toggle-widget nil) Index: tests/gutter-test.el =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/tests/Attic/gutter-test.el,v retrieving revision 1.1.2.5 diff -u -r1.1.2.5 gutter-test.el --- tests/gutter-test.el 2000/03/07 09:24:32 1.1.2.5 +++ tests/gutter-test.el 2000/07/22 19:26:17 @@ -17,7 +17,23 @@ (set-specifier bottom-gutter-height 'autodetect) (set-specifier bottom-gutter-border-width 2) -(set-gutter-element bottom-gutter 'str str) + +(set-gutter-element + bottom-gutter 'str + (make-glyph + [layout :orientation vertical + :justify left :margin-width 4 + :items ([string :data "Fontifying glyphs.c..."] + [layout :orientation horizontal + :items + ([progress-gauge :value 0 :pixel-height 24 + :pixel-width 250 :descriptor + "Progress"] + [button :pixel-height 24 + :descriptor " Stop " + :callback (quote quit)])])])) + (set-gutter-element bottom-gutter 'str2 str2) (set-gutter-element-visible-p bottom-gutter-visible-p 'str t) (set-gutter-element-visible-p bottom-gutter-visible-p 'str2 t) +