Contents of release-21-2 in 1999-06-17-23.
[chise/xemacs-chise.git.1] / src / glyphs-widget.c
index 4bb451f..7b4e2bc 100644 (file)
@@ -20,6 +20,8 @@ Boston, MA 02111-1307, USA.  */
 
 /* Synched up with: Not in FSF. */
 
+/* written by Andy Piper <andy@xemacs.org> */
+
 #include <config.h>
 #include "lisp.h"
 #include "lstream.h"
@@ -28,7 +30,7 @@ Boston, MA 02111-1307, USA.  */
 #include "faces.h"
 #include "glyphs.h"
 #include "objects.h"
-
+#include "bytecode.h"
 #include "window.h"
 #include "buffer.h"
 #include "frame.h"
@@ -49,8 +51,15 @@ Lisp_Object Qgroup;
 #endif
 DEFINE_IMAGE_INSTANTIATOR_FORMAT (label);
 Lisp_Object Qlabel;
+DEFINE_IMAGE_INSTANTIATOR_FORMAT (progress);
+Lisp_Object Qprogress;
+DEFINE_IMAGE_INSTANTIATOR_FORMAT (tree);
+Lisp_Object Qtree;
+DEFINE_IMAGE_INSTANTIATOR_FORMAT (tab);
+Lisp_Object Qtab;
 
 Lisp_Object Q_descriptor, Q_height, Q_width, Q_properties, Q_items;
+Lisp_Object Q_image, Q_text, Q_percent;
 
 #define WIDGET_BORDER_HEIGHT 2
 #define WIDGET_BORDER_WIDTH 4
@@ -58,7 +67,6 @@ Lisp_Object Q_descriptor, Q_height, Q_width, Q_properties, Q_items;
 /* TODO:
    - more complex controls.
    - tooltips for controls.
-   - images in controls.
  */
 
 /* In windows normal windows work in pixels, dialog boxes work in
@@ -99,33 +107,78 @@ widget_possible_dest_types (void)
   return IMAGE_WIDGET_MASK;
 }
 
-#if 0 /* currently unused */
 static void
-check_valid_glyph (Lisp_Object data)
+check_valid_glyph_or_image (Lisp_Object data)
 {
+  Lisp_Object glyph = data;
   if (SYMBOLP (data))
-    CHECK_BUFFER_GLYPH (XSYMBOL (data)->value);
-  else
-    CHECK_BUFFER_GLYPH (data);
+    glyph = XSYMBOL (data)->value;
+
+  if (IMAGE_INSTANCEP (glyph))
+    CHECK_IMAGE_INSTANCE (glyph);
+  else if (!CONSP (glyph))
+    CHECK_BUFFER_GLYPH (glyph);
 }
-#endif /* currently unused */
 
 static void
-check_valid_item_list (Lisp_Object data)
+check_valid_anything (Lisp_Object data)
+{
+}
+
+static void
+check_valid_callback (Lisp_Object data)
+{
+    if (!SYMBOLP (data)
+       && !COMPILED_FUNCTIONP (data)
+       && !CONSP (data))
+    {
+       signal_simple_error (":callback must be a function or expression", data);
+    }
+}
+
+static void
+check_valid_symbol (Lisp_Object data)
+{
+    CHECK_SYMBOL (data);
+}
+
+static void
+check_valid_string_or_vector (Lisp_Object data)
+{
+    if (!STRINGP (data) && !VECTORP (data))
+       signal_simple_error (":descriptor must be a string or a vector", data);
+}
+
+static void
+check_valid_item_list_1 (Lisp_Object items)
 {
   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));
+      if (STRINGP (XCAR (rest)))
+       CHECK_STRING (XCAR (rest));
+      else if (VECTORP (XCAR (rest)))
+       gui_parse_item_keywords (XCAR (rest));
+      else if (LISTP (XCAR (rest)))
+       check_valid_item_list_1 (XCAR (rest));
+      else
+       signal_simple_error ("Items must be vectors, lists or strings", items);
     }
 }
 
