Mercurial > hg > xemacs-beta

comparison src/objects-msw.c @ 771:943eaba38521

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2002-03-13 08:51:24 by ben] The big ben-mule-21-5 check-in! Various files were added and deleted. See CHANGES-ben-mule. There are still some test suite failures. No crashes, though. Many of the failures have to do with problems in the test suite itself rather than in the actual code. I'll be addressing these in the next day or so -- none of the test suite failures are at all critical. Meanwhile I'll be trying to address the biggest issues -- i.e. build or run failures, which will almost certainly happen on various platforms. All comments should be sent to ben@xemacs.org -- use a Cc: if necessary when sending to mailing lists. There will be pre- and post- tags, something like pre-ben-mule-21-5-merge-in, and post-ben-mule-21-5-merge-in.
author ben
date Wed, 13 Mar 2002 08:54:06 +0000
parents fdefd0186b75
children 026c5bf9c134
comparison
equal deleted inserted replaced
770:336a418893b5 771:943eaba38521
1 /* mswindows-specific Lisp objects. 1 /* mswindows-specific Lisp objects.
2 Copyright (C) 1993, 1994 Free Software Foundation, Inc. 2 Copyright (C) 1993, 1994 Free Software Foundation, Inc.
3 Copyright (C) 1995 Board of Trustees, University of Illinois. 3 Copyright (C) 1995 Board of Trustees, University of Illinois.
4 Copyright (C) 1995 Tinker Systems. 4 Copyright (C) 1995 Tinker Systems.
5 Copyright (C) 1995, 1996 Ben Wing. 5 Copyright (C) 1995, 1996, 2000, 2001 Ben Wing.
6 Copyright (C) 1995 Sun Microsystems, Inc. 6 Copyright (C) 1995 Sun Microsystems, Inc.
7 Copyright (C) 1997 Jonathan Harris. 7 Copyright (C) 1997 Jonathan Harris.
8 8
9 This file is part of XEmacs. 9 This file is part of XEmacs.
10 10
29 29
30 Jamie Zawinski, Chuck Thompson, Ben Wing 30 Jamie Zawinski, Chuck Thompson, Ben Wing
31 Rewritten for mswindows by Jonathan Harris, November 1997 for 21.0. 31 Rewritten for mswindows by Jonathan Harris, November 1997 for 21.0.
32 */ 32 */
33 33
34 /* This function mostly Mule-ized (except perhaps some Unicode splitting).
35 5-2000. */
34 36
35 /* TODO: palette handling */ 37 /* TODO: palette handling */
36 38
37 #include <config.h> 39 #include <config.h>
38 #include "lisp.h" 40 #include "lisp.h"
39 #include "hash.h" 41 #include "hash.h"
40 42
41 #include "console-msw.h" 43 #include "console-msw.h"
42 #include "objects-msw.h" 44 #include "objects-msw.h"
43
44 #ifdef MULE
45 #include "mule-charset.h"
46 #endif
47
48 #include "buffer.h" 45 #include "buffer.h"
46 #include "charset.h"
49 #include "device.h" 47 #include "device.h"
50 #include "insdel.h" 48 #include "insdel.h"
51 49
52 typedef struct colormap_t 50 typedef struct colormap_t
53 { 51 {
54 const char *name; 52 const Char_ASCII *name;
55 COLORREF colorref; 53 COLORREF colorref;
56 } colormap_t; 54 } colormap_t;
57 55
58 /* Colors from X11R6 "XConsortium: rgb.txt,v 10.41 94/02/20 18:39:36 rws Exp" */ 56 /* Colors from X11R6 "XConsortium: rgb.txt,v 10.41 94/02/20 18:39:36 rws Exp" */
59 /* MSWindows tends to round up the numbers in it's palette, ie where X uses 57 /* MSWindows tends to round up the numbers in its palette, ie where X uses
60 * 127, MSWindows uses 128. Colors commented as "Adjusted" are tweaked to 58 * 127, MSWindows uses 128. Colors commented as "Adjusted" are tweaked to
61 * match the Windows standard palette to increase the likelihood of 59 * match the Windows standard palette to increase the likelihood of
62 * mswindows_color_to_string() finding a named match. 60 * mswindows_color_to_string() finding a named match.
63 */ 61 */
64 static const colormap_t mswindows_X_color_map[] = 62 static const colormap_t mswindows_X_color_map[] =
727 }; 725 };
728 726
729 727
730 typedef struct fontmap_t 728 typedef struct fontmap_t
731 { 729 {
732 const char *name; 730 const Char_ASCII *name;
733 int value; 731 int value;
734 } fontmap_t; 732 } fontmap_t;
735 733
736 /* Default weight first, preferred names listed before synonyms */ 734 /* Default weight first, preferred names listed before synonyms */
737 static const fontmap_t fontweight_map[] = 735 static const fontmap_t fontweight_map[] =
754 752
755 /* Default charset first, no synonyms allowed because these names are 753 /* Default charset first, no synonyms allowed because these names are
756 * matched against the names reported by win32 by match_font() */ 754 * matched against the names reported by win32 by match_font() */
757 static const fontmap_t charset_map[] = 755 static const fontmap_t charset_map[] =
758 { 756 {
759 {"Western" , ANSI_CHARSET}, 757 {"Western" , ANSI_CHARSET}, /* Latin 1 */
760 {"Symbol" , SYMBOL_CHARSET}, 758 {"Central European" , EASTEUROPE_CHARSET},
761 {"Shift JIS" , SHIFTJIS_CHARSET}, /* #### Name to be verified */ 759 {"Cyrillic" , RUSSIAN_CHARSET},
762 {"GB2312" , GB2312_CHARSET}, /* #### Name to be verified */
763 {"Hanguel" , HANGEUL_CHARSET},
764 {"Chinese Big 5" , CHINESEBIG5_CHARSET}, /* #### Name to be verified */
765 #if (WINVER >= 0x0400)
766 {"Johab" , JOHAB_CHARSET}, /* #### Name to be verified */
767 {"Hebrew" , HEBREW_CHARSET}, /* #### Name to be verified */
768 {"Arabic" , ARABIC_CHARSET}, /* #### Name to be verified */
769 {"Greek" , GREEK_CHARSET}, 760 {"Greek" , GREEK_CHARSET},
770 {"Turkish" , TURKISH_CHARSET}, 761 {"Turkish" , TURKISH_CHARSET},
771 {"Vietnamese" , VIETNAMESE_CHARSET}, /* #### Name to be verified */ 762 {"Hebrew" , HEBREW_CHARSET},
772 {"Thai" , THAI_CHARSET}, /* #### Name to be verified */ 763 {"Arabic" , ARABIC_CHARSET},
773 {"Central European" , EASTEUROPE_CHARSET}, 764 {"Baltic" , BALTIC_CHARSET},
774 {"Cyrillic" , RUSSIAN_CHARSET}, 765 {"Viet Nam" , VIETNAMESE_CHARSET},
766 {"Thai" , THAI_CHARSET},
767 {"Japanese" , SHIFTJIS_CHARSET},
768 {"Korean" , HANGEUL_CHARSET},
769 {"Simplified Chinese" , GB2312_CHARSET},
770 {"Traditional Chinese", CHINESEBIG5_CHARSET},
771
772 {"Symbol" , SYMBOL_CHARSET},
775 {"Mac" , MAC_CHARSET}, 773 {"Mac" , MAC_CHARSET},
776 {"Baltic" , BALTIC_CHARSET}, 774 {"Korean Johab" , JOHAB_CHARSET},
777 #endif
778 {"OEM/DOS" , OEM_CHARSET} 775 {"OEM/DOS" , OEM_CHARSET}
779 }; 776 };
780 777
781 778
782 /************************************************************************/ 779 /************************************************************************/
783 /* helpers */ 780 /* helpers */
784 /************************************************************************/ 781 /************************************************************************/
785 782
786 static int 783 static int
787 hexval (char c) 784 hexval (Intbyte c)
788 { 785 {
789 /* assumes ASCII and isxdigit(c) */ 786 /* assumes ASCII and isxdigit (c) */
790 if (c >= 'a') 787 if (c >= 'a')
791 return c-'a' + 10; 788 return c - 'a' + 10;
792 else if (c >= 'A') 789 else if (c >= 'A')
793 return c-'A' + 10; 790 return c - 'A' + 10;
794 else 791 else
795 return c-'0'; 792 return c - '0';
796 } 793 }
797 794
798 COLORREF 795 COLORREF
799 mswindows_string_to_color(const char *name) 796 mswindows_string_to_color (const Intbyte *name)
800 { 797 {
801 int i; 798 int i;
802 799
803 if (*name == '#') 800 if (*name == '#')
804 { 801 {
805 /* numeric names look like "#RRGGBB", "#RRRGGGBBB" or "#RRRRGGGGBBBB" 802 /* numeric names look like "#RRGGBB", "#RRRGGGBBB" or "#RRRRGGGGBBBB"
806 or "rgb:rrrr/gggg/bbbb" */ 803 or "rgb:rrrr/gggg/bbbb" */
807 unsigned int r, g, b; 804 unsigned int r, g, b;
808 805
809 for (i=1; i< (int) strlen(name); i++) 806 for (i = 1; i < qxestrlen (name); i++)
810 { 807 {
811 if (!isxdigit ((int)name[i])) 808 if (!BYTE_ASCII_P (name[i]) || !isxdigit ((int) name[i]))
812 return (COLORREF) -1; 809 return (COLORREF) -1;
813 } 810 }
814 if (strlen(name)==7) 811 if (qxestrlen (name) == 7)
815 { 812 {
816 r = hexval (name[1]) * 16 + hexval (name[2]); 813 r = hexval (name[1]) * 16 + hexval (name[2]);
817 g = hexval (name[3]) * 16 + hexval (name[4]); 814 g = hexval (name[3]) * 16 + hexval (name[4]);
818 b = hexval (name[5]) * 16 + hexval (name[6]); 815 b = hexval (name[5]) * 16 + hexval (name[6]);
819 return (PALETTERGB (r, g, b)); 816 return (PALETTERGB (r, g, b));
820 } 817 }
821 else if (strlen(name)==10) 818 else if (qxestrlen (name) == 10)
822 { 819 {
823 r = hexval (name[1]) * 16 + hexval (name[2]); 820 r = hexval (name[1]) * 16 + hexval (name[2]);
824 g = hexval (name[4]) * 16 + hexval (name[5]); 821 g = hexval (name[4]) * 16 + hexval (name[5]);
825 b = hexval (name[7]) * 16 + hexval (name[8]); 822 b = hexval (name[7]) * 16 + hexval (name[8]);
826 return (PALETTERGB (r, g, b)); 823 return (PALETTERGB (r, g, b));
827 } 824 }
828 else if (strlen(name)==13) 825 else if (qxestrlen (name) == 13)
829 { 826 {
830 r = hexval (name[1]) * 16 + hexval (name[2]); 827 r = hexval (name[1]) * 16 + hexval (name[2]);
831 g = hexval (name[5]) * 16 + hexval (name[6]); 828 g = hexval (name[5]) * 16 + hexval (name[6]);
832 b = hexval (name[9]) * 16 + hexval (name[10]); 829 b = hexval (name[9]) * 16 + hexval (name[10]);
833 return (PALETTERGB (r, g, b)); 830 return (PALETTERGB (r, g, b));
834 } 831 }
835 } 832 }
836 else if (!strncmp(name, "rgb:", 4)) 833 else if (!qxestrncmp_c (name, "rgb:", 4))
837 { 834 {
838 unsigned int r,g,b; 835 unsigned int r, g, b;
839 836
840 if (sscanf(name, "rgb:%04x/%04x/%04x", &r, &g, &b) == 3) 837 if (sscanf ((CIntbyte *) name, "rgb:%04x/%04x/%04x", &r, &g, &b) == 3)
841 { 838 {
842 int len = strlen (name); 839 int len = qxestrlen (name);
843 if (len == 18) 840 if (len == 18)
844 { 841 {
845 r /= 257; 842 r /= 257;
846 g /= 257; 843 g /= 257;
847 b /= 257; 844 b /= 257;
857 else 854 else
858 return (COLORREF) -1; 855 return (COLORREF) -1;
859 } 856 }
860 else if (*name) /* Can't be an empty string */ 857 else if (*name) /* Can't be an empty string */
861 { 858 {
862 char *nospaces = (char*) alloca (strlen (name)+1); 859 Intbyte *nospaces = (Intbyte *) alloca (qxestrlen (name) + 1);
863 char *c = nospaces; 860 Intbyte *c = nospaces;
864 while (*name) 861 while (*name)
865 if (*name != ' ') 862 if (*name != ' ')
866 *c++ = *name++; 863 *c++ = *name++;
867 else 864 else
868 name++; 865 name++;
869 *c = '\0'; 866 *c = '\0';
870 867
871 for (i = 0; i < countof (mswindows_X_color_map); i++) 868 for (i = 0; i < countof (mswindows_X_color_map); i++)
872 if (!stricmp (nospaces, mswindows_X_color_map[i].name)) 869 if (!qxestrcasecmp_c (nospaces, mswindows_X_color_map[i].name))
873 return (mswindows_X_color_map[i].colorref); 870 return (mswindows_X_color_map[i].colorref);
874 } 871 }
875 return (COLORREF) -1; 872 return (COLORREF) -1;
876 } 873 }
877 874
878 Lisp_Object 875 Lisp_Object
879 mswindows_color_to_string (COLORREF color) 876 mswindows_color_to_string (COLORREF color)
880 { 877 {
881 int i; 878 int i;
882 char buf[8]; 879 Char_ASCII buf[8];
883 COLORREF pcolor = PALETTERGB (GetRValue (color), GetGValue (color), 880 COLORREF pcolor = PALETTERGB (GetRValue (color), GetGValue (color),
884 GetBValue (color)); 881 GetBValue (color));
885 882
886 for (i=0; i < countof (mswindows_X_color_map); i++) 883 for (i = 0; i < countof (mswindows_X_color_map); i++)
887 if (pcolor == (mswindows_X_color_map[i].colorref)) 884 if (pcolor == (mswindows_X_color_map[i].colorref))
888 return build_string (mswindows_X_color_map[i].name); 885 return build_string (mswindows_X_color_map[i].name);
889 886
890 sprintf (buf, "#%02X%02X%02X", 887 sprintf (buf, "#%02X%02X%02X",
891 GetRValue (color), GetGValue (color), GetBValue (color)); 888 GetRValue (color), GetGValue (color), GetBValue (color));
899 * 896 *
900 * The patterns 'match' iff for each field that is not blank in either pattern, 897 * The patterns 'match' iff for each field that is not blank in either pattern,
901 * the corresponding field in the other pattern is either identical or blank. 898 * the corresponding field in the other pattern is either identical or blank.
902 */ 899 */
903 static int 900 static int
904 match_font (char *pattern1, char *pattern2, char *fontname) 901 match_font (Intbyte *pattern1, Intbyte *pattern2,
905 { 902 Intbyte *fontname)
906 char *c1=pattern1, *c2=pattern2, *e1=0, *e2=0; 903 {
904 Intbyte *c1 = pattern1, *c2 = pattern2, *e1 = 0, *e2 = 0;
907 int i; 905 int i;
908 906
909 if (fontname) 907 if (fontname)
910 fontname[0] = '\0'; 908 fontname[0] = '\0';
911 909
912 for (i=0; i<5; i++) 910 for (i = 0; i < 5; i++)
913 { 911 {
914 if (c1 && (e1 = strchr (c1, ':'))) 912 if (c1 && (e1 = qxestrchr (c1, ':')))
915 *(e1) = '\0'; 913 *(e1) = '\0';
916 if (c2 && (e2 = strchr (c2, ':'))) 914 if (c2 && (e2 = qxestrchr (c2, ':')))
917 *(e2) = '\0'; 915 *(e2) = '\0';
918 916
919 if (c1 && c1[0]!='\0') 917 if (c1 && c1[0] != '\0')
920 { 918 {
921 if (c2 && c2[0]!='\0' && stricmp(c1, c2)) 919 if (c2 && c2[0] != '\0' && qxestrcasecmp (c1, c2))
922 { 920 {
923 if (e1) *e1 = ':'; 921 if (e1) *e1 = ':';
924 if (e2) *e2 = ':'; 922 if (e2) *e2 = ':';
925 return 0; 923 return 0;
926 } 924 }
927 else if (fontname) 925 else if (fontname)
928 strcat (strcat (fontname, c1), ":"); 926 qxestrcat_c (qxestrcat (fontname, c1), ":");
929 } 927 }
930 else if (fontname) 928 else if (fontname)
931 { 929 {
932 if (c2 && c2[0]!='\0') 930 if (c2 && c2[0] != '\0')
933 strcat (strcat (fontname, c2), ":"); 931 qxestrcat_c (qxestrcat (fontname, c2), ":");
934 else 932 else
935 strcat (fontname, ":"); 933 qxestrcat_c (fontname, ":");
936 } 934 }
937 935
938 if (e1) *(e1++) = ':'; 936 if (e1) *(e1++) = ':';
939 if (e2) *(e2++) = ':'; 937 if (e2) *(e2++) = ':';
940 c1=e1; 938 c1 = e1;
941 c2=e2; 939 c2 = e2;
942 } 940 }
943 941
944 if (fontname) 942 if (fontname)
945 fontname[strlen (fontname) - 1] = '\0'; /* Trim trailing ':' */ 943 fontname[qxestrlen (fontname) - 1] = '\0'; /* Trim trailing ':' */
946 return 1; 944 return 1;
947 } 945 }
948
949
950
951 946
952 947
953 /************************************************************************/ 948 /************************************************************************/
954 /* exports */ 949 /* exports */
955 /************************************************************************/ 950 /************************************************************************/
959 HDC hdc; 954 HDC hdc;
960 Lisp_Object list; 955 Lisp_Object list;
961 }; 956 };
962 957
963 static int CALLBACK 958 static int CALLBACK
964 old_font_enum_callback_2 (ENUMLOGFONT FAR *lpelfe, NEWTEXTMETRIC FAR *lpntme, 959 font_enum_callback_2 (ENUMLOGFONTEXW *lpelfe, NEWTEXTMETRICEXW *lpntme,
965 int FontType, struct font_enum_t *font_enum) 960 int FontType, struct font_enum_t *font_enum)
966 { 961 {
967 char fontname[MSW_FONTSIZE]; 962 Intbyte fontname[MSW_FONTSIZE * 2 * MAX_EMCHAR_LEN]; /* should be enough :)*/
968 Lisp_Object fontname_lispstr; 963 Lisp_Object fontname_lispstr;
969 int i; 964 int i;
965 Intbyte *facename;
970 966
971 /* 967 /*
972 * The enumerated font weights are not to be trusted because: 968 * The enumerated font weights are not to be trusted because:
973 * a) lpelfe->elfStyle is only filled in for TrueType fonts. 969 * a) lpelfe->elfStyle is only filled in for TrueType fonts.
974 * b) Not all Bold and Italic styles of all fonts (including some Vector, 970 * b) Not all Bold and Italic styles of all fonts (including some Vector,
977 * 'on-the-fly' are not enumerated. It would be overly restrictive to 973 * 'on-the-fly' are not enumerated. It would be overly restrictive to
978 * disallow Bold And Italic weights for these fonts, so we just leave 974 * disallow Bold And Italic weights for these fonts, so we just leave
979 * weights unspecified. This means that we have to weed out duplicates of 975 * weights unspecified. This means that we have to weed out duplicates of
980 * those fonts that do get enumerated with different weights. 976 * those fonts that do get enumerated with different weights.
981 */ 977 */
982 if (FontType == 0 /*vector*/ || FontType == TRUETYPE_FONTTYPE) 978 TSTR_TO_C_STRING (lpelfe->elfLogFont.lfFaceName, facename);
979 if (charptr_emchar (facename) == '@')
980 /* This is a font for writing vertically. We ignore it. */
981 return 1;
982
983 if (FontType == 0 /*vector*/ || FontType & TRUETYPE_FONTTYPE)
983 /* Scalable, so leave pointsize blank */ 984 /* Scalable, so leave pointsize blank */
984 sprintf (fontname, "%s::::", lpelfe->elfLogFont.lfFaceName); 985 qxesprintf (fontname, "%s::::", facename);
985 else 986 else
986 /* Formula for pointsize->height from LOGFONT docs in Platform SDK */ 987 /* Formula for pointsize->height from LOGFONT docs in Platform SDK */
987 sprintf (fontname, "%s::%d::", lpelfe->elfLogFont.lfFaceName, 988 qxesprintf (fontname, "%s::%d::", facename,
988 MulDiv (lpntme->tmHeight - lpntme->tmInternalLeading, 989 MulDiv (lpntme->ntmTm.tmHeight -
989 72, GetDeviceCaps (font_enum->hdc, LOGPIXELSY))); 990 lpntme->ntmTm.tmInternalLeading,
991 72, GetDeviceCaps (font_enum->hdc, LOGPIXELSY)));
990 992
991 /* 993 /*
992 * The enumerated font character set strings are not to be trusted because 994 * The enumerated font character set strings are not to be trusted because
993 * lpelfe->elfScript is returned in the host language and not in English. 995 * lpelfe->elfScript is returned in the host language and not in English.
994 * We can't know a priori the translations of "Western", "Central European" 996 * We can't know a priori the translations of "Western", "Central European"
995 * etc into the host language, so we must use English. The same argument 997 * etc into the host language, so we must use English. The same argument
996 * applies to the font weight string when matching fonts. 998 * applies to the font weight string when matching fonts.
997 */ 999 */
998 for (i=0; i<countof (charset_map); i++) 1000 for (i = 0; i < countof (charset_map); i++)
999 if (lpelfe->elfLogFont.lfCharSet == charset_map[i].value) 1001 if (lpelfe->elfLogFont.lfCharSet == charset_map[i].value)
1000 { 1002 {
1001 strcat (fontname, charset_map[i].name); 1003 qxestrcat_c (fontname, charset_map[i].name);
1002 break; 1004 break;
1003 } 1005 }
1004 if (i==countof (charset_map)) 1006 if (i == countof (charset_map))
1005 strcpy (fontname, charset_map[0].name); 1007 return 1;
1006 1008
1007 /* Add the font name to the list if not already there */ 1009 /* Add the font name to the list if not already there */
1008 fontname_lispstr = build_string (fontname); 1010 fontname_lispstr = build_intstring (fontname);
1009 if (NILP (memq_no_quit (fontname_lispstr, font_enum->list))) 1011 if (NILP (Fmember (fontname_lispstr, font_enum->list)))
1010 font_enum->list = Fcons (fontname_lispstr, font_enum->list); 1012 font_enum->list = Fcons (fontname_lispstr, font_enum->list);
1011 1013
1012 return 1; 1014 return 1;
1013 } 1015 }
1014 1016
1015 static int CALLBACK 1017 static int CALLBACK
1016 old_font_enum_callback_1 (ENUMLOGFONT FAR *lpelfe, NEWTEXTMETRIC FAR *lpntme, 1018 font_enum_callback_1 (ENUMLOGFONTEXW *lpelfe, NEWTEXTMETRICEXW *lpntme,
1017 int FontType, struct font_enum_t *font_enum) 1019 int FontType, struct font_enum_t *font_enum)
1018 { 1020 {
1019 /* This function gets called once per facename per character set. 1021 /* This function gets called once per facename per character set.
1020 * We call a second callback to enumerate the fonts in each facename */ 1022 * We call a second callback to enumerate the fonts in each facename */
1021 return EnumFontFamilies (font_enum->hdc, lpelfe->elfLogFont.lfFaceName, 1023 return qxeEnumFontFamiliesEx (font_enum->hdc, &lpelfe->elfLogFont,
1022 (FONTENUMPROC) old_font_enum_callback_2, 1024 (FONTENUMPROCW) font_enum_callback_2,
1023 (LPARAM) font_enum); 1025 (LPARAM) font_enum, 0);
1024 }
1025
1026 static int CALLBACK
1027 font_enum_callback_2 (ENUMLOGFONTEX *lpelfe, NEWTEXTMETRICEX *lpntme,
1028 int FontType, struct font_enum_t *font_enum)
1029 {
1030 char fontname[MSW_FONTSIZE];
1031 Lisp_Object fontname_lispstr;
1032 int i;
1033
1034 /*
1035 * The enumerated font weights are not to be trusted because:
1036 * a) lpelfe->elfStyle is only filled in for TrueType fonts.
1037 * b) Not all Bold and Italic styles of all fonts (including some Vector,
1038 * Truetype and Raster fonts) are enumerated.
1039 * I guess that fonts for which Bold and Italic styles are generated
1040 * 'on-the-fly' are not enumerated. It would be overly restrictive to
1041 * disallow Bold And Italic weights for these fonts, so we just leave
1042 * weights unspecified. This means that we have to weed out duplicates of
1043 * those fonts that do get enumerated with different weights.
1044 */
1045 if (FontType == 0 /*vector*/ || FontType == TRUETYPE_FONTTYPE)
1046 /* Scalable, so leave pointsize blank */
1047 sprintf (fontname, "%s::::", lpelfe->elfLogFont.lfFaceName);
1048 else
1049 /* Formula for pointsize->height from LOGFONT docs in Platform SDK */
1050 sprintf (fontname, "%s::%d::", lpelfe->elfLogFont.lfFaceName,
1051 MulDiv (lpntme->ntmTm.tmHeight - lpntme->ntmTm.tmInternalLeading,
1052 72, GetDeviceCaps (font_enum->hdc, LOGPIXELSY)));
1053
1054 /*
1055 * The enumerated font character set strings are not to be trusted because
1056 * lpelfe->elfScript is returned in the host language and not in English.
1057 * We can't know a priori the translations of "Western", "Central European"
1058 * etc into the host language, so we must use English. The same argument
1059 * applies to the font weight string when matching fonts.
1060 */
1061 for (i=0; i<countof (charset_map); i++)
1062 if (lpelfe->elfLogFont.lfCharSet == charset_map[i].value)
1063 {
1064 strcat (fontname, charset_map[i].name);
1065 break;
1066 }
1067 if (i==countof (charset_map))
1068 strcpy (fontname, charset_map[0].name);
1069
1070 /* Add the font name to the list if not already there */
1071 fontname_lispstr = build_string (fontname);
1072 if (NILP (memq_no_quit (fontname_lispstr, font_enum->list)))
1073 font_enum->list = Fcons (fontname_lispstr, font_enum->list);
1074
1075 return 1;
1076 }
1077
1078 static int CALLBACK
1079 font_enum_callback_1 (ENUMLOGFONTEX *lpelfe, NEWTEXTMETRICEX *lpntme,
1080 int FontType, struct font_enum_t *font_enum)
1081 {
1082 /* This function gets called once per facename per character set.
1083 * We call a second callback to enumerate the fonts in each facename */
1084 return xEnumFontFamiliesExA (font_enum->hdc, &lpelfe->elfLogFont,
1085 (FONTENUMPROC) font_enum_callback_2,
1086 (LPARAM) font_enum, 0);
1087 } 1026 }
1088 1027
1089 /* 1028 /*
1090 * Enumerate the available on the HDC fonts and return a list of string 1029 * Enumerate the available on the HDC fonts and return a list of string
1091 * font names. 1030 * font names.
1092 */ 1031 */
1093 Lisp_Object 1032 Lisp_Object
1094 mswindows_enumerate_fonts (HDC hdc) 1033 mswindows_enumerate_fonts (HDC hdc)
1095 { 1034 {
1096 /* This cannot CG */ 1035 /* This cannot GC */
1097 LOGFONT logfont; 1036 LOGFONTW logfont;
1098 struct font_enum_t font_enum; 1037 struct font_enum_t font_enum;
1099 1038
1100 assert (hdc!=NULL); 1039 assert (hdc != NULL);
1101 logfont.lfCharSet = DEFAULT_CHARSET; 1040 logfont.lfCharSet = DEFAULT_CHARSET;
1102 logfont.lfFaceName[0] = '\0'; 1041 logfont.lfFaceName[0] = '\0';
1103 logfont.lfPitchAndFamily = DEFAULT_PITCH; 1042 logfont.lfPitchAndFamily = DEFAULT_PITCH;
1104 font_enum.hdc = hdc; 1043 font_enum.hdc = hdc;
1105 font_enum.list = Qnil; 1044 font_enum.list = Qnil;
1106 if (xEnumFontFamiliesExA) 1045 /* EnumFontFamilies seems to enumerate only one charset per font, which
1107 xEnumFontFamiliesExA (hdc, &logfont, (FONTENUMPROC) font_enum_callback_1, 1046 is not what we want. We aren't supporting NT 3.5x, so no need to
1108 (LPARAM) (&font_enum), 0); 1047 worry about this not existing. */
1109 else /* NT 3.5x */ 1048 qxeEnumFontFamiliesEx (hdc, &logfont, (FONTENUMPROCW) font_enum_callback_1,
1110 EnumFontFamilies (hdc, 0, (FONTENUMPROC) old_font_enum_callback_1, 1049 (LPARAM) (&font_enum), 0);
1111 (LPARAM) (&font_enum));
1112 1050
1113 return font_enum.list; 1051 return font_enum.list;
1114 } 1052 }
1115 1053
1116 static HFONT 1054 static HFONT
1117 mswindows_create_font_variant (Lisp_Font_Instance* f, 1055 mswindows_create_font_variant (Lisp_Font_Instance *f,
1118 int under, int strike) 1056 int under, int strike)
1119 { 1057 {
1120 /* Cannot GC */ 1058 /* Cannot GC */
1121 1059 LOGFONTW lf;
1122 LOGFONT lf;
1123 HFONT hfont; 1060 HFONT hfont;
1124 1061
1125 assert (FONT_INSTANCE_MSWINDOWS_HFONT_VARIANT (f, under, strike) == NULL); 1062 assert (FONT_INSTANCE_MSWINDOWS_HFONT_VARIANT (f, under, strike) == NULL);
1126 1063
1127 if (GetObject (FONT_INSTANCE_MSWINDOWS_HFONT_VARIANT (f, 0, 0), 1064 if (qxeGetObject (FONT_INSTANCE_MSWINDOWS_HFONT_VARIANT (f, 0, 0),
1128 sizeof (lf), (void*) &lf) == 0) 1065 sizeof (lf), (void *) &lf) == 0)
1129 { 1066 {
1130 hfont = MSWINDOWS_BAD_HFONT; 1067 hfont = MSWINDOWS_BAD_HFONT;
1131 } 1068 }
1132 else 1069 else
1133 { 1070 {
1134 lf.lfUnderline = under; 1071 lf.lfUnderline = under;
1135 lf.lfStrikeOut = strike; 1072 lf.lfStrikeOut = strike;
1136 1073
1137 hfont = CreateFontIndirect (&lf); 1074 hfont = qxeCreateFontIndirect (&lf);
1138 if (hfont == NULL) 1075 if (hfont == NULL)
1139 hfont = MSWINDOWS_BAD_HFONT; 1076 hfont = MSWINDOWS_BAD_HFONT;
1140 } 1077 }
1141 1078
1142 FONT_INSTANCE_MSWINDOWS_HFONT_VARIANT (f, under, strike) = hfont; 1079 FONT_INSTANCE_MSWINDOWS_HFONT_VARIANT (f, under, strike) = hfont;
1143 return hfont; 1080 return hfont;
1144 } 1081 }
1145 1082
1146 HFONT 1083 HFONT
1147 mswindows_get_hfont (Lisp_Font_Instance* f, 1084 mswindows_get_hfont (Lisp_Font_Instance *f,
1148 int under, int strike) 1085 int under, int strike)
1149 { 1086 {
1150 /* Cannot GC */ 1087 /* Cannot GC */
1151 HFONT hfont = FONT_INSTANCE_MSWINDOWS_HFONT_VARIANT (f, under, strike); 1088 HFONT hfont = FONT_INSTANCE_MSWINDOWS_HFONT_VARIANT (f, under, strike);
1152 1089
1169 1106
1170 static int 1107 static int
1171 mswindows_initialize_color_instance (Lisp_Color_Instance *c, Lisp_Object name, 1108 mswindows_initialize_color_instance (Lisp_Color_Instance *c, Lisp_Object name,
1172 Lisp_Object device, Error_Behavior errb) 1109 Lisp_Object device, Error_Behavior errb)
1173 { 1110 {
1174 const char *extname;
1175 COLORREF color; 1111 COLORREF color;
1176 1112
1177 TO_EXTERNAL_FORMAT (LISP_STRING, name, 1113 color = mswindows_string_to_color (XSTRING_DATA (name));
1178 C_STRING_ALLOCA, extname,
1179 Qctext);
1180 color = mswindows_string_to_color (extname);
1181 if (color != (COLORREF) -1) 1114 if (color != (COLORREF) -1)
1182 { 1115 {
1183 c->data = xnew (struct mswindows_color_instance_data); 1116 c->data = xnew (struct mswindows_color_instance_data);
1184 COLOR_INSTANCE_MSWINDOWS_COLOR (c) = color; 1117 COLOR_INSTANCE_MSWINDOWS_COLOR (c) = color;
1185 return 1; 1118 return 1;
1186 } 1119 }
1187 maybe_signal_error (Qinvalid_constant, 1120 maybe_signal_error (Qinvalid_constant,
1188 "Unrecognized color", name, Qcolor, errb); 1121 "Unrecognized color", name, Qcolor, errb);
1189 return(0); 1122 return(0);
1190 } 1123 }
1191 1124
1192 #if 0 1125 #if 0
1193 static void 1126 static void
1199 static void 1132 static void
1200 mswindows_print_color_instance (Lisp_Color_Instance *c, 1133 mswindows_print_color_instance (Lisp_Color_Instance *c,
1201 Lisp_Object printcharfun, 1134 Lisp_Object printcharfun,
1202 int escapeflag) 1135 int escapeflag)
1203 { 1136 {
1204 char buf[32]; 1137 Char_ASCII buf[32];
1205 COLORREF color = COLOR_INSTANCE_MSWINDOWS_COLOR (c); 1138 COLORREF color = COLOR_INSTANCE_MSWINDOWS_COLOR (c);
1206 sprintf (buf, " %06ld=(%04X,%04X,%04X)", color & 0xffffff, 1139 sprintf (buf, " %06ld=(%04X,%04X,%04X)", color & 0xffffff,
1207 GetRValue(color)*257, GetGValue(color)*257, GetBValue(color)*257); 1140 GetRValue (color) * 257, GetGValue (color) * 257,
1141 GetBValue (color) * 257);
1208 write_c_string (buf, printcharfun); 1142 write_c_string (buf, printcharfun);
1209 } 1143 }
1210 1144
1211 static void 1145 static void
1212 mswindows_finalize_color_instance (Lisp_Color_Instance *c) 1146 mswindows_finalize_color_instance (Lisp_Color_Instance *c)
1221 static int 1155 static int
1222 mswindows_color_instance_equal (Lisp_Color_Instance *c1, 1156 mswindows_color_instance_equal (Lisp_Color_Instance *c1,
1223 Lisp_Color_Instance *c2, 1157 Lisp_Color_Instance *c2,
1224 int depth) 1158 int depth)
1225 { 1159 {
1226 return (COLOR_INSTANCE_MSWINDOWS_COLOR(c1) == COLOR_INSTANCE_MSWINDOWS_COLOR(c2)); 1160 return (COLOR_INSTANCE_MSWINDOWS_COLOR(c1) ==
1161 COLOR_INSTANCE_MSWINDOWS_COLOR(c2));
1227 } 1162 }
1228 1163
1229 static unsigned long 1164 static unsigned long
1230 mswindows_color_instance_hash (Lisp_Color_Instance *c, int depth) 1165 mswindows_color_instance_hash (Lisp_Color_Instance *c, int depth)
1231 { 1166 {
1242 } 1177 }
1243 1178
1244 static int 1179 static int
1245 mswindows_valid_color_name_p (struct device *d, Lisp_Object color) 1180 mswindows_valid_color_name_p (struct device *d, Lisp_Object color)
1246 { 1181 {
1247 const char *extname; 1182 return (mswindows_string_to_color (XSTRING_DATA (color)) != (COLORREF) -1);
1248
1249 TO_EXTERNAL_FORMAT (LISP_STRING, color,
1250 C_STRING_ALLOCA, extname,
1251 Qctext);
1252 return (mswindows_string_to_color (extname) != (COLORREF) -1);
1253 } 1183 }
1254 1184
1255 1185
1256 1186
1257 static void 1187 static void
1264 static int 1194 static int
1265 initialize_font_instance (Lisp_Font_Instance *f, Lisp_Object name, 1195 initialize_font_instance (Lisp_Font_Instance *f, Lisp_Object name,
1266 Lisp_Object device_font_list, HDC hdc, 1196 Lisp_Object device_font_list, HDC hdc,
1267 Error_Behavior errb) 1197 Error_Behavior errb)
1268 { 1198 {
1269 const char *extname; 1199 LOGFONTW logfont;
1270 LOGFONT logfont;
1271 int fields, i; 1200 int fields, i;
1272 int pt; 1201 int pt;
1273 char fontname[LF_FACESIZE], weight[LF_FACESIZE], *style, points[8]; 1202 Intbyte fontname[LF_FACESIZE], weight[LF_FACESIZE], *style, points[8];
1274 char effects[LF_FACESIZE], charset[LF_FACESIZE]; 1203 Intbyte effects[LF_FACESIZE], charset[LF_FACESIZE];
1275 char *c; 1204 Intbyte *c;
1276 HFONT hfont, hfont2; 1205 HFONT hfont, hfont2;
1277 TEXTMETRIC metrics; 1206 TEXTMETRICW metrics;
1278 1207 Intbyte *namestr = XSTRING_DATA (name);
1279 /* !!#### more mule bogosity */
1280 extname = (const char *) XSTRING_DATA (name);
1281 1208
1282 /* 1209 /*
1283 * mswindows fonts look like: 1210 * mswindows fonts look like:
1284 * fontname[:[weight ][style][:pointsize[:effects]]][:charset] 1211 * fontname[:[weight ][style][:pointsize[:effects]]][:charset]
1285 * The font name field shouldn't be empty. 1212 * The font name field shouldn't be empty.
1290 * Courier New 1217 * Courier New
1291 * maximal: 1218 * maximal:
1292 * Courier New:Bold Italic:10:underline strikeout:western 1219 * Courier New:Bold Italic:10:underline strikeout:western
1293 */ 1220 */
1294 1221
1295 fields = sscanf (extname, "%31[^:]:%31[^:]:%7[^:]:%31[^:]:%31s", 1222 fields = sscanf ((CIntbyte *) namestr, "%31[^:]:%31[^:]:%7[^:]:%31[^:]:%31s",
1296 fontname, weight, points, effects, charset); 1223 fontname, weight, points, effects, charset);
1297 1224
1298 /* This function is implemented in a fairly ad-hoc manner. 1225 /* This function is implemented in a fairly ad-hoc manner.
1299 * The general idea is to validate and canonicalize each of the above fields 1226 * The general idea is to validate and canonicalize each of the above fields
1300 * at the same time as we build up the win32 LOGFONT structure. This enables 1227 * at the same time as we build up the win32 LOGFONT structure. This enables
1301 * us to use match_font() on a canonicalized font string to check the 1228 * us to use match_font() on a canonicalized font string to check the
1302 * availability of the requested font */ 1229 * availability of the requested font */
1303 1230
1304 if (fields < 0) 1231 if (fields < 0)
1305 { 1232 {
1306 maybe_signal_error (Qinvalid_argument, "Invalid font", name, Qfont, errb); 1233 maybe_signal_error (Qinvalid_argument, "Invalid font", name,
1307 return (0); 1234 Qfont, errb);
1308 } 1235 return (0);
1309 1236 }
1310 if (fields>0 && strlen(fontname)) 1237
1311 { 1238 if (fields > 0 && qxestrlen (fontname))
1312 strncpy (logfont.lfFaceName, fontname, LF_FACESIZE); 1239 {
1313 logfont.lfFaceName[LF_FACESIZE-1] = 0; 1240 Extbyte *extfontname;
1314 } 1241
1242 C_STRING_TO_TSTR (fontname, extfontname);
1243 xetcsncpy ((Extbyte *) logfont.lfFaceName, extfontname, LF_FACESIZE - 1);
1244 logfont.lfFaceName[LF_FACESIZE - 1] = 0;
1245 }
1315 else 1246 else
1316 { 1247 {
1317 maybe_signal_error (Qinvalid_argument, "Must specify a font name", name, Qfont, errb); 1248 maybe_signal_error (Qinvalid_argument, "Must specify a font name",
1318 return (0); 1249 name, Qfont, errb);
1319 } 1250 return (0);
1251 }
1320 1252
1321 /* weight */ 1253 /* weight */
1322 if (fields < 2) 1254 if (fields < 2)
1323 strcpy (weight, fontweight_map[0].name); 1255 qxestrcpy_c (weight, fontweight_map[0].name);
1324 1256
1325 /* Maybe split weight into weight and style */ 1257 /* Maybe split weight into weight and style */
1326 if ((c=strchr(weight, ' '))) 1258 if ((c = qxestrchr (weight, ' ')))
1327 { 1259 {
1328 *c = '\0'; 1260 *c = '\0';
1329 style = c+1; 1261 style = c + 1;
1330 } 1262 }
1331 else 1263 else
1332 style = NULL; 1264 style = NULL;
1333 1265
1334 for (i=0; i<countof (fontweight_map); i++) 1266 for (i = 0; i < countof (fontweight_map); i++)
1335 if (!stricmp (weight, fontweight_map[i].name)) 1267 if (!qxestrcasecmp_c (weight, fontweight_map[i].name))
1336 { 1268 {
1337 logfont.lfWeight = fontweight_map[i].value; 1269 logfont.lfWeight = fontweight_map[i].value;
1338 break; 1270 break;
1339 } 1271 }
1340 if (i == countof (fontweight_map)) /* No matching weight */ 1272 if (i == countof (fontweight_map)) /* No matching weight */
1344 logfont.lfWeight = FW_REGULAR; 1276 logfont.lfWeight = FW_REGULAR;
1345 style = weight; /* May have specified style without weight */ 1277 style = weight; /* May have specified style without weight */
1346 } 1278 }
1347 else 1279 else
1348 { 1280 {
1349 maybe_signal_error (Qinvalid_constant, "Invalid font weight", name, Qfont, errb); 1281 maybe_signal_error (Qinvalid_constant, "Invalid font weight", name,
1282 Qfont, errb);
1350 return (0); 1283 return (0);
1351 } 1284 }
1352 } 1285 }
1353 1286
1354 if (style) 1287 if (style)
1355 { 1288 {
1356 /* #### what about oblique? */ 1289 /* #### what about oblique? */
1357 if (stricmp (style,"italic") == 0) 1290 if (qxestrcasecmp_c (style, "italic") == 0)
1358 logfont.lfItalic = TRUE; 1291 logfont.lfItalic = TRUE;
1359 else 1292 else
1360 { 1293 {
1361 maybe_signal_error (Qinvalid_constant, "Invalid font weight or style", name, Qfont, errb); 1294 maybe_signal_error (Qinvalid_constant, "Invalid font weight or style",
1295 name, Qfont, errb);
1362 return (0); 1296 return (0);
1363 } 1297 }
1364 1298
1365 /* Glue weight and style together again */ 1299 /* Glue weight and style together again */
1366 if (weight != style) 1300 if (weight != style)
1369 else 1303 else
1370 logfont.lfItalic = FALSE; 1304 logfont.lfItalic = FALSE;
1371 1305
1372 if (fields < 3) 1306 if (fields < 3)
1373 pt = 10; /* #### Should we reject strings that don't specify a size? */ 1307 pt = 10; /* #### Should we reject strings that don't specify a size? */
1374 else if ((pt=atoi(points)) == 0) 1308 else if ((pt = qxeatoi (points)) == 0)
1375 { 1309 {
1376 maybe_signal_error (Qinvalid_argument, "Invalid font pointsize", name, Qfont, errb); 1310 maybe_signal_error (Qinvalid_argument, "Invalid font pointsize", name,
1311 Qfont, errb);
1377 return (0); 1312 return (0);
1378 } 1313 }
1379 1314
1380 /* Formula for pointsize->height from LOGFONT docs in MSVC5 Platform SDK */ 1315 /* Formula for pointsize->height from LOGFONT docs in MSVC5 Platform SDK */
1381 logfont.lfHeight = -MulDiv(pt, GetDeviceCaps (hdc, LOGPIXELSY), 72); 1316 logfont.lfHeight = -MulDiv (pt, GetDeviceCaps (hdc, LOGPIXELSY), 72);
1382 logfont.lfWidth = 0; 1317 logfont.lfWidth = 0;
1383 1318
1384 /* Effects */ 1319 /* Effects */
1385 logfont.lfUnderline = FALSE; 1320 logfont.lfUnderline = FALSE;
1386 logfont.lfStrikeOut = FALSE; 1321 logfont.lfStrikeOut = FALSE;
1387 if (fields >= 4 && effects[0] != '\0') 1322 if (fields >= 4 && effects[0] != '\0')
1388 { 1323 {
1389 char *effects2; 1324 Intbyte *effects2;
1390 1325
1391 /* Maybe split effects into effects and effects2 */ 1326 /* Maybe split effects into effects and effects2 */
1392 if ((c=strchr (effects, ' '))) 1327 if ((c = qxestrchr (effects, ' ')))
1393 { 1328 {
1394 *c = '\0'; 1329 *c = '\0';
1395 effects2 = c+1; 1330 effects2 = c + 1;
1396 } 1331 }
1397 else 1332 else
1398 effects2 = NULL; 1333 effects2 = NULL;
1399 1334
1400 if (stricmp (effects, "underline") == 0) 1335 if (qxestrcasecmp_c (effects, "underline") == 0)
1401 logfont.lfUnderline = TRUE; 1336 logfont.lfUnderline = TRUE;
1402 else if (stricmp (effects, "strikeout") == 0) 1337 else if (qxestrcasecmp_c (effects, "strikeout") == 0)
1403 logfont.lfStrikeOut = TRUE; 1338 logfont.lfStrikeOut = TRUE;
1404 else 1339 else
1405 { 1340 {
1406 maybe_signal_error (Qinvalid_constant, "Invalid font effect", name, Qfont, errb); 1341 maybe_signal_error (Qinvalid_constant, "Invalid font effect", name,
1342 Qfont, errb);
1407 return (0); 1343 return (0);
1408 } 1344 }
1409 1345
1410 if (effects2 && effects2[0] != '\0') 1346 if (effects2 && effects2[0] != '\0')
1411 { 1347 {
1412 if (stricmp (effects2, "underline") == 0) 1348 if (qxestrcasecmp_c (effects2, "underline") == 0)
1413 logfont.lfUnderline = TRUE; 1349 logfont.lfUnderline = TRUE;
1414 else if (stricmp (effects2, "strikeout") == 0) 1350 else if (qxestrcasecmp_c (effects2, "strikeout") == 0)
1415 logfont.lfStrikeOut = TRUE; 1351 logfont.lfStrikeOut = TRUE;
1416 else 1352 else
1417 { 1353 {
1418 maybe_signal_error (Qinvalid_constant, "Invalid font effect", name, 1354 maybe_signal_error (Qinvalid_constant, "Invalid font effect",
1419 Qfont, errb); 1355 name, Qfont, errb);
1420 return (0); 1356 return (0);
1421 } 1357 }
1422 } 1358 }
1423 1359
1424 /* Regenerate sanitised effects string */ 1360 /* Regenerate sanitised effects string */
1425 if (logfont.lfUnderline) 1361 if (logfont.lfUnderline)
1426 { 1362 {
1427 if (logfont.lfStrikeOut) 1363 if (logfont.lfStrikeOut)
1428 strcpy (effects, "underline strikeout"); 1364 qxestrcpy_c (effects, "underline strikeout");
1429 else 1365 else
1430 strcpy (effects, "underline"); 1366 qxestrcpy_c (effects, "underline");
1431 } 1367 }
1432 else if (logfont.lfStrikeOut) 1368 else if (logfont.lfStrikeOut)
1433 strcpy (effects, "strikeout"); 1369 qxestrcpy_c (effects, "strikeout");
1434 } 1370 }
1435 else 1371 else
1436 effects[0] = '\0'; 1372 effects[0] = '\0';
1437 1373
1438 /* Charset */ 1374 /* Charset */
1439 /* charset can be specified even if earlier fields haven't been */ 1375 /* charset can be specified even if earlier fields haven't been */
1440 if (fields < 5) 1376 if (fields < 5)
1441 { 1377 {
1442 if ((c=strchr (extname, ':')) && (c=strchr (c+1, ':')) && 1378 if ((c = qxestrchr (namestr, ':')) && (c = qxestrchr (c + 1, ':')) &&
1443 (c=strchr (c+1, ':')) && (c=strchr (c+1, ':'))) 1379 (c = qxestrchr (c + 1, ':')) && (c = qxestrchr (c + 1, ':')))
1444 { 1380 {
1445 strncpy (charset, c+1, LF_FACESIZE); 1381 qxestrncpy (charset, c + 1, LF_FACESIZE);
1446 charset[LF_FACESIZE-1] = '\0'; 1382 charset[LF_FACESIZE - 1] = '\0';
1447 } 1383 }
1448 else 1384 else
1449 strcpy (charset, charset_map[0].name); 1385 qxestrcpy_c (charset, charset_map[0].name);
1450 } 1386 }
1451 1387
1452 for (i=0; i<countof (charset_map); i++) 1388 for (i = 0; i < countof (charset_map); i++)
1453 if (!stricmp (charset, charset_map[i].name)) 1389 if (!qxestrcasecmp_c (charset, charset_map[i].name))
1454 { 1390 {
1455 logfont.lfCharSet = charset_map[i].value; 1391 logfont.lfCharSet = charset_map[i].value;
1456 break; 1392 break;
1457 } 1393 }
1458 1394
1459 if (i == countof (charset_map)) /* No matching charset */ 1395 if (i == countof (charset_map)) /* No matching charset */
1460 { 1396 {
1461 maybe_signal_error (Qinvalid_argument, "Invalid charset", name, Qfont, errb); 1397 maybe_signal_error (Qinvalid_argument, "Invalid charset", name, Qfont,
1398 errb);
1462 return 0; 1399 return 0;
1463 } 1400 }
1464 1401
1465 /* Misc crud */ 1402 /* Misc crud */
1466 logfont.lfEscapement = logfont.lfOrientation = 0; 1403 logfont.lfEscapement = logfont.lfOrientation = 0;
1483 for the default face. */ 1420 for the default face. */
1484 1421
1485 if (!NILP (device_font_list)) 1422 if (!NILP (device_font_list))
1486 { 1423 {
1487 Lisp_Object fonttail; 1424 Lisp_Object fonttail;
1488 char truename[MSW_FONTSIZE]; 1425 Intbyte truename[MSW_FONTSIZE];
1489 1426
1490 sprintf (truename, "%s:%s:%d:%s:%s", fontname, weight, pt, effects, charset); 1427 qxesprintf (truename, "%s:%s:%d:%s:%s", fontname, weight, pt, effects,
1428 charset);
1491 LIST_LOOP (fonttail, device_font_list) 1429 LIST_LOOP (fonttail, device_font_list)
1492 { 1430 {
1493 /* !!#### more mule bogosity */ 1431 if (match_font (XSTRING_DATA (XCAR (fonttail)), truename,
1494 if (match_font ((char *) XSTRING_DATA (XCAR (fonttail)), truename, NULL)) 1432 NULL))
1495 break; 1433 break;
1496 } 1434 }
1497 if (NILP (fonttail)) 1435 if (NILP (fonttail))
1498 { 1436 {
1499 maybe_signal_error (Qinvalid_argument, "No matching font", name, Qfont, errb); 1437 maybe_signal_error (Qinvalid_argument, "No matching font", name,
1438 Qfont, errb);
1500 return 0; 1439 return 0;
1501 } 1440 }
1502 } 1441 }
1503 1442
1504 if ((hfont = CreateFontIndirect(&logfont)) == NULL) 1443 if ((hfont = qxeCreateFontIndirect (&logfont)) == NULL)
1505 { 1444 {
1506 maybe_signal_error (Qgui_error, "Couldn't create font", name, Qfont, errb); 1445 maybe_signal_error (Qgui_error, "Couldn't create font", name, Qfont, errb);
1507 return 0; 1446 return 0;
1508 } 1447 }
1509 1448
1523 { 1462 {
1524 mswindows_finalize_font_instance (f); 1463 mswindows_finalize_font_instance (f);
1525 maybe_signal_error (Qgui_error, "Couldn't map font", name, Qfont, errb); 1464 maybe_signal_error (Qgui_error, "Couldn't map font", name, Qfont, errb);
1526 return 0; 1465 return 0;
1527 } 1466 }
1528 GetTextMetrics (hdc, &metrics); 1467 qxeGetTextMetrics (hdc, &metrics);
1529 SelectObject(hdc, hfont2); 1468 SelectObject (hdc, hfont2);
1530 1469
1531 f->width = (unsigned short) metrics.tmAveCharWidth; 1470 f->width = (unsigned short) metrics.tmAveCharWidth;
1532 f->height = (unsigned short) metrics.tmHeight; 1471 f->height = (unsigned short) metrics.tmHeight;
1533 f->ascent = (unsigned short) metrics.tmAscent; 1472 f->ascent = (unsigned short) metrics.tmAscent;
1534 f->descent = (unsigned short) metrics.tmDescent; 1473 f->descent = (unsigned short) metrics.tmDescent;
1586 static void 1525 static void
1587 mswindows_print_font_instance (Lisp_Font_Instance *f, 1526 mswindows_print_font_instance (Lisp_Font_Instance *f,
1588 Lisp_Object printcharfun, 1527 Lisp_Object printcharfun,
1589 int escapeflag) 1528 int escapeflag)
1590 { 1529 {
1591 char buf[10]; 1530 Intbyte buf[10];
1592 sprintf (buf, " 0x%lx", 1531 qxesprintf (buf, " 0x%lx",
1593 (unsigned long)FONT_INSTANCE_MSWINDOWS_HFONT_VARIANT (f,0,0)); 1532 (unsigned long)FONT_INSTANCE_MSWINDOWS_HFONT_VARIANT (f,0,0));
1594 write_c_string (buf, printcharfun); 1533 write_string (buf, printcharfun);
1595 } 1534 }
1596 1535
1597 static Lisp_Object 1536 static Lisp_Object
1598 mswindows_list_fonts (Lisp_Object pattern, Lisp_Object device) 1537 mswindows_list_fonts (Lisp_Object pattern, Lisp_Object device)
1599 { 1538 {
1600 Lisp_Object fonttail, result = Qnil; 1539 struct device *d = XDEVICE (device);
1601 char *extpattern; 1540 Lisp_Object font_list = Qnil, fonttail, result = Qnil;
1602 1541
1603 TO_EXTERNAL_FORMAT (LISP_STRING, pattern, 1542 if (DEVICE_MSWINDOWS_P (d))
1604 C_STRING_ALLOCA, extpattern, 1543 font_list = DEVICE_MSWINDOWS_FONTLIST (d);
1605 Qctext); 1544 else if (DEVICE_MSPRINTER_P (d))
1606 1545 font_list = DEVICE_MSPRINTER_FONTLIST (d);
1607 LIST_LOOP (fonttail, DEVICE_MSWINDOWS_FONTLIST (XDEVICE (device))) 1546 else
1608 { 1547 abort ();
1609 /* !!#### more mule bogosity */ 1548
1610 if (match_font ((char *) XSTRING_DATA (XCAR (fonttail)), extpattern, NULL)) 1549 LIST_LOOP (fonttail, font_list)
1611 result = Fcons (XCAR (fonttail), result); 1550 {
1551 Intbyte fontname[MSW_FONTSIZE];
1552
1553 if (match_font (XSTRING_DATA (XCAR (fonttail)), XSTRING_DATA (pattern),
1554 fontname))
1555 result = Fcons (build_intstring (fontname), result);
1612 } 1556 }
1613 1557
1614 return Fnreverse (result); 1558 return Fnreverse (result);
1615 } 1559 }
1616 1560
1625 * Missing parts of the font spec should be filled in with these values: 1569 * Missing parts of the font spec should be filled in with these values:
1626 * Courier New:Regular:10::Western */ 1570 * Courier New:Regular:10::Western */
1627 static Lisp_Object 1571 static Lisp_Object
1628 mswindows_font_instance_truename (Lisp_Font_Instance *f, Error_Behavior errb) 1572 mswindows_font_instance_truename (Lisp_Font_Instance *f, Error_Behavior errb)
1629 { 1573 {
1630 int nsep=0; 1574 /* #### does not handle charset at end!!! charset can be given even
1631 char *name = (char *) XSTRING_DATA (f->name); 1575 when previous fields are not.
1632 char* ptr = name; 1576
1633 char* extname = (char*) alloca (strlen (name) + 19); 1577 #### does not canonicalize given fields! needs to be merged
1634 strcpy (extname, name); 1578 with initialize_font_instance(). */
1579
1580 int nsep = 0;
1581 CIntbyte *ptr = (CIntbyte *) XSTRING_DATA (f->name);
1582 CIntbyte *name = (CIntbyte *) alloca (XSTRING_LENGTH (f->name) + 19);
1583
1584 strcpy (name, ptr);
1635 1585
1636 while ((ptr = strchr (ptr, ':')) != 0) 1586 while ((ptr = strchr (ptr, ':')) != 0)
1637 { 1587 {
1638 ptr++; 1588 ptr++;
1639 nsep++; 1589 nsep++;
1640 } 1590 }
1641 1591
1642 switch (nsep) 1592 switch (nsep)
1643 { 1593 {
1644 case 0: 1594 case 0:
1645 strcat (extname, ":Regular:10::Western"); 1595 strcat (name, ":Regular:10::Western");
1646 break; 1596 break;
1647 case 1: 1597 case 1:
1648 strcat (extname, ":10::Western"); 1598 strcat (name, ":10::Western");
1649 break; 1599 break;
1650 case 2: 1600 case 2:
1651 strcat (extname, "::Western"); 1601 strcat (name, "::Western");
1652 break; 1602 break;
1653 case 3: 1603 case 3:
1654 strcat (extname, ":Western"); 1604 strcat (name, ":Western");
1655 break; 1605 break;
1656 default:; 1606 default:;
1657 } 1607 }
1658 1608
1659 return build_ext_string (extname, Qnative); 1609 return build_string (name);
1660 } 1610 }
1661 1611
1662 #ifdef MULE 1612 #ifdef MULE
1663 1613
1664 static int 1614 static int
1665 mswindows_font_spec_matches_charset (struct device *d, Lisp_Object charset, 1615 mswindows_font_spec_matches_charset (struct device *d, Lisp_Object charset,
1666 const Intbyte *nonreloc, Lisp_Object reloc, 1616 const Intbyte *nonreloc,
1667 Bytecount offset, Bytecount length) 1617 Lisp_Object reloc,
1668 { 1618 Bytecount offset, Bytecount length)
1669 /* #### Implement me */ 1619 {
1620 const Intbyte *the_nonreloc = nonreloc;
1621 int i, ms_charset = 0;
1622 const Intbyte *c;
1623 Bytecount the_length = length;
1624 CHARSETINFO info;
1625 int font_code_page;
1626 Lisp_Object charset_code_page;
1627
1670 if (UNBOUNDP (charset)) 1628 if (UNBOUNDP (charset))
1671 return 1; 1629 return 1;
1672 1630
1673 return 1; 1631 if (!the_nonreloc)
1632 the_nonreloc = XSTRING_DATA (reloc);
1633 fixup_internal_substring (nonreloc, reloc, offset, &the_length);
1634 the_nonreloc += offset;
1635
1636 /* Get code page from the font spec */
1637
1638 c = the_nonreloc;
1639 for (i = 0; i < 4; i++)
1640 {
1641 Intbyte *newc = (Intbyte *) memchr (c, ':', the_length);
1642 if (!newc)
1643 break;
1644 newc++;
1645 the_length -= (newc - c);
1646 c = newc;
1647 }
1648
1649 if (i < 4)
1650 return 0;
1651
1652 for (i = 0; i < countof (charset_map); i++)
1653 if (qxestrcasecmp_c (c, charset_map[i].name) == 0)
1654 {
1655 ms_charset = charset_map[i].value;
1656 break;
1657 }
1658 if (i == countof (charset_map))
1659 return 0;
1660
1661 /* For border-glyph use */
1662 if (ms_charset == SYMBOL_CHARSET)
1663 ms_charset = ANSI_CHARSET;
1664
1665 if (!TranslateCharsetInfo ((DWORD *) ms_charset, &info, TCI_SRCCHARSET))
1666 return 0;
1667
1668 font_code_page = info.ciACP;
1669
1670 /* Get code page for the charset */
1671 charset_code_page = Fmswindows_charset_code_page (charset);
1672 if (!INTP (charset_code_page))
1673 return 0;
1674
1675 return font_code_page == XINT (charset_code_page);
1674 } 1676 }
1675 1677
1676 /* find a font spec that matches font spec FONT and also matches 1678 /* find a font spec that matches font spec FONT and also matches
1677 (the registry of) CHARSET. */ 1679 (the registry of) CHARSET. */
1678 static Lisp_Object 1680 static Lisp_Object
1679 mswindows_find_charset_font (Lisp_Object device, Lisp_Object font, 1681 mswindows_find_charset_font (Lisp_Object device, Lisp_Object font,
1680 Lisp_Object charset) 1682 Lisp_Object charset)
1681 { 1683 {
1682 /* #### Implement me */ 1684 Lisp_Object fontlist, fonttail;
1683 return build_string ("Courier New:Regular:10"); 1685
1686 fontlist = mswindows_list_fonts (font, device);
1687 LIST_LOOP (fonttail, fontlist)
1688 {
1689 if (mswindows_font_spec_matches_charset
1690 (XDEVICE (device), charset, 0, XCAR (fonttail), 0, -1))
1691 return XCAR (fonttail);
1692 }
1693 return Qnil;
1684 } 1694 }
1685 1695
1686 #endif /* MULE */ 1696 #endif /* MULE */
1687 1697
1688 1698
1696 ()) 1706 ())
1697 { 1707 {
1698 Lisp_Object result = Qnil; 1708 Lisp_Object result = Qnil;
1699 int i; 1709 int i;
1700 1710
1701 for (i=0; i<countof (mswindows_X_color_map); i++) 1711 for (i = 0; i < countof (mswindows_X_color_map); i++)
1702 result = Fcons (build_string (mswindows_X_color_map[i].name), result); 1712 result = Fcons (build_string (mswindows_X_color_map[i].name), result);
1703 1713
1704 return Fnreverse (result); 1714 return Fnreverse (result);
1705 } 1715 }
1706 1716