/* Widget-specific glyph objects.
   Copyright (C) 1998 Andy Piper

This file is part of XEmacs.

XEmacs is free software; you can redistribute it and/or modify it
under the terms of the GNU General Public License as published by the
Free Software Foundation; either version 2, or (at your option) any
later version.

XEmacs is distributed in the hope that it will be useful, but WITHOUT
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,
Boston, MA 02111-1307, USA.  */

/* Synched up with: Not in FSF. */

#include <config.h>
#include "lisp.h"
#include "lstream.h"
#include "console.h"
#include "device.h"
#include "faces.h"
#include "glyphs.h"
#include "objects.h"

#include "window.h"
#include "buffer.h"
#include "frame.h"
#include "insdel.h"
#include "opaque.h"

DEFINE_IMAGE_INSTANTIATOR_FORMAT (button);
DEFINE_IMAGE_INSTANTIATOR_FORMAT (combo);
Lisp_Object Qcombo;
DEFINE_IMAGE_INSTANTIATOR_FORMAT (edit);
Lisp_Object Qedit;
DEFINE_IMAGE_INSTANTIATOR_FORMAT (scrollbar);
Lisp_Object Qscrollbar;
DEFINE_IMAGE_INSTANTIATOR_FORMAT (widget);
#if 0
DEFINE_IMAGE_INSTANTIATOR_FORMAT (group);
Lisp_Object Qgroup;
#endif
DEFINE_IMAGE_INSTANTIATOR_FORMAT (label);
Lisp_Object Qlabel;

Lisp_Object Q_descriptor, Q_height, Q_width, Q_properties, Q_items;

#define WIDGET_BORDER_HEIGHT 2
#define WIDGET_BORDER_WIDTH 4

/* TODO:
   - more complex controls.
   - tooltips for controls.
   - images in controls.
 */

/* In windows normal windows work in pixels, dialog boxes work in
   dialog box units. Why? sigh. We could reuse the metrics for dialogs
   if this were not the case. As it is we have to position things
   pixel wise. I'm not even sure that X has this problem at least for
   buttons in groups. */
Lisp_Object
widget_face_font_info (Lisp_Object domain, Lisp_Object face,
		       int *height, int *width)
{
  Lisp_Object font_instance = FACE_FONT (face, domain, Vcharset_ascii);

  if (height)
    *height = XFONT_INSTANCE (font_instance)->height;
  if (width)
    *width = XFONT_INSTANCE (font_instance)->width;
  
  return font_instance;
}

void
widget_text_to_pixel_conversion (Lisp_Object domain, Lisp_Object face,
				 int th, int tw,
				 int* height, int* width)
{
  int ch=0, cw=0;
  widget_face_font_info (domain, face, &ch, &cw);
  if (height)
    *height = th * (ch + 2 * WIDGET_BORDER_HEIGHT);
  if (width)
    *width = tw * cw + 2 * WIDGET_BORDER_WIDTH;
}

static int
widget_possible_dest_types (void)
{
  return IMAGE_WIDGET_MASK;
}

#if 0 /* currently unused */
static void
check_valid_glyph (Lisp_Object data)
{
  if (SYMBOLP (data))
    CHECK_BUFFER_GLYPH (XSYMBOL (data)->value);
  else
    CHECK_BUFFER_GLYPH (data);
}
#endif /* currently unused */

static void
check_valid_item_list (Lisp_Object data)
{
  Lisp_Object rest;
  Lisp_Object items;
  Fcheck_valid_plist (data);
  
  items = Fplist_get (data, Q_items, Qnil);

  CHECK_LIST (items);
  EXTERNAL_LIST_LOOP (rest, items)
    {
      CHECK_STRING (XCAR (rest));
    }
}

/* wire widget property invocations to specific widgets ...  The
 problem we are solving here is that when instantiators get converted
 to instances they lose some type information (they just become
 subwindows or widgets for example). For widgets we need to preserve
 this type information so that we can do widget specific operations on
 the instances. This is encoded in the widget type
 field. widget_property gets invoked by decoding the primary type
 (Qwidget), widget property then invokes based on the secondary type
 (Qedit for example). It is debatable that we should wire things in this
 generalised way rather than treating widgets specially in
 image_instance_property. */
