+/* widgets */
+/************************************************************************/
+static void
+mswindows_widget_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
+ Lisp_Object pointer_fg, Lisp_Object pointer_bg,
+ int dest_mask, Lisp_Object domain,
+ CONST char* class, int flags, int exflags)
+{
+ struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
+#if 0
+ struct Lisp_Image_Instance *groupii = 0;
+ Lisp_Object group = find_keyword_in_vector (instantiator, Q_group);
+#endif
+ Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii), style;
+ struct device* d = XDEVICE (device);
+ Lisp_Object frame = FW_FRAME (domain);
+ Extbyte* nm=0;
+ HWND wnd;
+ int id = 0xffff;
+ Lisp_Object gui = IMAGE_INSTANCE_WIDGET_ITEM (ii);
+ struct Lisp_Gui_Item* pgui = XGUI_ITEM (gui);
+
+ if (!DEVICE_MSWINDOWS_P (d))
+ signal_simple_error ("Not an mswindows device", device);
+#if 0
+ /* if the user specified another glyph as a group pick up the
+ instance in our domain. */
+ if (!NILP (group))
+ {
+ if (SYMBOLP (group))
+ group = XSYMBOL (group)->value;
+ group = glyph_image_instance (group, domain, ERROR_ME, 1);
+ groupii = XIMAGE_INSTANCE (group);
+ }
+#endif
+ if (!gui_item_active_p (gui))
+ flags |= WS_DISABLED;
+
+ style = pgui->style;
+
+ if (!NILP (pgui->callback))
+ {
+ id = mswindows_register_widget_instance (image_instance, domain);
+ }
+ /* have to set the type this late in case there is no device
+ instantiation for a widget */
+ IMAGE_INSTANCE_TYPE (ii) = IMAGE_WIDGET;
+ if (!NILP (IMAGE_INSTANCE_WIDGET_TEXT (ii)))
+ GET_C_STRING_OS_DATA_ALLOCA (IMAGE_INSTANCE_WIDGET_TEXT (ii), nm);
+
+ wnd = CreateWindowEx(
+ exflags /* | WS_EX_NOPARENTNOTIFY*/,
+ class,
+ nm,
+ flags | WS_CHILD,
+ 0, /* starting x position */
+ 0, /* starting y position */
+ IMAGE_INSTANCE_WIDGET_WIDTH (ii),
+ IMAGE_INSTANCE_WIDGET_HEIGHT (ii),
+ /* parent window */
+ FRAME_MSWINDOWS_HANDLE (XFRAME (frame)),
+ (HMENU)id, /* No menu */
+ (HINSTANCE)
+ GetWindowLong (FRAME_MSWINDOWS_HANDLE (XFRAME (frame)),
+ GWL_HINSTANCE),
+ NULL);
+
+ IMAGE_INSTANCE_SUBWINDOW_ID (ii) = wnd;
+ SetWindowLong (wnd, GWL_USERDATA, (LONG)LISP_TO_VOID(image_instance));
+ /* set the widget font from the widget face */
+ SendMessage (wnd, WM_SETFONT,
+ (WPARAM)FONT_INSTANCE_MSWINDOWS_HFONT
+ (XFONT_INSTANCE (widget_face_font_info
+ (domain,
+ IMAGE_INSTANCE_WIDGET_FACE (ii),
+ 0, 0))),
+ MAKELPARAM (TRUE, 0));
+}
+
+/* Instantiate a button widget. Unfortunately instantiated widgets are
+ particular to a frame since they need to have a parent. It's not
+ like images where you just select the image into the context you
+ want to display it in and BitBlt it. So images instances can have a
+ many-to-one relationship with things you see, whereas widgets can
+ only be one-to-one (i.e. per frame) */
+static void
+mswindows_button_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
+ Lisp_Object pointer_fg, Lisp_Object pointer_bg,
+ int dest_mask, Lisp_Object domain)
+{
+ struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
+ HWND wnd;
+ int flags = BS_NOTIFY;
+ Lisp_Object style;
+ Lisp_Object gui = IMAGE_INSTANCE_WIDGET_ITEM (ii);
+ struct Lisp_Gui_Item* pgui = XGUI_ITEM (gui);
+ Lisp_Object glyph = find_keyword_in_vector (instantiator, Q_image);
+
+ if (!gui_item_active_p (gui))
+ flags |= WS_DISABLED;
+
+ if (!NILP (glyph))
+ {
+ if (!IMAGE_INSTANCEP (glyph))
+ glyph = glyph_image_instance (glyph, domain, ERROR_ME, 1);
+
+ if (IMAGE_INSTANCEP (glyph))
+ flags |= XIMAGE_INSTANCE_MSWINDOWS_BITMAP (glyph) ?
+ BS_BITMAP : BS_ICON;
+ }
+
+ style = pgui->style;
+
+ if (EQ (style, Qradio))
+ {
+ flags |= BS_RADIOBUTTON;
+ }
+ else if (EQ (style, Qtoggle))
+ {
+ flags |= BS_AUTOCHECKBOX;
+ }
+ else
+ flags |= BS_DEFPUSHBUTTON;
+
+ mswindows_widget_instantiate (image_instance, instantiator, pointer_fg,
+ pointer_bg, dest_mask, domain, "BUTTON", flags,
+ WS_EX_CONTROLPARENT);
+
+ wnd = WIDGET_INSTANCE_MSWINDOWS_HANDLE (ii);
+ /* set the checked state */
+ if (gui_item_selected_p (gui))
+ SendMessage (wnd, BM_SETCHECK, (WPARAM)BST_CHECKED, 0);
+ else
+ SendMessage (wnd, BM_SETCHECK, (WPARAM)BST_UNCHECKED, 0);
+ /* add the image if one was given */
+ if (!NILP (glyph) && IMAGE_INSTANCEP (glyph))
+ {
+ SendMessage (wnd, BM_SETIMAGE,
+ (WPARAM) (XIMAGE_INSTANCE_MSWINDOWS_BITMAP (glyph) ?
+ IMAGE_BITMAP : IMAGE_ICON),
+ (LPARAM) (XIMAGE_INSTANCE_MSWINDOWS_BITMAP (glyph) ?
+ XIMAGE_INSTANCE_MSWINDOWS_BITMAP (glyph) :
+ XIMAGE_INSTANCE_MSWINDOWS_ICON (glyph)));
+ }
+}
+
+/* instantiate an edit control */
+static void
+mswindows_edit_field_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
+ Lisp_Object pointer_fg, Lisp_Object pointer_bg,
+ int dest_mask, Lisp_Object domain)
+{
+ mswindows_widget_instantiate (image_instance, instantiator, pointer_fg,
+ pointer_bg, dest_mask, domain, "EDIT",
+ ES_LEFT | ES_AUTOHSCROLL | WS_TABSTOP
+ | WS_BORDER,
+ WS_EX_CLIENTEDGE | WS_EX_CONTROLPARENT);
+}
+
+/* instantiate a progress gauge */
+static void
+mswindows_progress_gauge_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
+ Lisp_Object pointer_fg, Lisp_Object pointer_bg,
+ int dest_mask, Lisp_Object domain)
+{
+ HWND wnd;
+ struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
+ mswindows_widget_instantiate (image_instance, instantiator, pointer_fg,
+ pointer_bg, dest_mask, domain, PROGRESS_CLASS,
+ WS_TABSTOP | WS_BORDER | PBS_SMOOTH,
+ WS_EX_CLIENTEDGE | WS_EX_CONTROLPARENT);
+ wnd = WIDGET_INSTANCE_MSWINDOWS_HANDLE (ii);
+ /* set the colors */
+#ifdef PBS_SETBKCOLOR
+ SendMessage (wnd, PBS_SETBKCOLOR, 0,
+ (LPARAM) (COLOR_INSTANCE_MSWINDOWS_COLOR
+ (XCOLOR_INSTANCE
+ (FACE_BACKGROUND
+ (XIMAGE_INSTANCE_WIDGET_FACE (ii),
+ XIMAGE_INSTANCE_SUBWINDOW_FRAME (ii))))));
+#endif
+#ifdef PBS_SETBARCOLOR
+ SendMessage (wnd, PBS_SETBARCOLOR, 0,
+ (L:PARAM) (COLOR_INSTANCE_MSWINDOWS_COLOR
+ (XCOLOR_INSTANCE
+ (FACE_FOREGROUND
+ (XIMAGE_INSTANCE_WIDGET_FACE (ii),
+ XIMAGE_INSTANCE_SUBWINDOW_FRAME (ii))))));
+#endif
+}
+
+/* instantiate a tree view widget */
+static HTREEITEM add_tree_item (Lisp_Object image_instance,
+ HWND wnd, HTREEITEM parent, Lisp_Object entry,
+ int children, Lisp_Object domain)
+{
+ TV_INSERTSTRUCT tvitem;
+ HTREEITEM ret;
+
+ tvitem.hParent = parent;
+ tvitem.hInsertAfter = TVI_LAST;
+ tvitem.item.mask = TVIF_TEXT | TVIF_CHILDREN;
+ tvitem.item.cChildren = children;
+
+ if (VECTORP (entry))
+ {
+ /* we always maintain the real gui item at the head of the
+ list. We have to put them in the list in the first place
+ because the whole model assumes that the glyph instances have
+ references to all the associated data. If we didn't do this
+ GC would bite us badly. */
+ Lisp_Object gui = gui_parse_item_keywords_no_errors (entry);
+ if (CONSP (XIMAGE_INSTANCE_WIDGET_ITEM (image_instance)))
+ {
+ Lisp_Object rest =
+ Fcons (gui, XCDR (XIMAGE_INSTANCE_WIDGET_ITEM (image_instance)));
+ Fsetcdr (XIMAGE_INSTANCE_WIDGET_ITEM (image_instance), rest);
+ }
+ else
+ {
+ XIMAGE_INSTANCE_WIDGET_ITEM (image_instance) =
+ Fcons (XIMAGE_INSTANCE_WIDGET_ITEM (image_instance), gui);
+ }
+
+ tvitem.item.lParam = mswindows_register_gui_item (gui, domain);
+ tvitem.item.mask |= TVIF_PARAM;
+ GET_C_STRING_OS_DATA_ALLOCA (XGUI_ITEM (gui)->name,
+ tvitem.item.pszText);
+ }
+ else
+ GET_C_STRING_OS_DATA_ALLOCA (entry, tvitem.item.pszText);
+
+ tvitem.item.cchTextMax = strlen (tvitem.item.pszText);
+
+ if ((ret = (HTREEITEM)SendMessage (wnd, TVM_INSERTITEM,
+ 0, (LPARAM)&tvitem)) == 0)
+ signal_simple_error ("error adding tree view entry", entry);
+
+ return ret;
+}
+
+static void add_tree_item_list (Lisp_Object image_instance,
+ HWND wnd, HTREEITEM parent, Lisp_Object list,
+ Lisp_Object domain)
+{
+ Lisp_Object rest;
+
+ /* get the first item */
+ parent = add_tree_item (image_instance, wnd, parent, XCAR (list), TRUE, domain);
+ /* recursively add items to the tree view */
+ LIST_LOOP (rest, XCDR (list))
+ {
+ if (LISTP (XCAR (rest)))
+ add_tree_item_list (image_instance, wnd, parent, XCAR (rest), domain);
+ else
+ add_tree_item (image_instance, wnd, parent, XCAR (rest), FALSE, domain);
+ }
+}
+
+static void
+mswindows_tree_view_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
+ Lisp_Object pointer_fg, Lisp_Object pointer_bg,
+ int dest_mask, Lisp_Object domain)
+{
+ Lisp_Object rest;
+ HWND wnd;
+ HTREEITEM parent;
+ struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
+ mswindows_widget_instantiate (image_instance, instantiator, pointer_fg,
+ pointer_bg, dest_mask, domain, WC_TREEVIEW,
+ WS_TABSTOP | WS_BORDER | PBS_SMOOTH
+ | TVS_HASLINES | TVS_HASBUTTONS,
+ WS_EX_CLIENTEDGE | WS_EX_CONTROLPARENT);
+
+ wnd = WIDGET_INSTANCE_MSWINDOWS_HANDLE (ii);
+
+ /* define a root */
+ parent = add_tree_item (image_instance,
+ wnd, NULL, IMAGE_INSTANCE_WIDGET_TEXT (ii), TRUE,
+ domain);
+
+ /* recursively add items to the tree view */
+ LIST_LOOP (rest, Fplist_get (IMAGE_INSTANCE_WIDGET_PROPS (ii), Q_items, Qnil))
+ {
+ if (LISTP (XCAR (rest)))
+ add_tree_item_list (image_instance, wnd, parent, XCAR (rest), domain);
+ else
+ add_tree_item (image_instance, wnd, parent, XCAR (rest), FALSE, domain);
+ }
+}
+
+/* instantiate a tab control */
+static TC_ITEM* add_tab_item (Lisp_Object image_instance,
+ HWND wnd, Lisp_Object entry,
+ Lisp_Object domain, int index)
+{
+ TC_ITEM tvitem, *ret;
+
+ tvitem.mask = TCIF_TEXT;
+
+ if (VECTORP (entry))
+ {
+ /* we always maintain the real gui item at the head of the
+ list. We have to put them in the list in the first place
+ because the whole model assumes that the glyph instances have
+ references to all the associated data. If we didn't do this
+ GC would bite us badly. */
+ Lisp_Object gui = gui_parse_item_keywords_no_errors (entry);
+ if (CONSP (XIMAGE_INSTANCE_WIDGET_ITEM (image_instance)))
+ {
+ Lisp_Object rest =
+ Fcons (gui, XCDR (XIMAGE_INSTANCE_WIDGET_ITEM (image_instance)));
+ Fsetcdr (XIMAGE_INSTANCE_WIDGET_ITEM (image_instance), rest);
+ }
+ else
+ {
+ XIMAGE_INSTANCE_WIDGET_ITEM (image_instance) =
+ Fcons (XIMAGE_INSTANCE_WIDGET_ITEM (image_instance), gui);
+ }
+
+ tvitem.lParam = mswindows_register_gui_item (gui, domain);
+ tvitem.mask |= TCIF_PARAM;
+ GET_C_STRING_OS_DATA_ALLOCA (XGUI_ITEM (gui)->name,
+ tvitem.pszText);
+ }
+ else
+ GET_C_STRING_OS_DATA_ALLOCA (entry, tvitem.pszText);
+
+ tvitem.cchTextMax = strlen (tvitem.pszText);
+
+ if ((ret = (TC_ITEM*)SendMessage (wnd, TCM_INSERTITEM,
+ index, (LPARAM)&tvitem)) < 0)
+ signal_simple_error ("error adding tab entry", entry);
+
+ return ret;
+}
+
+static void
+mswindows_tab_control_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
+ Lisp_Object pointer_fg, Lisp_Object pointer_bg,
+ int dest_mask, Lisp_Object domain)
+{
+ Lisp_Object rest;
+ HWND wnd;
+ int index = 0;
+ struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
+ mswindows_widget_instantiate (image_instance, instantiator, pointer_fg,
+ pointer_bg, dest_mask, domain, WC_TABCONTROL,
+ /* borders don't suit tabs so well */
+ WS_TABSTOP,
+ WS_EX_CONTROLPARENT);
+
+ wnd = WIDGET_INSTANCE_MSWINDOWS_HANDLE (ii);
+ /* add items to the tab */
+ LIST_LOOP (rest, Fplist_get (IMAGE_INSTANCE_WIDGET_PROPS (ii), Q_items, Qnil))
+ {
+ add_tab_item (image_instance, wnd, XCAR (rest), domain, index);
+ index++;
+ }
+}
+
+/* set the properties of a tab control */
+static Lisp_Object
+mswindows_tab_control_set_property (Lisp_Object image_instance, Lisp_Object prop,
+ Lisp_Object val)
+{
+ struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
+
+ if (EQ (prop, Q_items))
+ {
+ HWND wnd = WIDGET_INSTANCE_MSWINDOWS_HANDLE (ii);
+ int index = 0;
+ Lisp_Object rest;
+ check_valid_item_list_1 (val);
+
+ /* delete the pre-existing items */
+ SendMessage (wnd, TCM_DELETEALLITEMS, 0, 0);
+
+ /* add items to the tab */
+ LIST_LOOP (rest, val)
+ {
+ add_tab_item (image_instance, wnd, XCAR (rest),
+ IMAGE_INSTANCE_SUBWINDOW_FRAME (ii), index);
+ index++;
+ }
+
+ return Qt;
+ }
+ return Qunbound;
+}
+
+/* instantiate a static control possible for putting other things in */
+static void
+mswindows_label_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
+ Lisp_Object pointer_fg, Lisp_Object pointer_bg,
+ int dest_mask, Lisp_Object domain)
+{
+ mswindows_widget_instantiate (image_instance, instantiator, pointer_fg,
+ pointer_bg, dest_mask, domain, "STATIC",
+ 0, WS_EX_STATICEDGE);
+}
+
+#if 0
+/* instantiate a static control possible for putting other things in */
+static void
+mswindows_group_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
+ Lisp_Object pointer_fg, Lisp_Object pointer_bg,
+ int dest_mask, Lisp_Object domain)
+{
+ mswindows_widget_instantiate (image_instance, instantiator, pointer_fg,
+ pointer_bg, dest_mask, domain, "BUTTON",
+ WS_GROUP | BS_GROUPBOX | WS_BORDER,
+ WS_EX_CLIENTEDGE );
+}
+#endif
+
+/* instantiate a scrollbar control */
+static void
+mswindows_scrollbar_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
+ Lisp_Object pointer_fg, Lisp_Object pointer_bg,
+ int dest_mask, Lisp_Object domain)
+{
+ mswindows_widget_instantiate (image_instance, instantiator, pointer_fg,
+ pointer_bg, dest_mask, domain, "SCROLLBAR",
+ 0,
+ WS_EX_CLIENTEDGE );
+}
+
+/* instantiate a combo control */
+static void
+mswindows_combo_box_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
+ Lisp_Object pointer_fg, Lisp_Object pointer_bg,
+ int dest_mask, Lisp_Object domain)
+{
+ struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
+ HANDLE wnd;
+ Lisp_Object rest;
+
+ /* Maybe ought to generalise this more but it may be very windows
+ specific. In windows the window height of a combo box is the
+ height when the combo box is open. Thus we need to set the height
+ before creating the window and then reset it to a single line
+ after the window is created so that redisplay does the right
+ thing. */
+ mswindows_widget_instantiate (image_instance, instantiator, pointer_fg,
+ pointer_bg, dest_mask, domain, "COMBOBOX",
+ WS_BORDER | WS_TABSTOP | CBS_DROPDOWN
+ | CBS_AUTOHSCROLL
+ | CBS_HASSTRINGS | WS_VSCROLL,
+ WS_EX_CLIENTEDGE | WS_EX_CONTROLPARENT);
+ /* reset the height */
+ widget_text_to_pixel_conversion (domain,
+ IMAGE_INSTANCE_WIDGET_FACE (ii), 1, 0,
+ &IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii), 0);
+ wnd = WIDGET_INSTANCE_MSWINDOWS_HANDLE (ii);
+ /* add items to the combo box */
+ SendMessage (wnd, CB_RESETCONTENT, 0, 0);
+ LIST_LOOP (rest, Fplist_get (IMAGE_INSTANCE_WIDGET_PROPS (ii), Q_items, Qnil))
+ {
+ Extbyte* lparam;
+ GET_C_STRING_OS_DATA_ALLOCA (XCAR (rest), lparam);
+ if (SendMessage (wnd, CB_ADDSTRING, 0, (LPARAM)lparam) == CB_ERR)
+ signal_simple_error ("error adding combo entries", instantiator);
+ }
+}
+
+/* get properties of a control */
+static Lisp_Object
+mswindows_widget_property (Lisp_Object image_instance, Lisp_Object prop)
+{
+ struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
+ HANDLE wnd = WIDGET_INSTANCE_MSWINDOWS_HANDLE (ii);
+ /* get the text from a control */
+ if (EQ (prop, Q_text))
+ {
+ Extcount len = SendMessage (wnd, WM_GETTEXTLENGTH, 0, 0);
+ Extbyte* buf =alloca (len+1);
+
+ SendMessage (wnd, WM_GETTEXT, (WPARAM)len+1, (LPARAM) buf);
+ return build_ext_string (buf, FORMAT_OS);
+ }
+ return Qunbound;
+}
+
+/* get properties of a button */
+static Lisp_Object
+mswindows_button_property (Lisp_Object image_instance, Lisp_Object prop)
+{
+ struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
+ HANDLE wnd = WIDGET_INSTANCE_MSWINDOWS_HANDLE (ii);
+ /* check the state of a button */
+ if (EQ (prop, Q_selected))
+ {
+ if (SendMessage (wnd, BM_GETSTATE, 0, 0) & BST_CHECKED)
+ return Qt;
+ else
+ return Qnil;
+ }
+ return Qunbound;
+}
+
+/* get properties of a combo box */
+static Lisp_Object
+mswindows_combo_box_property (Lisp_Object image_instance, Lisp_Object prop)
+{
+ struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
+ HANDLE wnd = WIDGET_INSTANCE_MSWINDOWS_HANDLE (ii);
+ /* get the text from a control */
+ if (EQ (prop, Q_text))
+ {
+ long item = SendMessage (wnd, CB_GETCURSEL, 0, 0);
+ Extcount len = SendMessage (wnd, CB_GETLBTEXTLEN, (WPARAM)item, 0);
+ Extbyte* buf = alloca (len+1);
+ SendMessage (wnd, CB_GETLBTEXT, (WPARAM)item, (LPARAM)buf);
+ return build_ext_string (buf, FORMAT_OS);
+ }
+ return Qunbound;
+}
+
+/* set the properties of a control */
+static Lisp_Object
+mswindows_widget_set_property (Lisp_Object image_instance, Lisp_Object prop,
+ Lisp_Object val)
+{
+ struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
+
+ if (EQ (prop, Q_text))
+ {
+ Extbyte* lparam=0;
+ CHECK_STRING (val);
+ GET_C_STRING_OS_DATA_ALLOCA (val, lparam);
+ SendMessage (WIDGET_INSTANCE_MSWINDOWS_HANDLE (ii),
+ WM_SETTEXT, 0, (LPARAM)lparam);
+ return Qt;
+ }
+ return Qunbound;
+}
+
+/* set the properties of a progres guage */
+static Lisp_Object
+mswindows_progress_gauge_set_property (Lisp_Object image_instance, Lisp_Object prop,
+ Lisp_Object val)
+{
+ struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
+
+ if (EQ (prop, Q_percent))
+ {
+ CHECK_INT (val);
+ SendMessage (WIDGET_INSTANCE_MSWINDOWS_HANDLE (ii),
+ PBM_SETPOS, (WPARAM)XINT (val), 0);
+ return Qt;
+ }
+ return Qunbound;
+}
+
+\f
+/************************************************************************/