diff src/glyphs-x.c @ 288:e11d67e05968 r21-0b42

Import from CVS: tag r21-0b42
author cvs
date Mon, 13 Aug 2007 10:35:54 +0200
parents 7df0dd720c89
children c9fe270a4101
line wrap: on
line diff
--- a/src/glyphs-x.c	Mon Aug 13 10:35:07 2007 +0200
+++ b/src/glyphs-x.c	Mon Aug 13 10:35:54 2007 +0200
@@ -93,12 +93,6 @@
 
 #define LISP_DEVICE_TO_X_SCREEN(dev) XDefaultScreenOfDisplay (DEVICE_X_DISPLAY (XDEVICE (dev)))
 
-DEFINE_IMAGE_INSTANTIATOR_FORMAT (xbm);
-Lisp_Object Qxbm;
-
-Lisp_Object Q_mask_file, Q_mask_data, Q_hotspot_x, Q_hotspot_y;
-Lisp_Object Q_foreground, Q_background;
-
 #ifdef HAVE_XFACE
 DEFINE_IMAGE_INSTANTIATOR_FORMAT (xface);
 Lisp_Object Qxface;
@@ -853,212 +847,12 @@
     }
 }
 
-
-/**********************************************************************
- *                             XBM                                    *
- **********************************************************************/
-
-/* Check if DATA represents a valid inline XBM spec (i.e. a list
-   of (width height bits), with checking done on the dimensions).
-   If not, signal an error. */
-
-static void
-check_valid_xbm_inline (Lisp_Object data)
-{
-  Lisp_Object width, height, bits;
-
-  if (!CONSP (data) ||
-      !CONSP (XCDR (data)) ||
-      !CONSP (XCDR (XCDR (data))) ||
-      !NILP (XCDR (XCDR (XCDR (data)))))
-    signal_simple_error ("Must be list of 3 elements", data);
-
-  width  = XCAR (data);
-  height = XCAR (XCDR (data));
-  bits   = XCAR (XCDR (XCDR (data)));
-
-  CHECK_STRING (bits);
-
-  if (!NATNUMP (width))
-    signal_simple_error ("Width must be a natural number", width);
-
-  if (!NATNUMP (height))
-    signal_simple_error ("Height must be a natural number", height);
-
-  if (((XINT (width) * XINT (height)) / 8) > XSTRING_CHAR_LENGTH (bits))
-    signal_simple_error ("data is too short for width and height",
-			 vector3 (width, height, bits));
-}
-
-/* Validate method for XBM's. */
-
-static void
-xbm_validate (Lisp_Object instantiator)
-{
-  file_or_data_must_be_present (instantiator);
-}
-
-/* Given a filename that is supposed to contain XBM data, return
-   the inline representation of it as (width height bits).  Return
-   the hotspot through XHOT and YHOT, if those pointers are not 0.
-   If there is no hotspot, XHOT and YHOT will contain -1.
-
-   If the function fails:
-
-   -- if OK_IF_DATA_INVALID is set and the data was invalid,
-      return Qt.
-   -- maybe return an error, or return Qnil.
- */
-
-
-static Lisp_Object
-bitmap_to_lisp_data (Lisp_Object name, int *xhot, int *yhot,
-		     int ok_if_data_invalid)
+int read_bitmap_data_from_file (CONST char *filename, unsigned int *width, 
+				unsigned int *height, unsigned char **datap,
+				int *x_hot, int *y_hot)
 {
-  unsigned int w, h;
-  Extbyte *data;
-  int result;
-  CONST char *filename_ext;
-
-  GET_C_STRING_FILENAME_DATA_ALLOCA (name, filename_ext);
-  result = XmuReadBitmapDataFromFile (filename_ext, &w, &h, &data, xhot, yhot);
-
-  if (result == BitmapSuccess)
-    {
-      Lisp_Object retval;
-      int len = (w + 7) / 8 * h;
-
-      retval = list3 (make_int (w), make_int (h),
-		      make_ext_string (data, len, FORMAT_BINARY));
-      XFree ((char *) data);
-      return retval;
-    }
-
-  switch (result)
-    {
-    case BitmapOpenFailed:
-      {
-	/* should never happen */
-	signal_double_file_error ("Opening bitmap file",
-				  "no such file or directory",
-				  name);
-      }
-    case BitmapFileInvalid:
-      {
-	if (ok_if_data_invalid)
-	  return Qt;
-	signal_double_file_error ("Reading bitmap file",
-				  "invalid data in file",
-				  name);
-      }
-    case BitmapNoMemory:
-      {
-	signal_double_file_error ("Reading bitmap file",
-				  "out of memory",
-				  name);
-      }
-    default:
-      {
-	signal_double_file_error_2 ("Reading bitmap file",
-				    "unknown error code",
-				    make_int (result), name);
-      }
-    }
-
-  return Qnil; /* not reached */
-}
-
-static Lisp_Object
-xbm_mask_file_munging (Lisp_Object alist, Lisp_Object file,
-		       Lisp_Object mask_file)
-{
-  /* This is unclean but it's fairly standard -- a number of the
-     bitmaps in /usr/include/X11/bitmaps use it -- so we support
-     it. */
-  if (NILP (mask_file)
-      /* don't override explicitly specified mask data. */
-      && NILP (assq_no_quit (Q_mask_data, alist))
-      && !NILP (file))
-    {
-      mask_file =
-	locate_pixmap_file (concat2 (file, build_string ("Mask")));
-      if (NILP (mask_file))
-	mask_file =
-	  locate_pixmap_file (concat2 (file, build_string ("msk")));
-    }
-
-  if (!NILP (mask_file))
-    {
-      Lisp_Object mask_data =
-	bitmap_to_lisp_data (mask_file, 0, 0, 0);
-      alist = remassq_no_quit (Q_mask_file, alist);
-      /* there can't be a :mask-data at this point. */
-      alist = Fcons (Fcons (Q_mask_file, mask_file),
-		     Fcons (Fcons (Q_mask_data, mask_data), alist));
-    }
-
-  return alist;
-}
-
-/* Normalize method for XBM's. */
-
-static Lisp_Object
-xbm_normalize (Lisp_Object inst, Lisp_Object console_type)
-{
-  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);
-
-  if (!NILP (file))
-    {
-      int xhot, yhot;
-      Lisp_Object data = bitmap_to_lisp_data (file, &xhot, &yhot, 0);
-      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));
-
-      if (xhot != -1 && NILP (assq_no_quit (Q_hotspot_x, alist)))
-	alist = Fcons (Fcons (Q_hotspot_x, make_int (xhot)),
-		       alist);
-      if (yhot != -1 && NILP (assq_no_quit (Q_hotspot_y, alist)))
-	alist = Fcons (Fcons (Q_hotspot_y, make_int (yhot)),
-		       alist);
-    }
-
-  alist = xbm_mask_file_munging (alist, file, mask_file);
-
-  {
-    Lisp_Object result = alist_to_tagged_vector (Qxbm, alist);
-    free_alist (alist);
-    RETURN_UNGCPRO (result);
-  }
+  return XmuReadBitmapDataFromFile (filename, width, height, 
+				    datap, x_hot, y_hot);
 }
 
 /* Given inline data for a mono pixmap, create and return the
@@ -1214,15 +1008,6 @@
       abort ();
     }
 }
-
-static int
-xbm_possible_dest_types (void)
-{
-  return
-    IMAGE_MONO_PIXMAP_MASK  |
-    IMAGE_COLOR_PIXMAP_MASK |
-    IMAGE_POINTER_MASK;
-}
 
 static void
 xbm_instantiate_1 (Lisp_Object image_instance, Lisp_Object instantiator,
@@ -1247,7 +1032,7 @@
 				XINT (XCAR (XCDR (mask_data))),
 				(CONST unsigned char *)
 				gcc_may_you_rot_in_hell);
-}
+    }
 
   init_image_instance_from_xbm_inline (ii, width, height, bits,
 				       instantiator, pointer_fg, pointer_bg,
@@ -1257,9 +1042,9 @@
 /* Instantiate method for XBM's. */
 
 static void