static Lisp_Object 
widget_property (Lisp_Object image_instance, Lisp_Object prop)
{
  struct Lisp_Image_Instance* ii = XIMAGE_INSTANCE (image_instance);
  struct image_instantiator_methods* meths;

  /* 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);

  /* .. then try device specific methods ... */
  meths = decode_device_ii_format (IMAGE_INSTANCE_DEVICE (ii), 
				   IMAGE_INSTANCE_WIDGET_TYPE (ii), 
				   ERROR_ME_NOT);
  if (meths && HAS_IIFORMAT_METH_P (meths, property))
    return IIFORMAT_METH (meths, property, (image_instance, prop));
  /* ... 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, property))
    return IIFORMAT_METH (meths, property, (image_instance, prop));
  /* ... then fail */
  return Qunbound;
}

static Lisp_Object 
widget_set_property (Lisp_Object image_instance, Lisp_Object prop, Lisp_Object val)
{
  struct Lisp_Image_Instance* ii = XIMAGE_INSTANCE (image_instance);
  struct image_instantiator_methods* meths;
  Lisp_Object ret;

  /* try device specific methods first ... */
  meths = decode_device_ii_format (IMAGE_INSTANCE_DEVICE (ii), 
				   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;
    }
  /* ... 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 */
  IMAGE_INSTANCE_WIDGET_PROPS (ii)
    = Fplist_put (IMAGE_INSTANCE_WIDGET_PROPS (ii), prop, val);
  return val;
}

static void
widget_validate (Lisp_Object instantiator)
{
  Lisp_Object desc = find_keyword_in_vector (instantiator, Q_descriptor);
  struct gui_item gui;
  if (NILP (desc))
    signal_simple_error ("Must supply :descriptor", instantiator);

  gui_parse_item_keywords (desc, &gui);

  if (!NILP (find_keyword_in_vector (instantiator, Q_width))
	     && !NILP (find_keyword_in_vector (instantiator, Q_pixel_width)))
    signal_simple_error ("Must supply only one of :width and :pixel-width", instantiator);

  if (!NILP (find_keyword_in_vector (instantiator, Q_height))
	     && !NILP (find_keyword_in_vector (instantiator, Q_pixel_height)))
    signal_simple_error ("Must supply only one of :height and :pixel-height", instantiator);
}

static void
combo_validate (Lisp_Object instantiator)
{
  widget_validate (instantiator);
  if (NILP (find_keyword_in_vector (instantiator, Q_properties)))
    signal_simple_error ("Must supply item list", instantiator);
}

static void
initialize_widget_image_instance (struct Lisp_Image_Instance *ii, Lisp_Object type)
{
  /*  initialize_subwindow_image_instance (ii);*/
  IMAGE_INSTANCE_WIDGET_TYPE (ii) = type;
  IMAGE_INSTANCE_WIDGET_PROPS (ii) = Qnil;
  IMAGE_INSTANCE_WIDGET_FACE (ii) = Vwidget_face;
  gui_item_init (&IMAGE_INSTANCE_WIDGET_ITEM (ii));
}

