X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/f507f365a77d2a43bc1f57797bfdb945bd73ec57..e3021fe7dbe7a4bbbe9b4c9433c0f01f64cdcef3:/src/w32fns.c diff --git a/src/w32fns.c b/src/w32fns.c index d88e86d54f..237299c437 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -5,10 +5,10 @@ This file is part of GNU Emacs. -GNU Emacs is free software; you can redistribute it and/or modify +GNU Emacs is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. +the Free Software Foundation, either version 3 of the License, or +(at your option) any later version. GNU Emacs is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of @@ -16,9 +16,7 @@ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License -along with GNU Emacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -Boston, MA 02110-1301, USA. */ +along with GNU Emacs. If not, see . */ /* Added by Kevin Gallo */ @@ -62,8 +60,11 @@ Boston, MA 02110-1301, USA. */ #include #define FILE_NAME_TEXT_FIELD edt1 -#ifdef USE_FONT_BACKEND #include "font.h" +#include "w32font.h" + +#ifndef FOF_NO_CONNECTED_ELEMENTS +#define FOF_NO_CONNECTED_ELEMENTS 0x2000 #endif void syms_of_w32fns (); @@ -74,7 +75,7 @@ extern double atof (); extern int w32_console_toggle_lock_key P_ ((int, Lisp_Object)); extern void w32_menu_display_help P_ ((HWND, HMENU, UINT, UINT)); extern void w32_free_menu_strings P_ ((HWND)); -extern XCharStruct *w32_per_char_metric P_ ((XFontStruct *, wchar_t *, int)); +extern const char *map_w32_filename P_ ((const char *, const char **)); extern int quit_char; @@ -150,9 +151,10 @@ static int w32_pass_multimedia_buttons_to_system; /* Non nil if no window manager is in use. */ Lisp_Object Vx_no_window_manager; -/* Non-zero means we're allowed to display a hourglass pointer. */ - -int display_hourglass_p; +/* If non-zero, a w32 timer that, when it expires, displays an + hourglass cursor on all frames. */ +static unsigned hourglass_timer = 0; +static HWND hourglass_hwnd = NULL; /* The background and shape of the mouse pointer, and shape when not over text or in the modeline. */ @@ -190,18 +192,11 @@ static int w32_strict_fontnames; indicates there is an update region. */ static int w32_strict_painting; -/* Associative list linking character set strings to Windows codepages. */ -static Lisp_Object Vw32_charset_info_alist; - -/* VIETNAMESE_CHARSET is not defined in some versions of MSVC. */ -#ifndef VIETNAMESE_CHARSET -#define VIETNAMESE_CHARSET 163 -#endif - Lisp_Object Qnone; Lisp_Object Qsuppress_icon; Lisp_Object Qundefined_color; Lisp_Object Qcancel_timer; +Lisp_Object Qfont_param; Lisp_Object Qhyper; Lisp_Object Qsuper; Lisp_Object Qmeta; @@ -210,35 +205,6 @@ Lisp_Object Qctrl; Lisp_Object Qcontrol; Lisp_Object Qshift; -Lisp_Object Qw32_charset_ansi; -Lisp_Object Qw32_charset_default; -Lisp_Object Qw32_charset_symbol; -Lisp_Object Qw32_charset_shiftjis; -Lisp_Object Qw32_charset_hangeul; -Lisp_Object Qw32_charset_gb2312; -Lisp_Object Qw32_charset_chinesebig5; -Lisp_Object Qw32_charset_oem; - -#ifndef JOHAB_CHARSET -#define JOHAB_CHARSET 130 -#endif -#ifdef JOHAB_CHARSET -Lisp_Object Qw32_charset_easteurope; -Lisp_Object Qw32_charset_turkish; -Lisp_Object Qw32_charset_baltic; -Lisp_Object Qw32_charset_russian; -Lisp_Object Qw32_charset_arabic; -Lisp_Object Qw32_charset_greek; -Lisp_Object Qw32_charset_hebrew; -Lisp_Object Qw32_charset_vietnamese; -Lisp_Object Qw32_charset_thai; -Lisp_Object Qw32_charset_johab; -Lisp_Object Qw32_charset_mac; -#endif - -#ifdef UNICODE_CHARSET -Lisp_Object Qw32_charset_unicode; -#endif /* The ANSI codepage. */ int w32_ansi_code_page; @@ -276,6 +242,11 @@ struct MONITOR_INFO DWORD dwFlags; }; +/* Reportedly, VS 6 does not have this in its headers. */ +#if defined(_MSC_VER) && _MSC_VER < 1300 +DECLARE_HANDLE(HMONITOR); +#endif + typedef BOOL (WINAPI * TrackMouseEvent_Proc) (IN OUT LPTRACKMOUSEEVENT lpEventTrack); typedef LONG (WINAPI * ImmGetCompositionString_Proc) @@ -304,6 +275,7 @@ unsigned int msh_mousewheel = 0; #define MOUSE_BUTTON_ID 1 #define MOUSE_MOVE_ID 2 #define MENU_FREE_ID 3 +#define HOURGLASS_ID 4 /* The delay (milliseconds) before a menu is freed after WM_EXITMENULOOP is received. */ #define MENU_FREE_DELAY 1000 @@ -335,6 +307,15 @@ static HWND w32_visible_system_caret_hwnd; extern HMENU current_popup_menu; static int menubar_in_use = 0; +/* From w32uniscribe.c */ +extern void syms_of_w32uniscribe (); +extern int uniscribe_available; + +/* Function prototypes for hourglass support. */ +static void w32_show_hourglass P_ ((struct frame *)); +static void w32_hide_hourglass P_ ((void)); + + /* Error if we are not connected to MS-Windows. */ void @@ -423,8 +404,6 @@ x_window_to_frame (dpyinfo, wdesc) f = XFRAME (frame); if (!FRAME_W32_P (f) || FRAME_W32_DISPLAY_INFO (f) != dpyinfo) continue; - if (f->output_data.w32->hourglass_window == wdesc) - return f; if (FRAME_W32_WINDOW (f) == wdesc) return f; @@ -490,7 +469,7 @@ x_real_positions (f, xptr, yptr) DEFUN ("w32-define-rgb-color", Fw32_define_rgb_color, Sw32_define_rgb_color, 4, 4, 0, - doc: /* Convert RGB numbers to a windows color reference and associate with NAME. + doc: /* Convert RGB numbers to a Windows color reference and associate with NAME. This adds or updates a named color to `w32-color-map', making it available for use. The original entry's RGB ref is returned, or nil if the entry is new. */) @@ -528,53 +507,6 @@ if the entry is new. */) return (oldrgb); } -DEFUN ("w32-load-color-file", Fw32_load_color_file, - Sw32_load_color_file, 1, 1, 0, - doc: /* Create an alist of color entries from an external file. -Assign this value to `w32-color-map' to replace the existing color map. - -The file should define one named RGB color per line like so: - R G B name -where R,G,B are numbers between 0 and 255 and name is an arbitrary string. */) - (filename) - Lisp_Object filename; -{ - FILE *fp; - Lisp_Object cmap = Qnil; - Lisp_Object abspath; - - CHECK_STRING (filename); - abspath = Fexpand_file_name (filename, Qnil); - - fp = fopen (SDATA (filename), "rt"); - if (fp) - { - char buf[512]; - int red, green, blue; - int num; - - BLOCK_INPUT; - - while (fgets (buf, sizeof (buf), fp) != NULL) { - if (sscanf (buf, "%u %u %u %n", &red, &green, &blue, &num) == 3) - { - char *name = buf + num; - num = strlen (name) - 1; - if (name[num] == '\n') - name[num] = 0; - cmap = Fcons (Fcons (build_string (name), - make_number (RGB (red, green, blue))), - cmap); - } - } - fclose (fp); - - UNBLOCK_INPUT; - } - - return cmap; -} - /* The default colors for the w32 color map */ typedef struct colormap_t { @@ -2007,32 +1939,8 @@ void x_set_scroll_bar_default_width (f) } -/* Subroutines of creating a frame. */ - - -/* Return the value of parameter PARAM. - - First search ALIST, then Vdefault_frame_alist, then the X defaults - database, using ATTRIBUTE as the attribute name and CLASS as its class. - - Convert the resource to the type specified by desired_type. - - If no default is specified, return Qunbound. If you call - w32_get_arg, make sure you deal with Qunbound in a reasonable way, - and don't let it get stored in any Lisp-visible variables! */ - -static Lisp_Object -w32_get_arg (alist, param, attribute, class, type) - Lisp_Object alist, param; - char *attribute; - char *class; - enum resource_types type; -{ - return x_get_arg (check_x_display_info (Qnil), - alist, param, attribute, class, type); -} +/* Subroutines for creating a frame. */ - Cursor w32_load_cursor (LPCTSTR name) { @@ -2096,6 +2004,7 @@ w32_createwindow (f) RECT rect; Lisp_Object top = Qunbound; Lisp_Object left = Qunbound; + struct w32_display_info *dpyinfo = &one_w32_display_info; rect.left = rect.top = 0; rect.right = FRAME_PIXEL_WIDTH (f); @@ -2120,8 +2029,8 @@ w32_createwindow (f) { /* When called with RES_TYPE_NUMBER, w32_get_arg will return zero for anything that is not a number and is not Qunbound. */ - left = w32_get_arg (Qnil, Qleft, "left", "Left", RES_TYPE_NUMBER); - top = w32_get_arg (Qnil, Qtop, "top", "Top", RES_TYPE_NUMBER); + left = x_get_arg (dpyinfo, Qnil, Qleft, "left", "Left", RES_TYPE_NUMBER); + top = x_get_arg (dpyinfo, Qnil, Qtop, "top", "Top", RES_TYPE_NUMBER); } FRAME_W32_WINDOW (f) = hwnd @@ -2744,7 +2653,7 @@ w32_msg_worker (void *arg) dummy_buf.w32msg.msg.hwnd = NULL; dummy_buf.w32msg.msg.message = WM_NULL; - /* This is the inital message loop which should only exit when the + /* This is the initial message loop which should only exit when the application quits. */ w32_msg_pump (&dummy_buf); @@ -3525,6 +3434,12 @@ w32_wnd_proc (hwnd, msg, wParam, lParam) menubar_in_use = 0; } } + else if (wParam == hourglass_timer) + { + KillTimer (hwnd, hourglass_timer); + hourglass_timer = 0; + w32_show_hourglass (x_window_to_frame (dpyinfo, hwnd)); + } return 0; case WM_NCACTIVATE: @@ -3590,6 +3505,11 @@ w32_wnd_proc (hwnd, msg, wParam, lParam) */ if (f && menubar_in_use && current_popup_menu == NULL) menu_free_timer = SetTimer (hwnd, MENU_FREE_ID, MENU_FREE_DELAY, NULL); + + /* If hourglass cursor should be displayed, display it now. */ + if (f && f->output_data.w32->hourglass_p) + SetCursor (f->output_data.w32->hourglass_cursor); + goto dflt; case WM_MENUSELECT: @@ -3858,15 +3778,27 @@ w32_wnd_proc (hwnd, msg, wParam, lParam) case WM_SETCURSOR: if (LOWORD (lParam) == HTCLIENT) - return 0; - + { + f = x_window_to_frame (dpyinfo, hwnd); + if (f->output_data.w32->hourglass_p && !menubar_in_use + && !current_popup_menu) + SetCursor (f->output_data.w32->hourglass_cursor); + else + SetCursor (f->output_data.w32->current_cursor); + return 0; + } goto dflt; case WM_EMACS_SETCURSOR: { Cursor cursor = (Cursor) wParam; - if (cursor) - SetCursor (cursor); + f = x_window_to_frame (dpyinfo, hwnd); + if (f && cursor) + { + f->output_data.w32->current_cursor = cursor; + if (!f->output_data.w32->hourglass_p) + SetCursor (cursor); + } return 0; } @@ -4139,11 +4071,12 @@ x_icon (f, parms) Lisp_Object parms; { Lisp_Object icon_x, icon_y; + struct w32_display_info *dpyinfo = &one_w32_display_info; /* Set the position of the icon. Note that Windows 95 groups all icons in the tray. */ - icon_x = w32_get_arg (parms, Qicon_left, 0, 0, RES_TYPE_NUMBER); - icon_y = w32_get_arg (parms, Qicon_top, 0, 0, RES_TYPE_NUMBER); + icon_x = x_get_arg (dpyinfo, parms, Qicon_left, 0, 0, RES_TYPE_NUMBER); + icon_y = x_get_arg (dpyinfo, parms, Qicon_top, 0, 0, RES_TYPE_NUMBER); if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound)) { CHECK_NUMBER (icon_x); @@ -4160,7 +4093,7 @@ x_icon (f, parms) #if 0 /* TODO */ /* Start up iconic or window? */ x_wm_set_window_state - (f, (EQ (w32_get_arg (parms, Qvisibility, 0, 0, RES_TYPE_SYMBOL), Qicon) + (f, (EQ (x_get_arg (dpyinfo, parms, Qvisibility, 0, 0, RES_TYPE_SYMBOL), Qicon) ? IconicState : NormalState)); @@ -4222,25 +4155,30 @@ unwind_create_frame (frame) x_free_frame_resources (f); +#if GLYPH_DEBUG /* Check that reference counts are indeed correct. */ xassert (dpyinfo->reference_count == dpyinfo_refcount); xassert (dpyinfo->image_cache->refcount == image_cache_refcount); - +#endif return Qt; } return Qnil; } -#ifdef USE_FONT_BACKEND static void x_default_font_parameter (f, parms) struct frame *f; Lisp_Object parms; { struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f); - Lisp_Object font = x_get_arg (dpyinfo, parms, Qfont, "font", "Font", - RES_TYPE_STRING); + Lisp_Object font_param = x_get_arg (dpyinfo, parms, Qfont, NULL, NULL, + RES_TYPE_STRING); + Lisp_Object font; + if (EQ (font_param, Qunbound)) + font_param = Qnil; + font = !NILP (font_param) ? font_param + : x_get_arg (dpyinfo, parms, Qfont, "font", "Font", RES_TYPE_STRING); if (!STRINGP (font)) { @@ -4261,9 +4199,14 @@ x_default_font_parameter (f, parms) if (NILP (font)) error ("No suitable font was found"); } + else if (!NILP (font_param)) + { + /* Remember the explicit font parameter, so we can re-apply it after + we've applied the `default' face settings. */ + x_set_frame_parameters (f, Fcons (Fcons (Qfont_param, font_param), Qnil)); + } x_default_parameter (f, parms, Qfont, font, "font", "Font", RES_TYPE_STRING); } -#endif DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame, 1, 1, 0, @@ -4292,8 +4235,6 @@ This function is an internal primitive--use `make-frame' instead. */) Lisp_Object parent; struct kboard *kb; - check_w32 (); - /* Make copy of frame parameters because the original is in pure storage now. */ parameters = Fcopy_alist (parameters); @@ -4302,17 +4243,18 @@ This function is an internal primitive--use `make-frame' instead. */) until we know if this frame has a specified name. */ Vx_resource_name = Vinvocation_name; - display = w32_get_arg (parameters, Qdisplay, 0, 0, RES_TYPE_STRING); + display = x_get_arg (dpyinfo, parameters, Qterminal, 0, 0, RES_TYPE_NUMBER); + if (EQ (display, Qunbound)) + display = x_get_arg (dpyinfo, parameters, Qdisplay, 0, 0, RES_TYPE_STRING); if (EQ (display, Qunbound)) display = Qnil; dpyinfo = check_x_display_info (display); -#ifdef MULTI_KBOARD kb = dpyinfo->terminal->kboard; -#else - kb = &the_only_kboard; -#endif - name = w32_get_arg (parameters, Qname, "name", "Name", RES_TYPE_STRING); + if (!dpyinfo->terminal->name) + error ("Terminal is not live, can't create new frames on it"); + + name = x_get_arg (dpyinfo, parameters, Qname, "name", "Name", RES_TYPE_STRING); if (!STRINGP (name) && ! EQ (name, Qunbound) && ! NILP (name)) @@ -4322,7 +4264,7 @@ This function is an internal primitive--use `make-frame' instead. */) Vx_resource_name = name; /* See if parent window is specified. */ - parent = w32_get_arg (parameters, Qparent_id, NULL, NULL, RES_TYPE_NUMBER); + parent = x_get_arg (dpyinfo, parameters, Qparent_id, NULL, NULL, RES_TYPE_NUMBER); if (EQ (parent, Qunbound)) parent = Qnil; if (! NILP (parent)) @@ -4333,7 +4275,7 @@ This function is an internal primitive--use `make-frame' instead. */) it to make_frame_without_minibuffer. */ frame = Qnil; GCPRO4 (parameters, parent, name, frame); - tem = w32_get_arg (parameters, Qminibuffer, "minibuffer", "Minibuffer", + tem = x_get_arg (dpyinfo, parameters, Qminibuffer, "minibuffer", "Minibuffer", RES_TYPE_SYMBOL); if (EQ (tem, Qnone) || NILP (tem)) f = make_frame_without_minibuffer (Qnil, kb, display); @@ -4363,17 +4305,21 @@ This function is an internal primitive--use `make-frame' instead. */) (struct w32_output *) xmalloc (sizeof (struct w32_output)); bzero (f->output_data.w32, sizeof (struct w32_output)); FRAME_FONTSET (f) = -1; - record_unwind_protect (unwind_create_frame, frame); f->icon_name - = w32_get_arg (parameters, Qicon_name, "iconName", "Title", RES_TYPE_STRING); + = x_get_arg (dpyinfo, parameters, Qicon_name, "iconName", "Title", + RES_TYPE_STRING); if (! STRINGP (f->icon_name)) f->icon_name = Qnil; /* FRAME_W32_DISPLAY_INFO (f) = dpyinfo; */ -#ifdef MULTI_KBOARD - FRAME_KBOARD (f) = kb; -#endif + + /* With FRAME_X_DISPLAY_INFO set up, this unwind-protect is safe. */ + record_unwind_protect (unwind_create_frame, frame); +#if GLYPH_DEBUG + image_cache_refcount = FRAME_IMAGE_CACHE (f)->refcount; + dpyinfo_refcount = dpyinfo->reference_count; +#endif /* GLYPH_DEBUG */ /* Specify the parent under which to make this window. */ @@ -4406,66 +4352,25 @@ This function is an internal primitive--use `make-frame' instead. */) f->resx = dpyinfo->resx; f->resy = dpyinfo->resy; -#ifdef USE_FONT_BACKEND - if (enable_font_backend) - { - /* Perhaps, we must allow frame parameter, say `font-backend', - to specify which font backends to use. */ - register_font_driver (&w32font_driver, f); - - x_default_parameter (f, parameters, Qfont_backend, Qnil, - "fontBackend", "FontBackend", RES_TYPE_STRING); - } -#endif /* USE_FONT_BACKEND */ + if (uniscribe_available) + register_font_driver (&uniscribe_font_driver, f); + register_font_driver (&w32font_driver, f); + x_default_parameter (f, parameters, Qfont_backend, Qnil, + "fontBackend", "FontBackend", RES_TYPE_STRING); /* Extract the window parameters from the supplied values that are needed to determine window geometry. */ -#ifdef USE_FONT_BACKEND - if (enable_font_backend) - x_default_font_parameter (f, parameters); - else -#endif - { - Lisp_Object font; - - font = w32_get_arg (parameters, Qfont, "font", "Font", RES_TYPE_STRING); - - BLOCK_INPUT; - /* First, try whatever font the caller has specified. */ - if (STRINGP (font)) - { - tem = Fquery_fontset (font, Qnil); - if (STRINGP (tem)) - font = x_new_fontset (f, tem); - else - font = x_new_font (f, SDATA (font)); - } - /* Try out a font which we hope has bold and italic variations. */ - if (!STRINGP (font)) - font = x_new_font (f, "-*-Courier New-normal-r-*-*-*-100-*-*-c-*-iso8859-1"); - if (! STRINGP (font)) - font = x_new_font (f, "-*-Courier-normal-r-*-*-13-*-*-*-c-*-iso8859-1"); - /* If those didn't work, look for something which will at least work. */ - if (! STRINGP (font)) - font = x_new_font (f, "-*-Fixedsys-normal-r-*-*-12-*-*-*-c-*-iso8859-1"); - UNBLOCK_INPUT; - if (! STRINGP (font)) - font = build_string ("Fixedsys"); - - x_default_parameter (f, parameters, Qfont, font, - "font", "Font", RES_TYPE_STRING); - } - + x_default_font_parameter (f, parameters); x_default_parameter (f, parameters, Qborder_width, make_number (2), "borderWidth", "BorderWidth", RES_TYPE_NUMBER); - /* This defaults to 2 in order to match xterm. We recognize either - internalBorderWidth or internalBorder (which is what xterm calls - it). */ + + /* We recognize either internalBorderWidth or internalBorder + (which is what xterm calls it). */ if (NILP (Fassq (Qinternal_border_width, parameters))) { Lisp_Object value; - value = w32_get_arg (parameters, Qinternal_border_width, + value = x_get_arg (dpyinfo, parameters, Qinternal_border_width, "internalBorder", "InternalBorder", RES_TYPE_NUMBER); if (! EQ (value, Qunbound)) parameters = Fcons (Fcons (Qinternal_border_width, value), @@ -4528,9 +4433,11 @@ This function is an internal primitive--use `make-frame' instead. */) f->output_data.w32->hourglass_cursor = w32_load_cursor (IDC_WAIT); f->output_data.w32->horizontal_drag_cursor = w32_load_cursor (IDC_SIZEWE); + f->output_data.w32->current_cursor = f->output_data.w32->nontext_cursor; + window_prompting = x_figure_window_size (f, parameters, 1); - tem = w32_get_arg (parameters, Qunsplittable, 0, 0, RES_TYPE_BOOLEAN); + tem = x_get_arg (dpyinfo, parameters, Qunsplittable, 0, 0, RES_TYPE_BOOLEAN); f->no_split = minibuffer_only || EQ (tem, Qt); w32_window (f, window_prompting, minibuffer_only); @@ -4555,6 +4462,8 @@ This function is an internal primitive--use `make-frame' instead. */) "cursorType", "CursorType", RES_TYPE_SYMBOL); x_default_parameter (f, parameters, Qscroll_bar_width, Qnil, "scrollBarWidth", "ScrollBarWidth", RES_TYPE_NUMBER); + x_default_parameter (f, parameters, Qalpha, Qnil, + "alpha", "Alpha", RES_TYPE_NUMBER); /* Dimensions, especially FRAME_LINES (f), must be done via change_frame_size. Change will not be effected unless different from the current @@ -4580,7 +4489,7 @@ This function is an internal primitive--use `make-frame' instead. */) { Lisp_Object visibility; - visibility = w32_get_arg (parameters, Qvisibility, 0, 0, RES_TYPE_SYMBOL); + visibility = x_get_arg (dpyinfo, parameters, Qvisibility, 0, 0, RES_TYPE_SYMBOL); if (EQ (visibility, Qunbound)) visibility = Qt; @@ -4641,2092 +4550,159 @@ DEFUN ("x-focus-frame", Fx_focus_frame, Sx_focus_frame, 1, 1, 0, } -/* Return the charset portion of a font name. */ -char * -xlfd_charset_of_font (char * fontname) +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; { - char *charset, *encoding; - - encoding = strrchr (fontname, '-'); - if (!encoding || encoding == fontname) - return NULL; - - for (charset = encoding - 1; charset >= fontname; charset--) - if (*charset == '-') - break; + XColor foo; + FRAME_PTR f = check_x_frame (frame); - if (charset == fontname || strcmp (charset, "-*-*") == 0) - return NULL; + CHECK_STRING (color); - return charset + 1; + if (w32_defined_color (f, SDATA (color), &foo, 0)) + return Qt; + else + return Qnil; } -struct font_info *w32_load_bdf_font (struct frame *f, char *fontname, - int size, char* filename); -static Lisp_Object w32_list_bdf_fonts (Lisp_Object pattern, int max_names); -static BOOL w32_to_x_font (LOGFONT * lplf, char * lpxstr, int len, - char * charset); -static BOOL x_to_w32_font (char *lpxstr, LOGFONT *lplogfont); - -static struct font_info * -w32_load_system_font (f, fontname, size) - struct frame *f; - char * fontname; - int size; +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; { - struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f); - Lisp_Object font_names; - - /* Get a list of all the fonts that match this name. Once we - have a list of matching fonts, we compare them against the fonts - we already have loaded by comparing names. */ - font_names = w32_list_fonts (f, build_string (fontname), size, 100); - - if (!NILP (font_names)) - { - Lisp_Object tail; - int i; + XColor foo; + FRAME_PTR f = check_x_frame (frame); - /* First check if any are already loaded, as that is cheaper - than loading another one. */ - for (i = 0; i < dpyinfo->n_fonts; i++) - for (tail = font_names; CONSP (tail); tail = XCDR (tail)) - if (dpyinfo->font_table[i].name - && (!strcmp (dpyinfo->font_table[i].name, - SDATA (XCAR (tail))) - || !strcmp (dpyinfo->font_table[i].full_name, - SDATA (XCAR (tail))))) - return (dpyinfo->font_table + i); - - fontname = (char *) SDATA (XCAR (font_names)); - } - else if (w32_strict_fontnames) - { - /* If EnumFontFamiliesEx was available, we got a full list of - fonts back so stop now to avoid the possibility of loading a - random font. If we had to fall back to EnumFontFamilies, the - list is incomplete, so continue whether the font we want was - listed or not. */ - HMODULE gdi32 = GetModuleHandle ("gdi32.dll"); - FARPROC enum_font_families_ex - = GetProcAddress (gdi32, "EnumFontFamiliesExA"); - if (enum_font_families_ex) - return NULL; - } + CHECK_STRING (color); - /* Load the font and add it to the table. */ - { - char *full_name, *encoding, *charset; - XFontStruct *font; - struct font_info *fontp; - LOGFONT lf; - BOOL ok; - int codepage; - int i; + 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; +} - if (!fontname || !x_to_w32_font (fontname, &lf)) - return (NULL); +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 (!*lf.lfFaceName) - /* If no name was specified for the font, we get a random font - from CreateFontIndirect - this is not particularly - desirable, especially since CreateFontIndirect does not - fill out the missing name in lf, so we never know what we - ended up with. */ - return NULL; + if ((dpyinfo->n_planes * dpyinfo->n_cbits) <= 2) + return Qnil; - lf.lfQuality = DEFAULT_QUALITY; + return Qt; +} - font = (XFontStruct *) xmalloc (sizeof (XFontStruct)); - bzero (font, sizeof (*font)); +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); - /* Set bdf to NULL to indicate that this is a Windows font. */ - font->bdf = NULL; + if ((dpyinfo->n_planes * dpyinfo->n_cbits) <= 1) + return Qnil; - BLOCK_INPUT; + return Qt; +} - font->hfont = CreateFontIndirect (&lf); +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); - if (font->hfont == NULL) - { - ok = FALSE; - } - else - { - HDC hdc; - HANDLE oldobj; + return make_number (x_display_pixel_width (dpyinfo)); +} - codepage = w32_codepage_for_font (fontname); +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); - hdc = GetDC (dpyinfo->root_window); - oldobj = SelectObject (hdc, font->hfont); + return make_number (x_display_pixel_height (dpyinfo)); +} - ok = GetTextMetrics (hdc, &font->tm); - if (codepage == CP_UNICODE) - font->double_byte_p = 1; - else - { - /* Unfortunately, some fonts (eg. MingLiU, a big5 ttf font) - don't report themselves as double byte fonts, when - patently they are. So instead of trusting - GetFontLanguageInfo, we check the properties of the - codepage directly, since that is ultimately what we are - working from anyway. */ - /* font->double_byte_p = GetFontLanguageInfo (hdc) & GCP_DBCS; */ - CPINFO cpi = {0}; - GetCPInfo (codepage, &cpi); - font->double_byte_p = cpi.MaxCharSize > 1; - } +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); - SelectObject (hdc, oldobj); - ReleaseDC (dpyinfo->root_window, hdc); - /* Fill out details in lf according to the font that was - actually loaded. */ - lf.lfHeight = font->tm.tmInternalLeading - font->tm.tmHeight; - lf.lfWidth = font->tm.tmMaxCharWidth; - lf.lfWeight = font->tm.tmWeight; - lf.lfItalic = font->tm.tmItalic; - lf.lfCharSet = font->tm.tmCharSet; - lf.lfPitchAndFamily = ((font->tm.tmPitchAndFamily & TMPF_FIXED_PITCH) - ? VARIABLE_PITCH : FIXED_PITCH); - lf.lfOutPrecision = ((font->tm.tmPitchAndFamily & TMPF_VECTOR) - ? OUT_STROKE_PRECIS : OUT_STRING_PRECIS); - - w32_cache_char_metrics (font); - } + return make_number (dpyinfo->n_planes * dpyinfo->n_cbits); +} - UNBLOCK_INPUT; +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; - if (!ok) - { - w32_unload_font (dpyinfo, font); - return (NULL); - } + hdc = GetDC (dpyinfo->root_window); + if (dpyinfo->has_palette) + cap = GetDeviceCaps (hdc, SIZEPALETTE); + else + cap = GetDeviceCaps (hdc, NUMCOLORS); - /* Find a free slot in the font table. */ - for (i = 0; i < dpyinfo->n_fonts; ++i) - if (dpyinfo->font_table[i].name == NULL) - break; + /* 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); - /* If no free slot found, maybe enlarge the font table. */ - if (i == dpyinfo->n_fonts - && dpyinfo->n_fonts == dpyinfo->font_table_size) - { - int sz; - dpyinfo->font_table_size = max (16, 2 * dpyinfo->font_table_size); - sz = dpyinfo->font_table_size * sizeof *dpyinfo->font_table; - dpyinfo->font_table - = (struct font_info *) xrealloc (dpyinfo->font_table, sz); - } + ReleaseDC (dpyinfo->root_window, hdc); - fontp = dpyinfo->font_table + i; - if (i == dpyinfo->n_fonts) - ++dpyinfo->n_fonts; + return make_number (cap); +} - /* 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); +DEFUN ("x-server-max-request-size", Fx_server_max_request_size, + Sx_server_max_request_size, + 0, 1, 0, + doc: /* Return the maximum request size of the server 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); - 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: - * "[: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; - - /* Reject raster fonts if we are looking for a unicode font. */ - if (charset - && FontType == RASTER_FONTTYPE - && strncmp (charset, "iso10646", 8) == 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); - - /* Don't list raster fonts as unicode. */ - if (charset - && FontType == RASTER_FONTTYPE - && strncmp (charset, "iso10646", 8) == 0) - continue; - - 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)); - - -/* 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; -} - - -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); -} - -DEFUN ("x-server-max-request-size", Fx_server_max_request_size, - Sx_server_max_request_size, - 0, 1, 0, - doc: /* Return the maximum request size of the server 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 (1); -} + return make_number (1); +} DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0, doc: /* Return the "vendor ID" string of the W32 system (Microsoft). @@ -6932,7 +4908,7 @@ x_display_info_for_name (name) error ("Cannot connect to server %s", SDATA (name)); w32_in_use = 1; - XSETFASTINT (Vwindow_system_version, 3); + XSETFASTINT (Vwindow_system_version, w32_major_version); return dpyinfo; } @@ -6978,7 +4954,7 @@ terminate Emacs if we can't open the connection. */) Fexpand_file_name (build_string ("rgb.txt"), Fsymbol_value (intern ("data-directory"))); - Vw32_color_map = Fw32_load_color_file (color_file); + Vw32_color_map = Fx_load_color_file (color_file); UNGCPRO; } @@ -7023,7 +4999,7 @@ terminate Emacs if we can't open the connection. */) w32_in_use = 1; - XSETFASTINT (Vwindow_system_version, 3); + XSETFASTINT (Vwindow_system_version, w32_major_version); return Qnil; } @@ -7042,15 +5018,6 @@ If DISPLAY is nil, that stands for the selected frame's display. */) error ("Display still has frames on it"); BLOCK_INPUT; - /* Free the fonts in the font table. */ - for (i = 0; i < dpyinfo->n_fonts; i++) - if (dpyinfo->font_table[i].name) - { - if (dpyinfo->font_table[i].name != dpyinfo->font_table[i].full_name) - xfree (dpyinfo->font_table[i].full_name); - xfree (dpyinfo->font_table[i].name); - w32_unload_font (dpyinfo, dpyinfo->font_table[i].font); - } x_destroy_all_bitmaps (dpyinfo); x_delete_display (dpyinfo); @@ -7216,38 +5183,34 @@ value. */) Busy cursor ***********************************************************************/ -/* If non-null, an asynchronous timer that, when it expires, displays - an hourglass cursor on all frames. */ - -static struct atimer *hourglass_atimer; - -/* Non-zero means an hourglass cursor is currently shown. */ - -static int hourglass_shown_p; - -/* Number of seconds to wait before displaying an hourglass cursor. */ - -static Lisp_Object Vhourglass_delay; - /* Default number of seconds to wait before displaying an hourglass - cursor. */ - + cursor. Duplicated from xdisp.c, but cannot use the version there + due to lack of atimers on w32. */ #define DEFAULT_HOURGLASS_DELAY 1 +extern Lisp_Object Vhourglass_delay; -/* Function prototypes. */ - -static void show_hourglass P_ ((struct atimer *)); -static void hide_hourglass P_ ((void)); +/* Return non-zero if houglass timer has been started or hourglass is shown. */ +/* PENDING: if W32 can use atimers (atimer.[hc]) then the common impl in + xdisp.c could be used. */ +int +hourglass_started () +{ + return hourglass_shown_p || hourglass_timer; +} /* Cancel a currently active hourglass timer, and start a new one. */ void start_hourglass () { -#if 0 /* TODO: cursor shape changes. */ - EMACS_TIME delay; - int secs, usecs = 0; + DWORD delay; + int secs, msecs = 0; + struct frame * f = SELECTED_FRAME (); + + /* No cursors on non GUI frames. */ + if (!FRAME_W32_P (f)) + return; cancel_hourglass (); @@ -7260,15 +5223,14 @@ start_hourglass () Lisp_Object tem; tem = Ftruncate (Vhourglass_delay, Qnil); secs = XFASTINT (tem); - usecs = (XFLOAT_DATA (Vhourglass_delay) - secs) * 1000000; + msecs = (XFLOAT_DATA (Vhourglass_delay) - secs) * 1000; } else secs = DEFAULT_HOURGLASS_DELAY; - EMACS_SET_SECS_USECS (delay, secs, usecs); - hourglass_atimer = start_atimer (ATIMER_RELATIVE, delay, - show_hourglass, NULL); -#endif + delay = secs * 1000 + msecs; + hourglass_hwnd = FRAME_W32_WINDOW (f); + hourglass_timer = SetTimer (hourglass_hwnd, HOURGLASS_ID, delay, NULL); } @@ -7278,108 +5240,50 @@ start_hourglass () void cancel_hourglass () { - if (hourglass_atimer) + if (hourglass_timer) { - cancel_atimer (hourglass_atimer); - hourglass_atimer = NULL; + KillTimer (hourglass_hwnd, hourglass_timer); + hourglass_timer = 0; } if (hourglass_shown_p) - hide_hourglass (); + w32_hide_hourglass (); } -/* Timer function of hourglass_atimer. TIMER is equal to - hourglass_atimer. +/* Timer function of hourglass_timer. - Display an hourglass cursor on all frames by mapping the frames' - hourglass_window. Set the hourglass_p flag in the frames' - output_data.x structure to indicate that an hourglass cursor is - shown on the frames. */ + Display an hourglass cursor. Set the hourglass_p flag in display info + to indicate that an hourglass cursor is shown. */ static void -show_hourglass (timer) - struct atimer *timer; +w32_show_hourglass (f) + struct frame *f; { -#if 0 /* TODO: cursor shape changes. */ - /* The timer implementation will cancel this timer automatically - after this function has run. Set hourglass_atimer to null - so that we know the timer doesn't have to be canceled. */ - hourglass_atimer = NULL; - if (!hourglass_shown_p) { - Lisp_Object rest, frame; - - BLOCK_INPUT; - - FOR_EACH_FRAME (rest, frame) - if (FRAME_W32_P (XFRAME (frame))) - { - struct frame *f = XFRAME (frame); - - f->output_data.w32->hourglass_p = 1; - - if (!f->output_data.w32->hourglass_window) - { - unsigned long mask = CWCursor; - XSetWindowAttributes attrs; - - attrs.cursor = f->output_data.w32->hourglass_cursor; - - f->output_data.w32->hourglass_window - = XCreateWindow (FRAME_X_DISPLAY (f), - FRAME_OUTER_WINDOW (f), - 0, 0, 32000, 32000, 0, 0, - InputOnly, - CopyFromParent, - mask, &attrs); - } - - XMapRaised (FRAME_X_DISPLAY (f), - f->output_data.w32->hourglass_window); - XFlush (FRAME_X_DISPLAY (f)); - } - + f->output_data.w32->hourglass_p = 1; + if (!menubar_in_use && !current_popup_menu) + SetCursor (f->output_data.w32->hourglass_cursor); hourglass_shown_p = 1; - UNBLOCK_INPUT; } -#endif } /* Hide the hourglass cursor on all frames, if it is currently shown. */ static void -hide_hourglass () +w32_hide_hourglass () { -#if 0 /* TODO: cursor shape changes. */ if (hourglass_shown_p) { - Lisp_Object rest, frame; - - BLOCK_INPUT; - FOR_EACH_FRAME (rest, frame) - { - struct frame *f = XFRAME (frame); - - if (FRAME_W32_P (f) - /* Watch out for newly created frames. */ - && f->output_data.x->hourglass_window) - { - XUnmapWindow (FRAME_X_DISPLAY (f), - f->output_data.x->hourglass_window); - /* Sync here because XTread_socket looks at the - hourglass_p flag that is reset to zero below. */ - XSync (FRAME_X_DISPLAY (f), False); - f->output_data.x->hourglass_p = 0; - } - } + struct frame *f = x_window_to_frame (&one_w32_display_info, + hourglass_hwnd); + f->output_data.w32->hourglass_p = 0; + SetCursor (f->output_data.w32->current_cursor); hourglass_shown_p = 0; - UNBLOCK_INPUT; } -#endif } @@ -7462,14 +5366,10 @@ x_create_tip_frame (dpyinfo, parms, text) this frame has a specified name. */ Vx_resource_name = Vinvocation_name; -#ifdef MULTI_KBOARD kb = dpyinfo->terminal->kboard; -#else - kb = &the_only_kboard; -#endif /* Get the name of the frame to use for resource lookup. */ - name = w32_get_arg (parms, Qname, "name", "Name", RES_TYPE_STRING); + name = x_get_arg (dpyinfo, parms, Qname, "name", "Name", RES_TYPE_STRING); if (!STRINGP (name) && !EQ (name, Qunbound) && !NILP (name)) @@ -7515,9 +5415,7 @@ x_create_tip_frame (dpyinfo, parms, text) image_cache_refcount = FRAME_IMAGE_CACHE (f)->refcount; dpyinfo_refcount = dpyinfo->reference_count; #endif /* GLYPH_DEBUG */ -#ifdef MULTI_KBOARD FRAME_KBOARD (f) = kb; -#endif f->output_data.w32->parent_desc = FRAME_W32_DISPLAY_INFO (f)->root_window; f->output_data.w32->explicit_parent = 0; @@ -7539,56 +5437,16 @@ x_create_tip_frame (dpyinfo, parms, text) f->resx = dpyinfo->resx; f->resy = dpyinfo->resy; -#ifdef USE_FONT_BACKEND - if (enable_font_backend) - { - /* Perhaps, we must allow frame parameter, say `font-backend', - to specify which font backends to use. */ - register_font_driver (&w32font_driver, f); + /* Perhaps, we must allow frame parameter, say `font-backend', + to specify which font backends to use. */ + register_font_driver (&w32font_driver, f); - x_default_parameter (f, parms, Qfont_backend, Qnil, - "fontBackend", "FontBackend", RES_TYPE_STRING); - } -#endif /* USE_FONT_BACKEND */ + x_default_parameter (f, parms, Qfont_backend, Qnil, + "fontBackend", "FontBackend", RES_TYPE_STRING); /* Extract the window parameters from the supplied values that are needed to determine window geometry. */ -#ifdef USE_FONT_BACKEND - if (enable_font_backend) - x_default_font_parameter (f, parms); - else -#endif /* USE_FONT_BACKEND */ - { - Lisp_Object font; - - font = w32_get_arg (parms, Qfont, "font", "Font", RES_TYPE_STRING); - - BLOCK_INPUT; - /* First, try whatever font the caller has specified. */ - if (STRINGP (font)) - { - tem = Fquery_fontset (font, Qnil); - if (STRINGP (tem)) - font = x_new_fontset (f, tem); - else - font = x_new_font (f, SDATA (font)); - } - - /* Try out a font which we hope has bold and italic variations. */ - if (!STRINGP (font)) - font = x_new_font (f, "-*-Courier New-normal-r-*-*-*-100-*-*-c-*-iso8859-1"); - if (! STRINGP (font)) - font = x_new_font (f, "-*-Courier-normal-r-*-*-13-*-*-*-c-*-iso8859-1"); - /* If those didn't work, look for something which will at least work. */ - if (! STRINGP (font)) - font = x_new_font (f, "-*-Fixedsys-normal-r-*-*-12-*-*-*-c-*-iso8859-1"); - UNBLOCK_INPUT; - if (! STRINGP (font)) - font = build_string ("Fixedsys"); - - x_default_parameter (f, parms, Qfont, font, - "font", "Font", RES_TYPE_STRING); - } + x_default_font_parameter (f, parms); x_default_parameter (f, parms, Qborder_width, make_number (2), "borderWidth", "BorderWidth", RES_TYPE_NUMBER); @@ -7599,7 +5457,7 @@ x_create_tip_frame (dpyinfo, parms, text) { Lisp_Object value; - value = w32_get_arg (parms, Qinternal_border_width, + value = x_get_arg (dpyinfo, parms, Qinternal_border_width, "internalBorder", "internalBorder", RES_TYPE_NUMBER); if (! EQ (value, Qunbound)) parms = Fcons (Fcons (Qinternal_border_width, value), @@ -7676,14 +5534,20 @@ x_create_tip_frame (dpyinfo, parms, text) of the tooltip frame appear in pink. Prevent this. */ { Lisp_Object bg = Fframe_parameter (frame, Qbackground_color); + Lisp_Object fg = Fframe_parameter (frame, Qforeground_color); + Lisp_Object colors = Qnil; /* Set tip_frame here, so that */ tip_frame = frame; - call1 (Qface_set_after_frame_default, frame); + call2 (Qface_set_after_frame_default, frame, Qnil); if (!EQ (bg, Fframe_parameter (frame, Qbackground_color))) - Fmodify_frame_parameters (frame, Fcons (Fcons (Qbackground_color, bg), - Qnil)); + colors = Fcons (Fcons (Qbackground_color, bg), colors); + if (!EQ (fg, Fframe_parameter (frame, Qforeground_color))) + colors = Fcons (Fcons (Qforeground_color, fg), colors); + + if (!NILP (colors)) + Fmodify_frame_parameters (frame, colors); } f->no_split = 1; @@ -7740,8 +5604,8 @@ compute_tip_xy (f, parms, dx, dy, width, height, root_x, root_y) /* Default min and max values. */ min_x = 0; min_y = 0; - max_x = FRAME_W32_DISPLAY_INFO (f)->width; - max_y = FRAME_W32_DISPLAY_INFO (f)->height; + max_x = x_display_pixel_width (FRAME_W32_DISPLAY_INFO (f)); + max_y = x_display_pixel_height (FRAME_W32_DISPLAY_INFO (f)); BLOCK_INPUT; GetCursorPos (&pt); @@ -8080,7 +5944,7 @@ Value is t if tooltip was open, nil otherwise. */) if (FRAMEP (frame)) { - Fdelete_frame (frame, Qnil); + delete_frame (frame, Qnil); deleted = Qt; } @@ -8095,7 +5959,7 @@ Value is t if tooltip was open, nil otherwise. */) ***********************************************************************/ extern Lisp_Object Qfile_name_history; -/* Callback for altering the behaviour of the Open File dialog. +/* Callback for altering the behavior of the Open File dialog. Makes the Filename text field contain "Current Directory" and be read-only when "Directories" is selected in the filter. This allows us to work around the fact that the standard Open File @@ -8280,67 +6144,65 @@ If ONLY-DIR-P is non-nil, the user can only select directories. */) } - -/*********************************************************************** - w32 specialized functions - ***********************************************************************/ +/* Moving files to the system recycle bin. + Used by `move-file-to-trash' instead of the default moving to ~/.Trash */ +DEFUN ("system-move-file-to-trash", Fsystem_move_file_to_trash, + Ssystem_move_file_to_trash, 1, 1, 0, + doc: /* Move file or directory named FILENAME to the recycle bin. */) + (filename) + Lisp_Object filename; +{ + Lisp_Object handler; + Lisp_Object encoded_file; + Lisp_Object operation; -DEFUN ("w32-select-font", Fw32_select_font, Sw32_select_font, 0, 2, 0, - doc: /* Select a font for the named FRAME using the W32 font dialog. -Return an X-style font string corresponding to the selection. + operation = Qdelete_file; + if (!NILP (Ffile_directory_p (filename)) + && NILP (Ffile_symlink_p (filename))) + { + operation = Qdelete_directory; + filename = Fdirectory_file_name (filename); + } + filename = Fexpand_file_name (filename, Qnil); -If FRAME is omitted or nil, it defaults to the selected frame. -If INCLUDE-PROPORTIONAL is non-nil, include proportional fonts -in the font selection dialog. */) - (frame, include_proportional) - Lisp_Object frame, include_proportional; -{ - FRAME_PTR f = check_x_frame (frame); - CHOOSEFONT cf; - LOGFONT lf; - TEXTMETRIC tm; - HDC hdc; - HANDLE oldobj; - char buf[100]; + handler = Ffind_file_name_handler (filename, operation); + if (!NILP (handler)) + return call2 (handler, operation, filename); - bzero (&cf, sizeof (cf)); - bzero (&lf, sizeof (lf)); + encoded_file = ENCODE_FILE (filename); - cf.lStructSize = sizeof (cf); - cf.hwndOwner = FRAME_W32_WINDOW (f); - cf.Flags = CF_FORCEFONTEXIST | CF_SCREENFONTS | CF_NOVERTFONTS; + { + const char * path; + SHFILEOPSTRUCT file_op; + char tmp_path[MAX_PATH + 1]; - /* Unless include_proportional is non-nil, limit the selection to - monospaced fonts. */ - if (NILP (include_proportional)) - cf.Flags |= CF_FIXEDPITCHONLY; + path = map_w32_filename (SDATA (encoded_file), NULL); - cf.lpLogFont = &lf; + /* On Windows, write permission is required to delete/move files. */ + _chmod (path, 0666); - /* Initialize as much of the font details as we can from the current - default font. */ - hdc = GetDC (FRAME_W32_WINDOW (f)); - oldobj = SelectObject (hdc, FRAME_FONT (f)->hfont); - GetTextFace (hdc, LF_FACESIZE, lf.lfFaceName); - if (GetTextMetrics (hdc, &tm)) - { - lf.lfHeight = tm.tmInternalLeading - tm.tmHeight; - lf.lfWeight = tm.tmWeight; - lf.lfItalic = tm.tmItalic; - lf.lfUnderline = tm.tmUnderlined; - lf.lfStrikeOut = tm.tmStruckOut; - lf.lfCharSet = tm.tmCharSet; - cf.Flags |= CF_INITTOLOGFONTSTRUCT; - } - SelectObject (hdc, oldobj); - ReleaseDC (FRAME_W32_WINDOW (f), hdc); + bzero (tmp_path, sizeof (tmp_path)); + strcpy (tmp_path, path); - if (!ChooseFont (&cf) || !w32_to_x_font (&lf, buf, 100, NULL)) - return Qnil; + bzero (&file_op, sizeof (file_op)); + file_op.hwnd = HWND_DESKTOP; + file_op.wFunc = FO_DELETE; + file_op.pFrom = tmp_path; + file_op.fFlags = FOF_SILENT | FOF_NOCONFIRMATION | FOF_ALLOWUNDO + | FOF_NOERRORUI | FOF_NO_CONNECTED_ELEMENTS; + file_op.fAnyOperationsAborted = FALSE; - return build_string (buf); + if (SHFileOperation (&file_op) != 0) + report_file_error ("Removing old name", list1 (filename)); + } + return Qnil; } + +/*********************************************************************** + w32 specialized functions + ***********************************************************************/ + DEFUN ("w32-send-sys-command", Fw32_send_sys_command, Sw32_send_sys_command, 1, 2, 0, doc: /* Send frame a Windows WM_SYSCOMMAND message of type COMMAND. @@ -8696,6 +6558,115 @@ Lisp_Object class, name; return Qt; } +DEFUN ("w32-battery-status", Fw32_battery_status, Sw32_battery_status, 0, 0, 0, + doc: /* Get power status information from Windows system. + +The following %-sequences are provided: +%L AC line status (verbose) +%B Battery status (verbose) +%b Battery status, empty means high, `-' means low, + `!' means critical, and `+' means charging +%p Battery load percentage +%s Remaining time (to charge or discharge) in seconds +%m Remaining time (to charge or discharge) in minutes +%h Remaining time (to charge or discharge) in hours +%t Remaining time (to charge or discharge) in the form `h:min' */) + () +{ + Lisp_Object status = Qnil; + + SYSTEM_POWER_STATUS system_status; + if (GetSystemPowerStatus (&system_status)) + { + Lisp_Object line_status, battery_status, battery_status_symbol; + Lisp_Object load_percentage, seconds, minutes, hours, remain; + Lisp_Object sequences[8]; + + long seconds_left = (long) system_status.BatteryLifeTime; + + if (system_status.ACLineStatus == 0) + line_status = build_string ("off-line"); + else if (system_status.ACLineStatus == 1) + line_status = build_string ("on-line"); + else + line_status = build_string ("N/A"); + + if (system_status.BatteryFlag & 128) + { + battery_status = build_string ("N/A"); + battery_status_symbol = build_string (""); + } + else if (system_status.BatteryFlag & 8) + { + battery_status = build_string ("charging"); + battery_status_symbol = build_string ("+"); + if (system_status.BatteryFullLifeTime != -1L) + seconds_left = system_status.BatteryFullLifeTime - seconds_left; + } + else if (system_status.BatteryFlag & 4) + { + battery_status = build_string ("critical"); + battery_status_symbol = build_string ("!"); + } + else if (system_status.BatteryFlag & 2) + { + battery_status = build_string ("low"); + battery_status_symbol = build_string ("-"); + } + else if (system_status.BatteryFlag & 1) + { + battery_status = build_string ("high"); + battery_status_symbol = build_string (""); + } + else + { + battery_status = build_string ("medium"); + battery_status_symbol = build_string (""); + } + + if (system_status.BatteryLifePercent > 100) + load_percentage = build_string ("N/A"); + else + { + char buffer[16]; + _snprintf (buffer, 16, "%d", system_status.BatteryLifePercent); + load_percentage = build_string (buffer); + } + + if (seconds_left < 0) + seconds = minutes = hours = remain = build_string ("N/A"); + else + { + long m; + float h; + char buffer[16]; + _snprintf (buffer, 16, "%ld", seconds_left); + seconds = build_string (buffer); + + m = seconds_left / 60; + _snprintf (buffer, 16, "%ld", m); + minutes = build_string (buffer); + + h = seconds_left / 3600.0; + _snprintf (buffer, 16, "%3.1f", h); + hours = build_string (buffer); + + _snprintf (buffer, 16, "%ld:%02ld", m / 60, m % 60); + remain = build_string (buffer); + } + sequences[0] = Fcons (make_number ('L'), line_status); + sequences[1] = Fcons (make_number ('B'), battery_status); + sequences[2] = Fcons (make_number ('b'), battery_status_symbol); + sequences[3] = Fcons (make_number ('p'), load_percentage); + sequences[4] = Fcons (make_number ('s'), seconds); + sequences[5] = Fcons (make_number ('m'), minutes); + sequences[6] = Fcons (make_number ('h'), hours); + sequences[7] = Fcons (make_number ('t'), remain); + + status = Flist (8, sequences); + } + return status; +} DEFUN ("file-system-info", Ffile_system_info, Sfile_system_info, 1, 1, 0, @@ -8903,9 +6874,8 @@ frame_parm_handler w32_frame_parm_handlers[] = x_set_fringe_width, 0, /* x_set_wait_for_wm, */ x_set_fullscreen, -#ifdef USE_FONT_BACKEND - x_set_font_backend -#endif + x_set_font_backend, + x_set_alpha }; void @@ -8929,6 +6899,7 @@ syms_of_w32fns () DEFSYM (Qctrl, "ctrl"); DEFSYM (Qcontrol, "control"); DEFSYM (Qshift, "shift"); + DEFSYM (Qfont_param, "font-parameter"); /* This is the end of symbol initialization. */ /* Text property `display' should be nonsticky by default. */ @@ -9124,15 +7095,6 @@ This variable takes effect when you create a new frame or when you set the mouse color. */); Vx_hourglass_pointer_shape = Qnil; - DEFVAR_BOOL ("display-hourglass", &display_hourglass_p, - doc: /* Non-zero means Emacs displays an hourglass pointer on window systems. */); - display_hourglass_p = 1; - - DEFVAR_LISP ("hourglass-delay", &Vhourglass_delay, - doc: /* *Seconds to wait before displaying an hourglass pointer. -Value must be an integer or float. */); - Vhourglass_delay = make_number (DEFAULT_HOURGLASS_DELAY); - DEFVAR_LISP ("x-sensitive-text-pointer-shape", &Vx_sensitive_text_pointer_shape, doc: /* The shape of the pointer when over mouse-sensitive text. @@ -9196,69 +7158,6 @@ Set this to nil to get the old behavior for repainting; this should only be necessary if the default setting causes problems. */); w32_strict_painting = 1; - DEFVAR_LISP ("w32-charset-info-alist", - &Vw32_charset_info_alist, - doc: /* Alist linking Emacs character sets to Windows fonts and codepages. -Each entry should be of the form: - - (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)) - -where CHARSET_NAME is a string used in font names to identify the charset, -WINDOWS_CHARSET is a symbol that can be one of: -w32-charset-ansi, w32-charset-default, w32-charset-symbol, -w32-charset-shiftjis, w32-charset-hangeul, w32-charset-gb2312, -w32-charset-chinesebig5, -w32-charset-johab, w32-charset-hebrew, -w32-charset-arabic, w32-charset-greek, w32-charset-turkish, -w32-charset-vietnamese, w32-charset-thai, w32-charset-easteurope, -w32-charset-russian, w32-charset-mac, w32-charset-baltic, -w32-charset-unicode, -or w32-charset-oem. -CODEPAGE should be an integer specifying the codepage that should be used -to display the character set, t to do no translation and output as Unicode, -or nil to do no translation and output as 8 bit (or multibyte on far-east -versions of Windows) characters. */); - Vw32_charset_info_alist = Qnil; - - DEFSYM (Qw32_charset_ansi, "w32-charset-ansi"); - DEFSYM (Qw32_charset_symbol, "w32-charset-symbol"); - DEFSYM (Qw32_charset_default, "w32-charset-default"); - DEFSYM (Qw32_charset_shiftjis, "w32-charset-shiftjis"); - DEFSYM (Qw32_charset_hangeul, "w32-charset-hangeul"); - DEFSYM (Qw32_charset_chinesebig5, "w32-charset-chinesebig5"); - DEFSYM (Qw32_charset_gb2312, "w32-charset-gb2312"); - DEFSYM (Qw32_charset_oem, "w32-charset-oem"); - -#ifdef JOHAB_CHARSET - { - static int w32_extra_charsets_defined = 1; - DEFVAR_BOOL ("w32-extra-charsets-defined", &w32_extra_charsets_defined, - doc: /* Internal variable. */); - - DEFSYM (Qw32_charset_johab, "w32-charset-johab"); - DEFSYM (Qw32_charset_easteurope, "w32-charset-easteurope"); - DEFSYM (Qw32_charset_turkish, "w32-charset-turkish"); - DEFSYM (Qw32_charset_baltic, "w32-charset-baltic"); - DEFSYM (Qw32_charset_russian, "w32-charset-russian"); - DEFSYM (Qw32_charset_arabic, "w32-charset-arabic"); - DEFSYM (Qw32_charset_greek, "w32-charset-greek"); - DEFSYM (Qw32_charset_hebrew, "w32-charset-hebrew"); - DEFSYM (Qw32_charset_vietnamese, "w32-charset-vietnamese"); - DEFSYM (Qw32_charset_thai, "w32-charset-thai"); - DEFSYM (Qw32_charset_mac, "w32-charset-mac"); - } -#endif - -#ifdef UNICODE_CHARSET - { - static int w32_unicode_charset_defined = 1; - DEFVAR_BOOL ("w32-unicode-charset-defined", - &w32_unicode_charset_defined, - doc: /* Internal variable. */); - DEFSYM (Qw32_charset_unicode, "w32-charset-unicode"); - } -#endif - #if 0 /* TODO: Port to W32 */ defsubr (&Sx_change_window_property); defsubr (&Sx_delete_window_property); @@ -9290,10 +7189,8 @@ versions of Windows) characters. */); /* W32 specific functions */ - defsubr (&Sw32_select_font); defsubr (&Sw32_define_rgb_color); defsubr (&Sw32_default_color_map); - defsubr (&Sw32_load_color_file); defsubr (&Sw32_send_sys_command); defsubr (&Sw32_shell_execute); defsubr (&Sw32_register_hot_key); @@ -9302,29 +7199,17 @@ versions of Windows) characters. */); defsubr (&Sw32_reconstruct_hot_key); defsubr (&Sw32_toggle_lock_key); defsubr (&Sw32_window_exists_p); - defsubr (&Sw32_find_bdf_fonts); + defsubr (&Sw32_battery_status); defsubr (&Sfile_system_info); defsubr (&Sdefault_printer_name); - /* Setting callback functions for fontset handler. */ - get_font_info_func = w32_get_font_info; - -#if 0 /* This function pointer doesn't seem to be used anywhere. - And the pointer assigned has the wrong type, anyway. */ - list_fonts_func = w32_list_fonts; -#endif - - load_font_func = w32_load_font; - find_ccl_program_func = w32_find_ccl_program; - query_font_func = w32_query_font; - set_frame_fontset_func = x_set_font; - get_font_repertory_func = x_get_font_repertory; check_window_system_func = check_w32; - hourglass_atimer = NULL; - hourglass_shown_p = 0; + hourglass_timer = 0; + hourglass_hwnd = NULL; + defsubr (&Sx_show_tip); defsubr (&Sx_hide_tip); tip_timer = Qnil; @@ -9336,6 +7221,7 @@ versions of Windows) characters. */); staticpro (&last_show_tip_args); defsubr (&Sx_file_dialog); + defsubr (&Ssystem_move_file_to_trash); } @@ -9380,6 +7266,8 @@ globals_of_w32fns () /* MessageBox does not work without this when linked to comctl32.dll 6.0. */ InitCommonControls (); + + syms_of_w32uniscribe (); } #undef abort