Mercurial > hg > xemacs-beta
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");