/* 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
widget_instantiate_1 (Lisp_Object image_instance, Lisp_Object instantiator,
		      Lisp_Object pointer_fg, Lisp_Object pointer_bg,
		      int dest_mask, Lisp_Object domain, int default_textheight,
		      int default_pixheight)
{
  struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
  struct gui_item* pgui = &IMAGE_INSTANCE_WIDGET_ITEM (ii);
  Lisp_Object face = find_keyword_in_vector (instantiator, Q_face);
  Lisp_Object height = find_keyword_in_vector (instantiator, Q_height);
  Lisp_Object width = find_keyword_in_vector (instantiator, Q_width);
  Lisp_Object pixwidth = find_keyword_in_vector (instantiator, Q_pixel_width);
  Lisp_Object pixheight = find_keyword_in_vector (instantiator, Q_pixel_height);
  Lisp_Object desc = find_keyword_in_vector (instantiator, Q_descriptor);
  int pw=0, ph=0, tw=0, th=0;
  
  /* this just does pixel type sizing */
  subwindow_instantiate (image_instance, instantiator, pointer_fg, pointer_bg,
			 dest_mask, domain);

  if (!(dest_mask & IMAGE_WIDGET_MASK))
    incompatible_image_types (instantiator, dest_mask, IMAGE_WIDGET_MASK);

  initialize_widget_image_instance (ii, XVECTOR_DATA (instantiator)[0]);

  /* retrieve the fg and bg colors */
  if (!NILP (face))
    IMAGE_INSTANCE_WIDGET_FACE (ii) = Fget_face (face);
  
  /* data items for some widgets */
  IMAGE_INSTANCE_WIDGET_PROPS (ii) = 
    find_keyword_in_vector (instantiator, Q_properties);

  /* retrieve the gui item information */
  if (STRINGP (desc) || NILP (desc))
    IMAGE_INSTANCE_WIDGET_TEXT (ii) = desc;
  else
    gui_parse_item_keywords (find_keyword_in_vector (instantiator, Q_descriptor),
			     pgui);

  /* normalize size information */
  if (!NILP (width))
    tw = XINT (width);
  if (!NILP (height))
    th = XINT (height);
  if (!NILP (pixwidth))
    pw = XINT (pixwidth);
  if (!NILP (pixheight))
    ph = XINT (pixheight);

  if (!tw && !pw && !NILP (IMAGE_INSTANCE_WIDGET_TEXT (ii)))
    tw = XSTRING_LENGTH (IMAGE_INSTANCE_WIDGET_TEXT (ii));
  if (!th && !ph)
    {
      if (default_textheight)
	th = default_textheight;
      else if (!NILP (IMAGE_INSTANCE_WIDGET_TEXT (ii)))
	th = 1;
      else
	ph = default_pixheight;
    }

  if (tw !=0 || th !=0)
    widget_text_to_pixel_conversion (domain,
				     IMAGE_INSTANCE_WIDGET_FACE (ii),
				     th, tw, th ? &ph : 0, tw ? &pw : 0);

  IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii) = pw;
  IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii) = ph;
}

static void
widget_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
		    Lisp_Object pointer_fg, Lisp_Object pointer_bg,
		    int dest_mask, Lisp_Object domain)
{
  widget_instantiate_1 (image_instance, instantiator, pointer_fg,
			       pointer_bg, dest_mask, domain, 1, 0);
}

static void
combo_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
		   Lisp_Object pointer_fg, Lisp_Object pointer_bg,
		   int dest_mask, Lisp_Object domain)
{
  Lisp_Object data = Fplist_get (find_keyword_in_vector (instantiator, Q_properties),
				 Q_items, Qnil);
  int len;
  GET_LIST_LENGTH (data, len);
  widget_instantiate_1 (image_instance, instantiator, pointer_fg,
			pointer_bg, dest_mask, domain, len + 1, 0);
}

/* Instantiate a static control */
static void
static_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
		    Lisp_Object pointer_fg, Lisp_Object pointer_bg,
		    int dest_mask, Lisp_Object domain)
{
  widget_instantiate_1 (image_instance, instantiator, pointer_fg,
			pointer_bg, dest_mask, domain, 0, 4);
}


/************************************************************************/
/*                            initialization                            */
/************************************************************************/

void
syms_of_glyphs_widget (void)
{
  defkeyword (&Q_descriptor, ":descriptor");
  defkeyword (&Q_height, ":height");
  defkeyword (&Q_width, ":width");
  defkeyword (&Q_properties, ":properties");
  defkeyword (&Q_items, ":items");
}

