/[emacs]/emacs/src/w32fns.c
ViewVC logotype

Diff of /emacs/src/w32fns.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.123.2.6 by jasonr, Sat Jan 19 09:53:05 2002 UTC revision 1.123.2.7 by jasonr, Sun Jan 20 17:00:59 2002 UTC
# Line 127  Lisp_Object Vw32_scroll_lock_modifier; Line 127  Lisp_Object Vw32_scroll_lock_modifier;
127    
128  /* Switch to control whether we inhibit requests for synthesized bold  /* Switch to control whether we inhibit requests for synthesized bold
129     and italic versions of fonts.  */     and italic versions of fonts.  */
130  Lisp_Object Vw32_enable_synthesized_fonts;  int w32_enable_synthesized_fonts;
131    
132  /* Enable palette management. */  /* Enable palette management. */
133  Lisp_Object Vw32_enable_palette;  Lisp_Object Vw32_enable_palette;
# Line 5746  w32_load_system_font (f,fontname,size) Line 5746  w32_load_system_font (f,fontname,size)
5746      /* SJIS fonts need to be set to type 4, all others seem to work as      /* SJIS fonts need to be set to type 4, all others seem to work as
5747         type FONT_ENCODING_NOT_DECIDED.  */         type FONT_ENCODING_NOT_DECIDED.  */
5748      encoding = strrchr (fontp->name, '-');      encoding = strrchr (fontp->name, '-');
5749      if (encoding && stricmp (encoding+1, "sjis") == 0)      if (encoding && strnicmp (encoding+1, "sjis", 4) == 0)
5750        fontp->encoding[1] = 4;        fontp->encoding[1] = 4;
5751      else      else
5752        fontp->encoding[1] = FONT_ENCODING_NOT_DECIDED;        fontp->encoding[1] = FONT_ENCODING_NOT_DECIDED;
# Line 5915  x_to_w32_charset (lpcs) Line 5915  x_to_w32_charset (lpcs)
5915    
5916    w32_charset = Fcar (Fcdr (this_entry));    w32_charset = Fcar (Fcdr (this_entry));
5917    
5918    // Translate Lisp symbol to number.    /* Translate Lisp symbol to number.  */
5919    if (w32_charset == Qw32_charset_ansi)    if (w32_charset == Qw32_charset_ansi)
5920      return ANSI_CHARSET;      return ANSI_CHARSET;
5921    if (w32_charset == Qw32_charset_symbol)    if (w32_charset == Qw32_charset_symbol)
# Line 6091  w32_to_x_charset (fncharset) Line 6091  w32_to_x_charset (fncharset)
6091                best_match = x_charset;                best_match = x_charset;
6092              /* If this is an ISO codepage, and the best so far isn't,              /* If this is an ISO codepage, and the best so far isn't,
6093                 then this is better.  */                 then this is better.  */
6094              else if (stricmp (best_match, "iso") != 0              else if (strnicmp (best_match, "iso", 3) != 0
6095                       && stricmp (x_charset, "iso") == 0)                       && strnicmp (x_charset, "iso", 3) == 0)
6096                best_match = x_charset;                best_match = x_charset;
6097              /* If both are ISO8859 codepages, choose the one with the              /* If both are ISO8859 codepages, choose the one with the
6098                 lowest number in the encoding field.  */                 lowest number in the encoding field.  */
6099              else if (stricmp (best_match, "iso8859-") == 0              else if (strnicmp (best_match, "iso8859-", 8) == 0
6100                       && stricmp (x_charset, "iso8859-") == 0)                       && strnicmp (x_charset, "iso8859-", 8) == 0)
6101                {                {
6102                  int best_enc = atoi (best_match + 8);                  int best_enc = atoi (best_match + 8);
6103                  int this_enc = atoi (x_charset + 8);                  int this_enc = atoi (x_charset + 8);
# Line 6121  w32_to_x_charset (fncharset) Line 6121  w32_to_x_charset (fncharset)
6121  }  }
6122    
6123    
6124    /* Return all the X charsets that map to a font.  */
6125    static Lisp_Object
6126    w32_to_all_x_charsets (fncharset)
6127        int fncharset;
6128    {
6129      static char buf[32];
6130      Lisp_Object charset_type;
6131      Lisp_Object retval = Qnil;
6132    
6133      switch (fncharset)
6134        {
6135        case ANSI_CHARSET:
6136          /* Handle startup case of w32-charset-info-alist not
6137             being set up yet. */
6138          if (NILP(Vw32_charset_info_alist))
6139            return "iso8859-1";
6140          charset_type = Qw32_charset_ansi;
6141          break;
6142        case DEFAULT_CHARSET:
6143          charset_type = Qw32_charset_default;
6144          break;
6145        case SYMBOL_CHARSET:
6146          charset_type = Qw32_charset_symbol;
6147          break;
6148        case SHIFTJIS_CHARSET:
6149          charset_type = Qw32_charset_shiftjis;
6150          break;
6151        case HANGEUL_CHARSET:
6152          charset_type = Qw32_charset_hangeul;
6153          break;
6154        case GB2312_CHARSET:
6155          charset_type = Qw32_charset_gb2312;
6156          break;
6157        case CHINESEBIG5_CHARSET:
6158          charset_type = Qw32_charset_chinesebig5;
6159          break;
6160        case OEM_CHARSET:
6161          charset_type = Qw32_charset_oem;
6162          break;
6163    
6164          /* More recent versions of Windows (95 and NT4.0) define more
6165             character sets.  */
6166    #ifdef EASTEUROPE_CHARSET
6167        case EASTEUROPE_CHARSET:
6168          charset_type = Qw32_charset_easteurope;
6169          break;
6170        case TURKISH_CHARSET:
6171          charset_type = Qw32_charset_turkish;
6172          break;
6173        case BALTIC_CHARSET:
6174          charset_type = Qw32_charset_baltic;
6175          break;
6176        case RUSSIAN_CHARSET:
6177          charset_type = Qw32_charset_russian;
6178          break;
6179        case ARABIC_CHARSET:
6180          charset_type = Qw32_charset_arabic;
6181          break;
6182        case GREEK_CHARSET:
6183          charset_type = Qw32_charset_greek;
6184          break;
6185        case HEBREW_CHARSET:
6186          charset_type = Qw32_charset_hebrew;
6187          break;
6188        case VIETNAMESE_CHARSET:
6189          charset_type = Qw32_charset_vietnamese;
6190          break;
6191        case THAI_CHARSET:
6192          charset_type = Qw32_charset_thai;
6193          break;
6194        case MAC_CHARSET:
6195          charset_type = Qw32_charset_mac;
6196          break;
6197        case JOHAB_CHARSET:
6198          charset_type = Qw32_charset_johab;
6199          break;
6200    #endif
6201    
6202    #ifdef UNICODE_CHARSET
6203        case UNICODE_CHARSET:
6204          charset_type = Qw32_charset_unicode;
6205          break;
6206    #endif
6207        default:
6208          /* Encode numerical value of unknown charset.  */
6209          sprintf (buf, "*-#%u", fncharset);
6210          return Fcons (build_string (buf), Qnil);
6211        }
6212      
6213      {
6214        Lisp_Object rest;
6215        /* Look through w32-charset-info-alist for the character set.
6216           Only return charsets for codepages which are installed.
6217    
6218           Format of each entry in Vw32_charset_info_alist is
6219             (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
6220        */
6221        for (rest = Vw32_charset_info_alist; CONSP (rest); rest = XCDR (rest))
6222          {
6223            Lisp_Object x_charset;
6224            Lisp_Object w32_charset;
6225            Lisp_Object codepage;
6226    
6227            Lisp_Object this_entry = XCAR (rest);
6228    
6229            /* Skip invalid entries in alist. */
6230            if (!CONSP (this_entry) || !STRINGP (XCAR (this_entry))
6231                || !CONSP (XCDR (this_entry))
6232                || !SYMBOLP (XCAR (XCDR (this_entry))))
6233              continue;
6234    
6235            x_charset = XCAR (this_entry);
6236            w32_charset = XCAR (XCDR (this_entry));
6237            codepage = XCDR (XCDR (this_entry));
6238    
6239            /* Look for Same charset and a valid codepage (or non-int
6240               which means ignore).  */
6241            if (w32_charset == charset_type
6242                && (!INTEGERP (codepage) || codepage == CP_DEFAULT
6243                    || IsValidCodePage (XINT (codepage))))
6244              {
6245                retval = Fcons (x_charset, retval);
6246              }
6247          }
6248    
6249        /* If no match, encode the numeric value. */
6250        if (NILP (retval))
6251          {
6252            sprintf (buf, "*-#%u", fncharset);
6253            return Fcons (build_string (buf), Qnil);
6254          }
6255    
6256        return retval;
6257      }
6258    }
6259    
6260  /* Get the Windows codepage corresponding to the specified font.  The  /* Get the Windows codepage corresponding to the specified font.  The
6261     charset info in the font name is used to look up     charset info in the font name is used to look up
6262     w32-charset-to-codepage-alist.  */     w32-charset-to-codepage-alist.  */
# Line 6635  typedef struct enumfont_t Line 6771  typedef struct enumfont_t
6771    LOGFONT logfont;    LOGFONT logfont;
6772    XFontStruct *size_ref;    XFontStruct *size_ref;
6773    Lisp_Object *pattern;    Lisp_Object *pattern;
6774      Lisp_Object list;
6775    Lisp_Object *tail;    Lisp_Object *tail;
6776  } enumfont_t;  } enumfont_t;
6777    
6778    static void
6779    enum_font_maybe_add_to_list (enumfont_t *, LOGFONT *, char *, Lisp_Object);
6780    
6781  static int CALLBACK  static int CALLBACK
6782  enum_font_cb2 (lplf, lptm, FontType, lpef)  enum_font_cb2 (lplf, lptm, FontType, lpef)
6783      ENUMLOGFONT * lplf;      ENUMLOGFONT * lplf;
# Line 6665  enum_font_cb2 (lplf, lptm, FontType, lpe Line 6805  enum_font_cb2 (lplf, lptm, FontType, lpe
6805    {    {
6806      char buf[100];      char buf[100];
6807      Lisp_Object width = Qnil;      Lisp_Object width = Qnil;
6808        Lisp_Object charset_list = Qnil;
6809      char *charset = NULL;      char *charset = NULL;
6810    
6811      /* Truetype fonts do not report their true metrics until loaded */      /* Truetype fonts do not report their true metrics until loaded */
# Line 6699  enum_font_cb2 (lplf, lptm, FontType, lpe Line 6840  enum_font_cb2 (lplf, lptm, FontType, lpe
6840        {        {
6841          charset = xlfd_charset_of_font (XSTRING(*(lpef->pattern))->data);          charset = xlfd_charset_of_font (XSTRING(*(lpef->pattern))->data);
6842    
6843          /* Ensure that charset is valid for this font. */          /* Ensure that charset is valid for this font.
6844               Continue if invalid in case charset contains a wildcard.  */
6845          if (charset          if (charset
6846              && (x_to_w32_charset (charset) != lplf->elfLogFont.lfCharSet))              && (x_to_w32_charset (charset) != lplf->elfLogFont.lfCharSet))
6847            charset = NULL;            charset = NULL;
6848        }        }
6849    
6850      /* TODO: List all relevant charsets if charset not specified. */      if (charset)
6851      if (!w32_to_x_font (&(lplf->elfLogFont), buf, 100, charset))        charset_list = Fcons (build_string (charset), Qnil);
6852        return 1;      else
6853          charset_list = w32_to_all_x_charsets (lplf->elfLogFont.lfCharSet);
6854    
6855      if (NILP (*(lpef->pattern))      /* Loop through the charsets.  */
6856          || w32_font_match (buf, XSTRING (*(lpef->pattern))->data))      for ( ; CONSP (charset_list); charset_list = Fcdr (charset_list))
6857        {        {
6858          *lpef->tail = Fcons (Fcons (build_string (buf), width), Qnil);          Lisp_Object this_charset = Fcar (charset_list);
6859          lpef->tail = &(XCDR (*lpef->tail));          charset = XSTRING (this_charset)->data;
6860          lpef->numFonts++;  
6861            /* List bold and italic variations if w32-enable-synthesized-fonts
6862               is non-nil and this is a plain font.  */
6863            if (w32_enable_synthesized_fonts
6864                && lplf->elfLogFont.lfWeight == FW_NORMAL
6865                && lplf->elfLogFont.lfItalic == FALSE)
6866              {
6867                enum_font_maybe_add_to_list (lpef, &(lplf->elfLogFont),
6868                                             charset, width);
6869                /* bold.  */
6870                lplf->elfLogFont.lfWeight = FW_BOLD;
6871                enum_font_maybe_add_to_list (lpef, &(lplf->elfLogFont),
6872                                             charset, width);
6873                /* bold italic.  */
6874                lplf->elfLogFont.lfItalic = TRUE;
6875                enum_font_maybe_add_to_list (lpef, &(lplf->elfLogFont),
6876                                             charset, width);
6877                /* italic.  */
6878                lplf->elfLogFont.lfWeight = FW_NORMAL;
6879                enum_font_maybe_add_to_list (lpef, &(lplf->elfLogFont),
6880                                             charset, width);
6881              }
6882            else
6883              enum_font_maybe_add_to_list (lpef, &(lplf->elfLogFont),
6884                                           charset, width);
6885        }        }
6886    }    }
6887    
6888    return 1;    return 1;
6889  }  }
6890    
6891    static void
6892    enum_font_maybe_add_to_list (lpef, logfont, match_charset, width)
6893         enumfont_t * lpef;
6894         LOGFONT * logfont;
6895         char * match_charset;
6896         Lisp_Object width;
6897    {
6898      char buf[100];
6899    
6900      if (!w32_to_x_font (logfont, buf, 100, match_charset))
6901        return;
6902    
6903      if (NILP (*(lpef->pattern))
6904          || w32_font_match (buf, XSTRING (*(lpef->pattern))->data))
6905        {
6906          /* Check if we already listed this font.  This may happen if
6907             w32_enable_synthesized_fonts is non-nil, and there are real
6908             bold and italic versions of the font.  */
6909          Lisp_Object font_name = build_string (buf);
6910          if (NILP (Fmember (font_name, lpef->list)))
6911            {
6912              *lpef->tail = Fcons (Fcons (build_string (buf), width), Qnil);
6913              lpef->tail = &(XCDR (*lpef->tail));
6914              lpef->numFonts++;
6915            }
6916        }
6917    }
6918    
6919    
6920  static int CALLBACK  static int CALLBACK
6921  enum_font_cb1 (lplf, lptm, FontType, lpef)  enum_font_cb1 (lplf, lptm, FontType, lpef)
6922       ENUMLOGFONT * lplf;       ENUMLOGFONT * lplf;
6923       NEWTEXTMETRIC * lptm;       NEWTEXTMETRIC * lptm;
6924       int FontType;       int FontType;
6925       enumfont_t * lpef;       enumfont_t * lpef;
6926  {  {  return EnumFontFamilies (lpef->hdc,
   return EnumFontFamilies (lpef->hdc,  
6927                             lplf->elfLogFont.lfFaceName,                             lplf->elfLogFont.lfFaceName,
6928                             (FONTENUMPROC) enum_font_cb2,                             (FONTENUMPROC) enum_font_cb2,
6929                             (LPARAM) lpef);                             (LPARAM) lpef);
# Line 6803  static Lisp_Object w32_list_bdf_fonts (L Line 6998  static Lisp_Object w32_list_bdf_fonts (L
6998    return newlist;    return newlist;
6999  }  }
7000    
 static Lisp_Object w32_list_synthesized_fonts (FRAME_PTR f,  
                                                Lisp_Object pattern,  
                                                int size, int max_names);  
   
