/[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.148 by jasonr, Sat Jan 19 10:04:04 2002 UTC revision 1.149 by jasonr, Sun Jan 20 14:57:54 2002 UTC
# Line 129  Lisp_Object Vw32_scroll_lock_modifier; Line 129  Lisp_Object Vw32_scroll_lock_modifier;
129    
130  /* Switch to control whether we inhibit requests for synthesized bold  /* Switch to control whether we inhibit requests for synthesized bold
131     and italic versions of fonts.  */     and italic versions of fonts.  */
132  Lisp_Object Vw32_enable_synthesized_fonts;  int w32_enable_synthesized_fonts;
133    
134  /* Enable palette management. */  /* Enable palette management. */
135  Lisp_Object Vw32_enable_palette;  Lisp_Object Vw32_enable_palette;
# Line 5913  w32_load_system_font (f,fontname,size) Line 5913  w32_load_system_font (f,fontname,size)
5913      /* 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
5914         type FONT_ENCODING_NOT_DECIDED.  */         type FONT_ENCODING_NOT_DECIDED.  */
5915      encoding = strrchr (fontp->name, '-');      encoding = strrchr (fontp->name, '-');
5916      if (encoding && stricmp (encoding+1, "sjis") == 0)      if (encoding && strnicmp (encoding+1, "sjis", 4) == 0)
5917        fontp->encoding[1] = 4;        fontp->encoding[1] = 4;
5918      else      else
5919        fontp->encoding[1] = FONT_ENCODING_NOT_DECIDED;        fontp->encoding[1] = FONT_ENCODING_NOT_DECIDED;
# Line 6082  x_to_w32_charset (lpcs) Line 6082  x_to_w32_charset (lpcs)
6082    
6083    w32_charset = Fcar (Fcdr (this_entry));    w32_charset = Fcar (Fcdr (this_entry));
6084    
6085    // Translate Lisp symbol to number.    /* Translate Lisp symbol to number.  */
6086    if (w32_charset == Qw32_charset_ansi)    if (w32_charset == Qw32_charset_ansi)
6087      return ANSI_CHARSET;      return ANSI_CHARSET;
6088    if (w32_charset == Qw32_charset_symbol)    if (w32_charset == Qw32_charset_symbol)
# Line 6258  w32_to_x_charset (fncharset) Line 6258  w32_to_x_charset (fncharset)
6258                best_match = x_charset;                best_match = x_charset;
6259              /* 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,
6260                 then this is better.  */                 then this is better.  */
6261              else if (stricmp (best_match, "iso") != 0              else if (strnicmp (best_match, "iso", 3) != 0
6262                       && stricmp (x_charset, "iso") == 0)                       && strnicmp (x_charset, "iso", 3) == 0)
6263                best_match = x_charset;                best_match = x_charset;
6264              /* If both are ISO8859 codepages, choose the one with the              /* If both are ISO8859 codepages, choose the one with the
6265                 lowest number in the encoding field.  */                 lowest number in the encoding field.  */
6266              else if (stricmp (best_match, "iso8859-") == 0              else if (strnicmp (best_match, "iso8859-", 8) == 0
6267                       && stricmp (x_charset, "iso8859-") == 0)                       && strnicmp (x_charset, "iso8859-", 8) == 0)
6268                {                {
6269                  int best_enc = atoi (best_match + 8);                  int best_enc = atoi (best_match + 8);
6270                  int this_enc = atoi (x_charset + 8);                  int this_enc = atoi (x_charset + 8);
# Line 6288  w32_to_x_charset (fncharset) Line 6288  w32_to_x_charset (fncharset)
6288  }  }
6289    
6290    
6291    /* Return all the X charsets that map to a font.  */
6292    static Lisp_Object
6293    w32_to_all_x_charsets (fncharset)
6294        int fncharset;
6295    {
6296      static char buf[32];
6297      Lisp_Object charset_type;
6298      Lisp_Object retval = Qnil;
6299    
6300      switch (fncharset)
6301        {
6302        case ANSI_CHARSET:
6303          /* Handle startup case of w32-charset-info-alist not
6304             being set up yet. */
6305          if (NILP(Vw32_charset_info_alist))
6306            return "iso8859-1";
6307          charset_type = Qw32_charset_ansi;
6308          break;
6309        case DEFAULT_CHARSET:
6310          charset_type = Qw32_charset_default;
6311          break;
6312        case SYMBOL_CHARSET:
6313          charset_type = Qw32_charset_symbol;
6314          break;
6315        case SHIFTJIS_CHARSET:
6316          charset_type = Qw32_charset_shiftjis;
6317          break;
6318        case HANGEUL_CHARSET:
6319          charset_type = Qw32_charset_hangeul;
6320          break;
6321        case GB2312_CHARSET:
6322          charset_type = Qw32_charset_gb2312;
6323          break;
6324        case CHINESEBIG5_CHARSET:
6325          charset_type = Qw32_charset_chinesebig5;
6326          break;
6327        case OEM_CHARSET:
6328          charset_type = Qw32_charset_oem;
6329          break;
6330    
6331          /* More recent versions of Windows (95 and NT4.0) define more
6332             character sets.  */
6333    #ifdef EASTEUROPE_CHARSET
6334        case EASTEUROPE_CHARSET:
6335          charset_type = Qw32_charset_easteurope;
6336          break;
6337        case TURKISH_CHARSET:
6338          charset_type = Qw32_charset_turkish;
6339          break;
6340        case BALTIC_CHARSET:
6341          charset_type = Qw32_charset_baltic;
6342          break;
6343        case RUSSIAN_CHARSET:
6344          charset_type = Qw32_charset_russian;
6345          break;
6346        case ARABIC_CHARSET:
6347          charset_type = Qw32_charset_arabic;
6348          break;
6349        case GREEK_CHARSET:
6350          charset_type = Qw32_charset_greek;
6351          break;
6352        case HEBREW_CHARSET:
6353          charset_type = Qw32_charset_hebrew;
6354          break;
6355        case VIETNAMESE_CHARSET:
6356          charset_type = Qw32_charset_vietnamese;
6357          break;
6358        case THAI_CHARSET:
6359          charset_type = Qw32_charset_thai;
6360          break;
6361        case MAC_CHARSET:
6362          charset_type = Qw32_charset_mac;
6363          break;
6364        case JOHAB_CHARSET:
6365          charset_type = Qw32_charset_johab;
6366          break;
6367    #endif
6368    
6369    #ifdef UNICODE_CHARSET
6370        case UNICODE_CHARSET:
6371          charset_type = Qw32_charset_unicode;
6372          break;
6373    #endif
6374        default:
6375          /* Encode numerical value of unknown charset.  */
6376          sprintf (buf, "*-#%u", fncharset);
6377          return Fcons (build_string (buf), Qnil);
6378        }
6379      
6380      {
6381        Lisp_Object rest;
6382        /* Look through w32-charset-info-alist for the character set.
6383           Only return charsets for codepages which are installed.
6384    
6385           Format of each entry in Vw32_charset_info_alist is
6386             (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
6387        */
6388        for (rest = Vw32_charset_info_alist; CONSP (rest); rest = XCDR (rest))
6389          {
6390            Lisp_Object x_charset;
6391            Lisp_Object w32_charset;
6392            Lisp_Object codepage;
6393    
6394            Lisp_Object this_entry = XCAR (rest);
6395    
6396            /* Skip invalid entries in alist. */
6397            if (!CONSP (this_entry) || !STRINGP (XCAR (this_entry))
6398                || !CONSP (XCDR (this_entry))
6399                || !SYMBOLP (XCAR (XCDR (this_entry))))
6400              continue;
6401    
6402            x_charset = XCAR (this_entry);
6403            w32_charset = XCAR (XCDR (this_entry));
6404            codepage = XCDR (XCDR (this_entry));
6405    
6406            /* Look for Same charset and a valid codepage (or non-int
6407               which means ignore).  */
6408            if (w32_charset == charset_type
6409                && (!INTEGERP (codepage) || codepage == CP_DEFAULT
6410                    || IsValidCodePage (XINT (codepage))))
6411              {
6412                retval = Fcons (x_charset, retval);
6413              }
6414          }
6415    
6416        /* If no match, encode the numeric value. */
6417        if (NILP (retval))
6418          {
6419            sprintf (buf, "*-#%u", fncharset);
6420            return Fcons (build_string (buf), Qnil);
6421          }
6422    
6423        return retval;
6424      }
6425    }
6426    
6427  /* Get the Windows codepage corresponding to the specified font.  The  /* Get the Windows codepage corresponding to the specified font.  The
6428     charset info in the font name is used to look up     charset info in the font name is used to look up
6429     w32-charset-to-codepage-alist.  */     w32-charset-to-codepage-alist.  */
# Line 6802  typedef struct enumfont_t Line 6938  typedef struct enumfont_t
6938    LOGFONT logfont;    LOGFONT logfont;
6939    XFontStruct *size_ref;    XFontStruct *size_ref;
6940    Lisp_Object *pattern;    Lisp_Object *pattern;
6941      Lisp_Object list;
6942    Lisp_Object *tail;    Lisp_Object *tail;
6943  } enumfont_t;  } enumfont_t;
6944    
6945    
6946    static void
6947    enum_font_maybe_add_to_list (enumfont_t *, LOGFONT *, char *, Lisp_Object);
6948    
6949    
6950  static int CALLBACK  static int CALLBACK
6951  enum_font_cb2 (lplf, lptm, FontType, lpef)  enum_font_cb2 (lplf, lptm, FontType, lpef)
6952      ENUMLOGFONT * lplf;      ENUMLOGFONT * lplf;
# Line 6832  enum_font_cb2 (lplf, lptm, FontType, lpe Line 6974  enum_font_cb2 (lplf, lptm, FontType, lpe
6974    {    {
6975      char buf[100];      char buf[100];
6976      Lisp_Object width = Qnil;      Lisp_Object width = Qnil;
6977        Lisp_Object charset_list = Qnil;
6978      char *charset = NULL;      char *charset = NULL;
6979    
6980      /* Truetype fonts do not report their true metrics until loaded */      /* Truetype fonts do not report their true metrics until loaded */
# Line 6866  enum_font_cb2 (lplf, lptm, FontType, lpe Line 7009  enum_font_cb2 (lplf, lptm, FontType, lpe
7009        {        {
7010          charset = xlfd_charset_of_font (XSTRING(*(lpef->pattern))->data);          charset = xlfd_charset_of_font (XSTRING(*(lpef->pattern))->data);
7011    
7012          /* Ensure that charset is valid for this font. */          /* Ensure that charset is valid for this font.
7013               Continue if invalid in case charset contains a wildcard.  */
7014          if (charset          if (charset
7015              && (x_to_w32_charset (charset) != lplf->elfLogFont.lfCharSet))              && (x_to_w32_charset (charset) != lplf->elfLogFont.lfCharSet))
7016            charset = NULL;            charset = NULL;
7017        }        }
7018    
7019      /* TODO: List all relevant charsets if charset not specified. */      if (charset)
7020      if (!w32_to_x_font (&(lplf->elfLogFont), buf, 100, charset))        charset_list = Fcons (build_string (charset), Qnil);
7021        return 1;      else
7022          charset_list = w32_to_all_x_charsets (lplf->elfLogFont.lfCharSet);
7023    
7024      if (NILP (*(lpef->pattern))      /* Loop through the charsets.  */
7025          || w32_font_match (buf, XSTRING (*(lpef->pattern))->data))      for ( ; CONSP (charset_list); charset_list = Fcdr (charset_list))
7026        {        {
7027          *lpef->tail = Fcons (Fcons (build_string (buf), width), Qnil);          Lisp_Object this_charset = Fcar (charset_list);
7028          lpef->tail = &(XCDR (*lpef->tail));          charset = XSTRING (this_charset)->data;
7029          lpef->numFonts++;  
7030            /* List bold and italic variations if w32-enable-synthesized-fonts
7031               is non-nil and this is a plain font.  */
7032            if (w32_enable_synthesized_fonts
7033                && lplf->elfLogFont.lfWeight == FW_NORMAL
7034                && lplf->elfLogFont.lfItalic == FALSE)
7035              {
7036                enum_font_maybe_add_to_list (lpef, &(lplf->elfLogFont),
7037                                             charset, width);
7038                /* bold.  */
7039                lplf->elfLogFont.lfWeight = FW_BOLD;
7040                enum_font_maybe_add_to_list (lpef, &(lplf->elfLogFont),
7041                                             charset, width);
7042                /* bold italic.  */
7043                lplf->elfLogFont.lfItalic = TRUE;
7044                enum_font_maybe_add_to_list (lpef, &(lplf->elfLogFont),
7045                                             charset, width);
7046                /* italic.  */
7047                lplf->elfLogFont.lfWeight = FW_NORMAL;
7048                enum_font_maybe_add_to_list (lpef, &(lplf->elfLogFont),
7049                                             charset, width);
7050              }
7051            else
7052              enum_font_maybe_add_to_list (lpef, &(lplf->elfLogFont),
7053                                           charset, width);
7054        }        }
7055    }    }
7056    
7057    return 1;    return 1;
7058  }  }
7059    
7060    static void
7061    enum_font_maybe_add_to_list (lpef, logfont, match_charset, width)
7062         enumfont_t * lpef;
7063         LOGFONT * logfont;
7064         char * match_charset;
7065         Lisp_Object width;
7066    {
7067      char buf[100];
7068    
7069      if (!w32_to_x_font (logfont, buf, 100, match_charset))
7070        return;
7071    
7072      if (NILP (*(lpef->pattern))
7073          || w32_font_match (buf, XSTRING (*(lpef->pattern))->data))
7074        {
7075          /* Check if we already listed this font.  This may happen if
7076             w32_enable_synthesized_fonts is non-nil, and there are real
7077             bold and italic versions of the font.  */
7078          Lisp_Object font_name = build_string (buf);
7079          if (NILP (Fmember (font_name, lpef->list)))
7080            {
7081              *lpef->tail = Fcons (Fcons (build_string (buf), width), Qnil);
7082              lpef->tail = &(XCDR (*lpef->tail));
7083              lpef->numFonts++;
7084            }
7085        }
7086    }
7087    
7088    
7089  static int CALLBACK  static int CALLBACK
7090  enum_font_cb1 (lplf, lptm, FontType, lpef)  enum_font_cb1 (lplf, lptm, FontType, lpef)
7091       ENUMLOGFONT * lplf;       ENUMLOGFONT * lplf;
# Line 6970  static Lisp_Object w32_list_bdf_fonts (L Line 7168  static Lisp_Object w32_list_bdf_fonts (L
7168    return newlist;    return newlist;
7169  }  }
7170    
 static Lisp_Object w32_list_synthesized_fonts (FRAME_PTR f,  
                                                Lisp_Object pattern,  
                                                int size, int max_names);  
