update.
[chise/xemacs-chise.git-] / src / glyphs.c
index fff0de9..b03fe24 100644 (file)
@@ -90,6 +90,11 @@ Lisp_Object Q_foreground, Q_background;
 #endif
 #endif
 
+#ifdef HAVE_XFACE
+DEFINE_IMAGE_INSTANTIATOR_FORMAT (xface);
+Lisp_Object Qxface;
+#endif
+
 #ifdef HAVE_XPM
 DEFINE_IMAGE_INSTANTIATOR_FORMAT (xpm);
 Lisp_Object Qxpm;
@@ -169,21 +174,38 @@ decode_image_instantiator_format (Lisp_Object format, Error_behavior errb)
 }
 
 static int
-valid_image_instantiator_format_p (Lisp_Object format)
+valid_image_instantiator_format_p (Lisp_Object format, Lisp_Object locale)
 {
-  return (decode_image_instantiator_format (format, ERROR_ME_NOT) != 0);
+  int i;
+  struct image_instantiator_methods* meths =
+    decode_image_instantiator_format (format, ERROR_ME_NOT);
+  struct console* console = decode_console (locale);
+  Lisp_Object contype = console ? CONSOLE_TYPE (console) : locale;
+  /* nothing is valid in all locales */
+  if (EQ (format, Qnothing))
+    return 1;
+  /* reject unknown formats */
+  else if (!console || !meths)
+    return 0;
+
+  for (i = 0; i < Dynarr_length (meths->consoles); i++)
+    if (EQ (contype, Dynarr_at (meths->consoles, i).symbol))
+      return 1;
+  return 0;
 }
 
 DEFUN ("valid-image-instantiator-format-p", Fvalid_image_instantiator_format_p,
-       1, 1, 0, /*
+       1, 2, 0, /*
 Given an IMAGE-INSTANTIATOR-FORMAT, return non-nil if it is valid.
+If LOCALE is non-nil then the format is checked in that domain.
+If LOCALE is nil the current console is used.
 Valid formats are some subset of 'nothing, 'string, 'formatted-string,
 'xpm, 'xbm, 'xface, 'gif, 'jpeg, 'png, 'tiff, 'cursor-font, 'font,
 'autodetect, 'widget and 'subwindow, depending on how XEmacs was compiled.
 */
-       (image_instantiator_format))
+       (image_instantiator_format, locale))
 {
-  return valid_image_instantiator_format_p (image_instantiator_format) ?
+  return valid_image_instantiator_format_p (image_instantiator_format, locale) ?
     Qt : Qnil;
 }
 