+static void
+check_valid_item_list (Lisp_Object data)
+{
+  Lisp_Object items;
+
+  Fcheck_valid_plist (data);
+  items = Fplist_get (data, Q_items, Qnil);
+
+  check_valid_item_list_1 (items);
+}
+
 /* 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
@@ -200,14 +253,15 @@ 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 (VECTORP (desc))
+    gui_parse_item_keywords (desc);
 
   if (!NILP (find_keyword_in_vector (instantiator, Q_width))
-            && !NILP (find_keyword_in_vector (instantiator, Q_pixel_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))
@@ -223,6 +277,40 @@ combo_validate (Lisp_Object instantiator)
     signal_simple_error ("Must supply item list", instantiator);
 }
 
+/* we need to convert things like glyphs to images, eval expressions
+   etc.*/
+static Lisp_Object
+widget_normalize (Lisp_Object inst, Lisp_Object console_type)
+{
+  /* 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. */
+  if (!NILP (glyph))
+    {
+      int i;
+      struct gcpro gcpro1;
+      if (SYMBOLP (glyph))
+       glyph = XSYMBOL (glyph)->value;
+      GCPRO1 (glyph);
+
+      if (CONSP (glyph))
+       glyph = Feval (glyph);
+      /* substitute the new glyph */
+      for (i = 0; i < XVECTOR_LENGTH (inst); i++)
+       {
+         if (EQ (Q_image, XVECTOR_DATA (inst)[i]))
+           {
+             XVECTOR_DATA (inst)[i+1] = glyph;
+             break;
+           }
+       }
+      UNGCPRO;
+    }
+  return inst;
+}
+
 static void
 initialize_widget_image_instance (struct Lisp_Image_Instance *ii, Lisp_Object type)
 {
@@ -230,29 +318,29 @@ initialize_widget_image_instance (struct Lisp_Image_Instance *ii, Lisp_Object ty
   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));
+  IMAGE_INSTANCE_WIDGET_ITEM (ii) = allocate_gui_item ();
 }
 
 /* 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
+   want to display it in and BitBlt it. So image 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)
+                     int default_pixheight, int default_textwidth)
 {
   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);
+  Lisp_Object glyph = find_keyword_in_vector (instantiator, Q_image);
   int pw=0, ph=0, tw=0, th=0;
   
   /* this just does pixel type sizing */
