- fontp = dpyinfo->font_table + i;
- if (i == dpyinfo->n_fonts)
- ++dpyinfo->n_fonts;
-
- /* Now fill in the slots of *FONTP. */
- BLOCK_INPUT;
- bzero (fontp, sizeof (*fontp));
- fontp->font = font;
- fontp->font_idx = i;
- fontp->name = (char *) xmalloc (strlen (fontname) + 1);
- bcopy (fontname, fontp->name, strlen (fontname) + 1);
-
- if ((lf.lfPitchAndFamily & 0x03) == FIXED_PITCH)
- {
- /* Fixed width font. */
- fontp->average_width = fontp->space_width = FONT_AVG_WIDTH (font);
- }
- else
- {
- wchar_t space = 32;
- XCharStruct* pcm;
- pcm = w32_per_char_metric (font, &space, ANSI_FONT);
- if (pcm)
- fontp->space_width = pcm->width;
- else
- fontp->space_width = FONT_AVG_WIDTH (font);
-
- fontp->average_width = font->tm.tmAveCharWidth;
- }
-
- fontp->charset = -1;
- charset = xlfd_charset_of_font (fontname);
-
- /* Cache the W32 codepage for a font. This makes w32_encode_char
- (called for every glyph during redisplay) much faster. */
- fontp->codepage = codepage;
-
- /* Work out the font's full name. */
- full_name = (char *)xmalloc (100);
- if (full_name && w32_to_x_font (&lf, full_name, 100, charset))
- fontp->full_name = full_name;
- else
- {
- /* If all else fails - just use the name we used to load it. */
- xfree (full_name);
- fontp->full_name = fontp->name;
- }
-
- fontp->size = FONT_WIDTH (font);
- fontp->height = FONT_HEIGHT (font);
-
- /* The slot `encoding' specifies how to map a character
- code-points (0x20..0x7F or 0x2020..0x7F7F) of each charset to
- the font code-points (0:0x20..0x7F, 1:0xA0..0xFF), or
- (0:0x20..0x7F, 1:0xA0..0xFF,
- (0:0x2020..0x7F7F, 1:0xA0A0..0xFFFF, 3:0x20A0..0x7FFF,
- 2:0xA020..0xFF7F). For the moment, we don't know which charset
- uses this font. So, we set information in fontp->encoding_type
- which is never used by any charset. If mapping can't be
- decided, set FONT_ENCODING_NOT_DECIDED. */
-
- /* SJIS fonts need to be set to type 4, all others seem to work as
- type FONT_ENCODING_NOT_DECIDED. */
- encoding = strrchr (fontp->name, '-');
- if (encoding && strnicmp (encoding+1, "sjis", 4) == 0)
- fontp->encoding_type = 4;
- else
- fontp->encoding_type = FONT_ENCODING_NOT_DECIDED;
-
- /* The following three values are set to 0 under W32, which is
- what they get set to if XGetFontProperty fails under X. */
- fontp->baseline_offset = 0;
- fontp->relative_compose = 0;
- fontp->default_ascent = 0;
-
- /* Set global flag fonts_changed_p to non-zero if the font loaded
- has a character with a smaller width than any other character
- before, or if the font loaded has a smaller height than any
- other font loaded before. If this happens, it will make a
- glyph matrix reallocation necessary. */
- fonts_changed_p |= x_compute_min_glyph_bounds (f);
- UNBLOCK_INPUT;
- return fontp;
- }
-}
-
-/* Load font named FONTNAME of size SIZE for frame F, and return a
- pointer to the structure font_info while allocating it dynamically.
- If loading fails, return NULL. */
-struct font_info *
-w32_load_font (f, fontname, size)
- struct frame *f;
- char * fontname;
- int size;
-{
- Lisp_Object bdf_fonts;
- struct font_info *retval = NULL;
- struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
-
- bdf_fonts = w32_list_bdf_fonts (build_string (fontname), 1);
-
- while (!retval && CONSP (bdf_fonts))
- {
- char *bdf_name, *bdf_file;
- Lisp_Object bdf_pair;
- int i;
-
- bdf_name = SDATA (XCAR (bdf_fonts));
- bdf_pair = Fassoc (XCAR (bdf_fonts), Vw32_bdf_filename_alist);
- bdf_file = SDATA (XCDR (bdf_pair));
-
- // If the font is already loaded, do not load it again.
- for (i = 0; i < dpyinfo->n_fonts; i++)
- {
- if ((dpyinfo->font_table[i].name
- && !strcmp (dpyinfo->font_table[i].name, bdf_name))
- || (dpyinfo->font_table[i].full_name
- && !strcmp (dpyinfo->font_table[i].full_name, bdf_name)))
- return dpyinfo->font_table + i;
- }
-
- retval = w32_load_bdf_font (f, bdf_name, size, bdf_file);
-
- bdf_fonts = XCDR (bdf_fonts);
- }
-
- if (retval)
- return retval;
-
- return w32_load_system_font (f, fontname, size);
-}
-
-
-void
-w32_unload_font (dpyinfo, font)
- struct w32_display_info *dpyinfo;
- XFontStruct * font;
-{
- if (font)
- {
- if (font->per_char) xfree (font->per_char);
- if (font->bdf) w32_free_bdf_font (font->bdf);
-
- if (font->hfont) DeleteObject (font->hfont);
- xfree (font);
- }
-}
-
-/* The font conversion stuff between x and w32 */
-
-/* X font string is as follows (from faces.el)
- * (let ((- "[-?]")
- * (foundry "[^-]+")
- * (family "[^-]+")
- * (weight "\\(bold\\|demibold\\|medium\\)") ; 1
- * (weight\? "\\([^-]*\\)") ; 1
- * (slant "\\([ior]\\)") ; 2
- * (slant\? "\\([^-]?\\)") ; 2
- * (swidth "\\([^-]*\\)") ; 3
- * (adstyle "[^-]*") ; 4
- * (pixelsize "[0-9]+")
- * (pointsize "[0-9][0-9]+")
- * (resx "[0-9][0-9]+")
- * (resy "[0-9][0-9]+")
- * (spacing "[cmp?*]")
- * (avgwidth "[0-9]+")
- * (registry "[^-]+")
- * (encoding "[^-]+")
- * )
- */
-
-static LONG
-x_to_w32_weight (lpw)
- char * lpw;
-{
- if (!lpw) return (FW_DONTCARE);
-
- if (stricmp (lpw, "heavy") == 0) return FW_HEAVY;
- else if (stricmp (lpw, "extrabold") == 0) return FW_EXTRABOLD;
- else if (stricmp (lpw, "bold") == 0) return FW_BOLD;
- else if (stricmp (lpw, "demibold") == 0) return FW_SEMIBOLD;
- else if (stricmp (lpw, "semibold") == 0) return FW_SEMIBOLD;
- else if (stricmp (lpw, "medium") == 0) return FW_MEDIUM;
- else if (stricmp (lpw, "normal") == 0) return FW_NORMAL;
- else if (stricmp (lpw, "light") == 0) return FW_LIGHT;
- else if (stricmp (lpw, "extralight") == 0) return FW_EXTRALIGHT;
- else if (stricmp (lpw, "thin") == 0) return FW_THIN;
- else
- return FW_DONTCARE;
-}
-
-
-static char *
-w32_to_x_weight (fnweight)
- int fnweight;
-{
- if (fnweight >= FW_HEAVY) return "heavy";
- if (fnweight >= FW_EXTRABOLD) return "extrabold";
- if (fnweight >= FW_BOLD) return "bold";
- if (fnweight >= FW_SEMIBOLD) return "demibold";
- if (fnweight >= FW_MEDIUM) return "medium";
- if (fnweight >= FW_NORMAL) return "normal";
- if (fnweight >= FW_LIGHT) return "light";
- if (fnweight >= FW_EXTRALIGHT) return "extralight";
- if (fnweight >= FW_THIN) return "thin";
- else
- return "*";
-}
-
-LONG
-x_to_w32_charset (lpcs)
- char * lpcs;
-{
- Lisp_Object this_entry, w32_charset;
- char *charset;
- int len = strlen (lpcs);
-
- /* Support "*-#nnn" format for unknown charsets. */
- if (strncmp (lpcs, "*-#", 3) == 0)
- return atoi (lpcs + 3);
-
- /* All Windows fonts qualify as unicode. */
- if (!strncmp (lpcs, "iso10646", 8))
- return DEFAULT_CHARSET;
-
- /* Handle wildcards by ignoring them; eg. treat "big5*-*" as "big5". */
- charset = alloca (len + 1);
- strcpy (charset, lpcs);
- lpcs = strchr (charset, '*');
- if (lpcs)
- *lpcs = '\0';
-
- /* Look through w32-charset-info-alist for the character set.
- Format of each entry is
- (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
- */
- this_entry = Fassoc (build_string (charset), Vw32_charset_info_alist);
-
- if (NILP (this_entry))
- {
- /* At startup, we want iso8859-1 fonts to come up properly. */
- if (stricmp (charset, "iso8859-1") == 0)
- return ANSI_CHARSET;
- else
- return DEFAULT_CHARSET;
- }
-
- w32_charset = Fcar (Fcdr (this_entry));
-
- /* Translate Lisp symbol to number. */
- if (EQ (w32_charset, Qw32_charset_ansi))
- return ANSI_CHARSET;
- if (EQ (w32_charset, Qw32_charset_symbol))
- return SYMBOL_CHARSET;
- if (EQ (w32_charset, Qw32_charset_shiftjis))
- return SHIFTJIS_CHARSET;
- if (EQ (w32_charset, Qw32_charset_hangeul))
- return HANGEUL_CHARSET;
- if (EQ (w32_charset, Qw32_charset_chinesebig5))
- return CHINESEBIG5_CHARSET;
- if (EQ (w32_charset, Qw32_charset_gb2312))
- return GB2312_CHARSET;
- if (EQ (w32_charset, Qw32_charset_oem))
- return OEM_CHARSET;
-#ifdef JOHAB_CHARSET
- if (EQ (w32_charset, Qw32_charset_johab))
- return JOHAB_CHARSET;
- if (EQ (w32_charset, Qw32_charset_easteurope))
- return EASTEUROPE_CHARSET;
- if (EQ (w32_charset, Qw32_charset_turkish))
- return TURKISH_CHARSET;
- if (EQ (w32_charset, Qw32_charset_baltic))
- return BALTIC_CHARSET;
- if (EQ (w32_charset, Qw32_charset_russian))
- return RUSSIAN_CHARSET;
- if (EQ (w32_charset, Qw32_charset_arabic))
- return ARABIC_CHARSET;
- if (EQ (w32_charset, Qw32_charset_greek))
- return GREEK_CHARSET;
- if (EQ (w32_charset, Qw32_charset_hebrew))
- return HEBREW_CHARSET;
- if (EQ (w32_charset, Qw32_charset_vietnamese))
- return VIETNAMESE_CHARSET;
- if (EQ (w32_charset, Qw32_charset_thai))
- return THAI_CHARSET;
- if (EQ (w32_charset, Qw32_charset_mac))
- return MAC_CHARSET;
-#endif /* JOHAB_CHARSET */
-#ifdef UNICODE_CHARSET
- if (EQ (w32_charset, Qw32_charset_unicode))
- return UNICODE_CHARSET;
-#endif
-
- return DEFAULT_CHARSET;
-}
-
-
-char *
-w32_to_x_charset (fncharset, matching)
- int fncharset;
- char *matching;
-{
- static char buf[32];
- Lisp_Object charset_type;
- int match_len = 0;
-
- if (matching)
- {
- /* If fully specified, accept it as it is. Otherwise use a
- substring match. */
- char *wildcard = strchr (matching, '*');
- if (wildcard)
- *wildcard = '\0';
- else if (strchr (matching, '-'))
- return matching;
-
- match_len = strlen (matching);
- }
-
- switch (fncharset)
- {
- case ANSI_CHARSET:
- /* Handle startup case of w32-charset-info-alist not
- being set up yet. */
- if (NILP (Vw32_charset_info_alist))
- return "iso8859-1";
- charset_type = Qw32_charset_ansi;
- break;
- case DEFAULT_CHARSET:
- charset_type = Qw32_charset_default;
- break;
- case SYMBOL_CHARSET:
- charset_type = Qw32_charset_symbol;
- break;
- case SHIFTJIS_CHARSET:
- charset_type = Qw32_charset_shiftjis;
- break;
- case HANGEUL_CHARSET:
- charset_type = Qw32_charset_hangeul;
- break;
- case GB2312_CHARSET:
- charset_type = Qw32_charset_gb2312;
- break;
- case CHINESEBIG5_CHARSET:
- charset_type = Qw32_charset_chinesebig5;
- break;
- case OEM_CHARSET:
- charset_type = Qw32_charset_oem;
- break;
-
- /* More recent versions of Windows (95 and NT4.0) define more
- character sets. */
-#ifdef EASTEUROPE_CHARSET
- case EASTEUROPE_CHARSET:
- charset_type = Qw32_charset_easteurope;
- break;
- case TURKISH_CHARSET:
- charset_type = Qw32_charset_turkish;
- break;
- case BALTIC_CHARSET:
- charset_type = Qw32_charset_baltic;
- break;
- case RUSSIAN_CHARSET:
- charset_type = Qw32_charset_russian;
- break;
- case ARABIC_CHARSET:
- charset_type = Qw32_charset_arabic;
- break;
- case GREEK_CHARSET:
- charset_type = Qw32_charset_greek;
- break;
- case HEBREW_CHARSET:
- charset_type = Qw32_charset_hebrew;
- break;
- case VIETNAMESE_CHARSET:
- charset_type = Qw32_charset_vietnamese;
- break;
- case THAI_CHARSET:
- charset_type = Qw32_charset_thai;
- break;
- case MAC_CHARSET:
- charset_type = Qw32_charset_mac;
- break;
- case JOHAB_CHARSET:
- charset_type = Qw32_charset_johab;
- break;
-#endif
-
-#ifdef UNICODE_CHARSET
- case UNICODE_CHARSET:
- charset_type = Qw32_charset_unicode;
- break;
-#endif
- default:
- /* Encode numerical value of unknown charset. */
- sprintf (buf, "*-#%u", fncharset);
- return buf;
- }
-
- {
- Lisp_Object rest;
- char * best_match = NULL;
- int matching_found = 0;
-
- /* Look through w32-charset-info-alist for the character set.
- Prefer ISO codepages, and prefer lower numbers in the ISO
- range. Only return charsets for codepages which are installed.
-
- Format of each entry is
- (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
- */
- for (rest = Vw32_charset_info_alist; CONSP (rest); rest = XCDR (rest))
- {
- char * x_charset;
- Lisp_Object w32_charset;
- Lisp_Object codepage;
-
- Lisp_Object this_entry = XCAR (rest);
-
- /* Skip invalid entries in alist. */
- if (!CONSP (this_entry) || !STRINGP (XCAR (this_entry))
- || !CONSP (XCDR (this_entry))
- || !SYMBOLP (XCAR (XCDR (this_entry))))
- continue;
-
- x_charset = SDATA (XCAR (this_entry));
- w32_charset = XCAR (XCDR (this_entry));
- codepage = XCDR (XCDR (this_entry));
-
- /* Look for Same charset and a valid codepage (or non-int
- which means ignore). */
- if (EQ (w32_charset, charset_type)
- && (!INTEGERP (codepage) || XINT (codepage) == CP_DEFAULT
- || IsValidCodePage (XINT (codepage))))
- {
- /* If we don't have a match already, then this is the
- best. */
- if (!best_match)
- {
- best_match = x_charset;
- if (matching && !strnicmp (x_charset, matching, match_len))
- matching_found = 1;
- }
- /* If we already found a match for MATCHING, then
- only consider other matches. */
- else if (matching_found
- && strnicmp (x_charset, matching, match_len))
- continue;
- /* If this matches what we want, and the best so far doesn't,
- then this is better. */
- else if (!matching_found && matching
- && !strnicmp (x_charset, matching, match_len))
- {
- best_match = x_charset;
- matching_found = 1;
- }
- /* If this is fully specified, and the best so far isn't,
- then this is better. */
- else if ((!strchr (best_match, '-') && strchr (x_charset, '-'))
- /* If this is an ISO codepage, and the best so far isn't,
- then this is better, but only if it fully specifies the
- encoding. */
- || (strnicmp (best_match, "iso", 3) != 0
- && strnicmp (x_charset, "iso", 3) == 0
- && strchr (x_charset, '-')))
- best_match = x_charset;
- /* If both are ISO8859 codepages, choose the one with the
- lowest number in the encoding field. */
- else if (strnicmp (best_match, "iso8859-", 8) == 0
- && strnicmp (x_charset, "iso8859-", 8) == 0)
- {
- int best_enc = atoi (best_match + 8);
- int this_enc = atoi (x_charset + 8);
- if (this_enc > 0 && this_enc < best_enc)
- best_match = x_charset;
- }
- }
- }
-
- /* If no match, encode the numeric value. */
- if (!best_match)
- {
- sprintf (buf, "*-#%u", fncharset);
- return buf;
- }
-
- strncpy (buf, best_match, 31);
- /* If the charset is not fully specified, put -0 on the end. */
- if (!strchr (best_match, '-'))
- {
- int pos = strlen (best_match);
- /* Charset specifiers shouldn't be very long. If it is a made
- up one, truncating it should not do any harm since it isn't
- recognized anyway. */
- if (pos > 29)
- pos = 29;
- strcpy (buf + pos, "-0");
- }
- buf[31] = '\0';
- return buf;
- }
-}
-
-
-/* Return all the X charsets that map to a font. */
-static Lisp_Object
-w32_to_all_x_charsets (fncharset)
- int fncharset;
-{
- static char buf[32];
- Lisp_Object charset_type;
- Lisp_Object retval = Qnil;
-
- switch (fncharset)
- {
- case ANSI_CHARSET:
- /* Handle startup case of w32-charset-info-alist not
- being set up yet. */
- if (NILP (Vw32_charset_info_alist))
- return Fcons (build_string ("iso8859-1"), Qnil);
-
- charset_type = Qw32_charset_ansi;
- break;
- case DEFAULT_CHARSET:
- charset_type = Qw32_charset_default;
- break;
- case SYMBOL_CHARSET:
- charset_type = Qw32_charset_symbol;
- break;
- case SHIFTJIS_CHARSET:
- charset_type = Qw32_charset_shiftjis;
- break;
- case HANGEUL_CHARSET:
- charset_type = Qw32_charset_hangeul;
- break;
- case GB2312_CHARSET:
- charset_type = Qw32_charset_gb2312;
- break;
- case CHINESEBIG5_CHARSET:
- charset_type = Qw32_charset_chinesebig5;
- break;
- case OEM_CHARSET:
- charset_type = Qw32_charset_oem;
- break;
-
- /* More recent versions of Windows (95 and NT4.0) define more
- character sets. */
-#ifdef EASTEUROPE_CHARSET
- case EASTEUROPE_CHARSET:
- charset_type = Qw32_charset_easteurope;
- break;
- case TURKISH_CHARSET:
- charset_type = Qw32_charset_turkish;
- break;
- case BALTIC_CHARSET:
- charset_type = Qw32_charset_baltic;
- break;
- case RUSSIAN_CHARSET:
- charset_type = Qw32_charset_russian;
- break;
- case ARABIC_CHARSET:
- charset_type = Qw32_charset_arabic;
- break;
- case GREEK_CHARSET:
- charset_type = Qw32_charset_greek;
- break;
- case HEBREW_CHARSET:
- charset_type = Qw32_charset_hebrew;
- break;
- case VIETNAMESE_CHARSET:
- charset_type = Qw32_charset_vietnamese;
- break;
- case THAI_CHARSET:
- charset_type = Qw32_charset_thai;
- break;
- case MAC_CHARSET:
- charset_type = Qw32_charset_mac;
- break;
- case JOHAB_CHARSET:
- charset_type = Qw32_charset_johab;
- break;
-#endif
-
-#ifdef UNICODE_CHARSET
- case UNICODE_CHARSET:
- charset_type = Qw32_charset_unicode;
- break;
-#endif
- default:
- /* Encode numerical value of unknown charset. */
- sprintf (buf, "*-#%u", fncharset);
- return Fcons (build_string (buf), Qnil);
- }
-
- {
- Lisp_Object rest;
- /* Look through w32-charset-info-alist for the character set.
- Only return fully specified charsets for codepages which are
- installed.
-
- Format of each entry in Vw32_charset_info_alist is
- (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
- */
- for (rest = Vw32_charset_info_alist; CONSP (rest); rest = XCDR (rest))
- {
- Lisp_Object x_charset;
- Lisp_Object w32_charset;
- Lisp_Object codepage;
-
- Lisp_Object this_entry = XCAR (rest);
-
- /* Skip invalid entries in alist. */
- if (!CONSP (this_entry) || !STRINGP (XCAR (this_entry))
- || !CONSP (XCDR (this_entry))
- || !SYMBOLP (XCAR (XCDR (this_entry))))
- continue;
-
- x_charset = XCAR (this_entry);
- w32_charset = XCAR (XCDR (this_entry));
- codepage = XCDR (XCDR (this_entry));
-
- if (!strchr (SDATA (x_charset), '-'))
- continue;
-
- /* Look for Same charset and a valid codepage (or non-int
- which means ignore). */
- if (EQ (w32_charset, charset_type)
- && (!INTEGERP (codepage) || XINT (codepage) == CP_DEFAULT
- || IsValidCodePage (XINT (codepage))))
- {
- retval = Fcons (x_charset, retval);
- }
- }
-
- /* If no match, encode the numeric value. */
- if (NILP (retval))
- {
- sprintf (buf, "*-#%u", fncharset);
- return Fcons (build_string (buf), Qnil);
- }
-
- return retval;
- }
-}
-
-/* Get the Windows codepage corresponding to the specified font. The
- charset info in the font name is used to look up
- w32-charset-to-codepage-alist. */
-int
-w32_codepage_for_font (char *fontname)
-{
- Lisp_Object codepage, entry;
- char *charset_str, *charset, *end;
-
- /* Extract charset part of font string. */
- charset = xlfd_charset_of_font (fontname);
-
- if (!charset)
- return CP_UNKNOWN;
-
- charset_str = (char *) alloca (strlen (charset) + 1);
- strcpy (charset_str, charset);
-
-#if 0
- /* Remove leading "*-". */
- if (strncmp ("*-", charset_str, 2) == 0)
- charset = charset_str + 2;
- else
-#endif
- charset = charset_str;
-
- /* Stop match at wildcard (including preceding '-'). */
- if (end = strchr (charset, '*'))
- {
- if (end > charset && *(end-1) == '-')
- end--;
- *end = '\0';
- }
-
- if (!strcmp (charset, "iso10646"))
- return CP_UNICODE;
-
- if (NILP (Vw32_charset_info_alist))
- return CP_DEFAULT;
-
- entry = Fassoc (build_string(charset), Vw32_charset_info_alist);
- if (NILP (entry))
- return CP_UNKNOWN;
-
- codepage = Fcdr (Fcdr (entry));
-
- if (NILP (codepage))
- return CP_8BIT;
- else if (XFASTINT (codepage) == XFASTINT (Qt))
- return CP_UNICODE;
- else if (INTEGERP (codepage))
- return XINT (codepage);
- else
- return CP_UNKNOWN;
-}
-
-
-static BOOL
-w32_to_x_font (lplogfont, lpxstr, len, specific_charset)
- LOGFONT * lplogfont;
- char * lpxstr;
- int len;
- char * specific_charset;
-{
- char* fonttype;
- char *fontname;
- char height_pixels[8];
- char height_dpi[8];
- char width_pixels[8];
- char *fontname_dash;
- int display_resy = (int) one_w32_display_info.resy;
- int display_resx = (int) one_w32_display_info.resx;
- struct coding_system coding;
-
- if (!lpxstr) abort ();
-
- if (!lplogfont)
- return FALSE;
-
- if (lplogfont->lfOutPrecision == OUT_STRING_PRECIS)
- fonttype = "raster";
- else if (lplogfont->lfOutPrecision == OUT_STROKE_PRECIS)
- fonttype = "outline";
- else
- fonttype = "unknown";
-
- setup_coding_system (Fcheck_coding_system (Vlocale_coding_system),
- &coding);
- coding.src_multibyte = 0;
- coding.dst_multibyte = 1;
- coding.mode |= CODING_MODE_LAST_BLOCK;
- /* We explicitely disable composition handling because selection
- data should not contain any composition sequence. */
- coding.common_flags &= ~CODING_ANNOTATION_MASK;
-
- coding.dst_bytes = LF_FACESIZE * 2;
- coding.destination = (unsigned char *) xmalloc (coding.dst_bytes + 1);
- decode_coding_c_string (&coding, lplogfont->lfFaceName,
- strlen(lplogfont->lfFaceName), Qnil);
- fontname = coding.destination;
-
- *(fontname + coding.produced) = '\0';
-
- /* Replace dashes with underscores so the dashes are not
- misinterpreted. */
- fontname_dash = fontname;
- while (fontname_dash = strchr (fontname_dash, '-'))
- *fontname_dash = '_';
-
- if (lplogfont->lfHeight)
- {
- sprintf (height_pixels, "%u", eabs (lplogfont->lfHeight));
- sprintf (height_dpi, "%u",
- eabs (lplogfont->lfHeight) * 720 / display_resy);
- }
- else
- {
- strcpy (height_pixels, "*");
- strcpy (height_dpi, "*");
- }
-
-#if 0 /* Never put the width in the xfld. It fails on fonts with
- double-width characters. */
- if (lplogfont->lfWidth)
- sprintf (width_pixels, "%u", lplogfont->lfWidth * 10);
- else
-#endif
- strcpy (width_pixels, "*");
-
- _snprintf (lpxstr, len - 1,
- "-%s-%s-%s-%c-normal-normal-%s-%s-%d-%d-%c-%s-%s",
- fonttype, /* foundry */
- fontname, /* family */
- w32_to_x_weight (lplogfont->lfWeight), /* weight */
- lplogfont->lfItalic?'i':'r', /* slant */
- /* setwidth name */
- /* add style name */
- height_pixels, /* pixel size */
- height_dpi, /* point size */
- display_resx, /* resx */
- display_resy, /* resy */
- ((lplogfont->lfPitchAndFamily & 0x3) == VARIABLE_PITCH)
- ? 'p' : 'c', /* spacing */
- width_pixels, /* avg width */
- w32_to_x_charset (lplogfont->lfCharSet, specific_charset)
- /* charset registry and encoding */
- );
-
- lpxstr[len - 1] = 0; /* just to be sure */
- return (TRUE);
-}
-
-static BOOL
-x_to_w32_font (lpxstr, lplogfont)
- char * lpxstr;
- LOGFONT * lplogfont;
-{
- struct coding_system coding;
-
- if (!lplogfont) return (FALSE);
-
- memset (lplogfont, 0, sizeof (*lplogfont));
-
- /* Set default value for each field. */
-#if 1
- lplogfont->lfOutPrecision = OUT_DEFAULT_PRECIS;
- lplogfont->lfClipPrecision = CLIP_DEFAULT_PRECIS;
- lplogfont->lfQuality = DEFAULT_QUALITY;
-#else
- /* go for maximum quality */
- lplogfont->lfOutPrecision = OUT_STROKE_PRECIS;
- lplogfont->lfClipPrecision = CLIP_STROKE_PRECIS;
- lplogfont->lfQuality = PROOF_QUALITY;
-#endif
-
- lplogfont->lfCharSet = DEFAULT_CHARSET;
- lplogfont->lfWeight = FW_DONTCARE;
- lplogfont->lfPitchAndFamily = DEFAULT_PITCH | FF_DONTCARE;
-
- if (!lpxstr)
- return FALSE;
-
- /* Provide a simple escape mechanism for specifying Windows font names
- * directly -- if font spec does not beginning with '-', assume this
- * format:
- * "<font name>[:height in pixels[:width in pixels[:weight]]]"
- */
-
- if (*lpxstr == '-')
- {
- int fields, tem;
- char name[50], weight[20], slant, pitch, pixels[10], height[10],
- width[10], resy[10], remainder[50];
- char * encoding;
- int dpi = (int) one_w32_display_info.resy;
-
- fields = sscanf (lpxstr,
- "-%*[^-]-%49[^-]-%19[^-]-%c-%*[^-]-%*[^-]-%9[^-]-%9[^-]-%*[^-]-%9[^-]-%c-%9[^-]-%49s",
- name, weight, &slant, pixels, height, resy, &pitch, width, remainder);
- if (fields == EOF)
- return (FALSE);
-
- /* In the general case when wildcards cover more than one field,
- we don't know which field is which, so don't fill any in.
- However, we need to cope with this particular form, which is
- generated by font_list_1 (invoked by try_font_list):
- "-raster-6x10-*-gb2312*-*"
- and make sure to correctly parse the charset field. */
- if (fields == 3)
- {
- fields = sscanf (lpxstr,
- "-%*[^-]-%49[^-]-*-%49s",
- name, remainder);
- }
- else if (fields < 9)
- {
- fields = 0;
- remainder[0] = 0;
- }
-
- if (fields > 0 && name[0] != '*')
- {
- Lisp_Object string = build_string (name);
- setup_coding_system
- (Fcheck_coding_system (Vlocale_coding_system), &coding);
- coding.mode |= (CODING_MODE_SAFE_ENCODING | CODING_MODE_LAST_BLOCK);
- /* Disable composition/charset annotation. */
- coding.common_flags &= ~CODING_ANNOTATION_MASK;
- coding.dst_bytes = SCHARS (string) * 2;
-
- coding.destination = (unsigned char *) xmalloc (coding.dst_bytes);
- encode_coding_object (&coding, string, 0, 0,
- SCHARS (string), SBYTES (string), Qnil);
- if (coding.produced >= LF_FACESIZE)
- coding.produced = LF_FACESIZE - 1;
-
- coding.destination[coding.produced] = '\0';
-
- strcpy (lplogfont->lfFaceName, coding.destination);
- xfree (coding.destination);
- }
- else
- {
- lplogfont->lfFaceName[0] = '\0';
- }
-
- fields--;
-
- lplogfont->lfWeight = x_to_w32_weight ((fields > 0 ? weight : ""));
-
- fields--;
-
- lplogfont->lfItalic = (fields > 0 && slant == 'i');
-
- fields--;
-
- if (fields > 0 && pixels[0] != '*')
- lplogfont->lfHeight = atoi (pixels);
-
- fields--;
- fields--;
- if (fields > 0 && resy[0] != '*')
- {
- tem = atoi (resy);
- if (tem > 0) dpi = tem;
- }
-
- if (fields > -1 && lplogfont->lfHeight == 0 && height[0] != '*')
- lplogfont->lfHeight = atoi (height) * dpi / 720;
-
- if (fields > 0)
- {
- if (pitch == 'p')
- lplogfont->lfPitchAndFamily = VARIABLE_PITCH | FF_DONTCARE;
- else if (pitch == 'c')
- lplogfont->lfPitchAndFamily = FIXED_PITCH | FF_DONTCARE;
- }
-
- fields--;
-
- if (fields > 0 && width[0] != '*')
- lplogfont->lfWidth = atoi (width) / 10;
-
- fields--;
-
- /* Strip the trailing '-' if present. (it shouldn't be, as it
- fails the test against xlfd-tight-regexp in fontset.el). */
- {
- int len = strlen (remainder);
- if (len > 0 && remainder[len-1] == '-')
- remainder[len-1] = 0;
- }
- encoding = remainder;
-#if 0
- if (strncmp (encoding, "*-", 2) == 0)
- encoding += 2;
-#endif
- lplogfont->lfCharSet = x_to_w32_charset (encoding);
- }
- else
- {
- int fields;
- char name[100], height[10], width[10], weight[20];
-
- fields = sscanf (lpxstr,
- "%99[^:]:%9[^:]:%9[^:]:%19s",
- name, height, width, weight);
-
- if (fields == EOF) return (FALSE);
-
- if (fields > 0)
- {
- strncpy (lplogfont->lfFaceName, name, LF_FACESIZE);
- lplogfont->lfFaceName[LF_FACESIZE-1] = 0;
- }
- else
- {
- lplogfont->lfFaceName[0] = 0;
- }
-
- fields--;
-
- if (fields > 0)
- lplogfont->lfHeight = atoi (height);
-
- fields--;
-
- if (fields > 0)
- lplogfont->lfWidth = atoi (width);
-
- fields--;
-
- lplogfont->lfWeight = x_to_w32_weight ((fields > 0 ? weight : ""));
- }
-
- /* This makes TrueType fonts work better. */
- lplogfont->lfHeight = - eabs (lplogfont->lfHeight);
-
- return (TRUE);
-}
-
-/* Strip the pixel height and point height from the given xlfd, and
- return the pixel height. If no pixel height is specified, calculate
- one from the point height, or if that isn't defined either, return
- 0 (which usually signifies a scalable font).
-*/
-static int
-xlfd_strip_height (char *fontname)
-{
- int pixel_height, field_number;
- char *read_from, *write_to;
-
- xassert (fontname);
-
- pixel_height = field_number = 0;
- write_to = NULL;
-
- /* Look for height fields. */
- for (read_from = fontname; *read_from; read_from++)
- {
- if (*read_from == '-')
- {
- field_number++;
- if (field_number == 7) /* Pixel height. */
- {
- read_from++;
- write_to = read_from;
-
- /* Find end of field. */
- for (;*read_from && *read_from != '-'; read_from++)
- ;
-
- /* Split the fontname at end of field. */
- if (*read_from)
- {
- *read_from = '\0';
- read_from++;
- }
- pixel_height = atoi (write_to);
- /* Blank out field. */
- if (read_from > write_to)
- {
- *write_to = '-';
- write_to++;
- }
- /* If the pixel height field is at the end (partial xlfd),
- return now. */
- else
- return pixel_height;
-
- /* If we got a pixel height, the point height can be
- ignored. Just blank it out and break now. */
- if (pixel_height)
- {
- /* Find end of point size field. */
- for (; *read_from && *read_from != '-'; read_from++)
- ;
-
- if (*read_from)
- read_from++;
-
- /* Blank out the point size field. */
- if (read_from > write_to)
- {
- *write_to = '-';
- write_to++;
- }
- else
- return pixel_height;
-
- break;
- }
- /* If the point height is already blank, break now. */
- if (*read_from == '-')
- {
- read_from++;
- break;
- }
- }
- else if (field_number == 8)
- {
- /* If we didn't get a pixel height, try to get the point
- height and convert that. */
- int point_size;
- char *point_size_start = read_from++;
-
- /* Find end of field. */
- for (; *read_from && *read_from != '-'; read_from++)
- ;
-
- if (*read_from)
- {
- *read_from = '\0';
- read_from++;
- }
-
- point_size = atoi (point_size_start);
-
- /* Convert to pixel height. */
- pixel_height = point_size
- * one_w32_display_info.height_in / 720;
-
- /* Blank out this field and break. */
- *write_to = '-';
- write_to++;
- break;
- }
- }
- }
-
- /* Shift the rest of the font spec into place. */
- if (write_to && read_from > write_to)
- {
- for (; *read_from; read_from++, write_to++)
- *write_to = *read_from;
- *write_to = '\0';
- }
-
- return pixel_height;
-}
-
-/* Assume parameter 1 is fully qualified, no wildcards. */
-static BOOL
-w32_font_match (fontname, pattern)
- char * fontname;
- char * pattern;
-{
- char *ptr;
- char *font_name_copy;
- char *regex = alloca (strlen (pattern) * 2 + 3);
-
- font_name_copy = alloca (strlen (fontname) + 1);
- strcpy (font_name_copy, fontname);
-
- ptr = regex;
- *ptr++ = '^';
-
- /* Turn pattern into a regexp and do a regexp match. */
- for (; *pattern; pattern++)
- {
- if (*pattern == '?')
- *ptr++ = '.';
- else if (*pattern == '*')
- {
- *ptr++ = '.';
- *ptr++ = '*';
- }
- else
- *ptr++ = *pattern;
- }
- *ptr = '$';
- *(ptr + 1) = '\0';
-
- /* Strip out font heights and compare them seperately, since
- rounding error can cause mismatches. This also allows a
- comparison between a font that declares only a pixel height and a
- pattern that declares the point height.
- */
- {
- int font_height, pattern_height;
-
- font_height = xlfd_strip_height (font_name_copy);
- pattern_height = xlfd_strip_height (regex);
-
- /* Compare now, and don't bother doing expensive regexp matching
- if the heights differ. */
- if (font_height && pattern_height && (font_height != pattern_height))
- return FALSE;
- }
-
- return (fast_string_match_ignore_case (build_string (regex),
- build_string (font_name_copy)) >= 0);
-}
-
-/* Callback functions, and a structure holding info they need, for
- listing system fonts on W32. We need one set of functions to do the
- job properly, but these don't work on NT 3.51 and earlier, so we
- have a second set which don't handle character sets properly to
- fall back on.
-
- In both cases, there are two passes made. The first pass gets one
- font from each family, the second pass lists all the fonts from
- each family. */
-
-typedef struct enumfont_t
-{
- HDC hdc;
- int numFonts;
- LOGFONT logfont;
- XFontStruct *size_ref;
- Lisp_Object pattern;
- Lisp_Object list;
-} enumfont_t;
-
-
-static void
-enum_font_maybe_add_to_list (enumfont_t *, LOGFONT *, char *, Lisp_Object);
-
-
-static int CALLBACK
-enum_font_cb2 (lplf, lptm, FontType, lpef)
- ENUMLOGFONT * lplf;
- NEWTEXTMETRIC * lptm;
- int FontType;
- enumfont_t * lpef;
-{
- /* Ignore struck out and underlined versions of fonts. */
- if (lplf->elfLogFont.lfStrikeOut || lplf->elfLogFont.lfUnderline)
- return 1;
-
- /* Only return fonts with names starting with @ if they were
- explicitly specified, since Microsoft uses an initial @ to
- denote fonts for vertical writing, without providing a more
- convenient way of identifying them. */
- if (lplf->elfLogFont.lfFaceName[0] == '@'
- && lpef->logfont.lfFaceName[0] != '@')
- return 1;
-
- /* Check that the character set matches if it was specified */
- if (lpef->logfont.lfCharSet != DEFAULT_CHARSET &&
- lplf->elfLogFont.lfCharSet != lpef->logfont.lfCharSet)
- return 1;
-
- if (FontType == RASTER_FONTTYPE)
- {
- /* DBCS raster fonts have problems displaying, so skip them. */
- int charset = lplf->elfLogFont.lfCharSet;
- if (charset == SHIFTJIS_CHARSET
- || charset == HANGEUL_CHARSET
- || charset == CHINESEBIG5_CHARSET
- || charset == GB2312_CHARSET
-#ifdef JOHAB_CHARSET
- || charset == JOHAB_CHARSET
-#endif
- )
- return 1;
- }
-
- {
- char buf[100];
- Lisp_Object width = Qnil;
- Lisp_Object charset_list = Qnil;
- char *charset = NULL;
-
- /* Truetype fonts do not report their true metrics until loaded */
- if (FontType != RASTER_FONTTYPE)
- {
- if (!NILP (lpef->pattern))
- {
- /* Scalable fonts are as big as you want them to be. */
- lplf->elfLogFont.lfHeight = lpef->logfont.lfHeight;
- lplf->elfLogFont.lfWidth = lpef->logfont.lfWidth;
- width = make_number (lpef->logfont.lfWidth);
- }
- else
- {
- lplf->elfLogFont.lfHeight = 0;
- lplf->elfLogFont.lfWidth = 0;
- }
- }
-
- /* Make sure the height used here is the same as everywhere
- else (ie character height, not cell height). */
- if (lplf->elfLogFont.lfHeight > 0)
- {
- /* lptm can be trusted for RASTER fonts, but not scalable ones. */
- if (FontType == RASTER_FONTTYPE)
- lplf->elfLogFont.lfHeight = lptm->tmInternalLeading - lptm->tmHeight;
- else
- lplf->elfLogFont.lfHeight = -lplf->elfLogFont.lfHeight;
- }
-
- if (!NILP (lpef->pattern))
- {
- charset = xlfd_charset_of_font (SDATA (lpef->pattern));
-
- /* We already checked charsets above, but DEFAULT_CHARSET
- slipped through. So only allow exact matches for DEFAULT_CHARSET. */
- if (charset
- && strncmp (charset, "*-*", 3) != 0
- && lpef->logfont.lfCharSet == DEFAULT_CHARSET
- && strcmp (charset, w32_to_x_charset (DEFAULT_CHARSET, NULL)) != 0)
- return 1;
- }
-
- if (charset)
- charset_list = Fcons (build_string (charset), Qnil);
- else
- /* Always prefer unicode. */
- charset_list
- = Fcons (build_string ("iso10646-1"),
- w32_to_all_x_charsets (lplf->elfLogFont.lfCharSet));
-
- /* Loop through the charsets. */
- for ( ; CONSP (charset_list); charset_list = Fcdr (charset_list))
- {
- Lisp_Object this_charset = Fcar (charset_list);
- charset = SDATA (this_charset);
-
- enum_font_maybe_add_to_list (lpef, &(lplf->elfLogFont),
- charset, width);
-
- /* List bold and italic variations if w32-enable-synthesized-fonts
- is non-nil and this is a plain font. */
- if (w32_enable_synthesized_fonts
- && lplf->elfLogFont.lfWeight == FW_NORMAL
- && lplf->elfLogFont.lfItalic == FALSE)
- {
- /* bold. */
- lplf->elfLogFont.lfWeight = FW_BOLD;
- enum_font_maybe_add_to_list (lpef, &(lplf->elfLogFont),
- charset, width);
- /* bold italic. */
- lplf->elfLogFont.lfItalic = TRUE;
- enum_font_maybe_add_to_list (lpef, &(lplf->elfLogFont),
- charset, width);
- /* italic. */
- lplf->elfLogFont.lfWeight = FW_NORMAL;
- enum_font_maybe_add_to_list (lpef, &(lplf->elfLogFont),
- charset, width);
- }
- }
- }
-
- return 1;
-}
-
-static void
-enum_font_maybe_add_to_list (lpef, logfont, match_charset, width)
- enumfont_t * lpef;
- LOGFONT * logfont;
- char * match_charset;
- Lisp_Object width;
-{
- char buf[100];
-
- if (!w32_to_x_font (logfont, buf, 100, match_charset))
- return;
-
- if (NILP (lpef->pattern)
- || w32_font_match (buf, SDATA (lpef->pattern)))
- {
- /* Check if we already listed this font. This may happen if
- w32_enable_synthesized_fonts is non-nil, and there are real
- bold and italic versions of the font. */
- Lisp_Object font_name = build_string (buf);
- if (NILP (Fmember (font_name, lpef->list)))
- {
- Lisp_Object entry = Fcons (font_name, width);
- lpef->list = Fcons (entry, lpef->list);
- lpef->numFonts++;
- }
- }
-}
-
-
-static int CALLBACK
-enum_font_cb1 (lplf, lptm, FontType, lpef)
- ENUMLOGFONT * lplf;
- NEWTEXTMETRIC * lptm;
- int FontType;
- enumfont_t * lpef;
-{
- return EnumFontFamilies (lpef->hdc,
- lplf->elfLogFont.lfFaceName,
- (FONTENUMPROC) enum_font_cb2,
- (LPARAM) lpef);
-}
-
-
-static int CALLBACK
-enum_fontex_cb2 (lplf, lptm, font_type, lpef)
- ENUMLOGFONTEX * lplf;
- NEWTEXTMETRICEX * lptm;
- int font_type;
- enumfont_t * lpef;
-{
- /* We are not interested in the extra info we get back from the 'Ex
- version - only the fact that we get character set variations
- enumerated seperately. */
- return enum_font_cb2 ((ENUMLOGFONT *) lplf, (NEWTEXTMETRIC *) lptm,
- font_type, lpef);
-}
-
-static int CALLBACK
-enum_fontex_cb1 (lplf, lptm, font_type, lpef)
- ENUMLOGFONTEX * lplf;
- NEWTEXTMETRICEX * lptm;
- int font_type;
- enumfont_t * lpef;
-{
- HMODULE gdi32 = GetModuleHandle ("gdi32.dll");
- FARPROC enum_font_families_ex
- = GetProcAddress ( gdi32, "EnumFontFamiliesExA");
- /* We don't really expect EnumFontFamiliesEx to disappear once we
- get here, so don't bother handling it gracefully. */
- if (enum_font_families_ex == NULL)
- error ("gdi32.dll has disappeared!");
- return enum_font_families_ex (lpef->hdc,
- &lplf->elfLogFont,
- (FONTENUMPROC) enum_fontex_cb2,
- (LPARAM) lpef, 0);
-}
-
-/* Interface to fontset handler. (adapted from mw32font.c in Meadow
- and xterm.c in Emacs 20.3) */
-
-static Lisp_Object
-w32_list_bdf_fonts (Lisp_Object pattern, int max_names)
-{
- char *fontname, *ptnstr;
- Lisp_Object list, tem, newlist = Qnil;
- int n_fonts = 0;
-
- list = Vw32_bdf_filename_alist;
- ptnstr = SDATA (pattern);
-
- for ( ; CONSP (list); list = XCDR (list))
- {
- tem = XCAR (list);
- if (CONSP (tem))
- fontname = SDATA (XCAR (tem));
- else if (STRINGP (tem))
- fontname = SDATA (tem);
- else
- continue;
-
- if (w32_font_match (fontname, ptnstr))
- {
- newlist = Fcons (XCAR (tem), newlist);
- n_fonts++;
- if (max_names >= 0 && n_fonts >= max_names)
- break;
- }
- }
-
- return newlist;
-}
-
-
-/* Return a list of names of available fonts matching PATTERN on frame
- F. If SIZE is not 0, it is the size (maximum bound width) of fonts
- to be listed. Frame F NULL means we have not yet created any
- frame, which means we can't get proper size info, as we don't have
- a device context to use for GetTextMetrics.
- MAXNAMES sets a limit on how many fonts to match. If MAXNAMES is
- negative, then all matching fonts are returned. */
-
-Lisp_Object
-w32_list_fonts (f, pattern, size, maxnames)
- struct frame *f;
- Lisp_Object pattern;
- int size;
- int maxnames;
-{
- Lisp_Object patterns, key = Qnil, tem, tpat;
- Lisp_Object list = Qnil, newlist = Qnil, second_best = Qnil;
- struct w32_display_info *dpyinfo = &one_w32_display_info;
- int n_fonts = 0;
-
- patterns = Fassoc (pattern, Valternate_fontname_alist);
- if (NILP (patterns))
- patterns = Fcons (pattern, Qnil);
-
- for (; CONSP (patterns); patterns = XCDR (patterns))
- {
- enumfont_t ef;
- int codepage;
-
- tpat = XCAR (patterns);
-
- if (!STRINGP (tpat))
- continue;
-
- /* Avoid expensive EnumFontFamilies functions if we are not
- going to be able to output one of these anyway. */
- codepage = w32_codepage_for_font (SDATA (tpat));
- if (codepage != CP_8BIT && codepage != CP_UNICODE
- && codepage != CP_DEFAULT && codepage != CP_UNKNOWN
- && !IsValidCodePage (codepage))
- continue;
-
- /* See if we cached the result for this particular query.
- The cache is an alist of the form:
- ((PATTERN (FONTNAME . WIDTH) ...) ...)
- */
- if (tem = XCDR (dpyinfo->name_list_element),
- !NILP (list = Fassoc (tpat, tem)))
- {
- list = Fcdr_safe (list);
- /* We have a cached list. Don't have to get the list again. */
- goto label_cached;
- }
-
- BLOCK_INPUT;
- /* At first, put PATTERN in the cache. */
- ef.pattern = tpat;
- ef.list = Qnil;
- ef.numFonts = 0;
-
- /* Use EnumFontFamiliesEx where it is available, as it knows
- about character sets. Fall back to EnumFontFamilies for
- older versions of NT that don't support the 'Ex function. */
- x_to_w32_font (SDATA (tpat), &ef.logfont);
- {
- LOGFONT font_match_pattern;
- HMODULE gdi32 = GetModuleHandle ("gdi32.dll");
- FARPROC enum_font_families_ex
- = GetProcAddress ( gdi32, "EnumFontFamiliesExA");
-
- /* We do our own pattern matching so we can handle wildcards. */
- font_match_pattern.lfFaceName[0] = 0;
- font_match_pattern.lfPitchAndFamily = 0;
- /* We can use the charset, because if it is a wildcard it will
- be DEFAULT_CHARSET anyway. */
- font_match_pattern.lfCharSet = ef.logfont.lfCharSet;
-
- ef.hdc = GetDC (dpyinfo->root_window);
-
- if (enum_font_families_ex)
- enum_font_families_ex (ef.hdc,
- &font_match_pattern,
- (FONTENUMPROC) enum_fontex_cb1,
- (LPARAM) &ef, 0);
- else
- EnumFontFamilies (ef.hdc, NULL, (FONTENUMPROC) enum_font_cb1,
- (LPARAM)&ef);
-
- ReleaseDC (dpyinfo->root_window, ef.hdc);
- }
-
- UNBLOCK_INPUT;
- list = ef.list;
-
- /* Make a list of the fonts we got back.
- Store that in the font cache for the display. */
- XSETCDR (dpyinfo->name_list_element,
- Fcons (Fcons (tpat, list),
- XCDR (dpyinfo->name_list_element)));
-
- label_cached:
- if (NILP (list)) continue; /* Try the remaining alternatives. */
-
- newlist = second_best = Qnil;
-
- /* Make a list of the fonts that have the right width. */
- for (; CONSP (list); list = XCDR (list))
- {
- int found_size;
- tem = XCAR (list);
-
- if (!CONSP (tem))
- continue;
- if (NILP (XCAR (tem)))
- continue;
- if (!size)
- {
- newlist = Fcons (XCAR (tem), newlist);
- n_fonts++;
- if (maxnames >= 0 && n_fonts >= maxnames)
- break;
- else
- continue;
- }
- if (!INTEGERP (XCDR (tem)))
- {
- /* Since we don't yet know the size of the font, we must
- load it and try GetTextMetrics. */
- W32FontStruct thisinfo;
- LOGFONT lf;
- HDC hdc;
- HANDLE oldobj;
-
- if (!x_to_w32_font (SDATA (XCAR (tem)), &lf))
- continue;
-
- BLOCK_INPUT;
- thisinfo.bdf = NULL;
- thisinfo.hfont = CreateFontIndirect (&lf);
- if (thisinfo.hfont == NULL)
- continue;
-
- hdc = GetDC (dpyinfo->root_window);
- oldobj = SelectObject (hdc, thisinfo.hfont);
- if (GetTextMetrics (hdc, &thisinfo.tm))
- XSETCDR (tem, make_number (FONT_AVG_WIDTH (&thisinfo)));
- else
- XSETCDR (tem, make_number (0));
- SelectObject (hdc, oldobj);
- ReleaseDC (dpyinfo->root_window, hdc);
- DeleteObject (thisinfo.hfont);
- UNBLOCK_INPUT;
- }
- found_size = XINT (XCDR (tem));
- if (found_size == size)
- {
- newlist = Fcons (XCAR (tem), newlist);
- n_fonts++;
- if (maxnames >= 0 && n_fonts >= maxnames)
- break;
- }
- /* keep track of the closest matching size in case
- no exact match is found. */
- else if (found_size > 0)
- {
- if (NILP (second_best))
- second_best = tem;
-
- else if (found_size < size)
- {
- if (XINT (XCDR (second_best)) > size
- || XINT (XCDR (second_best)) < found_size)
- second_best = tem;
- }
- else
- {
- if (XINT (XCDR (second_best)) > size
- && XINT (XCDR (second_best)) >
- found_size)
- second_best = tem;
- }
- }
- }
-
- if (!NILP (newlist))
- break;
- else if (!NILP (second_best))
- {
- newlist = Fcons (XCAR (second_best), Qnil);
- break;
- }
- }
-
- /* Include any bdf fonts. */
- if (n_fonts < maxnames || maxnames < 0)
- {
- Lisp_Object combined[2];
- combined[0] = w32_list_bdf_fonts (pattern, maxnames - n_fonts);
- combined[1] = newlist;
- newlist = Fnconc (2, combined);
- }
-
- return newlist;
-}
-
-
-/* Return a pointer to struct font_info of font FONT_IDX of frame F. */
-struct font_info *
-w32_get_font_info (f, font_idx)
- FRAME_PTR f;
- int font_idx;
-{
- return (FRAME_W32_FONT_TABLE (f) + font_idx);
-}
-
-
-struct font_info*
-w32_query_font (struct frame *f, char *fontname)
-{
- int i;
- struct font_info *pfi;
-
- pfi = FRAME_W32_FONT_TABLE (f);
-
- for (i = 0; i < one_w32_display_info.n_fonts ;i++, pfi++)
- {
- if (stricmp (pfi->name, fontname) == 0) return pfi;
- }
-
- return NULL;
-}
-
-/* Find a CCL program for a font specified by FONTP, and set the member
- `encoder' of the structure. */
-
-void
-w32_find_ccl_program (fontp)
- struct font_info *fontp;
-{
- Lisp_Object list, elt;
-
- for (list = Vfont_ccl_encoder_alist; CONSP (list); list = XCDR (list))
- {
- elt = XCAR (list);
- if (CONSP (elt)
- && STRINGP (XCAR (elt))
- && (fast_c_string_match_ignore_case (XCAR (elt), fontp->name)
- >= 0))
- break;
- }
- if (! NILP (list))
- {
- struct ccl_program *ccl
- = (struct ccl_program *) xmalloc (sizeof (struct ccl_program));
-
- if (setup_ccl_program (ccl, XCDR (elt)) < 0)
- xfree (ccl);
- else
- fontp->font_encoder = ccl;
- }
-}
-
-/* directory-files from dired.c. */
-Lisp_Object Fdirectory_files P_ ((Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object));
-
-\f
-/* Find BDF files in a specified directory. (use GCPRO when calling,
- as this calls lisp to get a directory listing). */
-static Lisp_Object
-w32_find_bdf_fonts_in_dir (Lisp_Object directory)
-{
- Lisp_Object filelist, list = Qnil;
- char fontname[100];
-
- if (!STRINGP (directory))
- return Qnil;
-
- filelist = Fdirectory_files (directory, Qt,
- build_string (".*\\.[bB][dD][fF]"), Qt);
-
- for ( ; CONSP (filelist); filelist = XCDR (filelist))
- {
- Lisp_Object filename = XCAR (filelist);
- if (w32_BDF_to_x_font (SDATA (filename), fontname, 100))
- store_in_alist (&list, build_string (fontname), filename);
- }
- return list;
-}
-
-DEFUN ("w32-find-bdf-fonts", Fw32_find_bdf_fonts, Sw32_find_bdf_fonts,
- 1, 1, 0,
- doc: /* Return a list of BDF fonts in DIRECTORY.
-The list is suitable for appending to `w32-bdf-filename-alist'.
-Fonts which do not contain an xlfd description will not be included
-in the list. DIRECTORY may be a list of directories. */)
- (directory)
- Lisp_Object directory;
-{
- Lisp_Object list = Qnil;
- struct gcpro gcpro1, gcpro2;
-
- if (!CONSP (directory))
- return w32_find_bdf_fonts_in_dir (directory);
-
- for ( ; CONSP (directory); directory = XCDR (directory))
- {
- Lisp_Object pair[2];
- pair[0] = list;
- pair[1] = Qnil;
- GCPRO2 (directory, list);
- pair[1] = w32_find_bdf_fonts_in_dir ( XCAR (directory) );
- list = Fnconc ( 2, pair );
- UNGCPRO;
- }
- return list;
-}
-
-\f
-DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1, 2, 0,
- doc: /* Internal function called by `color-defined-p', which see. */)
- (color, frame)
- Lisp_Object color, frame;
-{
- XColor foo;
- FRAME_PTR f = check_x_frame (frame);
-
- CHECK_STRING (color);
-
- if (w32_defined_color (f, SDATA (color), &foo, 0))
- return Qt;
- else
- return Qnil;
-}
-
-DEFUN ("xw-color-values", Fxw_color_values, Sxw_color_values, 1, 2, 0,
- doc: /* Internal function called by `color-values', which see. */)
- (color, frame)
- Lisp_Object color, frame;
-{
- XColor foo;
- FRAME_PTR f = check_x_frame (frame);
-
- CHECK_STRING (color);
-
- if (w32_defined_color (f, SDATA (color), &foo, 0))
- return list3 (make_number ((GetRValue (foo.pixel) << 8)
- | GetRValue (foo.pixel)),
- make_number ((GetGValue (foo.pixel) << 8)
- | GetGValue (foo.pixel)),
- make_number ((GetBValue (foo.pixel) << 8)
- | GetBValue (foo.pixel)));
- else
- return Qnil;
-}
-
-DEFUN ("xw-display-color-p", Fxw_display_color_p, Sxw_display_color_p, 0, 1, 0,
- doc: /* Internal function called by `display-color-p', which see. */)
- (display)
- Lisp_Object display;
-{
- struct w32_display_info *dpyinfo = check_x_display_info (display);
-
- if ((dpyinfo->n_planes * dpyinfo->n_cbits) <= 2)
- return Qnil;
-
- return Qt;
-}
-
-DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p,
- Sx_display_grayscale_p, 0, 1, 0,
- doc: /* Return t if DISPLAY supports shades of gray.
-Note that color displays do support shades of gray.
-The optional argument DISPLAY specifies which display to ask about.
-DISPLAY should be either a frame or a display name (a string).
-If omitted or nil, that stands for the selected frame's display. */)
- (display)
- Lisp_Object display;
-{
- struct w32_display_info *dpyinfo = check_x_display_info (display);
-
- if ((dpyinfo->n_planes * dpyinfo->n_cbits) <= 1)
- return Qnil;
-
- return Qt;
-}
-
-DEFUN ("x-display-pixel-width", Fx_display_pixel_width,
- Sx_display_pixel_width, 0, 1, 0,
- doc: /* Return the width in pixels of DISPLAY.
-The optional argument DISPLAY specifies which display to ask about.
-DISPLAY should be either a frame or a display name (a string).
-If omitted or nil, that stands for the selected frame's display. */)
- (display)
- Lisp_Object display;
-{
- struct w32_display_info *dpyinfo = check_x_display_info (display);
-
- return make_number (dpyinfo->width);
-}
-
-DEFUN ("x-display-pixel-height", Fx_display_pixel_height,
- Sx_display_pixel_height, 0, 1, 0,
- doc: /* Return the height in pixels of DISPLAY.
-The optional argument DISPLAY specifies which display to ask about.
-DISPLAY should be either a frame or a display name (a string).
-If omitted or nil, that stands for the selected frame's display. */)
- (display)
- Lisp_Object display;
-{
- struct w32_display_info *dpyinfo = check_x_display_info (display);
-
- return make_number (dpyinfo->height);
-}
-
-DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes,
- 0, 1, 0,
- doc: /* Return the number of bitplanes of DISPLAY.
-The optional argument DISPLAY specifies which display to ask about.
-DISPLAY should be either a frame or a display name (a string).
-If omitted or nil, that stands for the selected frame's display. */)
- (display)
- Lisp_Object display;
-{
- struct w32_display_info *dpyinfo = check_x_display_info (display);
-
- return make_number (dpyinfo->n_planes * dpyinfo->n_cbits);
-}
-
-DEFUN ("x-display-color-cells", Fx_display_color_cells, Sx_display_color_cells,
- 0, 1, 0,
- doc: /* Return the number of color cells of DISPLAY.
-The optional argument DISPLAY specifies which display to ask about.
-DISPLAY should be either a frame or a display name (a string).
-If omitted or nil, that stands for the selected frame's display. */)
- (display)
- Lisp_Object display;
-{
- struct w32_display_info *dpyinfo = check_x_display_info (display);
- HDC hdc;
- int cap;
-
- hdc = GetDC (dpyinfo->root_window);
- if (dpyinfo->has_palette)
- cap = GetDeviceCaps (hdc, SIZEPALETTE);
- else
- cap = GetDeviceCaps (hdc, NUMCOLORS);
-
- /* We force 24+ bit depths to 24-bit, both to prevent an overflow
- and because probably is more meaningful on Windows anyway */
- if (cap < 0)
- cap = 1 << min (dpyinfo->n_planes * dpyinfo->n_cbits, 24);
-
- ReleaseDC (dpyinfo->root_window, hdc);
-
- return make_number (cap);
-}