7171    
7172  /* Return a list of names of available fonts matching PATTERN on frame  /* Return a list of names of available fonts matching PATTERN on frame
7173     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
# Line 7031  w32_list_fonts (f, pattern, size, maxnam Line 7226  w32_list_fonts (f, pattern, size, maxnam
7226        /* At first, put PATTERN in the cache.  */        /* At first, put PATTERN in the cache.  */
7227        list = Qnil;        list = Qnil;
7228        ef.pattern = &tpat;        ef.pattern = &tpat;
7229          ef.list = list;
7230        ef.tail = &list;        ef.tail = &list;
7231        ef.numFonts = 0;        ef.numFonts = 0;
7232    
# Line 7175  w32_list_fonts (f, pattern, size, maxnam Line 7371  w32_list_fonts (f, pattern, size, maxnam
7371      newlist = Fnconc(2, combined);      newlist = Fnconc(2, combined);
7372    }    }
7373    
   /* 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);  
   
7374    return newlist;    return newlist;
7375  }  }
7376    
 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;  
 }  
   
7377    
7378  /* 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.  */
7379  struct font_info *  struct font_info *
# Line 13843  specified.  Ensure that file exists if M Line 13980  specified.  Ensure that file exists if M
13980                           w32 specialized functions                           w32 specialized functions
13981   ***********************************************************************/   ***********************************************************************/
13982    
13983  DEFUN ("w32-select-font", Fw32_select_font, Sw32_select_font, 0, 1, 0,  DEFUN ("w32-select-font", Fw32_select_font, Sw32_select_font, 0, 2, 0,
13984         doc: /* Select a font using the W32 font dialog.         doc: /* Select a font using the W32 font dialog.
13985  Returns an X font string corresponding to the selection.  */)  Returns an X font string corresponding to the selection.  */)
13986    (frame)    (frame, include_proportional)
13987       Lisp_Object frame;       Lisp_Object frame, include_proportional;
13988  {  {
13989    FRAME_PTR f = check_x_frame (frame);    FRAME_PTR f = check_x_frame (frame);
13990    CHOOSEFONT cf;    CHOOSEFONT cf;
# Line 13862  Returns an X font string corresponding t Line 13999  Returns an X font string corresponding t
13999    
14000    cf.lStructSize = sizeof (cf);    cf.lStructSize = sizeof (cf);
14001    cf.hwndOwner = FRAME_W32_WINDOW (f);    cf.hwndOwner = FRAME_W32_WINDOW (f);
14002    cf.Flags = CF_FORCEFONTEXIST | CF_SCREENFONTS;    cf.Flags = CF_FORCEFONTEXIST | CF_SCREENFONTS | CF_NOVERTFONTS;
14003    
14004      /* Unless include_proportional is non-nil, limit the selection to
14005         monospaced fonts.  */
14006      if (NILP (include_proportional))
14007        cf.Flags |= CF_FIXEDPITCHONLY;
14008    
14009    cf.lpLogFont = &lf;    cf.lpLogFont = &lf;
14010    
14011    /* 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 13892  Returns an X font string corresponding t Line 14035  Returns an X font string corresponding t
14035  DEFUN ("w32-send-sys-command", Fw32_send_sys_command,  DEFUN ("w32-send-sys-command", Fw32_send_sys_command,
14036         Sw32_send_sys_command, 1, 2, 0,         Sw32_send_sys_command, 1, 2, 0,
14037         doc: /* Send frame a Windows WM_SYSCOMMAND message of type COMMAND.         doc: /* Send frame a Windows WM_SYSCOMMAND message of type COMMAND.
14038  Some useful values for command are 0xf030 to maximise frame (0xf020  Some useful values for command are #xf030 to maximise frame (#xf020
14039  to minimize), 0xf120 to restore frame to original size, and 0xf100  to minimize), #xf120 to restore frame to original size, and #xf100
14040  to activate the menubar for keyboard access.  0xf140 activates the  to activate the menubar for keyboard access.  #xf140 activates the
14041  screen saver if defined.  screen saver if defined.
14042    
14043  If optional parameter FRAME is not specified, use selected frame.  */)  If optional parameter FRAME is not specified, use selected frame.  */)
# Line 14497  respective modifier, or nil to appear as Line 14640  respective modifier, or nil to appear as
14640  Any other value will cause the key to be ignored.  */);  Any other value will cause the key to be ignored.  */);
14641    Vw32_apps_modifier = Qnil;    Vw32_apps_modifier = Qnil;
14642    
14643    DEFVAR_LISP ("w32-enable-synthesized-fonts", &Vw32_enable_synthesized_fonts,    DEFVAR_BOOL ("w32-enable-synthesized-fonts", &w32_enable_synthesized_fonts,
14644                 doc: /* Non-nil enables selection of artificially italicized and bold fonts.  */);                 doc: /* Non-nil enables selection of artificially italicized and bold fonts.  */);
14645    Vw32_enable_synthesized_fonts = Qnil;    w32_enable_synthesized_fonts = 0;
14646    
14647    DEFVAR_LISP ("w32-enable-palette", &Vw32_enable_palette,    DEFVAR_LISP ("w32-enable-palette", &Vw32_enable_palette,
14648                 doc: /* Non-nil enables Windows palette management to map colors exactly.  */);                 doc: /* Non-nil enables Windows palette management to map colors exactly.  */);

Legend:
Removed from v.1.148  
changed lines
  Added in v.1.149

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