@@ -272,12 +360,19 @@ widget_instantiate_1 (Lisp_Object image_instance, Lisp_Object instantiator,
   IMAGE_INSTANCE_WIDGET_PROPS (ii) = 
     find_keyword_in_vector (instantiator, Q_properties);
 
-  /* retrieve the gui item information */
+  /* retrieve the gui item information. This is easy if we have been
+     provided with a vector, more difficult if we have just been given
+     keywords */
   if (STRINGP (desc) || NILP (desc))
-    IMAGE_INSTANCE_WIDGET_TEXT (ii) = desc;
+    {
+      /* big cheat - we rely on the fact that a gui item looks like an instantiator */
+      IMAGE_INSTANCE_WIDGET_ITEM (ii) = 
+       gui_parse_item_keywords_no_errors (instantiator);
+      IMAGE_INSTANCE_WIDGET_TEXT (ii) = desc;
+    }
   else
-    gui_parse_item_keywords (find_keyword_in_vector (instantiator, Q_descriptor),
-                            pgui);
+    IMAGE_INSTANCE_WIDGET_ITEM (ii) =
+      gui_parse_item_keywords_no_errors (desc);
 
   /* normalize size information */
   if (!NILP (width))
@@ -289,8 +384,26 @@ widget_instantiate_1 (Lisp_Object image_instance, Lisp_Object instantiator,
   if (!NILP (pixheight))
     ph = XINT (pixheight);
 
-  if (!tw && !pw && !NILP (IMAGE_INSTANCE_WIDGET_TEXT (ii)))
-    tw = XSTRING_LENGTH (IMAGE_INSTANCE_WIDGET_TEXT (ii));
+  /* for a widget with an image pick up the dimensions from that */
+  if (!NILP (glyph))
+    {
+      if (!pw && !tw)
+       pw = glyph_width (glyph, Qnil, DEFAULT_INDEX, domain) 
+         + 2 * WIDGET_BORDER_WIDTH;
+      if (!ph && !th)
+       ph = glyph_height (glyph, Qnil, DEFAULT_INDEX, domain) 
+         + 2 * WIDGET_BORDER_HEIGHT;
+    }
+
+  /* if we still don' t have sizes, guess from text size */
+  if (!tw && !pw)
+    {
+      if (default_textwidth)
+       tw = default_textwidth;
+      else if (!NILP (IMAGE_INSTANCE_WIDGET_TEXT (ii)))
+       tw = XSTRING_LENGTH (IMAGE_INSTANCE_WIDGET_TEXT (ii));
+    }
+
   if (!th && !ph)
     {
       if (default_textheight)
@@ -300,7 +413,7 @@ widget_instantiate_1 (Lisp_Object image_instance, Lisp_Object instantiator,
       else
        ph = default_pixheight;
     }
-
+  
   if (tw !=0 || th !=0)
     widget_text_to_pixel_conversion (domain,
                                     IMAGE_INSTANCE_WIDGET_FACE (ii),
@@ -316,9 +429,10 @@ widget_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
                    int dest_mask, Lisp_Object domain)
 {
   widget_instantiate_1 (image_instance, instantiator, pointer_fg,
-                              pointer_bg, dest_mask, domain, 1, 0);
+                              pointer_bg, dest_mask, domain, 1, 0, 0);
 }
 
+/* combo-box generic instantiation - get he heigh right */
 static void
 combo_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
                   Lisp_Object pointer_fg, Lisp_Object pointer_bg,
@@ -329,7 +443,33 @@ combo_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
   int len;
   GET_LIST_LENGTH (data, len);
   widget_instantiate_1 (image_instance, instantiator, pointer_fg,
-                       pointer_bg, dest_mask, domain, len + 1, 0);
+                       pointer_bg, dest_mask, domain, len + 1, 0, 0);
+}
+
+static void
+tab_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);
+  Lisp_Object rest;
+  int len = 0;
+
+  LIST_LOOP (rest, data)
+    {
+      len += 3;                        /* some bias */
+      if (STRINGP (XCAR (rest)))
+       len += XSTRING_LENGTH (XCAR (rest));
+      else if (VECTORP (XCAR (rest)))
+       {
+         Lisp_Object gui = gui_parse_item_keywords (XCAR (rest));
+         len += XSTRING_LENGTH (XGUI_ITEM (gui)->name);
+       }
+    }
+
+  widget_instantiate_1 (image_instance, instantiator, pointer_fg,
+                       pointer_bg, dest_mask, domain, 0, 0, len);
 }
 
 /* Instantiate a static control */
@@ -339,7 +479,7 @@ static_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
                    int dest_mask, Lisp_Object domain)
 {
   widget_instantiate_1 (image_instance, instantiator, pointer_fg,
-                       pointer_bg, dest_mask, domain, 0, 4);
+                       pointer_bg, dest_mask, domain, 0, 4, 0);
 }
 
 \f
@@ -355,11 +495,36 @@ syms_of_glyphs_widget (void)
   defkeyword (&Q_width, ":width");
   defkeyword (&Q_properties, ":properties");
   defkeyword (&Q_items, ":items");