-xbm_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
-		  Lisp_Object pointer_fg, Lisp_Object pointer_bg,
-		  int dest_mask, Lisp_Object domain)
+x_xbm_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 = find_keyword_in_vector (instantiator, Q_data);
   CONST char *gcc_go_home;
@@ -3554,7 +3339,7 @@
 		   Fcons (Fcons (Q_data, data), alist));
   }
 
-  alist = xbm_mask_file_munging (alist, file, mask_file);
+  alist = xbm_mask_file_munging (alist, file, mask_file, console_type);
 
   {
     Lisp_Object result = alist_to_tagged_vector (Qxface, alist);
@@ -3708,7 +3493,7 @@
 	    alist = Fcons (Fcons (Q_hotspot_y, make_int (yhot)),
 			   alist);
 
-	  alist = xbm_mask_file_munging (alist, filename, Qnil);
+	  alist = xbm_mask_file_munging (alist, filename, Qnil, console_type);
 
 	  {
 	    Lisp_Object result = alist_to_tagged_vector (Qxbm, alist);
@@ -4335,13 +4120,6 @@
   DEFSUBR (Fresize_subwindow);
   DEFSUBR (Fforce_subwindow_map);
 #endif
-
-  defkeyword (&Q_mask_file, ":mask-file");
-  defkeyword (&Q_mask_data, ":mask-data");
-  defkeyword (&Q_hotspot_x, ":hotspot-x");
-  defkeyword (&Q_hotspot_y, ":hotspot-y");
-  defkeyword (&Q_foreground, ":foreground");
-  defkeyword (&Q_background, ":background");
 }
 
 void
@@ -4359,29 +4137,12 @@
 #ifdef HAVE_XPM
   CONSOLE_HAS_METHOD (x, xpm_instantiate);
 #endif
+  CONSOLE_HAS_METHOD (x, xbm_instantiate);
 }
 
 void
 image_instantiator_format_create_glyphs_x (void)
 {
-  /* image-instantiator types */
-
-  INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (xbm, "xbm");
-
-  IIFORMAT_HAS_METHOD (xbm, validate);
-  IIFORMAT_HAS_METHOD (xbm, normalize);
-  IIFORMAT_HAS_METHOD (xbm, possible_dest_types);
-  IIFORMAT_HAS_METHOD (xbm, instantiate);
-
-
-  IIFORMAT_VALID_KEYWORD (xbm, Q_data, check_valid_xbm_inline);
-  IIFORMAT_VALID_KEYWORD (xbm, Q_file, check_valid_string);
-  IIFORMAT_VALID_KEYWORD (xbm, Q_mask_data, check_valid_xbm_inline);
-  IIFORMAT_VALID_KEYWORD (xbm, Q_mask_file, check_valid_string);
-  IIFORMAT_VALID_KEYWORD (xbm, Q_hotspot_x, check_valid_int);
-  IIFORMAT_VALID_KEYWORD (xbm, Q_hotspot_y, check_valid_int);
-  IIFORMAT_VALID_KEYWORD (xbm, Q_foreground, check_valid_string);
-  IIFORMAT_VALID_KEYWORD (xbm, Q_background, check_valid_string);
 
   INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (cursor_font, "cursor-font");