@@ -542,6 +564,11 @@ instantiate_image_instantiator (Lisp_Object device, Lisp_Object domain,
   int  methp = 0;
 
   GCPRO1 (ii);
+  if (!valid_image_instantiator_format_p (XVECTOR_DATA (instantiator)[0], device))
+    signal_simple_error
+      ("Image instantiator format is invalid in this locale.",
+       instantiator);
+
   meths = decode_image_instantiator_format (XVECTOR_DATA (instantiator)[0],
                                            ERROR_ME);
   methp = (int)HAS_IIFORMAT_METH_P (meths, instantiate);
@@ -595,7 +622,7 @@ mark_image_instance (Lisp_Object obj, void (*markobj) (Lisp_Object))
       markobj (IMAGE_INSTANCE_WIDGET_TYPE (i));
       markobj (IMAGE_INSTANCE_WIDGET_PROPS (i));
       markobj (IMAGE_INSTANCE_WIDGET_FACE (i));
-      mark_gui_item (&IMAGE_INSTANCE_WIDGET_ITEM (i), markobj);
+      markobj (IMAGE_INSTANCE_WIDGET_ITEM (i));
     case IMAGE_SUBWINDOW:
       markobj (IMAGE_INSTANCE_SUBWINDOW_FRAME (i));
       break;
@@ -702,11 +729,13 @@ print_image_instance (Lisp_Object obj, Lisp_Object printcharfun,
       break;
 
     case IMAGE_WIDGET:
+      /*
       if (!NILP (IMAGE_INSTANCE_WIDGET_CALLBACK (ii)))
        {
          print_internal (IMAGE_INSTANCE_WIDGET_CALLBACK (ii), printcharfun, 0);
          write_c_string (", ", printcharfun);
        }
+      */
       if (!NILP (IMAGE_INSTANCE_WIDGET_FACE (ii)))
        {
          write_c_string (" (", printcharfun);
@@ -829,15 +858,14 @@ image_instance_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
 
     case IMAGE_WIDGET:
       if (!(EQ (IMAGE_INSTANCE_WIDGET_TYPE (i1),
-               IMAGE_INSTANCE_WIDGET_TYPE (i2)) &&
-           EQ (IMAGE_INSTANCE_WIDGET_CALLBACK (i1),
-               IMAGE_INSTANCE_WIDGET_CALLBACK (i2))
+               IMAGE_INSTANCE_WIDGET_TYPE (i2))
+           && internal_equal (IMAGE_INSTANCE_WIDGET_ITEM (i1),
+                              IMAGE_INSTANCE_WIDGET_ITEM (i2),
+                              depth + 1)
            && internal_equal (IMAGE_INSTANCE_WIDGET_PROPS (i1),
                               IMAGE_INSTANCE_WIDGET_PROPS (i2),
                               depth + 1)
-           && internal_equal (IMAGE_INSTANCE_WIDGET_TEXT (i1),
-                              IMAGE_INSTANCE_WIDGET_TEXT (i2),
-                              depth + 1)))
+           ))
        return 0;
     case IMAGE_SUBWINDOW:
       if (!(IMAGE_INSTANCE_SUBWINDOW_WIDTH (i1) ==
@@ -887,7 +915,7 @@ image_instance_hash (Lisp_Object obj, int depth)
       hash = HASH4 (hash, 
                    internal_hash (IMAGE_INSTANCE_WIDGET_TYPE (i), depth + 1),
                    internal_hash (IMAGE_INSTANCE_WIDGET_PROPS (i), depth + 1),
-                   internal_hash (IMAGE_INSTANCE_WIDGET_CALLBACK (i), depth + 1));
+                   internal_hash (IMAGE_INSTANCE_WIDGET_ITEM (i), depth + 1));
     case IMAGE_SUBWINDOW:
       hash = HASH4 (hash, IMAGE_INSTANCE_SUBWINDOW_WIDTH (i),
                    IMAGE_INSTANCE_SUBWINDOW_HEIGHT (i),
@@ -905,14 +933,14 @@ image_instance_hash (Lisp_Object obj, int depth)
 DEFINE_LRECORD_IMPLEMENTATION ("image-instance", image_instance,
                               mark_image_instance, print_image_instance,
                               finalize_image_instance, image_instance_equal,
-                              image_instance_hash,
+                              image_instance_hash, 0,
                               struct Lisp_Image_Instance);
 
 static Lisp_Object
 allocate_image_instance (Lisp_Object device)
 {
   struct Lisp_Image_Instance *lp =
-    alloc_lcrecord_type (struct Lisp_Image_Instance, lrecord_image_instance);
+    alloc_lcrecord_type (struct Lisp_Image_Instance, &lrecord_image_instance);
   Lisp_Object val;
 
   zero_lcrecord (lp);
@@ -2001,6 +2029,80 @@ xbm_possible_dest_types (void)
 #endif
 
 \f
+#ifdef HAVE_XFACE
+/**********************************************************************
+ *                             X-Face                                 *
+ **********************************************************************/
+
+static void
+xface_validate (Lisp_Object instantiator)
+{
+  file_or_data_must_be_present (instantiator);
+}
+
+static Lisp_Object
+xface_normalize (Lisp_Object inst, Lisp_Object console_type)
+{
+  /* This function can call lisp */
+  Lisp_Object file = Qnil, mask_file = Qnil;
+  struct gcpro gcpro1, gcpro2, gcpro3;
+  Lisp_Object alist = Qnil;
+
+  GCPRO3 (file, mask_file, alist);
+
+  /* Now, convert any file data into inline data for both the regular
+     data and the mask data.  At the end of this, `data' will contain
+     the inline data (if any) or Qnil, and `file' will contain
+     the name this data was derived from (if known) or Qnil.
+     Likewise for `mask_file' and `mask_data'.
+
+     Note that if we cannot generate any regular inline data, we
+     skip out. */
+
+  file = potential_pixmap_file_instantiator (inst, Q_file, Q_data,
+                                            console_type);
+  mask_file = potential_pixmap_file_instantiator (inst, Q_mask_file,
+                                                 Q_mask_data, console_type);
+
+  if (CONSP (file)) /* failure locating filename */
+    signal_double_file_error ("Opening bitmap file",
+                             "no such file or directory",
+                             Fcar (file));
+
+  if (NILP (file) && NILP (mask_file)) /* no conversion necessary */
+    RETURN_UNGCPRO (inst);
+
+  alist = tagged_vector_to_alist (inst);
+
+  {
+    Lisp_Object data = make_string_from_file (file);
+    alist = remassq_no_quit (Q_file, alist);
+    /* there can't be a :data at this point. */
+    alist = Fcons (Fcons (Q_file, file),
+                  Fcons (Fcons (Q_data, data), alist));
+  }
+
+  alist = xbm_mask_file_munging (alist, file, mask_file, console_type);
+
+  {
+    Lisp_Object result = alist_to_tagged_vector (Qxface, alist);
+    free_alist (alist);
+    RETURN_UNGCPRO (result);
+  }
+}
+
+static int
+xface_possible_dest_types (void)
+{
+  return
+    IMAGE_MONO_PIXMAP_MASK  |
+    IMAGE_COLOR_PIXMAP_MASK |
+    IMAGE_POINTER_MASK;
+}
+
+#endif /* HAVE_XFACE */
+
+\f
 #ifdef HAVE_XPM
 
 /**********************************************************************
@@ -2846,9 +2948,14 @@ glyph_plist (Lisp_Object obj)
   return result;
 }
 
+static const struct lrecord_description glyph_description[] = {
+  { XD_LISP_OBJECT, offsetof(struct Lisp_Glyph, image), 5 },
+  { XD_END }
+};
+
 DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS ("glyph", glyph,
                                          mark_glyph, print_glyph, 0,
-                                         glyph_equal, glyph_hash,
+                                         glyph_equal, glyph_hash, glyph_description,
                                          glyph_getprop, glyph_putprop,
                                          glyph_remprop, glyph_plist,
                                          struct Lisp_Glyph);
@@ -2861,7 +2968,7 @@ allocate_glyph (enum glyph_type type,
   /* This function can GC */
   Lisp_Object obj = Qnil;
   struct Lisp_Glyph *g =
-    alloc_lcrecord_type (struct Lisp_Glyph, lrecord_glyph);
+    alloc_lcrecord_type (struct Lisp_Glyph, &lrecord_glyph);
 
   g->type = type;
   g->image = Fmake_specifier (Qimage); /* This function can GC */
@@ -3127,7 +3234,7 @@ glyph_height_internal (Lisp_Object glyph, Lisp_Object frame_face,
       {
        struct font_metric_info fm;
        Lisp_Object string = XIMAGE_INSTANCE_TEXT_STRING (instance);
-       unsigned char charsets[NUM_LEADING_BYTES];
+       Charset_ID charsets[NUM_LEADING_BYTES];
        struct face_cachel frame_cachel;
        struct face_cachel *cachel;
 
@@ -3539,9 +3646,26 @@ get_subwindow_cachel_index (struct frame *f, Lisp_Object subwindow)
   return elt;
 }
 
+/* redisplay in general assumes that drawing something will erase
+   what was there before. unfortunately this does not apply to
+   subwindows that need to be specifically unmapped in order to
+   disappear. we take a brute force approach - on the basis that its
+   cheap - and unmap all subwindows in a display line */
 void
 reset_subwindow_cachels (struct frame *f)
 {
+  int elt;
+  for (elt = 0; elt < Dynarr_length (f->subwindow_cachels); elt++)
+    {
+      struct subwindow_cachel *cachel =
+       Dynarr_atp (f->subwindow_cachels, elt);
+
+      if (!NILP (cachel->subwindow) && cachel->being_displayed)
+       {
+         struct Lisp_Image_Instance* ii = XIMAGE_INSTANCE (cachel->subwindow);
+         MAYBE_DEVMETH (XDEVICE (f->device), unmap_subwindow, (ii));
+       }
+    }
   Dynarr_reset (f->subwindow_cachels);
 }
 
@@ -4005,7 +4129,6 @@ image_instantiator_format_create (void)
   IIFORMAT_HAS_METHOD (formatted_string, validate);
   IIFORMAT_HAS_METHOD (formatted_string, possible_dest_types);
   IIFORMAT_HAS_METHOD (formatted_string, instantiate);
-
   IIFORMAT_VALID_KEYWORD (formatted_string, Q_data, check_valid_string);
 
   /* subwindows */
@@ -4032,6 +4155,21 @@ image_instantiator_format_create (void)
   IIFORMAT_VALID_KEYWORD (xbm, Q_background, check_valid_string);
 #endif /* HAVE_WINDOW_SYSTEM */
 
+#ifdef HAVE_XFACE
+  INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (xface, "xface");
+
+  IIFORMAT_HAS_METHOD (xface, validate);
+  IIFORMAT_HAS_METHOD (xface, normalize);
+  IIFORMAT_HAS_METHOD (xface, possible_dest_types);
+
+  IIFORMAT_VALID_KEYWORD (xface, Q_data, check_valid_string);
+  IIFORMAT_VALID_KEYWORD (xface, Q_file, check_valid_string);
+  IIFORMAT_VALID_KEYWORD (xface, Q_hotspot_x, check_valid_int);
+  IIFORMAT_VALID_KEYWORD (xface, Q_hotspot_y, check_valid_int);
+  IIFORMAT_VALID_KEYWORD (xface, Q_foreground, check_valid_string);
+  IIFORMAT_VALID_KEYWORD (xface, Q_background, check_valid_string);
+#endif
+
 #ifdef HAVE_XPM
   INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (xpm, "xpm");
 
@@ -4110,6 +4248,9 @@ The default value of this variable defines the logical color names
 */ );
   Vxpm_color_symbols = Qnil; /* initialized in x-faces.el */
 #endif /* HAVE_XPM */
+#ifdef HAVE_XFACE
+  Fprovide (Qxface);
+#endif
 }
 
 void