7001  /* Return a list of names of available fonts matching PATTERN on frame  /* Return a list of names of available fonts matching PATTERN on frame
7002     F.  If SIZE is not 0, it is the size (maximum bound width) of fonts     F.  If SIZE is not 0, it is the size (maximum bound width) of fonts
7003     to be listed.  Frame F NULL means we have not yet created any     to be listed.  Frame F NULL means we have not yet created any
# Line 6864  w32_list_fonts (f, pattern, size, maxnam Line 7055  w32_list_fonts (f, pattern, size, maxnam
7055        /* At first, put PATTERN in the cache.  */        /* At first, put PATTERN in the cache.  */
7056        list = Qnil;        list = Qnil;
7057        ef.pattern = &tpat;        ef.pattern = &tpat;
7058          ef.list = list;
7059        ef.tail = &list;        ef.tail = &list;
7060        ef.numFonts = 0;        ef.numFonts = 0;
7061    
# Line 7008  w32_list_fonts (f, pattern, size, maxnam Line 7200  w32_list_fonts (f, pattern, size, maxnam
7200      newlist = Fnconc(2, combined);      newlist = Fnconc(2, combined);
7201    }    }
7202    
   /* If we can't find a font that matches, check if Windows would be  
      able to synthesize it from a different style.  */  
   if (NILP (newlist) && !NILP (Vw32_enable_synthesized_fonts))  
     newlist = w32_list_synthesized_fonts (f, pattern, size, maxnames);  
   