void
image_instantiator_format_create_glyphs_widget (void)
{
  /* 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);

  /* widget image-instantiator types - buttons */
  INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (button, "button");
  IIFORMAT_HAS_SHARED_METHOD (button, validate, widget);
  IIFORMAT_HAS_SHARED_METHOD (button, possible_dest_types, widget);
  IIFORMAT_HAS_SHARED_METHOD (button, instantiate, widget);

  IIFORMAT_VALID_KEYWORD (button, Q_width, check_valid_int);
  IIFORMAT_VALID_KEYWORD (button, Q_height, check_valid_int);
  IIFORMAT_VALID_KEYWORD (button, Q_pixel_width, check_valid_int);
  IIFORMAT_VALID_KEYWORD (button, Q_pixel_height, check_valid_int);
  IIFORMAT_VALID_KEYWORD (button, Q_face, check_valid_face);
  IIFORMAT_VALID_KEYWORD (button, Q_descriptor, check_valid_vector);
  /* edit fields */
  INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (edit, "edit");
  IIFORMAT_HAS_SHARED_METHOD (edit, validate, widget);
  IIFORMAT_HAS_SHARED_METHOD (edit, possible_dest_types, widget);
  IIFORMAT_HAS_SHARED_METHOD (edit, instantiate, widget);

  IIFORMAT_VALID_KEYWORD (edit, Q_width, check_valid_int);
  IIFORMAT_VALID_KEYWORD (edit, Q_height, check_valid_int);
  IIFORMAT_VALID_KEYWORD (edit, Q_pixel_width, check_valid_int);
  IIFORMAT_VALID_KEYWORD (edit, Q_pixel_height, check_valid_int);
  IIFORMAT_VALID_KEYWORD (edit, Q_face, check_valid_face);
  IIFORMAT_VALID_KEYWORD (edit, Q_descriptor, check_valid_vector);
  /* combo box */
  INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (combo, "combo");
  IIFORMAT_HAS_METHOD (combo, validate);
  IIFORMAT_HAS_SHARED_METHOD (combo, possible_dest_types, widget);
  IIFORMAT_HAS_METHOD (combo, instantiate);

  IIFORMAT_VALID_KEYWORD (combo, Q_width, check_valid_int);
  IIFORMAT_VALID_KEYWORD (combo, Q_height, check_valid_int);
  IIFORMAT_VALID_KEYWORD (combo, Q_pixel_width, check_valid_int);
  IIFORMAT_VALID_KEYWORD (combo, Q_face, check_valid_face);
  IIFORMAT_VALID_KEYWORD (combo, Q_descriptor, check_valid_vector);
  IIFORMAT_VALID_KEYWORD (combo, Q_properties, check_valid_item_list);
  /* scrollbar */
  INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (scrollbar, "scrollbar");
  IIFORMAT_HAS_SHARED_METHOD (scrollbar, validate, widget);
  IIFORMAT_HAS_SHARED_METHOD (scrollbar, possible_dest_types, widget);
  IIFORMAT_HAS_SHARED_METHOD (scrollbar, instantiate, widget);

  IIFORMAT_VALID_KEYWORD (scrollbar, Q_pixel_width, check_valid_int);
  IIFORMAT_VALID_KEYWORD (scrollbar, Q_pixel_height, check_valid_int);
  IIFORMAT_VALID_KEYWORD (scrollbar, Q_face, check_valid_face);
  IIFORMAT_VALID_KEYWORD (scrollbar, Q_descriptor, check_valid_vector);
  /* labels */
  INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (label, "label");
  IIFORMAT_HAS_SHARED_METHOD (label, possible_dest_types, widget);
  IIFORMAT_HAS_SHARED_METHOD (label, instantiate, static);

  IIFORMAT_VALID_KEYWORD (label, Q_pixel_width, check_valid_int);
  IIFORMAT_VALID_KEYWORD (label, Q_pixel_height, check_valid_int);
  IIFORMAT_VALID_KEYWORD (label, Q_width, check_valid_int);
  IIFORMAT_VALID_KEYWORD (label, Q_height, check_valid_int);
  IIFORMAT_VALID_KEYWORD (label, Q_face, check_valid_face);
  IIFORMAT_VALID_KEYWORD (label, Q_descriptor, check_valid_string);
#if 0
  /* group */
  INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (group, "group");
  IIFORMAT_HAS_SHARED_METHOD (group, possible_dest_types, widget);
  IIFORMAT_HAS_METHOD (group, instantiate);

  IIFORMAT_VALID_KEYWORD (group, Q_width, check_valid_int);
  IIFORMAT_VALID_KEYWORD (group, Q_height, check_valid_int);
  IIFORMAT_VALID_KEYWORD (group, Q_pixel_width, check_valid_int);
  IIFORMAT_VALID_KEYWORD (group, Q_pixel_height, check_valid_int);
  IIFORMAT_VALID_KEYWORD (group, Q_face, check_valid_face);
  IIFORMAT_VALID_KEYWORD (group, Q_background, check_valid_string);
  IIFORMAT_VALID_KEYWORD (group, Q_descriptor, check_valid_string);
#endif
}

void
vars_of_glyphs_widget (void)
{
}