Mercurial > hg > xemacs-beta

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

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-0b42
author cvs
date Mon, 13 Aug 2007 10:35:54 +0200
parents 7df0dd720c89
children c9fe270a4101
comparison
equal deleted inserted replaced
287:13a0bd77a29d 288:e11d67e05968
90 #else 90 #else
91 #error What kind of strange-ass system are we running on? 91 #error What kind of strange-ass system are we running on?
92 #endif 92 #endif
93 93
94 #define LISP_DEVICE_TO_X_SCREEN(dev) XDefaultScreenOfDisplay (DEVICE_X_DISPLAY (XDEVICE (dev))) 94 #define LISP_DEVICE_TO_X_SCREEN(dev) XDefaultScreenOfDisplay (DEVICE_X_DISPLAY (XDEVICE (dev)))
95
96 DEFINE_IMAGE_INSTANTIATOR_FORMAT (xbm);
97 Lisp_Object Qxbm;
98
99 Lisp_Object Q_mask_file, Q_mask_data, Q_hotspot_x, Q_hotspot_y;
100 Lisp_Object Q_foreground, Q_background;
101 95
102 #ifdef HAVE_XFACE 96 #ifdef HAVE_XFACE
103 DEFINE_IMAGE_INSTANTIATOR_FORMAT (xface); 97 DEFINE_IMAGE_INSTANTIATOR_FORMAT (xface);
104 Lisp_Object Qxface; 98 Lisp_Object Qxface;
105 #endif 99 #endif
851 } 845 }
852 XDestroyImage (ximage); 846 XDestroyImage (ximage);
853 } 847 }
854 } 848 }
855 849
856 850 int read_bitmap_data_from_file (CONST char *filename, unsigned int *width,
857 /********************************************************************** 851 unsigned int *height, unsigned char **datap,
858 * XBM * 852 int *x_hot, int *y_hot)
859 **********************************************************************/ 853 {
860 854 return XmuReadBitmapDataFromFile (filename, width, height,
861 /* Check if DATA represents a valid inline XBM spec (i.e. a list 855 datap, x_hot, y_hot);
862 of (width height bits), with checking done on the dimensions).
863 If not, signal an error. */
864
865 static void
866 check_valid_xbm_inline (Lisp_Object data)
867 {
868 Lisp_Object width, height, bits;
869
870 if (!CONSP (data) ||
871 !CONSP (XCDR (data)) ||
872 !CONSP (XCDR (XCDR (data))) ||
873 !NILP (XCDR (XCDR (XCDR (data)))))
874 signal_simple_error ("Must be list of 3 elements", data);
875
876 width = XCAR (data);
877 height = XCAR (XCDR (data));
878 bits = XCAR (XCDR (XCDR (data)));
879
880 CHECK_STRING (bits);
881
882 if (!NATNUMP (width))
883 signal_simple_error ("Width must be a natural number", width);
884
885 if (!NATNUMP (height))
886 signal_simple_error ("Height must be a natural number", height);
887
888 if (((XINT (width) * XINT (height)) / 8) > XSTRING_CHAR_LENGTH (bits))
889 signal_simple_error ("data is too short for width and height",
890 vector3 (width, height, bits));
891 }
892
893 /* Validate method for XBM's. */
894
895 static void
896 xbm_validate (Lisp_Object instantiator)
897 {
898 file_or_data_must_be_present (instantiator);
899 }
900
901 /* Given a filename that is supposed to contain XBM data, return
902 the inline representation of it as (width height bits). Return
903 the hotspot through XHOT and YHOT, if those pointers are not 0.
904 If there is no hotspot, XHOT and YHOT will contain -1.
905
906 If the function fails:
907
908 -- if OK_IF_DATA_INVALID is set and the data was invalid,
909 return Qt.
910 -- maybe return an error, or return Qnil.
911 */
912
913
914 static Lisp_Object
915 bitmap_to_lisp_data (Lisp_Object name, int *xhot, int *yhot,
916 int ok_if_data_invalid)
917 {
918 unsigned int w, h;
919 Extbyte *data;
920 int result;
921 CONST char *filename_ext;
922
923 GET_C_STRING_FILENAME_DATA_ALLOCA (name, filename_ext);
924 result = XmuReadBitmapDataFromFile (filename_ext, &w, &h, &data, xhot, yhot);
925
926 if (result == BitmapSuccess)
927 {
928 Lisp_Object retval;
929 int len = (w + 7) / 8 * h;
930
931 retval = list3 (make_int (w), make_int (h),
932 make_ext_string (data, len, FORMAT_BINARY));
933 XFree ((char *) data);
934 return retval;
935 }
936
937 switch (result)
938 {
939 case BitmapOpenFailed:
940 {
941 /* should never happen */
942 signal_double_file_error ("Opening bitmap file",
943 "no such file or directory",
944 name);
945 }
946 case BitmapFileInvalid:
947 {
948 if (ok_if_data_invalid)
949 return Qt;
950 signal_double_file_error ("Reading bitmap file",
951 "invalid data in file",
952 name);
953 }
954 case BitmapNoMemory:
955 {
956 signal_double_file_error ("Reading bitmap file",
957 "out of memory",
958 name);
959 }
960 default:
961 {
962 signal_double_file_error_2 ("Reading bitmap file",
963 "unknown error code",
964 make_int (result), name);
965 }
966 }
967
968 return Qnil; /* not reached */
969 }
970
971 static Lisp_Object
972 xbm_mask_file_munging (Lisp_Object alist, Lisp_Object file,
973 Lisp_Object mask_file)
974 {
975 /* This is unclean but it's fairly standard -- a number of the
976 bitmaps in /usr/include/X11/bitmaps use it -- so we support
977 it. */
978 if (NILP (mask_file)
979 /* don't override explicitly specified mask data. */
980 && NILP (assq_no_quit (Q_mask_data, alist))
981 && !NILP (file))
982 {
983 mask_file =
984 locate_pixmap_file (concat2 (file, build_string ("Mask")));
985 if (NILP (mask_file))
986 mask_file =
987 locate_pixmap_file (concat2 (file, build_string ("msk")));
988 }
989
990 if (!NILP (mask_file))
991 {
992 Lisp_Object mask_data =
993 bitmap_to_lisp_data (mask_file, 0, 0, 0);
994 alist = remassq_no_quit (Q_mask_file, alist);
995 /* there can't be a :mask-data at this point. */
996 alist = Fcons (Fcons (Q_mask_file, mask_file),
997 Fcons (Fcons (Q_mask_data, mask_data), alist));
998 }
999
1000 return alist;
1001 }
1002
1003 /* Normalize method for XBM's. */
1004
1005 static Lisp_Object
1006 xbm_normalize (Lisp_Object inst, Lisp_Object console_type)
1007 {
1008 Lisp_Object file = Qnil, mask_file = Qnil;
1009 struct gcpro gcpro1, gcpro2, gcpro3;
1010 Lisp_Object alist = Qnil;
1011
1012 GCPRO3 (file, mask_file, alist);
1013
1014 /* Now, convert any file data into inline data for both the regular
1015 data and the mask data. At the end of this, `data' will contain
1016 the inline data (if any) or Qnil, and `file' will contain
1017 the name this data was derived from (if known) or Qnil.
1018 Likewise for `mask_file' and `mask_data'.
1019
1020 Note that if we cannot generate any regular inline data, we
1021 skip out. */
1022
1023 file = potential_pixmap_file_instantiator (inst, Q_file, Q_data,
1024 console_type);
1025 mask_file = potential_pixmap_file_instantiator (inst, Q_mask_file,
1026 Q_mask_data, console_type);
1027
1028 if (CONSP (file)) /* failure locating filename */
1029 signal_double_file_error ("Opening bitmap file",
1030 "no such file or directory",
1031 Fcar (file));
1032
1033 if (NILP (file) && NILP (mask_file)) /* no conversion necessary */
1034 RETURN_UNGCPRO (inst);
1035
1036 alist = tagged_vector_to_alist (inst);
1037
1038 if (!NILP (file))
1039 {
1040 int xhot, yhot;
1041 Lisp_Object data = bitmap_to_lisp_data (file, &xhot, &yhot, 0);
1042 alist = remassq_no_quit (Q_file, alist);
1043 /* there can't be a :data at this point. */
1044 alist = Fcons (Fcons (Q_file, file),
1045 Fcons (Fcons (Q_data, data), alist));
1046
1047 if (xhot != -1 && NILP (assq_no_quit (Q_hotspot_x, alist)))
1048 alist = Fcons (Fcons (Q_hotspot_x, make_int (xhot)),
1049 alist);
1050 if (yhot != -1 && NILP (assq_no_quit (Q_hotspot_y, alist)))
1051 alist = Fcons (Fcons (Q_hotspot_y, make_int (yhot)),
1052 alist);
1053 }
1054
1055 alist = xbm_mask_file_munging (alist, file, mask_file);
1056
1057 {
1058 Lisp_Object result = alist_to_tagged_vector (Qxbm, alist);
1059 free_alist (alist);
1060 RETURN_UNGCPRO (result);
1061 }
1062 } 856 }
1063 857
1064 /* Given inline data for a mono pixmap, create and return the 858 /* Given inline data for a mono pixmap, create and return the
1065 corresponding X object. */ 859 corresponding X object. */
1066 860
1212 1006
1213 default: 1007 default:
1214 abort (); 1008 abort ();
1215 } 1009 }
1216 } 1010 }
1217
1218 static int
1219 xbm_possible_dest_types (void)
1220 {
1221 return
1222 IMAGE_MONO_PIXMAP_MASK |
1223 IMAGE_COLOR_PIXMAP_MASK |
1224 IMAGE_POINTER_MASK;
1225 }
1226 1011
1227 static void 1012 static void
1228 xbm_instantiate_1 (Lisp_Object image_instance, Lisp_Object instantiator, 1013 xbm_instantiate_1 (Lisp_Object image_instance, Lisp_Object instantiator,
1229 Lisp_Object pointer_fg, Lisp_Object pointer_bg, 1014 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1230 int dest_mask, int width, int height, 1015 int dest_mask, int width, int height,
1245 pixmap_from_xbm_inline (IMAGE_INSTANCE_DEVICE (ii), 1030 pixmap_from_xbm_inline (IMAGE_INSTANCE_DEVICE (ii),
1246 XINT (XCAR (mask_data)), 1031 XINT (XCAR (mask_data)),
1247 XINT (XCAR (XCDR (mask_data))), 1032 XINT (XCAR (XCDR (mask_data))),
1248 (CONST unsigned char *) 1033 (CONST unsigned char *)
1249 gcc_may_you_rot_in_hell); 1034 gcc_may_you_rot_in_hell);
1250 } 1035 }
1251 1036
1252 init_image_instance_from_xbm_inline (ii, width, height, bits, 1037 init_image_instance_from_xbm_inline (ii, width, height, bits,
1253 instantiator, pointer_fg, pointer_bg, 1038 instantiator, pointer_fg, pointer_bg,
1254 dest_mask, mask, mask_file); 1039 dest_mask, mask, mask_file);
1255 } 1040 }
1256 1041
1257 /* Instantiate method for XBM's. */ 1042 /* Instantiate method for XBM's. */
1258 1043
1259 static void 1044 static void
1260 xbm_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, 1045 x_xbm_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1261 Lisp_Object pointer_fg, Lisp_Object pointer_bg, 1046 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1262 int dest_mask, Lisp_Object domain) 1047 int dest_mask, Lisp_Object domain)
1263 { 1048 {
1264 Lisp_Object data = find_keyword_in_vector (instantiator, Q_data); 1049 Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1265 CONST char *gcc_go_home; 1050 CONST char *gcc_go_home;
1266 1051
1267 assert (!NILP (data)); 1052 assert (!NILP (data));
3552 /* there can't be a :data at this point. */ 3337 /* there can't be a :data at this point. */
3553 alist = Fcons (Fcons (Q_file, file), 3338 alist = Fcons (Fcons (Q_file, file),
3554 Fcons (Fcons (Q_data, data), alist)); 3339 Fcons (Fcons (Q_data, data), alist));
3555 } 3340 }
3556 3341
3557 alist = xbm_mask_file_munging (alist, file, mask_file); 3342 alist = xbm_mask_file_munging (alist, file, mask_file, console_type);
3558 3343
3559 { 3344 {
3560 Lisp_Object result = alist_to_tagged_vector (Qxface, alist); 3345 Lisp_Object result = alist_to_tagged_vector (Qxface, alist);
3561 free_alist (alist); 3346 free_alist (alist);
3562 RETURN_UNGCPRO (result); 3347 RETURN_UNGCPRO (result);
3706 alist); 3491 alist);
3707 if (yhot != -1) 3492 if (yhot != -1)
3708 alist = Fcons (Fcons (Q_hotspot_y, make_int (yhot)), 3493 alist = Fcons (Fcons (Q_hotspot_y, make_int (yhot)),
3709 alist); 3494 alist);
3710 3495
3711 alist = xbm_mask_file_munging (alist, filename, Qnil); 3496 alist = xbm_mask_file_munging (alist, filename, Qnil, console_type);
3712 3497
3713 { 3498 {
3714 Lisp_Object result = alist_to_tagged_vector (Qxbm, alist); 3499 Lisp_Object result = alist_to_tagged_vector (Qxbm, alist);
3715 free_alist (alist); 3500 free_alist (alist);
3716 RETURN_UNGCPRO (result); 3501 RETURN_UNGCPRO (result);
4333 DEFSUBR (Fsubwindow_height); 4118 DEFSUBR (Fsubwindow_height);
4334 DEFSUBR (Fsubwindow_xid); 4119 DEFSUBR (Fsubwindow_xid);
4335 DEFSUBR (Fresize_subwindow); 4120 DEFSUBR (Fresize_subwindow);
4336 DEFSUBR (Fforce_subwindow_map); 4121 DEFSUBR (Fforce_subwindow_map);
4337 #endif 4122 #endif
4338
4339 defkeyword (&Q_mask_file, ":mask-file");
4340 defkeyword (&Q_mask_data, ":mask-data");
4341 defkeyword (&Q_hotspot_x, ":hotspot-x");
4342 defkeyword (&Q_hotspot_y, ":hotspot-y");
4343 defkeyword (&Q_foreground, ":foreground");
4344 defkeyword (&Q_background, ":background");
4345 } 4123 }
4346 4124
4347 void 4125 void
4348 console_type_create_glyphs_x (void) 4126 console_type_create_glyphs_x (void)
4349 { 4127 {
4357 CONSOLE_HAS_METHOD (x, init_image_instance_from_eimage); 4135 CONSOLE_HAS_METHOD (x, init_image_instance_from_eimage);
4358 CONSOLE_HAS_METHOD (x, locate_pixmap_file); 4136 CONSOLE_HAS_METHOD (x, locate_pixmap_file);
4359 #ifdef HAVE_XPM 4137 #ifdef HAVE_XPM
4360 CONSOLE_HAS_METHOD (x, xpm_instantiate); 4138 CONSOLE_HAS_METHOD (x, xpm_instantiate);
4361 #endif 4139 #endif
4140 CONSOLE_HAS_METHOD (x, xbm_instantiate);
4362 } 4141 }
4363 4142
4364 void 4143 void
4365 image_instantiator_format_create_glyphs_x (void) 4144 image_instantiator_format_create_glyphs_x (void)
4366 { 4145 {
4367 /* image-instantiator types */
4368
4369 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (xbm, "xbm");
4370
4371 IIFORMAT_HAS_METHOD (xbm, validate);
4372 IIFORMAT_HAS_METHOD (xbm, normalize);
4373 IIFORMAT_HAS_METHOD (xbm, possible_dest_types);
4374 IIFORMAT_HAS_METHOD (xbm, instantiate);
4375
4376
4377 IIFORMAT_VALID_KEYWORD (xbm, Q_data, check_valid_xbm_inline);
4378 IIFORMAT_VALID_KEYWORD (xbm, Q_file, check_valid_string);
4379 IIFORMAT_VALID_KEYWORD (xbm, Q_mask_data, check_valid_xbm_inline);
4380 IIFORMAT_VALID_KEYWORD (xbm, Q_mask_file, check_valid_string);
4381 IIFORMAT_VALID_KEYWORD (xbm, Q_hotspot_x, check_valid_int);
4382 IIFORMAT_VALID_KEYWORD (xbm, Q_hotspot_y, check_valid_int);
4383 IIFORMAT_VALID_KEYWORD (xbm, Q_foreground, check_valid_string);
4384 IIFORMAT_VALID_KEYWORD (xbm, Q_background, check_valid_string);
4385 4146
4386 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (cursor_font, "cursor-font"); 4147 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (cursor_font, "cursor-font");
4387 4148
4388 IIFORMAT_HAS_METHOD (cursor_font, validate); 4149 IIFORMAT_HAS_METHOD (cursor_font, validate);
4389 IIFORMAT_HAS_METHOD (cursor_font, possible_dest_types); 4150 IIFORMAT_HAS_METHOD (cursor_font, possible_dest_types);