7203    return newlist;    return newlist;
7204  }  }
7205    
 static Lisp_Object  
 w32_list_synthesized_fonts (f, pattern, size, max_names)  
      FRAME_PTR f;  
      Lisp_Object pattern;  
      int size;  
      int max_names;  
 {  
   int fields;  
   char *full_pattn, *new_pattn, foundary[50], family[50], *pattn_part2;  
   char style[20], slant;  
   Lisp_Object matches, tem, synthed_matches = Qnil;  
   
   full_pattn = XSTRING (pattern)->data;  
   
   pattn_part2 = alloca (XSTRING (pattern)->size + 1);  
   /* Allow some space for wildcard expansion.  */  
   new_pattn = alloca (XSTRING (pattern)->size + 100);  
   
   fields = sscanf (full_pattn, "-%49[^-]-%49[^-]-%19[^-]-%c-%s",  
                    foundary, family, style, &slant, pattn_part2);  
   if (fields == EOF || fields < 5)  
     return Qnil;  
   
   /* If the style and slant are wildcards already there is no point  
      checking again (and we don't want to keep recursing).  */  
   if (*style == '*' && slant == '*')  
     return Qnil;  
   
   sprintf (new_pattn, "-%s-%s-*-*-%s", foundary, family, pattn_part2);  
   
   matches = w32_list_fonts (f, build_string (new_pattn), size, max_names);  
   
   for ( ; CONSP (matches); matches = XCDR (matches))  
     {  
       tem = XCAR (matches);  
       if (!STRINGP (tem))  
         continue;  
   
       full_pattn = XSTRING (tem)->data;  
       fields = sscanf (full_pattn, "-%49[^-]-%49[^-]-%*[^-]-%*c-%s",  
                        foundary, family, pattn_part2);  
       if (fields == EOF || fields < 3)  
         continue;  
   
       sprintf (new_pattn, "-%s-%s-%s-%c-%s", foundary, family, style,  
                slant, pattn_part2);  
   
       synthed_matches = Fcons (build_string (new_pattn),  
                                synthed_matches);  
     }  
   
   return synthed_matches;  
 }  
   