+  defkeyword (&Q_image, ":image");
+  defkeyword (&Q_percent, ":percent");
+  defkeyword (&Q_text, ":text");
 }
 
 void
 image_instantiator_format_create_glyphs_widget (void)
 {
+#define VALID_GUI_KEYWORDS(type) \
+  IIFORMAT_VALID_KEYWORD (type, Q_active, check_valid_anything); \
+  IIFORMAT_VALID_KEYWORD (type, Q_suffix, check_valid_anything); \
+  IIFORMAT_VALID_KEYWORD (type, Q_keys, check_valid_string);           \
+  IIFORMAT_VALID_KEYWORD (type, Q_style, check_valid_symbol);          \
+  IIFORMAT_VALID_KEYWORD (type, Q_selected, check_valid_anything);     \
+  IIFORMAT_VALID_KEYWORD (type, Q_filter, check_valid_anything);               \
+  IIFORMAT_VALID_KEYWORD (type, Q_config, check_valid_symbol);         \
+  IIFORMAT_VALID_KEYWORD (type, Q_included, check_valid_anything);     \
+  IIFORMAT_VALID_KEYWORD (type, Q_key_sequence, check_valid_string);   \
+  IIFORMAT_VALID_KEYWORD (type, Q_accelerator, check_valid_string);    \
+  IIFORMAT_VALID_KEYWORD (type, Q_label, check_valid_anything);                \
+  IIFORMAT_VALID_KEYWORD (type, Q_callback, check_valid_callback);             \
+  IIFORMAT_VALID_KEYWORD (type, Q_descriptor, check_valid_string_or_vector)
+
+#define VALID_WIDGET_KEYWORDS(type) \
+  IIFORMAT_VALID_KEYWORD (type, Q_width, check_valid_int);             \
+  IIFORMAT_VALID_KEYWORD (type, Q_height, check_valid_int);            \
+  IIFORMAT_VALID_KEYWORD (type, Q_pixel_width, check_valid_int);       \
+  IIFORMAT_VALID_KEYWORD (type, Q_pixel_height, check_valid_int);      \
+  IIFORMAT_VALID_KEYWORD (type, Q_face, check_valid_face)
+
   /* we only do this for properties */
   INITIALIZE_IMAGE_INSTANTIATOR_FORMAT_NO_SYM (widget, "widget");
   IIFORMAT_HAS_METHOD (widget, property);
@@ -370,58 +535,76 @@ image_instantiator_format_create_glyphs_widget (void)
   IIFORMAT_HAS_SHARED_METHOD (button, validate, widget);
   IIFORMAT_HAS_SHARED_METHOD (button, possible_dest_types, widget);
   IIFORMAT_HAS_SHARED_METHOD (button, instantiate, widget);
+  IIFORMAT_HAS_SHARED_METHOD (button, normalize, widget);
+  IIFORMAT_VALID_KEYWORD (button, Q_image, check_valid_glyph_or_image);
+  VALID_WIDGET_KEYWORDS (button);
+  VALID_GUI_KEYWORDS (button);
 
-  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);
+  VALID_WIDGET_KEYWORDS (edit);
+  VALID_GUI_KEYWORDS (edit);
 
-  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);
+  VALID_GUI_KEYWORDS (combo);
 
   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);
+  VALID_GUI_KEYWORDS (scrollbar);
 
   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);
+
+  /* progress guage */
+  INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (progress, "progress");
+  IIFORMAT_HAS_SHARED_METHOD (progress, validate, widget);
+  IIFORMAT_HAS_SHARED_METHOD (progress, possible_dest_types, widget);
+  IIFORMAT_HAS_SHARED_METHOD (progress, instantiate, combo);
+  VALID_WIDGET_KEYWORDS (progress);
+  VALID_GUI_KEYWORDS (progress);
+
+  /* tree view */
+  INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (tree, "tree");
+  IIFORMAT_HAS_SHARED_METHOD (tree, validate, combo);
+  IIFORMAT_HAS_SHARED_METHOD (tree, possible_dest_types, widget);
+  IIFORMAT_HAS_SHARED_METHOD (tree, instantiate, combo);
+  VALID_WIDGET_KEYWORDS (tree);
+  VALID_GUI_KEYWORDS (tree);
+  IIFORMAT_VALID_KEYWORD (tree, Q_properties, check_valid_item_list);
+
+  /* tab control */
+  INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (tab, "tab");
+  IIFORMAT_HAS_SHARED_METHOD (tab, validate, combo);
+  IIFORMAT_HAS_SHARED_METHOD (tab, possible_dest_types, widget);
+  IIFORMAT_HAS_METHOD (tab, instantiate);
+  VALID_WIDGET_KEYWORDS (tab);
+  VALID_GUI_KEYWORDS (tab);
+  IIFORMAT_VALID_KEYWORD (tab, Q_properties, check_valid_item_list);
+
   /* 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);
+  VALID_WIDGET_KEYWORDS (label);
   IIFORMAT_VALID_KEYWORD (label, Q_descriptor, check_valid_string);
+
 #if 0
   /* group */
   INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (group, "group");