+#ifdef HAVE_WIDGETS
+
+/************************************************************************/
+/* widgets */
+/************************************************************************/
+
+static void
+update_widget_face (widget_value* wv, struct Lisp_Image_Instance *ii,
+ Lisp_Object domain)
+{
+#ifdef LWLIB_WIDGETS_MOTIF
+ XmFontList fontList;
+#endif
+
+ Lisp_Object pixel = FACE_FOREGROUND
+ (IMAGE_INSTANCE_WIDGET_FACE (ii),
+ domain);
+ XColor fcolor = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (pixel));
+
+ lw_add_widget_value_arg (wv, XtNforeground, fcolor.pixel);
+#ifdef LWLIB_WIDGETS_MOTIF
+ fontList = XmFontListCreate
+ (FONT_INSTANCE_X_FONT
+ (XFONT_INSTANCE (widget_face_font_info
+ (domain,
+ IMAGE_INSTANCE_WIDGET_FACE (ii),
+ 0, 0))), XmSTRING_DEFAULT_CHARSET);
+ lw_add_widget_value_arg (wv, XmNfontList, (XtArgVal)fontList);
+#endif
+ lw_add_widget_value_arg
+ (wv, XtNfont, (XtArgVal)FONT_INSTANCE_X_FONT
+ (XFONT_INSTANCE (widget_face_font_info
+ (domain,
+ IMAGE_INSTANCE_WIDGET_FACE (ii),
+ 0, 0))));
+}
+
+static void
+update_tab_widget_face (widget_value* wv, struct Lisp_Image_Instance *ii,
+ Lisp_Object domain)
+{
+ if (wv->contents)
+ {
+ widget_value* val = wv->contents, *cur;
+
+ /* Give each child label the correct foreground color. */
+ Lisp_Object pixel = FACE_FOREGROUND
+ (IMAGE_INSTANCE_WIDGET_FACE (ii),
+ domain);
+ XColor fcolor = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (pixel));
+ lw_add_widget_value_arg (val, XtNtabForeground, fcolor.pixel);
+
+ for (cur = val->next; cur; cur = cur->next)
+ {
+ if (cur->value)
+ {
+ lw_copy_widget_value_args (val, cur);
+ }
+ }
+ }
+}
+
+static void
+x_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* type, widget_value* wv)
+{
+ struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
+ Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii), pixel;
+ struct device* d = XDEVICE (device);
+ Lisp_Object frame = FW_FRAME (domain);
+ struct frame* f = XFRAME (frame);
+ char* nm=0;
+ Widget wid;
+ Arg al [32];
+ int ac = 0;
+ int id = new_lwlib_id ();
+ widget_value* clip_wv;
+ XColor fcolor, bcolor;
+
+ if (!DEVICE_X_P (d))
+ signal_simple_error ("Not an X device", device);
+
+ /* have to set the type this late in case there is no device
+ instantiation for a widget. But we can go ahead and do it without
+ checking because there is always a generic instantiator. */
+ 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);
+
+ ii->data = xnew_and_zero (struct x_subwindow_data);
+
+ /* Create a clip window to contain the subwidget. Incredibly the
+ XEmacs manager seems to be the most appropriate widget for
+ this. Nothing else is simple enough and yet does what is
+ required. */
+ clip_wv = xmalloc_widget_value ();
+
+ lw_add_widget_value_arg (clip_wv, XtNresize, False);
+ lw_add_widget_value_arg (clip_wv, XtNwidth,
+ (Dimension)IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii));
+ lw_add_widget_value_arg (clip_wv, XtNheight,
+ (Dimension)IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii));
+ clip_wv->enabled = True;
+
+ clip_wv->name = xstrdup ("clip-window");
+ clip_wv->value = xstrdup ("clip-window");
+
+ IMAGE_INSTANCE_X_CLIPWIDGET (ii)
+ = lw_create_widget ("clip-window", "clip-window", new_lwlib_id (),
+ clip_wv, FRAME_X_CONTAINER_WIDGET (f),
+ False, 0, 0, 0);
+
+ free_widget_value_tree (clip_wv);
+
+ /* copy any args we were given */
+ ac = 0;
+ lw_add_value_args_to_args (wv, al, &ac);
+
+ /* Fixup the colors. We have to do this *before* the widget gets
+ created so that Motif will fix up the shadow colors
+ correctly. Once the widget is created Motif won't do this
+ anymore...*/
+ pixel = FACE_FOREGROUND
+ (IMAGE_INSTANCE_WIDGET_FACE (ii),
+ IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
+ fcolor = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (pixel));
+
+ pixel = FACE_BACKGROUND
+ (IMAGE_INSTANCE_WIDGET_FACE (ii),
+ IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
+ bcolor = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (pixel));
+
+ lw_add_widget_value_arg (wv, XtNbackground, bcolor.pixel);
+ lw_add_widget_value_arg (wv, XtNforeground, fcolor.pixel);
+ /* we cannot allow widgets to resize themselves */
+ lw_add_widget_value_arg (wv, XtNresize, False);
+ lw_add_widget_value_arg (wv, XtNwidth,
+ (Dimension)IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii));
+ lw_add_widget_value_arg (wv, XtNheight,
+ (Dimension)IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii));
+ /* update the font. */
+ update_widget_face (wv, ii, domain);
+
+ wid = lw_create_widget (type, wv->name, id, wv, IMAGE_INSTANCE_X_CLIPWIDGET (ii),
+ False, 0, popup_selection_callback, 0);
+
+ IMAGE_INSTANCE_SUBWINDOW_ID (ii) = (void*)wid;
+ IMAGE_INSTANCE_X_WIDGET_LWID (ii) = id;
+
+ /* Resize the widget here so that the values do not get copied by
+ lwlib. */
+ ac = 0;
+ XtSetArg (al [ac], XtNwidth,
+ (Dimension)IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii)); ac++;
+ XtSetArg (al [ac], XtNheight,
+ (Dimension)IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii)); ac++;
+ XtSetValues (IMAGE_INSTANCE_X_WIDGET_ID (ii), al, ac);
+ /* because the EmacsManager is the widgets parent we have to
+ offset the redisplay of the widget by the amount the text
+ widget is inside the manager. */
+ ac = 0;
+ XtSetArg (al [ac], XtNx, &IMAGE_INSTANCE_X_WIDGET_XOFFSET (ii)); ac++;
+ XtSetArg (al [ac], XtNy, &IMAGE_INSTANCE_X_WIDGET_YOFFSET (ii)); ac++;
+ XtGetValues (FRAME_X_TEXT_WIDGET (f), al, ac);
+
+ XtMapWidget (wid);
+
+ free_widget_value_tree (wv);
+}
+
+static Lisp_Object
+x_widget_set_property (Lisp_Object image_instance, Lisp_Object prop,
+ Lisp_Object val)
+{
+ struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
+
+ /* Modify the text properties of the widget */
+ if (EQ (prop, Q_text))
+ {
+ char* str;
+ widget_value* wv = lw_get_all_values (IMAGE_INSTANCE_X_WIDGET_LWID (ii));
+ CHECK_STRING (val);
+ GET_C_STRING_OS_DATA_ALLOCA (val, str);
+ wv->value = str;
+ lw_modify_all_widgets (IMAGE_INSTANCE_X_WIDGET_LWID (ii), wv, False);
+ return Qt;
+ }
+
+ /* Modify the text properties of the widget */
+ else if (EQ (prop, Q_face))
+ {
+ widget_value* wv = lw_get_all_values (IMAGE_INSTANCE_X_WIDGET_LWID (ii));
+ update_widget_face (wv, ii, IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
+ lw_modify_all_widgets (IMAGE_INSTANCE_X_WIDGET_LWID (ii), wv, False);
+ return Qt;
+ }
+ return Qunbound;
+}
+
+/* get properties of a control */
+static Lisp_Object
+x_widget_property (Lisp_Object image_instance, Lisp_Object prop)
+{
+ struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
+ /* get the text from a control */
+ if (EQ (prop, Q_text))
+ {
+ widget_value* wv = lw_get_all_values (IMAGE_INSTANCE_X_WIDGET_LWID (ii));
+ return build_ext_string (wv->value, FORMAT_OS);
+ }
+ return Qunbound;
+}
+
+/* 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
+x_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);
+ Lisp_Object gui = IMAGE_INSTANCE_WIDGET_ITEM (ii);
+ Lisp_Object glyph = find_keyword_in_vector (instantiator, Q_image);
+ widget_value* wv = xmalloc_widget_value ();
+
+ button_item_to_widget_value (gui, wv, 1, 1);
+
+ if (!NILP (glyph))
+ {
+ if (!IMAGE_INSTANCEP (glyph))
+ glyph = glyph_image_instance (glyph, domain, ERROR_ME, 1);
+ }
+
+ x_widget_instantiate (image_instance, instantiator, pointer_fg,
+ pointer_bg, dest_mask, domain, "button", wv);
+
+ /* add the image if one was given */
+ if (!NILP (glyph) && IMAGE_INSTANCEP (glyph))
+ {
+ Arg al [2];
+ int ac =0;
+#ifdef LWLIB_WIDGETS_MOTIF
+ XtSetArg (al [ac], XmNlabelType, XmPIXMAP); ac++;
+ XtSetArg (al [ac], XmNlabelPixmap, XIMAGE_INSTANCE_X_PIXMAP (glyph));ac++;
+#else
+ XtSetArg (al [ac], XtNpixmap, XIMAGE_INSTANCE_X_PIXMAP (glyph)); ac++;
+#endif
+ XtSetValues (IMAGE_INSTANCE_X_WIDGET_ID (ii), al, ac);
+ }
+}
+
+/* get properties of a button */
+static Lisp_Object
+x_button_property (Lisp_Object image_instance, Lisp_Object prop)
+{
+ struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
+ /* check the state of a button */
+ if (EQ (prop, Q_selected))
+ {
+ widget_value* wv = lw_get_all_values (IMAGE_INSTANCE_X_WIDGET_LWID (ii));
+
+ if (wv->selected)
+ return Qt;
+ else
+ return Qnil;
+ }
+ return Qunbound;
+}
+
+/* instantiate a progress gauge */
+static void
+x_progress_gauge_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);
+ Lisp_Object gui = IMAGE_INSTANCE_WIDGET_ITEM (ii);
+ widget_value* wv = xmalloc_widget_value ();
+
+ button_item_to_widget_value (gui, wv, 1, 1);
+
+ x_widget_instantiate (image_instance, instantiator, pointer_fg,
+ pointer_bg, dest_mask, domain, "progress", wv);
+}
+
+/* set the properties of a progres guage */
+static Lisp_Object
+x_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))
+ {
+ Arg al [1];
+ CHECK_INT (val);
+ XtSetArg (al[0], XtNvalue, XINT (val));
+ XtSetValues (IMAGE_INSTANCE_X_WIDGET_ID (ii), al, 1);
+ return Qt;
+ }
+ return Qunbound;
+}
+
+/* instantiate an edit control */
+static void
+x_edit_field_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);
+ Lisp_Object gui = IMAGE_INSTANCE_WIDGET_ITEM (ii);
+ widget_value* wv = xmalloc_widget_value ();
+
+ button_item_to_widget_value (gui, wv, 1, 1);
+
+ x_widget_instantiate (image_instance, instantiator, pointer_fg,
+ pointer_bg, dest_mask, domain, "text-field", wv);
+}
+
+#if defined (LWLIB_WIDGETS_MOTIF) && XmVERSION > 1
+/* instantiate a combo control */
+static void
+x_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);
+ widget_value * wv = 0;
+ /* This is not done generically because of sizing problems under
+ mswindows. */
+ widget_instantiate_1 (image_instance, instantiator, pointer_fg,
+ pointer_bg, dest_mask, domain, 1, 0, 0);
+
+ wv = gui_items_to_widget_values (IMAGE_INSTANCE_WIDGET_ITEMS (ii));
+
+ x_widget_instantiate (image_instance, instantiator, pointer_fg,
+ pointer_bg, dest_mask, domain, "combo-box", wv);
+}
+#endif
+
+static void
+x_tab_control_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);
+ widget_value * wv =
+ gui_items_to_widget_values (IMAGE_INSTANCE_WIDGET_ITEMS (ii));
+
+ update_tab_widget_face (wv, ii,
+ IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
+
+ x_widget_instantiate (image_instance, instantiator, pointer_fg,
+ pointer_bg, dest_mask, domain, "tab-control", wv);
+}
+
+/* set the properties of a tab control */
+static Lisp_Object
+x_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))
+ {
+ widget_value * wv = 0;
+ check_valid_item_list_1 (val);
+
+ IMAGE_INSTANCE_WIDGET_ITEMS (ii) =
+ Fcons (XCAR (IMAGE_INSTANCE_WIDGET_ITEMS (ii)),
+ parse_gui_item_tree_children (val));
+
+ wv = gui_items_to_widget_values (IMAGE_INSTANCE_WIDGET_ITEMS (ii));
+
+ update_tab_widget_face (wv, ii,
+ IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
+
+ lw_modify_all_widgets (IMAGE_INSTANCE_X_WIDGET_LWID (ii), wv, True);
+
+ free_widget_value_tree (wv);
+ return Qt;
+ }
+
+ return Qunbound;
+}
+
+/* instantiate a static control possible for putting other things in */
+static void
+x_label_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);
+ Lisp_Object gui = IMAGE_INSTANCE_WIDGET_ITEM (ii);
+ widget_value* wv = xmalloc_widget_value ();
+
+ button_item_to_widget_value (gui, wv, 1, 1);
+
+ x_widget_instantiate (image_instance, instantiator, pointer_fg,
+ pointer_bg, dest_mask, domain, "button", wv);
+}
+#endif /* HAVE_WIDGETS */
+
+\f
projects / chise / xemacs-chise.git.1 / blobdiff