comparison src/objects-msw.c @ 294:4b85ae5eabfb r21-0b45

Import from CVS: tag r21-0b45
author cvs
date Mon, 13 Aug 2007 10:38:01 +0200
parents e11d67e05968
children 5a79be0ef6a8
comparison
equal deleted inserted replaced
293:403535bfea94 294:4b85ae5eabfb
719 {"DarkMagenta" , PALETTERGB (139, 0, 139) }, 719 {"DarkMagenta" , PALETTERGB (139, 0, 139) },
720 {"DarkRed" , PALETTERGB (139, 0, 0) }, 720 {"DarkRed" , PALETTERGB (139, 0, 0) },
721 {"LightGreen" , PALETTERGB (144, 238, 144) } 721 {"LightGreen" , PALETTERGB (144, 238, 144) }
722 }; 722 };
723 723
724
725 /************************************************************************/
726 /* helpers */
727 /************************************************************************/
728
724 static int 729 static int
725 hexval (char c) 730 hexval (char c)
726 { 731 {
727 /* assumes ASCII and isxdigit(c) */ 732 /* assumes ASCII and isxdigit(c) */
728 if (c >= 'a') 733 if (c >= 'a')
745 unsigned int r, g, b; 750 unsigned int r, g, b;
746 751
747 for (i=1; i<strlen(name); i++) 752 for (i=1; i<strlen(name); i++)
748 { 753 {
749 if (!isxdigit ((int)name[i])) 754 if (!isxdigit ((int)name[i]))
750 return(-1); 755 return (COLORREF) -1;
751 } 756 }
752 if (strlen(name)==7) 757 if (strlen(name)==7)
753 { 758 {
754 r = hexval (name[1]) * 16 + hexval (name[2]); 759 r = hexval (name[1]) * 16 + hexval (name[2]);
755 g = hexval (name[3]) * 16 + hexval (name[4]); 760 g = hexval (name[3]) * 16 + hexval (name[4]);
791 b /= 17; 796 b /= 17;
792 } 797 }
793 return (PALETTERGB (r, g, b)); 798 return (PALETTERGB (r, g, b));
794 } 799 }
795 else 800 else
796 return -1; 801 return (COLORREF) -1;
797 } 802 }
798 else if (*name) /* Can't be an empty string */ 803 else if (*name) /* Can't be an empty string */
799 { 804 {
800 char *nospaces = alloca (strlen (name)+1); 805 char *nospaces = alloca (strlen (name)+1);
801 char *c=nospaces; 806 char *c=nospaces;
808 813
809 for (i=0; i< countof (mswindows_X_color_map); i++) 814 for (i=0; i< countof (mswindows_X_color_map); i++)
810 if (!stricmp (nospaces, mswindows_X_color_map[i].name)) 815 if (!stricmp (nospaces, mswindows_X_color_map[i].name))
811 return (mswindows_X_color_map[i].colorref); 816 return (mswindows_X_color_map[i].colorref);
812 } 817 }
813 return(-1); 818 return (COLORREF) -1;
814 } 819 }
820
821 /*
822 * Returns non-zero if the two supplied font patterns match.
823 * If they match and fontname is not NULL, copies the logical OR of the
824 * patterns to fontname (which is assumed to be at least MSW_FONTSIZE in size).
825 *
826 * The patterns 'match' iff for each field that is not blank in either pattern,
827 * the corresponding field in the other pattern is either identical or blank.
828 */
829 static int
830 match_font (char *pattern1, char *pattern2, char *fontname)
831 {
832 char *c1=pattern1, *c2=pattern2, *e1, *e2;
833 int i;
834
835 if (fontname)
836 fontname[0] = '\0';
837
838 for (i=0; i<5; i++)
839 {
840 if (c1 && (e1 = strchr (c1, ':')))
841 *(e1) = '\0';
842 if (c2 && (e2 = strchr (c2, ':')))
843 *(e2) = '\0';
844
845 if (c1 && c1[0]!='\0')
846 {
847 if (c2 && c2[0]!='\0' && stricmp(c1, c2))
848 {
849 if (e1) *e1 = ':';
850 if (e2) *e2 = ':';
851 return 0;
852 }
853 else if (fontname)
854 strcat (strcat (fontname, c1), ":");
855 }
856 else if (fontname)
857 {
858 if (c2 && c2[0]!='\0')
859 strcat (strcat (fontname, c2), ":");
860 else
861 strcat (fontname, ":");
862 }
863
864 if (e1) *(e1++) = ':';
865 if (e2) *(e2++) = ':';
866 c1=e1;
867 c2=e2;
868 }
869
870 if (fontname)
871 fontname[strlen (fontname) - 1] = '\0'; /* Trim trailing ':' */
872 return 1;
873 }
874
875
876 /************************************************************************/
877 /* methods */
878 /************************************************************************/
815 879
816 static int 880 static int
817 mswindows_initialize_color_instance (struct Lisp_Color_Instance *c, Lisp_Object name, 881 mswindows_initialize_color_instance (struct Lisp_Color_Instance *c, Lisp_Object name,
818 Lisp_Object device, Error_behavior errb) 882 Lisp_Object device, Error_behavior errb)
819 { 883 {
906 } 970 }
907 } 971 }
908 972
909 static int 973 static int
910 mswindows_initialize_font_instance (struct Lisp_Font_Instance *f, Lisp_Object name, 974 mswindows_initialize_font_instance (struct Lisp_Font_Instance *f, Lisp_Object name,
911 Lisp_Object device, Error_behavior errb) 975 Lisp_Object device, Error_behavior errb)
912 { 976 {
913 CONST char *extname; 977 CONST char *extname;
914 LOGFONT logfont; 978 LOGFONT logfont;
915 int fields; 979 int fields;
916 int pt; 980 int pt;
917 char fontname[LF_FACESIZE], weight[32], *style, points[8], effects[32], charset[32]; 981 char fontname[LF_FACESIZE], weight[LF_FACESIZE], *style, points[8];
918 982 char effects[LF_FACESIZE], charset[LF_FACESIZE];
983 char *c;
984
919 GET_C_STRING_CTEXT_DATA_ALLOCA (f->name, extname); 985 GET_C_STRING_CTEXT_DATA_ALLOCA (f->name, extname);
920 986
921 /* 987 /*
922 * mswindows fonts look like: 988 * mswindows fonts look like:
923 * fontname[:[weight ][style][:pointsize[:effects[:charset]]]] 989 * fontname[:[weight ][style][:pointsize[:effects]]][:charset]
924 * The font name field shouldn't be empty. 990 * The font name field shouldn't be empty.
925 * #### Windows will substitute a default (monospace) font if the font name
926 * specifies a non-existent font. We don't catch this.
927 * effects and charset are currently ignored.
928 * 991 *
929 * ie: 992 * ie:
930 * Lucida Console:Regular:10 993 * Lucida Console:Regular:10
931 * minimal: 994 * minimal:
932 * Courier New 995 * Courier New
933 * maximal: 996 * maximal:
934 * Courier New:Bold Italic:10:underline strikeout:ansi 997 * Courier New:Bold Italic:10:underline strikeout:western
935 */ 998 */
999
936 fields = sscanf (extname, "%31[^:]:%31[^:]:%7[^:]:%31[^:]:%31s", 1000 fields = sscanf (extname, "%31[^:]:%31[^:]:%7[^:]:%31[^:]:%31s",
937 fontname, weight, points, effects, charset); 1001 fontname, weight, points, effects, charset);
1002
1003 /* This function is implemented in a fairly ad-hoc manner.
1004 * The general idea is to validate and canonicalize each of the above fields
1005 * at the same time as we build up the win32 LOGFONT structure. This enables
1006 * us to use math_font() on a canonicalized font string to check the
1007 * availability of the requested font */
938 1008
939 if (fields<0) 1009 if (fields<0)
940 { 1010 {
941 maybe_signal_simple_error ("Invalid font", f->name, Qfont, errb); 1011 maybe_signal_simple_error ("Invalid font", f->name, Qfont, errb);
942 return (0); 1012 return (0);
951 { 1021 {
952 maybe_signal_simple_error ("Must specify a font name", f->name, Qfont, errb); 1022 maybe_signal_simple_error ("Must specify a font name", f->name, Qfont, errb);
953 return (0); 1023 return (0);
954 } 1024 }
955 1025
956 if (fields > 1 && strlen(weight)) 1026 /* weight */
1027 if (fields < 2)
1028 strcpy (weight, "Regular");
1029
1030 /* Maybe split weight into weight and style */
1031 if ((c=strchr(weight, ' ')))
957 { 1032 {
958 char *c; 1033 *c = '\0';
959 /* Maybe split weight into weight and style */ 1034 style = c+1;
960 if ((c=strchr(weight, ' '))) 1035 }
961 { 1036 else
962 *c = '\0'; 1037 style = NULL;
963 style = c+1; 1038
964 } 1039 #define FROB(wgt) \
965 else 1040 if (stricmp (weight, #wgt) == 0) \
966 style = NULL; 1041 logfont.lfWeight = FW_##wgt
967 1042
968 /* weight: Most-often used (maybe) first */ 1043 FROB (REGULAR);
969 if (stricmp (weight,"regular") == 0) 1044 else FROB (THIN);
1045 else FROB (EXTRALIGHT);
1046 else FROB (ULTRALIGHT);
1047 else FROB (LIGHT);
1048 else FROB (NORMAL);
1049 else FROB (MEDIUM);
1050 else FROB (SEMIBOLD);
1051 else FROB (DEMIBOLD);
1052 else FROB (BOLD);
1053 else FROB (EXTRABOLD);
1054 else FROB (ULTRABOLD);
1055 else FROB (HEAVY);
1056 else FROB (BLACK);
1057 else if (!style)
1058 {
970 logfont.lfWeight = FW_REGULAR; 1059 logfont.lfWeight = FW_REGULAR;
971 else if (stricmp (weight,"normal") == 0) 1060 style = weight; /* May have specified style without weight */
972 logfont.lfWeight = FW_NORMAL; 1061 }
973 else if (stricmp (weight,"bold") == 0) 1062 else
974 logfont.lfWeight = FW_BOLD; 1063 {
975 else if (stricmp (weight,"medium") == 0) 1064 maybe_signal_simple_error ("Invalid font weight", f->name, Qfont, errb);
976 logfont.lfWeight = FW_MEDIUM; 1065 return (0);
977 else if (stricmp (weight,"italic") == 0) /* Hack for early exit */ 1066 }
978 { 1067
979 logfont.lfItalic = TRUE; 1068 #undef FROB
980 style=weight; 1069
981 } 1070 if (style)
982 /* the rest */
983 else if (stricmp (weight,"black") == 0)
984 logfont.lfWeight = FW_BLACK;
985 else if (stricmp (weight,"heavy") == 0)
986 logfont.lfWeight = FW_HEAVY;
987 else if (stricmp (weight,"ultrabold") == 0)
988 logfont.lfWeight = FW_ULTRABOLD;
989 else if (stricmp (weight,"extrabold") == 0)
990 logfont.lfWeight = FW_EXTRABOLD;
991 else if (stricmp (weight,"demibold") == 0)
992 logfont.lfWeight = FW_SEMIBOLD;
993 else if (stricmp (weight,"semibold") == 0)
994 logfont.lfWeight = FW_SEMIBOLD;
995 else if (stricmp (weight,"light") == 0)
996 logfont.lfWeight = FW_LIGHT;
997 else if (stricmp (weight,"ultralight") == 0)
998 logfont.lfWeight = FW_ULTRALIGHT;
999 else if (stricmp (weight,"extralight") == 0)
1000 logfont.lfWeight = FW_EXTRALIGHT;
1001 else if (stricmp (weight,"thin") == 0)
1002 logfont.lfWeight = FW_THIN;
1003 else
1004 {
1005 logfont.lfWeight = FW_NORMAL;
1006 if (!style)
1007 style = weight; /* May have specified a style without a weight */
1008 else
1009 {
1010 maybe_signal_simple_error ("Invalid font weight", f->name, Qfont, errb);
1011 return (0); /* Invalid weight */
1012 }
1013 }
1014
1015 if (style)
1016 { 1071 {
1017 /* #### what about oblique? */ 1072 /* #### what about oblique? */
1018 if (stricmp (style,"italic") == 0) 1073 if (stricmp (style,"italic") == 0)
1019 logfont.lfItalic = TRUE; 1074 logfont.lfItalic = TRUE;
1020 else if (stricmp (style,"roman") == 0)
1021 logfont.lfItalic = FALSE;
1022 else 1075 else
1023 { 1076 {
1024 maybe_signal_simple_error ("Invalid font weight or style", f->name, Qfont, errb); 1077 maybe_signal_simple_error ("Invalid font weight or style", f->name, Qfont, errb);
1025 return (0); /* Invalid weight or style */ 1078 return (0);
1026 } 1079 }
1027 } 1080
1028 else 1081 /* Glue weight and style together again */
1029 { 1082 if (weight != style)
1030 logfont.lfItalic = FALSE; 1083 *c = ' ';
1031 } 1084 }
1032
1033 }
1034 else 1085 else
1035 {
1036 logfont.lfWeight = FW_NORMAL;
1037 logfont.lfItalic = FALSE; 1086 logfont.lfItalic = FALSE;
1038 } 1087
1039 1088 if (fields < 3)
1040 /* #### Should we reject strings that don't specify a size? */ 1089 pt = 10; /* #### Should we reject strings that don't specify a size? */
1041 if (fields < 3 || !strlen(points) || (pt=atoi(points))==0) 1090 else if ((pt=atoi(points)) == 0)
1042 pt = 10; 1091 {
1092 maybe_signal_simple_error ("Invalid font pointsize", f->name, Qfont, errb);
1093 return (0);
1094 }
1043 1095
1044 /* Formula for pointsize->height from LOGFONT docs in MSVC5 Platform SDK */ 1096 /* Formula for pointsize->height from LOGFONT docs in MSVC5 Platform SDK */
1045 logfont.lfHeight = -MulDiv(pt, DEVICE_MSWINDOWS_LOGPIXELSY(XDEVICE (device)), 72); 1097 logfont.lfHeight = -MulDiv(pt, DEVICE_MSWINDOWS_LOGPIXELSY(XDEVICE (device)), 72);
1046 logfont.lfWidth = 0; 1098 logfont.lfWidth = 0;
1047 1099
1048 /* Default to monospaced if the specified font name is not found */ 1100 /* Effects */
1049 logfont.lfPitchAndFamily = FF_MODERN;
1050
1051 /* ####: FIXME? */
1052 logfont.lfUnderline = FALSE; 1101 logfont.lfUnderline = FALSE;
1053 logfont.lfStrikeOut = FALSE; 1102 logfont.lfStrikeOut = FALSE;
1054 1103 if (fields >= 4 && effects[0] != '\0')
1104 {
1105 char *effects2;
1106
1107 /* Maybe split effects into effects and effects2 */
1108 if ((c=strchr (effects, ' ')))
1109 {
1110 *c = '\0';
1111 effects2 = c+1;
1112 }
1113 else
1114 effects2 = NULL;
1115
1116 if (stricmp (effects, "underline") == 0)
1117 logfont.lfUnderline = TRUE;
1118 else if (stricmp (effects, "strikeout") == 0)
1119 logfont.lfStrikeOut = TRUE;
1120 else
1121 {
1122 maybe_signal_simple_error ("Invalid font effect", f->name,
1123 Qfont, errb);
1124 return (0);
1125 }
1126
1127 if (effects2 && effects2[0] != '\0')
1128 {
1129 if (stricmp (effects2, "underline") == 0)
1130 logfont.lfUnderline = TRUE;
1131 else if (stricmp (effects2, "strikeout") == 0)
1132 logfont.lfStrikeOut = TRUE;
1133 else
1134 {
1135 maybe_signal_simple_error ("Invalid font effect", f->name,
1136 Qfont, errb);
1137 return (0);
1138 }
1139 }
1140
1141 /* Regenerate sanitised effects string */
1142 if (logfont.lfUnderline)
1143 {
1144 if (logfont.lfStrikeOut)
1145 strcpy (effects, "underline strikeout");
1146 else
1147 strcpy (effects, "underline");
1148 }
1149 else if (logfont.lfStrikeOut)
1150 strcpy (effects, "strikeout");
1151 }
1152 else
1153 effects[0] = '\0';
1055 1154
1056 #define FROB(cs) \ 1155 #define FROB(cs) \
1057 else if (stricmp (charset, #cs) == 0) \ 1156 else if (stricmp (charset, #cs) == 0) \
1058 logfont.lfCharSet = cs##_CHARSET 1157 logfont.lfCharSet = cs##_CHARSET
1059 1158
1061 We do not use the name "russian", only "cyrillic", as it is 1160 We do not use the name "russian", only "cyrillic", as it is
1062 the common name of this charset, used in other languages 1161 the common name of this charset, used in other languages
1063 than Russian. */ 1162 than Russian. */
1064 #define CYRILLIC_CHARSET RUSSIAN_CHARSET 1163 #define CYRILLIC_CHARSET RUSSIAN_CHARSET
1065 #define CENTRALEUROPEAN_CHARSET EASTEUROPE_CHARSET 1164 #define CENTRALEUROPEAN_CHARSET EASTEUROPE_CHARSET
1066 1165 #define CENTRALEUROPEAN_CHARSET EASTEUROPE_CHARSET
1067 if (fields > 4) 1166
1068 { 1167 /* charset can be specified even if earlier fields havn't been */
1069 if (charset[0] == '\0' || stricmp (charset, "ansi") == 0) 1168 if ((fields < 5) && (c=strchr (extname, ':')) && (c=strchr (c+1, ':')) &&
1070 logfont.lfCharSet = ANSI_CHARSET; 1169 (c=strchr (c+1, ':')) && (c=strchr (c+1, ':')))
1071 FROB (DEFAULT); /* #### Should we alow this? */ 1170 {
1072 FROB (SYMBOL); 1171 strncpy (charset, c+1, LF_FACESIZE);
1073 FROB (SHIFTJIS); 1172 charset[LF_FACESIZE-1] = '\0';
1074 FROB (GB2312);
1075 FROB (HANGEUL);
1076 FROB (CHINESEBIG5);
1077 FROB (OEM);
1078 FROB (JOHAB);
1079 FROB (HEBREW);
1080 FROB (ARABIC);
1081 FROB (GREEK);
1082 FROB (TURKISH);
1083 FROB (THAI);
1084 FROB (EASTEUROPE);
1085 FROB (CENTRALEUROPEAN);
1086 FROB (CYRILLIC);
1087 FROB (MAC);
1088 FROB (BALTIC);
1089 else
1090 {
1091 maybe_signal_simple_error ("Invalid charset name", f->name, Qfont, errb);
1092 return 0;
1093 }
1094 } 1173 }
1095 else 1174 else
1096 logfont.lfCharSet = ANSI_CHARSET; 1175 charset[0] = '\0';
1176
1177 if (charset[0] == '\0' || (stricmp (charset, "ansi") == 0) ||
1178 (stricmp (charset, "western") == 0))
1179 {
1180 logfont.lfCharSet = ANSI_CHARSET;
1181 strcpy (charset, "western");
1182 }
1183 FROB (SYMBOL);
1184 FROB (SHIFTJIS);
1185 FROB (GB2312);
1186 FROB (HANGEUL);
1187 FROB (CHINESEBIG5);
1188 FROB (JOHAB);
1189 FROB (HEBREW);
1190 FROB (ARABIC);
1191 FROB (GREEK);
1192 FROB (TURKISH);
1193 FROB (THAI);
1194 FROB (EASTEUROPE);
1195 FROB (CENTRALEUROPEAN);
1196 FROB (CYRILLIC);
1197 FROB (MAC);
1198 FROB (BALTIC);
1199 else if (stricmp (charset, "oem/dos") == 0)
1200 logfont.lfCharSet = OEM_CHARSET;
1201 else
1202 {
1203 maybe_signal_simple_error ("Invalid charset", f->name, Qfont, errb);
1204 return 0;
1205 }
1097 1206
1098 #undef FROB 1207 #undef FROB
1099 1208
1209 /* Windows will silently substitute a default font if the fontname
1210 * specifies a non-existent font. So we check the font against the device's
1211 * list of font patterns to make sure that at least one of them matches */
1212 {
1213 struct mswindows_font_enum *fontlist;
1214 char truename[MSW_FONTSIZE];
1215 int done = 0;
1216
1217 sprintf (truename, "%s:%s:%d:%s:%s", fontname, weight, pt, effects, charset);
1218 fontlist = DEVICE_MSWINDOWS_FONTLIST (XDEVICE (device));
1219 while (fontlist && !done)
1220 {
1221 done = match_font (fontlist->fontname, truename, NULL);
1222 fontlist = fontlist->next;
1223 }
1224 if (!done)
1225 {
1226 maybe_signal_simple_error ("No matching font", f->name, Qfont, errb);
1227 return 0;
1228 }
1229 }
1230
1100 /* Misc crud */ 1231 /* Misc crud */
1101 logfont.lfEscapement = logfont.lfOrientation = 0; 1232 logfont.lfEscapement = logfont.lfOrientation = 0;
1102 #if 1 1233 #if 1
1103 logfont.lfOutPrecision = OUT_DEFAULT_PRECIS; 1234 logfont.lfOutPrecision = OUT_DEFAULT_PRECIS;
1104 logfont.lfClipPrecision = CLIP_DEFAULT_PRECIS; 1235 logfont.lfClipPrecision = CLIP_DEFAULT_PRECIS;
1106 #else 1237 #else
1107 logfont.lfOutPrecision = OUT_STROKE_PRECIS; 1238 logfont.lfOutPrecision = OUT_STROKE_PRECIS;
1108 logfont.lfClipPrecision = CLIP_STROKE_PRECIS; 1239 logfont.lfClipPrecision = CLIP_STROKE_PRECIS;
1109 logfont.lfQuality = PROOF_QUALITY; 1240 logfont.lfQuality = PROOF_QUALITY;
1110 #endif 1241 #endif
1242 /* Default to monospaced if the specified fontname doesn't exist.
1243 * The match_font calls above should mean that this can't happen. */
1244 logfont.lfPitchAndFamily = FF_MODERN;
1111 1245
1112 if ((f->data = CreateFontIndirect(&logfont)) == NULL) 1246 if ((f->data = CreateFontIndirect(&logfont)) == NULL)
1113 { 1247 {
1114 maybe_signal_simple_error ("Couldn't create font", f->name, Qfont, errb); 1248 maybe_signal_simple_error ("Couldn't create font", f->name, Qfont, errb);
1115 return 0; 1249 return 0;
1160 } 1294 }
1161 1295
1162 static Lisp_Object 1296 static Lisp_Object
1163 mswindows_list_fonts (Lisp_Object pattern, Lisp_Object device) 1297 mswindows_list_fonts (Lisp_Object pattern, Lisp_Object device)
1164 { 1298 {
1165 /* #### Implement me */ 1299 Lisp_Object result = Qnil;
1166 return list1 (build_string ("Courier New:Regular:10")); 1300 struct mswindows_font_enum *fontlist;
1301 char fontname[MSW_FONTSIZE], *extpattern;
1302
1303 GET_C_STRING_CTEXT_DATA_ALLOCA (pattern, extpattern);
1304 fontlist = DEVICE_MSWINDOWS_FONTLIST (XDEVICE (device));
1305 while (fontlist)
1306 {
1307 if (match_font (fontlist->fontname, extpattern, fontname))
1308 result = Fcons (build_string (fontname), result);
1309 fontlist = fontlist->next;
1310 }
1311
1312 return Fnreverse (result);
1167 } 1313 }
1168 1314
1169 #ifdef MULE 1315 #ifdef MULE
1170 1316
1171 static int 1317 static int
1192 1338
1193 #endif /* MULE */ 1339 #endif /* MULE */
1194 1340
1195 1341
1196 /************************************************************************/ 1342 /************************************************************************/
1343 /* non-methods */
1344 /************************************************************************/
1345
1346 DEFUN ("mswindows-color-list", Fmswindows_color_list, 0, 0, 0, /*
1347 Return a list of the colors available on mswindows devices.
1348 */
1349 ())
1350 {
1351 Lisp_Object result = Qnil;
1352 int i;
1353
1354 for (i=0; i<countof (mswindows_X_color_map); i++)
1355 result = Fcons (build_string (mswindows_X_color_map[i].name), result);
1356
1357 return Fnreverse (result);
1358 }
1359
1360
1361
1362 /************************************************************************/
1197 /* initialization */ 1363 /* initialization */
1198 /************************************************************************/ 1364 /************************************************************************/
1199 1365
1200 void 1366 void
1201 syms_of_objects_mswindows (void) 1367 syms_of_objects_mswindows (void)
1202 { 1368 {
1369 DEFSUBR (Fmswindows_color_list);
1203 } 1370 }
1204 1371
1205 void 1372 void
1206 console_type_create_objects_mswindows (void) 1373 console_type_create_objects_mswindows (void)
1207 { 1374 {