7206    
7207  /* Return a pointer to struct font_info of font FONT_IDX of frame F.  */  /* Return a pointer to struct font_info of font FONT_IDX of frame F.  */
7208  struct font_info *  struct font_info *
# Line 13078  DEFUN ("w32-select-font", Fw32_select_fo Line 13211  DEFUN ("w32-select-font", Fw32_select_fo
13211    
13212    cf.lStructSize = sizeof (cf);    cf.lStructSize = sizeof (cf);
13213    cf.hwndOwner = FRAME_W32_WINDOW (f);    cf.hwndOwner = FRAME_W32_WINDOW (f);
13214    cf.Flags = CF_FORCEFONTEXIST | CF_SCREENFONTS;    cf.Flags = CF_FORCEFONTEXIST | CF_SCREENFONTS | CF_NOVERTFONTS;
13215    cf.lpLogFont = &lf;    cf.lpLogFont = &lf;
13216    
13217    /* Initialize as much of the font details as we can from the current    /* Initialize as much of the font details as we can from the current
# Line 13107  DEFUN ("w32-select-font", Fw32_select_fo Line 13240  DEFUN ("w32-select-font", Fw32_select_fo
13240    
13241  DEFUN ("w32-send-sys-command", Fw32_send_sys_command, Sw32_send_sys_command, 1, 2, 0,  DEFUN ("w32-send-sys-command", Fw32_send_sys_command, Sw32_send_sys_command, 1, 2, 0,
13242     "Send frame a Windows WM_SYSCOMMAND message of type COMMAND.\n\     "Send frame a Windows WM_SYSCOMMAND message of type COMMAND.\n\
13243  Some useful values for command are 0xf030 to maximise frame (0xf020\n\  Some useful values for command are #xf030 to maximise frame (#xf020\n\
13244  to minimize), 0xf120 to restore frame to original size, and 0xf100\n\  to minimize), #xf120 to restore frame to original size, and #xf100\n\
13245  to activate the menubar for keyboard access.  0xf140 activates the\n\  to activate the menubar for keyboard access.  #xf140 activates the\n\
13246  screen saver if defined.\n\  screen saver if defined.\n\
13247  \n\  \n\
13248  If optional parameter FRAME is not specified, use selected frame.")  If optional parameter FRAME is not specified, use selected frame.")
# Line 13683  respective modifier, or nil to appear as Line 13816  respective modifier, or nil to appear as
13816  Any other value will cause the key to be ignored.");  Any other value will cause the key to be ignored.");
13817    Vw32_apps_modifier = Qnil;    Vw32_apps_modifier = Qnil;
13818    
13819    DEFVAR_LISP ("w32-enable-synthesized-fonts", &Vw32_enable_synthesized_fonts,    DEFVAR_BOOL ("w32-enable-synthesized-fonts", &w32_enable_synthesized_fonts,
13820      "Non-nil enables selection of artificially italicized and bold fonts.");      "Non-nil enables selection of artificially italicized and bold fonts.");
13821    Vw32_enable_synthesized_fonts = Qnil;    w32_enable_synthesized_fonts = 0;
13822    
13823    DEFVAR_LISP ("w32-enable-palette", &Vw32_enable_palette,    DEFVAR_LISP ("w32-enable-palette", &Vw32_enable_palette,
13824      "Non-nil enables Windows palette management to map colors exactly.");      "Non-nil enables Windows palette management to map colors exactly.");

Legend:
Removed from v.1.123.2.6  
changed lines
  Added in v.1.123.2.7

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26