Fix previous change.
[emacs.git] / src / w32fns.c
blobd88e86d54f677bdfa72d722bff75147b9f5ad1e2
1 /* Graphical user interface functions for the Microsoft W32 API.
2 Copyright (C) 1989, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000,
3 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
4 Free Software Foundation, Inc.
6 This file is part of GNU Emacs.
8 GNU Emacs is free software; you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation; either version 3, or (at your option)
11 any later version.
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs; see the file COPYING. If not, write to
20 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
21 Boston, MA 02110-1301, USA. */
23 /* Added by Kevin Gallo */
25 #include <config.h>
27 #include <signal.h>
28 #include <stdio.h>
29 #include <limits.h>
30 #include <errno.h>
31 #include <math.h>
33 #include "lisp.h"
34 #include "w32term.h"
35 #include "frame.h"
36 #include "window.h"
37 #include "buffer.h"
38 #include "intervals.h"
39 #include "dispextern.h"
40 #include "keyboard.h"
41 #include "blockinput.h"
42 #include "epaths.h"
43 #include "character.h"
44 #include "charset.h"
45 #include "coding.h"
46 #include "ccl.h"
47 #include "fontset.h"
48 #include "systime.h"
49 #include "termhooks.h"
50 #include "w32heap.h"
52 #include "bitmaps/gray.xbm"
54 #include <commctrl.h>
55 #include <commdlg.h>
56 #include <shellapi.h>
57 #include <ctype.h>
58 #include <winspool.h>
59 #include <objbase.h>
61 #include <dlgs.h>
62 #include <imm.h>
63 #define FILE_NAME_TEXT_FIELD edt1
65 #ifdef USE_FONT_BACKEND
66 #include "font.h"
67 #endif
69 void syms_of_w32fns ();
70 void globals_of_w32fns ();
72 extern void free_frame_menubar ();
73 extern double atof ();
74 extern int w32_console_toggle_lock_key P_ ((int, Lisp_Object));
75 extern void w32_menu_display_help P_ ((HWND, HMENU, UINT, UINT));
76 extern void w32_free_menu_strings P_ ((HWND));
77 extern XCharStruct *w32_per_char_metric P_ ((XFontStruct *, wchar_t *, int));
79 extern int quit_char;
81 extern char *lispy_function_keys[];
83 /* The colormap for converting color names to RGB values */
84 Lisp_Object Vw32_color_map;
86 /* Non nil if alt key presses are passed on to Windows. */
87 Lisp_Object Vw32_pass_alt_to_system;
89 /* Non nil if alt key is translated to meta_modifier, nil if it is translated
90 to alt_modifier. */
91 Lisp_Object Vw32_alt_is_meta;
93 /* If non-zero, the windows virtual key code for an alternative quit key. */
94 int w32_quit_key;
96 /* Non nil if left window key events are passed on to Windows (this only
97 affects whether "tapping" the key opens the Start menu). */
98 Lisp_Object Vw32_pass_lwindow_to_system;
100 /* Non nil if right window key events are passed on to Windows (this
101 only affects whether "tapping" the key opens the Start menu). */
102 Lisp_Object Vw32_pass_rwindow_to_system;
104 /* Virtual key code used to generate "phantom" key presses in order
105 to stop system from acting on Windows key events. */
106 Lisp_Object Vw32_phantom_key_code;
108 /* Modifier associated with the left "Windows" key, or nil to act as a
109 normal key. */
110 Lisp_Object Vw32_lwindow_modifier;
112 /* Modifier associated with the right "Windows" key, or nil to act as a
113 normal key. */
114 Lisp_Object Vw32_rwindow_modifier;
116 /* Modifier associated with the "Apps" key, or nil to act as a normal
117 key. */
118 Lisp_Object Vw32_apps_modifier;
120 /* Value is nil if Num Lock acts as a function key. */
121 Lisp_Object Vw32_enable_num_lock;
123 /* Value is nil if Caps Lock acts as a function key. */
124 Lisp_Object Vw32_enable_caps_lock;
126 /* Modifier associated with Scroll Lock, or nil to act as a normal key. */
127 Lisp_Object Vw32_scroll_lock_modifier;
129 /* Switch to control whether we inhibit requests for synthesized bold
130 and italic versions of fonts. */
131 int w32_enable_synthesized_fonts;
133 /* Enable palette management. */
134 Lisp_Object Vw32_enable_palette;
136 /* Control how close left/right button down events must be to
137 be converted to a middle button down event. */
138 int w32_mouse_button_tolerance;
140 /* Minimum interval between mouse movement (and scroll bar drag)
141 events that are passed on to the event loop. */
142 int w32_mouse_move_interval;
144 /* Flag to indicate if XBUTTON events should be passed on to Windows. */
145 static int w32_pass_extra_mouse_buttons_to_system;
147 /* Flag to indicate if media keys should be passed on to Windows. */
148 static int w32_pass_multimedia_buttons_to_system;
150 /* Non nil if no window manager is in use. */
151 Lisp_Object Vx_no_window_manager;
153 /* Non-zero means we're allowed to display a hourglass pointer. */
155 int display_hourglass_p;
157 /* The background and shape of the mouse pointer, and shape when not
158 over text or in the modeline. */
160 Lisp_Object Vx_pointer_shape, Vx_nontext_pointer_shape, Vx_mode_pointer_shape;
161 Lisp_Object Vx_hourglass_pointer_shape, Vx_window_horizontal_drag_shape;
163 /* The shape when over mouse-sensitive text. */
165 Lisp_Object Vx_sensitive_text_pointer_shape;
167 #ifndef IDC_HAND
168 #define IDC_HAND MAKEINTRESOURCE(32649)
169 #endif
171 /* Color of chars displayed in cursor box. */
173 Lisp_Object Vx_cursor_fore_pixel;
175 /* Nonzero if using Windows. */
177 static int w32_in_use;
179 /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'. */
181 Lisp_Object Vx_pixel_size_width_font_regexp;
183 /* Alist of bdf fonts and the files that define them. */
184 Lisp_Object Vw32_bdf_filename_alist;
186 /* A flag to control whether fonts are matched strictly or not. */
187 static int w32_strict_fontnames;
189 /* A flag to control whether we should only repaint if GetUpdateRect
190 indicates there is an update region. */
191 static int w32_strict_painting;
193 /* Associative list linking character set strings to Windows codepages. */
194 static Lisp_Object Vw32_charset_info_alist;
196 /* VIETNAMESE_CHARSET is not defined in some versions of MSVC. */
197 #ifndef VIETNAMESE_CHARSET
198 #define VIETNAMESE_CHARSET 163
199 #endif
201 Lisp_Object Qnone;
202 Lisp_Object Qsuppress_icon;
203 Lisp_Object Qundefined_color;
204 Lisp_Object Qcancel_timer;
205 Lisp_Object Qhyper;
206 Lisp_Object Qsuper;
207 Lisp_Object Qmeta;
208 Lisp_Object Qalt;
209 Lisp_Object Qctrl;
210 Lisp_Object Qcontrol;
211 Lisp_Object Qshift;
213 Lisp_Object Qw32_charset_ansi;
214 Lisp_Object Qw32_charset_default;
215 Lisp_Object Qw32_charset_symbol;
216 Lisp_Object Qw32_charset_shiftjis;
217 Lisp_Object Qw32_charset_hangeul;
218 Lisp_Object Qw32_charset_gb2312;
219 Lisp_Object Qw32_charset_chinesebig5;
220 Lisp_Object Qw32_charset_oem;
222 #ifndef JOHAB_CHARSET
223 #define JOHAB_CHARSET 130
224 #endif
225 #ifdef JOHAB_CHARSET
226 Lisp_Object Qw32_charset_easteurope;
227 Lisp_Object Qw32_charset_turkish;
228 Lisp_Object Qw32_charset_baltic;
229 Lisp_Object Qw32_charset_russian;
230 Lisp_Object Qw32_charset_arabic;
231 Lisp_Object Qw32_charset_greek;
232 Lisp_Object Qw32_charset_hebrew;
233 Lisp_Object Qw32_charset_vietnamese;
234 Lisp_Object Qw32_charset_thai;
235 Lisp_Object Qw32_charset_johab;
236 Lisp_Object Qw32_charset_mac;
237 #endif
239 #ifdef UNICODE_CHARSET
240 Lisp_Object Qw32_charset_unicode;
241 #endif
243 /* The ANSI codepage. */
244 int w32_ansi_code_page;
246 /* Prefix for system colors. */
247 #define SYSTEM_COLOR_PREFIX "System"
248 #define SYSTEM_COLOR_PREFIX_LEN (sizeof (SYSTEM_COLOR_PREFIX) - 1)
250 /* State variables for emulating a three button mouse. */
251 #define LMOUSE 1
252 #define MMOUSE 2
253 #define RMOUSE 4
255 static int button_state = 0;
256 static W32Msg saved_mouse_button_msg;
257 static unsigned mouse_button_timer = 0; /* non-zero when timer is active */
258 static W32Msg saved_mouse_move_msg;
259 static unsigned mouse_move_timer = 0;
261 /* Window that is tracking the mouse. */
262 static HWND track_mouse_window;
264 /* Multi-monitor API definitions that are not pulled from the headers
265 since we are compiling for NT 4. */
266 #ifndef MONITOR_DEFAULT_TO_NEAREST
267 #define MONITOR_DEFAULT_TO_NEAREST 2
268 #endif
269 /* MinGW headers define MONITORINFO unconditionally, but MSVC ones don't.
270 To avoid a compile error on one or the other, redefine with a new name. */
271 struct MONITOR_INFO
273 DWORD cbSize;
274 RECT rcMonitor;
275 RECT rcWork;
276 DWORD dwFlags;
279 typedef BOOL (WINAPI * TrackMouseEvent_Proc)
280 (IN OUT LPTRACKMOUSEEVENT lpEventTrack);
281 typedef LONG (WINAPI * ImmGetCompositionString_Proc)
282 (IN HIMC context, IN DWORD index, OUT LPVOID buffer, IN DWORD bufLen);
283 typedef HIMC (WINAPI * ImmGetContext_Proc) (IN HWND window);
284 typedef HMONITOR (WINAPI * MonitorFromPoint_Proc) (IN POINT pt, IN DWORD flags);
285 typedef BOOL (WINAPI * GetMonitorInfo_Proc)
286 (IN HMONITOR monitor, OUT struct MONITOR_INFO* info);
288 TrackMouseEvent_Proc track_mouse_event_fn = NULL;
289 ClipboardSequence_Proc clipboard_sequence_fn = NULL;
290 ImmGetCompositionString_Proc get_composition_string_fn = NULL;
291 ImmGetContext_Proc get_ime_context_fn = NULL;
292 MonitorFromPoint_Proc monitor_from_point_fn = NULL;
293 GetMonitorInfo_Proc get_monitor_info_fn = NULL;
295 extern AppendMenuW_Proc unicode_append_menu;
297 /* Flag to selectively ignore WM_IME_CHAR messages. */
298 static int ignore_ime_char = 0;
300 /* W95 mousewheel handler */
301 unsigned int msh_mousewheel = 0;
303 /* Timers */
304 #define MOUSE_BUTTON_ID 1
305 #define MOUSE_MOVE_ID 2
306 #define MENU_FREE_ID 3
307 /* The delay (milliseconds) before a menu is freed after WM_EXITMENULOOP
308 is received. */
309 #define MENU_FREE_DELAY 1000
310 static unsigned menu_free_timer = 0;
312 /* The below are defined in frame.c. */
314 extern Lisp_Object Vwindow_system_version;
316 #ifdef GLYPH_DEBUG
317 int image_cache_refcount, dpyinfo_refcount;
318 #endif
321 /* From w32term.c. */
322 extern int w32_num_mouse_buttons;
323 extern Lisp_Object Vw32_recognize_altgr;
325 extern HWND w32_system_caret_hwnd;
327 extern int w32_system_caret_height;
328 extern int w32_system_caret_x;
329 extern int w32_system_caret_y;
330 extern int w32_use_visible_system_caret;
332 static HWND w32_visible_system_caret_hwnd;
334 /* From w32menu.c */
335 extern HMENU current_popup_menu;
336 static int menubar_in_use = 0;
339 /* Error if we are not connected to MS-Windows. */
340 void
341 check_w32 ()
343 if (! w32_in_use)
344 error ("MS-Windows not in use or not initialized");
347 /* Nonzero if we can use mouse menus.
348 You should not call this unless HAVE_MENUS is defined. */
351 have_menus_p ()
353 return w32_in_use;
356 /* Extract a frame as a FRAME_PTR, defaulting to the selected frame
357 and checking validity for W32. */
359 FRAME_PTR
360 check_x_frame (frame)
361 Lisp_Object frame;
363 FRAME_PTR f;
365 if (NILP (frame))
366 frame = selected_frame;
367 CHECK_LIVE_FRAME (frame);
368 f = XFRAME (frame);
369 if (! FRAME_W32_P (f))
370 error ("Non-W32 frame used");
371 return f;
374 /* Let the user specify a display with a frame.
375 nil stands for the selected frame--or, if that is not a w32 frame,
376 the first display on the list. */
378 struct w32_display_info *
379 check_x_display_info (frame)
380 Lisp_Object frame;
382 if (NILP (frame))
384 struct frame *sf = XFRAME (selected_frame);
386 if (FRAME_W32_P (sf) && FRAME_LIVE_P (sf))
387 return FRAME_W32_DISPLAY_INFO (sf);
388 else
389 return &one_w32_display_info;
391 else if (STRINGP (frame))
392 return x_display_info_for_name (frame);
393 else
395 FRAME_PTR f;
397 CHECK_LIVE_FRAME (frame);
398 f = XFRAME (frame);
399 if (! FRAME_W32_P (f))
400 error ("Non-W32 frame used");
401 return FRAME_W32_DISPLAY_INFO (f);
405 /* Return the Emacs frame-object corresponding to an w32 window.
406 It could be the frame's main window or an icon window. */
408 /* This function can be called during GC, so use GC_xxx type test macros. */
410 struct frame *
411 x_window_to_frame (dpyinfo, wdesc)
412 struct w32_display_info *dpyinfo;
413 HWND wdesc;
415 Lisp_Object tail, frame;
416 struct frame *f;
418 for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
420 frame = XCAR (tail);
421 if (!FRAMEP (frame))
422 continue;
423 f = XFRAME (frame);
424 if (!FRAME_W32_P (f) || FRAME_W32_DISPLAY_INFO (f) != dpyinfo)
425 continue;
426 if (f->output_data.w32->hourglass_window == wdesc)
427 return f;
429 if (FRAME_W32_WINDOW (f) == wdesc)
430 return f;
432 return 0;
436 static Lisp_Object unwind_create_frame P_ ((Lisp_Object));
437 static Lisp_Object unwind_create_tip_frame P_ ((Lisp_Object));
438 static void my_create_window P_ ((struct frame *));
439 static void my_create_tip_window P_ ((struct frame *));
441 /* TODO: Native Input Method support; see x_create_im. */
442 void x_set_foreground_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
443 void x_set_background_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
444 void x_set_mouse_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
445 void x_set_cursor_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
446 void x_set_border_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
447 void x_set_cursor_type P_ ((struct frame *, Lisp_Object, Lisp_Object));
448 void x_set_icon_type P_ ((struct frame *, Lisp_Object, Lisp_Object));
449 void x_set_icon_name P_ ((struct frame *, Lisp_Object, Lisp_Object));
450 void x_explicitly_set_name P_ ((struct frame *, Lisp_Object, Lisp_Object));
451 void x_set_menu_bar_lines P_ ((struct frame *, Lisp_Object, Lisp_Object));
452 void x_set_title P_ ((struct frame *, Lisp_Object, Lisp_Object));
453 void x_set_tool_bar_lines P_ ((struct frame *, Lisp_Object, Lisp_Object));
454 static void x_edge_detection P_ ((struct frame *, struct image *, Lisp_Object,
455 Lisp_Object));
460 /* Store the screen positions of frame F into XPTR and YPTR.
461 These are the positions of the containing window manager window,
462 not Emacs's own window. */
464 void
465 x_real_positions (f, xptr, yptr)
466 FRAME_PTR f;
467 int *xptr, *yptr;
469 POINT pt;
470 RECT rect;
472 /* Get the bounds of the WM window. */
473 GetWindowRect (FRAME_W32_WINDOW (f), &rect);
475 pt.x = 0;
476 pt.y = 0;
478 /* Convert (0, 0) in the client area to screen co-ordinates. */
479 ClientToScreen (FRAME_W32_WINDOW (f), &pt);
481 /* Remember x_pixels_diff and y_pixels_diff. */
482 f->x_pixels_diff = pt.x - rect.left;
483 f->y_pixels_diff = pt.y - rect.top;
485 *xptr = rect.left;
486 *yptr = rect.top;
491 DEFUN ("w32-define-rgb-color", Fw32_define_rgb_color,
492 Sw32_define_rgb_color, 4, 4, 0,
493 doc: /* Convert RGB numbers to a windows color reference and associate with NAME.
494 This adds or updates a named color to `w32-color-map', making it
495 available for use. The original entry's RGB ref is returned, or nil
496 if the entry is new. */)
497 (red, green, blue, name)
498 Lisp_Object red, green, blue, name;
500 Lisp_Object rgb;
501 Lisp_Object oldrgb = Qnil;
502 Lisp_Object entry;
504 CHECK_NUMBER (red);
505 CHECK_NUMBER (green);
506 CHECK_NUMBER (blue);
507 CHECK_STRING (name);
509 XSETINT (rgb, RGB (XUINT (red), XUINT (green), XUINT (blue)));
511 BLOCK_INPUT;
513 /* replace existing entry in w32-color-map or add new entry. */
514 entry = Fassoc (name, Vw32_color_map);
515 if (NILP (entry))
517 entry = Fcons (name, rgb);
518 Vw32_color_map = Fcons (entry, Vw32_color_map);
520 else
522 oldrgb = Fcdr (entry);
523 Fsetcdr (entry, rgb);
526 UNBLOCK_INPUT;
528 return (oldrgb);
531 DEFUN ("w32-load-color-file", Fw32_load_color_file,
532 Sw32_load_color_file, 1, 1, 0,
533 doc: /* Create an alist of color entries from an external file.
534 Assign this value to `w32-color-map' to replace the existing color map.
536 The file should define one named RGB color per line like so:
537 R G B name
538 where R,G,B are numbers between 0 and 255 and name is an arbitrary string. */)
539 (filename)
540 Lisp_Object filename;
542 FILE *fp;
543 Lisp_Object cmap = Qnil;
544 Lisp_Object abspath;
546 CHECK_STRING (filename);
547 abspath = Fexpand_file_name (filename, Qnil);
549 fp = fopen (SDATA (filename), "rt");
550 if (fp)
552 char buf[512];
553 int red, green, blue;
554 int num;
556 BLOCK_INPUT;
558 while (fgets (buf, sizeof (buf), fp) != NULL) {
559 if (sscanf (buf, "%u %u %u %n", &red, &green, &blue, &num) == 3)
561 char *name = buf + num;
562 num = strlen (name) - 1;
563 if (name[num] == '\n')
564 name[num] = 0;
565 cmap = Fcons (Fcons (build_string (name),
566 make_number (RGB (red, green, blue))),
567 cmap);
570 fclose (fp);
572 UNBLOCK_INPUT;
575 return cmap;
578 /* The default colors for the w32 color map */
579 typedef struct colormap_t
581 char *name;
582 COLORREF colorref;
583 } colormap_t;
585 colormap_t w32_color_map[] =
587 {"snow" , PALETTERGB (255,250,250)},
588 {"ghost white" , PALETTERGB (248,248,255)},
589 {"GhostWhite" , PALETTERGB (248,248,255)},
590 {"white smoke" , PALETTERGB (245,245,245)},
591 {"WhiteSmoke" , PALETTERGB (245,245,245)},
592 {"gainsboro" , PALETTERGB (220,220,220)},
593 {"floral white" , PALETTERGB (255,250,240)},
594 {"FloralWhite" , PALETTERGB (255,250,240)},
595 {"old lace" , PALETTERGB (253,245,230)},
596 {"OldLace" , PALETTERGB (253,245,230)},
597 {"linen" , PALETTERGB (250,240,230)},
598 {"antique white" , PALETTERGB (250,235,215)},
599 {"AntiqueWhite" , PALETTERGB (250,235,215)},
600 {"papaya whip" , PALETTERGB (255,239,213)},
601 {"PapayaWhip" , PALETTERGB (255,239,213)},
602 {"blanched almond" , PALETTERGB (255,235,205)},
603 {"BlanchedAlmond" , PALETTERGB (255,235,205)},
604 {"bisque" , PALETTERGB (255,228,196)},
605 {"peach puff" , PALETTERGB (255,218,185)},
606 {"PeachPuff" , PALETTERGB (255,218,185)},
607 {"navajo white" , PALETTERGB (255,222,173)},
608 {"NavajoWhite" , PALETTERGB (255,222,173)},
609 {"moccasin" , PALETTERGB (255,228,181)},
610 {"cornsilk" , PALETTERGB (255,248,220)},
611 {"ivory" , PALETTERGB (255,255,240)},
612 {"lemon chiffon" , PALETTERGB (255,250,205)},
613 {"LemonChiffon" , PALETTERGB (255,250,205)},
614 {"seashell" , PALETTERGB (255,245,238)},
615 {"honeydew" , PALETTERGB (240,255,240)},
616 {"mint cream" , PALETTERGB (245,255,250)},
617 {"MintCream" , PALETTERGB (245,255,250)},
618 {"azure" , PALETTERGB (240,255,255)},
619 {"alice blue" , PALETTERGB (240,248,255)},
620 {"AliceBlue" , PALETTERGB (240,248,255)},
621 {"lavender" , PALETTERGB (230,230,250)},
622 {"lavender blush" , PALETTERGB (255,240,245)},
623 {"LavenderBlush" , PALETTERGB (255,240,245)},
624 {"misty rose" , PALETTERGB (255,228,225)},
625 {"MistyRose" , PALETTERGB (255,228,225)},
626 {"white" , PALETTERGB (255,255,255)},
627 {"black" , PALETTERGB ( 0, 0, 0)},
628 {"dark slate gray" , PALETTERGB ( 47, 79, 79)},
629 {"DarkSlateGray" , PALETTERGB ( 47, 79, 79)},
630 {"dark slate grey" , PALETTERGB ( 47, 79, 79)},
631 {"DarkSlateGrey" , PALETTERGB ( 47, 79, 79)},
632 {"dim gray" , PALETTERGB (105,105,105)},
633 {"DimGray" , PALETTERGB (105,105,105)},
634 {"dim grey" , PALETTERGB (105,105,105)},
635 {"DimGrey" , PALETTERGB (105,105,105)},
636 {"slate gray" , PALETTERGB (112,128,144)},
637 {"SlateGray" , PALETTERGB (112,128,144)},
638 {"slate grey" , PALETTERGB (112,128,144)},
639 {"SlateGrey" , PALETTERGB (112,128,144)},
640 {"light slate gray" , PALETTERGB (119,136,153)},
641 {"LightSlateGray" , PALETTERGB (119,136,153)},
642 {"light slate grey" , PALETTERGB (119,136,153)},
643 {"LightSlateGrey" , PALETTERGB (119,136,153)},
644 {"gray" , PALETTERGB (190,190,190)},
645 {"grey" , PALETTERGB (190,190,190)},
646 {"light grey" , PALETTERGB (211,211,211)},
647 {"LightGrey" , PALETTERGB (211,211,211)},
648 {"light gray" , PALETTERGB (211,211,211)},
649 {"LightGray" , PALETTERGB (211,211,211)},
650 {"midnight blue" , PALETTERGB ( 25, 25,112)},
651 {"MidnightBlue" , PALETTERGB ( 25, 25,112)},
652 {"navy" , PALETTERGB ( 0, 0,128)},
653 {"navy blue" , PALETTERGB ( 0, 0,128)},
654 {"NavyBlue" , PALETTERGB ( 0, 0,128)},
655 {"cornflower blue" , PALETTERGB (100,149,237)},
656 {"CornflowerBlue" , PALETTERGB (100,149,237)},
657 {"dark slate blue" , PALETTERGB ( 72, 61,139)},
658 {"DarkSlateBlue" , PALETTERGB ( 72, 61,139)},
659 {"slate blue" , PALETTERGB (106, 90,205)},
660 {"SlateBlue" , PALETTERGB (106, 90,205)},
661 {"medium slate blue" , PALETTERGB (123,104,238)},
662 {"MediumSlateBlue" , PALETTERGB (123,104,238)},
663 {"light slate blue" , PALETTERGB (132,112,255)},
664 {"LightSlateBlue" , PALETTERGB (132,112,255)},
665 {"medium blue" , PALETTERGB ( 0, 0,205)},
666 {"MediumBlue" , PALETTERGB ( 0, 0,205)},
667 {"royal blue" , PALETTERGB ( 65,105,225)},
668 {"RoyalBlue" , PALETTERGB ( 65,105,225)},
669 {"blue" , PALETTERGB ( 0, 0,255)},
670 {"dodger blue" , PALETTERGB ( 30,144,255)},
671 {"DodgerBlue" , PALETTERGB ( 30,144,255)},
672 {"deep sky blue" , PALETTERGB ( 0,191,255)},
673 {"DeepSkyBlue" , PALETTERGB ( 0,191,255)},
674 {"sky blue" , PALETTERGB (135,206,235)},
675 {"SkyBlue" , PALETTERGB (135,206,235)},
676 {"light sky blue" , PALETTERGB (135,206,250)},
677 {"LightSkyBlue" , PALETTERGB (135,206,250)},
678 {"steel blue" , PALETTERGB ( 70,130,180)},
679 {"SteelBlue" , PALETTERGB ( 70,130,180)},
680 {"light steel blue" , PALETTERGB (176,196,222)},
681 {"LightSteelBlue" , PALETTERGB (176,196,222)},
682 {"light blue" , PALETTERGB (173,216,230)},
683 {"LightBlue" , PALETTERGB (173,216,230)},
684 {"powder blue" , PALETTERGB (176,224,230)},
685 {"PowderBlue" , PALETTERGB (176,224,230)},
686 {"pale turquoise" , PALETTERGB (175,238,238)},
687 {"PaleTurquoise" , PALETTERGB (175,238,238)},
688 {"dark turquoise" , PALETTERGB ( 0,206,209)},
689 {"DarkTurquoise" , PALETTERGB ( 0,206,209)},
690 {"medium turquoise" , PALETTERGB ( 72,209,204)},
691 {"MediumTurquoise" , PALETTERGB ( 72,209,204)},
692 {"turquoise" , PALETTERGB ( 64,224,208)},
693 {"cyan" , PALETTERGB ( 0,255,255)},
694 {"light cyan" , PALETTERGB (224,255,255)},
695 {"LightCyan" , PALETTERGB (224,255,255)},
696 {"cadet blue" , PALETTERGB ( 95,158,160)},
697 {"CadetBlue" , PALETTERGB ( 95,158,160)},
698 {"medium aquamarine" , PALETTERGB (102,205,170)},
699 {"MediumAquamarine" , PALETTERGB (102,205,170)},
700 {"aquamarine" , PALETTERGB (127,255,212)},
701 {"dark green" , PALETTERGB ( 0,100, 0)},
702 {"DarkGreen" , PALETTERGB ( 0,100, 0)},
703 {"dark olive green" , PALETTERGB ( 85,107, 47)},
704 {"DarkOliveGreen" , PALETTERGB ( 85,107, 47)},
705 {"dark sea green" , PALETTERGB (143,188,143)},
706 {"DarkSeaGreen" , PALETTERGB (143,188,143)},
707 {"sea green" , PALETTERGB ( 46,139, 87)},
708 {"SeaGreen" , PALETTERGB ( 46,139, 87)},
709 {"medium sea green" , PALETTERGB ( 60,179,113)},
710 {"MediumSeaGreen" , PALETTERGB ( 60,179,113)},
711 {"light sea green" , PALETTERGB ( 32,178,170)},
712 {"LightSeaGreen" , PALETTERGB ( 32,178,170)},
713 {"pale green" , PALETTERGB (152,251,152)},
714 {"PaleGreen" , PALETTERGB (152,251,152)},
715 {"spring green" , PALETTERGB ( 0,255,127)},
716 {"SpringGreen" , PALETTERGB ( 0,255,127)},
717 {"lawn green" , PALETTERGB (124,252, 0)},
718 {"LawnGreen" , PALETTERGB (124,252, 0)},
719 {"green" , PALETTERGB ( 0,255, 0)},
720 {"chartreuse" , PALETTERGB (127,255, 0)},
721 {"medium spring green" , PALETTERGB ( 0,250,154)},
722 {"MediumSpringGreen" , PALETTERGB ( 0,250,154)},
723 {"green yellow" , PALETTERGB (173,255, 47)},
724 {"GreenYellow" , PALETTERGB (173,255, 47)},
725 {"lime green" , PALETTERGB ( 50,205, 50)},
726 {"LimeGreen" , PALETTERGB ( 50,205, 50)},
727 {"yellow green" , PALETTERGB (154,205, 50)},
728 {"YellowGreen" , PALETTERGB (154,205, 50)},
729 {"forest green" , PALETTERGB ( 34,139, 34)},
730 {"ForestGreen" , PALETTERGB ( 34,139, 34)},
731 {"olive drab" , PALETTERGB (107,142, 35)},
732 {"OliveDrab" , PALETTERGB (107,142, 35)},
733 {"dark khaki" , PALETTERGB (189,183,107)},
734 {"DarkKhaki" , PALETTERGB (189,183,107)},
735 {"khaki" , PALETTERGB (240,230,140)},
736 {"pale goldenrod" , PALETTERGB (238,232,170)},
737 {"PaleGoldenrod" , PALETTERGB (238,232,170)},
738 {"light goldenrod yellow" , PALETTERGB (250,250,210)},
739 {"LightGoldenrodYellow" , PALETTERGB (250,250,210)},
740 {"light yellow" , PALETTERGB (255,255,224)},
741 {"LightYellow" , PALETTERGB (255,255,224)},
742 {"yellow" , PALETTERGB (255,255, 0)},
743 {"gold" , PALETTERGB (255,215, 0)},
744 {"light goldenrod" , PALETTERGB (238,221,130)},
745 {"LightGoldenrod" , PALETTERGB (238,221,130)},
746 {"goldenrod" , PALETTERGB (218,165, 32)},
747 {"dark goldenrod" , PALETTERGB (184,134, 11)},
748 {"DarkGoldenrod" , PALETTERGB (184,134, 11)},
749 {"rosy brown" , PALETTERGB (188,143,143)},
750 {"RosyBrown" , PALETTERGB (188,143,143)},
751 {"indian red" , PALETTERGB (205, 92, 92)},
752 {"IndianRed" , PALETTERGB (205, 92, 92)},
753 {"saddle brown" , PALETTERGB (139, 69, 19)},
754 {"SaddleBrown" , PALETTERGB (139, 69, 19)},
755 {"sienna" , PALETTERGB (160, 82, 45)},
756 {"peru" , PALETTERGB (205,133, 63)},
757 {"burlywood" , PALETTERGB (222,184,135)},
758 {"beige" , PALETTERGB (245,245,220)},
759 {"wheat" , PALETTERGB (245,222,179)},
760 {"sandy brown" , PALETTERGB (244,164, 96)},
761 {"SandyBrown" , PALETTERGB (244,164, 96)},
762 {"tan" , PALETTERGB (210,180,140)},
763 {"chocolate" , PALETTERGB (210,105, 30)},
764 {"firebrick" , PALETTERGB (178,34, 34)},
765 {"brown" , PALETTERGB (165,42, 42)},
766 {"dark salmon" , PALETTERGB (233,150,122)},
767 {"DarkSalmon" , PALETTERGB (233,150,122)},
768 {"salmon" , PALETTERGB (250,128,114)},
769 {"light salmon" , PALETTERGB (255,160,122)},
770 {"LightSalmon" , PALETTERGB (255,160,122)},
771 {"orange" , PALETTERGB (255,165, 0)},
772 {"dark orange" , PALETTERGB (255,140, 0)},
773 {"DarkOrange" , PALETTERGB (255,140, 0)},
774 {"coral" , PALETTERGB (255,127, 80)},
775 {"light coral" , PALETTERGB (240,128,128)},
776 {"LightCoral" , PALETTERGB (240,128,128)},
777 {"tomato" , PALETTERGB (255, 99, 71)},
778 {"orange red" , PALETTERGB (255, 69, 0)},
779 {"OrangeRed" , PALETTERGB (255, 69, 0)},
780 {"red" , PALETTERGB (255, 0, 0)},
781 {"hot pink" , PALETTERGB (255,105,180)},
782 {"HotPink" , PALETTERGB (255,105,180)},
783 {"deep pink" , PALETTERGB (255, 20,147)},
784 {"DeepPink" , PALETTERGB (255, 20,147)},
785 {"pink" , PALETTERGB (255,192,203)},
786 {"light pink" , PALETTERGB (255,182,193)},
787 {"LightPink" , PALETTERGB (255,182,193)},
788 {"pale violet red" , PALETTERGB (219,112,147)},
789 {"PaleVioletRed" , PALETTERGB (219,112,147)},
790 {"maroon" , PALETTERGB (176, 48, 96)},
791 {"medium violet red" , PALETTERGB (199, 21,133)},
792 {"MediumVioletRed" , PALETTERGB (199, 21,133)},
793 {"violet red" , PALETTERGB (208, 32,144)},
794 {"VioletRed" , PALETTERGB (208, 32,144)},
795 {"magenta" , PALETTERGB (255, 0,255)},
796 {"violet" , PALETTERGB (238,130,238)},
797 {"plum" , PALETTERGB (221,160,221)},
798 {"orchid" , PALETTERGB (218,112,214)},
799 {"medium orchid" , PALETTERGB (186, 85,211)},
800 {"MediumOrchid" , PALETTERGB (186, 85,211)},
801 {"dark orchid" , PALETTERGB (153, 50,204)},
802 {"DarkOrchid" , PALETTERGB (153, 50,204)},
803 {"dark violet" , PALETTERGB (148, 0,211)},
804 {"DarkViolet" , PALETTERGB (148, 0,211)},
805 {"blue violet" , PALETTERGB (138, 43,226)},
806 {"BlueViolet" , PALETTERGB (138, 43,226)},
807 {"purple" , PALETTERGB (160, 32,240)},
808 {"medium purple" , PALETTERGB (147,112,219)},
809 {"MediumPurple" , PALETTERGB (147,112,219)},
810 {"thistle" , PALETTERGB (216,191,216)},
811 {"gray0" , PALETTERGB ( 0, 0, 0)},
812 {"grey0" , PALETTERGB ( 0, 0, 0)},
813 {"dark grey" , PALETTERGB (169,169,169)},
814 {"DarkGrey" , PALETTERGB (169,169,169)},
815 {"dark gray" , PALETTERGB (169,169,169)},
816 {"DarkGray" , PALETTERGB (169,169,169)},
817 {"dark blue" , PALETTERGB ( 0, 0,139)},
818 {"DarkBlue" , PALETTERGB ( 0, 0,139)},
819 {"dark cyan" , PALETTERGB ( 0,139,139)},
820 {"DarkCyan" , PALETTERGB ( 0,139,139)},
821 {"dark magenta" , PALETTERGB (139, 0,139)},
822 {"DarkMagenta" , PALETTERGB (139, 0,139)},
823 {"dark red" , PALETTERGB (139, 0, 0)},
824 {"DarkRed" , PALETTERGB (139, 0, 0)},
825 {"light green" , PALETTERGB (144,238,144)},
826 {"LightGreen" , PALETTERGB (144,238,144)},
829 DEFUN ("w32-default-color-map", Fw32_default_color_map, Sw32_default_color_map,
830 0, 0, 0, doc: /* Return the default color map. */)
833 int i;
834 colormap_t *pc = w32_color_map;
835 Lisp_Object cmap;
837 BLOCK_INPUT;
839 cmap = Qnil;
841 for (i = 0; i < sizeof (w32_color_map) / sizeof (w32_color_map[0]);
842 pc++, i++)
843 cmap = Fcons (Fcons (build_string (pc->name),
844 make_number (pc->colorref)),
845 cmap);
847 UNBLOCK_INPUT;
849 return (cmap);
852 static Lisp_Object
853 w32_to_x_color (rgb)
854 Lisp_Object rgb;
856 Lisp_Object color;
858 CHECK_NUMBER (rgb);
860 BLOCK_INPUT;
862 color = Frassq (rgb, Vw32_color_map);
864 UNBLOCK_INPUT;
866 if (!NILP (color))
867 return (Fcar (color));
868 else
869 return Qnil;
872 static Lisp_Object
873 w32_color_map_lookup (colorname)
874 char *colorname;
876 Lisp_Object tail, ret = Qnil;
878 BLOCK_INPUT;
880 for (tail = Vw32_color_map; CONSP (tail); tail = XCDR (tail))
882 register Lisp_Object elt, tem;
884 elt = XCAR (tail);
885 if (!CONSP (elt)) continue;
887 tem = Fcar (elt);
889 if (lstrcmpi (SDATA (tem), colorname) == 0)
891 ret = Fcdr (elt);
892 break;
895 QUIT;
899 UNBLOCK_INPUT;
901 return ret;
905 static void
906 add_system_logical_colors_to_map (system_colors)
907 Lisp_Object *system_colors;
909 HKEY colors_key;
911 /* Other registry operations are done with input blocked. */
912 BLOCK_INPUT;
914 /* Look for "Control Panel/Colors" under User and Machine registry
915 settings. */
916 if (RegOpenKeyEx (HKEY_CURRENT_USER, "Control Panel\\Colors", 0,
917 KEY_READ, &colors_key) == ERROR_SUCCESS
918 || RegOpenKeyEx (HKEY_LOCAL_MACHINE, "Control Panel\\Colors", 0,
919 KEY_READ, &colors_key) == ERROR_SUCCESS)
921 /* List all keys. */
922 char color_buffer[64];
923 char full_name_buffer[MAX_PATH + SYSTEM_COLOR_PREFIX_LEN];
924 int index = 0;
925 DWORD name_size, color_size;
926 char *name_buffer = full_name_buffer + SYSTEM_COLOR_PREFIX_LEN;
928 name_size = sizeof (full_name_buffer) - SYSTEM_COLOR_PREFIX_LEN;
929 color_size = sizeof (color_buffer);
931 strcpy (full_name_buffer, SYSTEM_COLOR_PREFIX);
933 while (RegEnumValueA (colors_key, index, name_buffer, &name_size,
934 NULL, NULL, color_buffer, &color_size)
935 == ERROR_SUCCESS)
937 int r, g, b;
938 if (sscanf (color_buffer, " %u %u %u", &r, &g, &b) == 3)
939 *system_colors = Fcons (Fcons (build_string (full_name_buffer),
940 make_number (RGB (r, g, b))),
941 *system_colors);
943 name_size = sizeof (full_name_buffer) - SYSTEM_COLOR_PREFIX_LEN;
944 color_size = sizeof (color_buffer);
945 index++;
947 RegCloseKey (colors_key);
950 UNBLOCK_INPUT;
954 static Lisp_Object
955 x_to_w32_color (colorname)
956 char * colorname;
958 register Lisp_Object ret = Qnil;
960 BLOCK_INPUT;
962 if (colorname[0] == '#')
964 /* Could be an old-style RGB Device specification. */
965 char *color;
966 int size;
967 color = colorname + 1;
969 size = strlen (color);
970 if (size == 3 || size == 6 || size == 9 || size == 12)
972 UINT colorval;
973 int i, pos;
974 pos = 0;
975 size /= 3;
976 colorval = 0;
978 for (i = 0; i < 3; i++)
980 char *end;
981 char t;
982 unsigned long value;
984 /* The check for 'x' in the following conditional takes into
985 account the fact that strtol allows a "0x" in front of
986 our numbers, and we don't. */
987 if (!isxdigit (color[0]) || color[1] == 'x')
988 break;
989 t = color[size];
990 color[size] = '\0';
991 value = strtoul (color, &end, 16);
992 color[size] = t;
993 if (errno == ERANGE || end - color != size)
994 break;
995 switch (size)
997 case 1:
998 value = value * 0x10;
999 break;
1000 case 2:
1001 break;
1002 case 3:
1003 value /= 0x10;
1004 break;
1005 case 4:
1006 value /= 0x100;
1007 break;
1009 colorval |= (value << pos);
1010 pos += 0x8;
1011 if (i == 2)
1013 UNBLOCK_INPUT;
1014 XSETINT (ret, colorval);
1015 return ret;
1017 color = end;
1021 else if (strnicmp (colorname, "rgb:", 4) == 0)
1023 char *color;
1024 UINT colorval;
1025 int i, pos;
1026 pos = 0;
1028 colorval = 0;
1029 color = colorname + 4;
1030 for (i = 0; i < 3; i++)
1032 char *end;
1033 unsigned long value;
1035 /* The check for 'x' in the following conditional takes into
1036 account the fact that strtol allows a "0x" in front of
1037 our numbers, and we don't. */
1038 if (!isxdigit (color[0]) || color[1] == 'x')
1039 break;
1040 value = strtoul (color, &end, 16);
1041 if (errno == ERANGE)
1042 break;
1043 switch (end - color)
1045 case 1:
1046 value = value * 0x10 + value;
1047 break;
1048 case 2:
1049 break;
1050 case 3:
1051 value /= 0x10;
1052 break;
1053 case 4:
1054 value /= 0x100;
1055 break;
1056 default:
1057 value = ULONG_MAX;
1059 if (value == ULONG_MAX)
1060 break;
1061 colorval |= (value << pos);
1062 pos += 0x8;
1063 if (i == 2)
1065 if (*end != '\0')
1066 break;
1067 UNBLOCK_INPUT;
1068 XSETINT (ret, colorval);
1069 return ret;
1071 if (*end != '/')
1072 break;
1073 color = end + 1;
1076 else if (strnicmp (colorname, "rgbi:", 5) == 0)
1078 /* This is an RGB Intensity specification. */
1079 char *color;
1080 UINT colorval;
1081 int i, pos;
1082 pos = 0;
1084 colorval = 0;
1085 color = colorname + 5;
1086 for (i = 0; i < 3; i++)
1088 char *end;
1089 double value;
1090 UINT val;
1092 value = strtod (color, &end);
1093 if (errno == ERANGE)
1094 break;
1095 if (value < 0.0 || value > 1.0)
1096 break;
1097 val = (UINT)(0x100 * value);
1098 /* We used 0x100 instead of 0xFF to give a continuous
1099 range between 0.0 and 1.0 inclusive. The next statement
1100 fixes the 1.0 case. */
1101 if (val == 0x100)
1102 val = 0xFF;
1103 colorval |= (val << pos);
1104 pos += 0x8;
1105 if (i == 2)
1107 if (*end != '\0')
1108 break;
1109 UNBLOCK_INPUT;
1110 XSETINT (ret, colorval);
1111 return ret;
1113 if (*end != '/')
1114 break;
1115 color = end + 1;
1118 /* I am not going to attempt to handle any of the CIE color schemes
1119 or TekHVC, since I don't know the algorithms for conversion to
1120 RGB. */
1122 /* If we fail to lookup the color name in w32_color_map, then check the
1123 colorname to see if it can be crudely approximated: If the X color
1124 ends in a number (e.g., "darkseagreen2"), strip the number and
1125 return the result of looking up the base color name. */
1126 ret = w32_color_map_lookup (colorname);
1127 if (NILP (ret))
1129 int len = strlen (colorname);
1131 if (isdigit (colorname[len - 1]))
1133 char *ptr, *approx = alloca (len + 1);
1135 strcpy (approx, colorname);
1136 ptr = &approx[len - 1];
1137 while (ptr > approx && isdigit (*ptr))
1138 *ptr-- = '\0';
1140 ret = w32_color_map_lookup (approx);
1144 UNBLOCK_INPUT;
1145 return ret;
1148 void
1149 w32_regenerate_palette (FRAME_PTR f)
1151 struct w32_palette_entry * list;
1152 LOGPALETTE * log_palette;
1153 HPALETTE new_palette;
1154 int i;
1156 /* don't bother trying to create palette if not supported */
1157 if (! FRAME_W32_DISPLAY_INFO (f)->has_palette)
1158 return;
1160 log_palette = (LOGPALETTE *)
1161 alloca (sizeof (LOGPALETTE) +
1162 FRAME_W32_DISPLAY_INFO (f)->num_colors * sizeof (PALETTEENTRY));
1163 log_palette->palVersion = 0x300;
1164 log_palette->palNumEntries = FRAME_W32_DISPLAY_INFO (f)->num_colors;
1166 list = FRAME_W32_DISPLAY_INFO (f)->color_list;
1167 for (i = 0;
1168 i < FRAME_W32_DISPLAY_INFO (f)->num_colors;
1169 i++, list = list->next)
1170 log_palette->palPalEntry[i] = list->entry;
1172 new_palette = CreatePalette (log_palette);
1174 enter_crit ();
1176 if (FRAME_W32_DISPLAY_INFO (f)->palette)
1177 DeleteObject (FRAME_W32_DISPLAY_INFO (f)->palette);
1178 FRAME_W32_DISPLAY_INFO (f)->palette = new_palette;
1180 /* Realize display palette and garbage all frames. */
1181 release_frame_dc (f, get_frame_dc (f));
1183 leave_crit ();
1186 #define W32_COLOR(pe) RGB (pe.peRed, pe.peGreen, pe.peBlue)
1187 #define SET_W32_COLOR(pe, color) \
1188 do \
1190 pe.peRed = GetRValue (color); \
1191 pe.peGreen = GetGValue (color); \
1192 pe.peBlue = GetBValue (color); \
1193 pe.peFlags = 0; \
1194 } while (0)
1196 #if 0
1197 /* Keep these around in case we ever want to track color usage. */
1198 void
1199 w32_map_color (FRAME_PTR f, COLORREF color)
1201 struct w32_palette_entry * list = FRAME_W32_DISPLAY_INFO (f)->color_list;
1203 if (NILP (Vw32_enable_palette))
1204 return;
1206 /* check if color is already mapped */
1207 while (list)
1209 if (W32_COLOR (list->entry) == color)
1211 ++list->refcount;
1212 return;
1214 list = list->next;
1217 /* not already mapped, so add to list and recreate Windows palette */
1218 list = (struct w32_palette_entry *)
1219 xmalloc (sizeof (struct w32_palette_entry));
1220 SET_W32_COLOR (list->entry, color);
1221 list->refcount = 1;
1222 list->next = FRAME_W32_DISPLAY_INFO (f)->color_list;
1223 FRAME_W32_DISPLAY_INFO (f)->color_list = list;
1224 FRAME_W32_DISPLAY_INFO (f)->num_colors++;
1226 /* set flag that palette must be regenerated */
1227 FRAME_W32_DISPLAY_INFO (f)->regen_palette = TRUE;
1230 void
1231 w32_unmap_color (FRAME_PTR f, COLORREF color)
1233 struct w32_palette_entry * list = FRAME_W32_DISPLAY_INFO (f)->color_list;
1234 struct w32_palette_entry **prev = &FRAME_W32_DISPLAY_INFO (f)->color_list;
1236 if (NILP (Vw32_enable_palette))
1237 return;
1239 /* check if color is already mapped */
1240 while (list)
1242 if (W32_COLOR (list->entry) == color)
1244 if (--list->refcount == 0)
1246 *prev = list->next;
1247 xfree (list);
1248 FRAME_W32_DISPLAY_INFO (f)->num_colors--;
1249 break;
1251 else
1252 return;
1254 prev = &list->next;
1255 list = list->next;
1258 /* set flag that palette must be regenerated */
1259 FRAME_W32_DISPLAY_INFO (f)->regen_palette = TRUE;
1261 #endif
1264 /* Gamma-correct COLOR on frame F. */
1266 void
1267 gamma_correct (f, color)
1268 struct frame *f;
1269 COLORREF *color;
1271 if (f->gamma)
1273 *color = PALETTERGB (
1274 pow (GetRValue (*color) / 255.0, f->gamma) * 255.0 + 0.5,
1275 pow (GetGValue (*color) / 255.0, f->gamma) * 255.0 + 0.5,
1276 pow (GetBValue (*color) / 255.0, f->gamma) * 255.0 + 0.5);
1281 /* Decide if color named COLOR is valid for the display associated with
1282 the selected frame; if so, return the rgb values in COLOR_DEF.
1283 If ALLOC is nonzero, allocate a new colormap cell. */
1286 w32_defined_color (f, color, color_def, alloc)
1287 FRAME_PTR f;
1288 char *color;
1289 XColor *color_def;
1290 int alloc;
1292 register Lisp_Object tem;
1293 COLORREF w32_color_ref;
1295 tem = x_to_w32_color (color);
1297 if (!NILP (tem))
1299 if (f)
1301 /* Apply gamma correction. */
1302 w32_color_ref = XUINT (tem);
1303 gamma_correct (f, &w32_color_ref);
1304 XSETINT (tem, w32_color_ref);
1307 /* Map this color to the palette if it is enabled. */
1308 if (!NILP (Vw32_enable_palette))
1310 struct w32_palette_entry * entry =
1311 one_w32_display_info.color_list;
1312 struct w32_palette_entry ** prev =
1313 &one_w32_display_info.color_list;
1315 /* check if color is already mapped */
1316 while (entry)
1318 if (W32_COLOR (entry->entry) == XUINT (tem))
1319 break;
1320 prev = &entry->next;
1321 entry = entry->next;
1324 if (entry == NULL && alloc)
1326 /* not already mapped, so add to list */
1327 entry = (struct w32_palette_entry *)
1328 xmalloc (sizeof (struct w32_palette_entry));
1329 SET_W32_COLOR (entry->entry, XUINT (tem));
1330 entry->next = NULL;
1331 *prev = entry;
1332 one_w32_display_info.num_colors++;
1334 /* set flag that palette must be regenerated */
1335 one_w32_display_info.regen_palette = TRUE;
1338 /* Ensure COLORREF value is snapped to nearest color in (default)
1339 palette by simulating the PALETTERGB macro. This works whether
1340 or not the display device has a palette. */
1341 w32_color_ref = XUINT (tem) | 0x2000000;
1343 color_def->pixel = w32_color_ref;
1344 color_def->red = GetRValue (w32_color_ref) * 256;
1345 color_def->green = GetGValue (w32_color_ref) * 256;
1346 color_def->blue = GetBValue (w32_color_ref) * 256;
1348 return 1;
1350 else
1352 return 0;
1356 /* Given a string ARG naming a color, compute a pixel value from it
1357 suitable for screen F.
1358 If F is not a color screen, return DEF (default) regardless of what
1359 ARG says. */
1362 x_decode_color (f, arg, def)
1363 FRAME_PTR f;
1364 Lisp_Object arg;
1365 int def;
1367 XColor cdef;
1369 CHECK_STRING (arg);
1371 if (strcmp (SDATA (arg), "black") == 0)
1372 return BLACK_PIX_DEFAULT (f);
1373 else if (strcmp (SDATA (arg), "white") == 0)
1374 return WHITE_PIX_DEFAULT (f);
1376 if ((FRAME_W32_DISPLAY_INFO (f)->n_planes * FRAME_W32_DISPLAY_INFO (f)->n_cbits) == 1)
1377 return def;
1379 /* w32_defined_color is responsible for coping with failures
1380 by looking for a near-miss. */
1381 if (w32_defined_color (f, SDATA (arg), &cdef, 1))
1382 return cdef.pixel;
1384 /* defined_color failed; return an ultimate default. */
1385 return def;
1390 /* Functions called only from `x_set_frame_param'
1391 to set individual parameters.
1393 If FRAME_W32_WINDOW (f) is 0,
1394 the frame is being created and its window does not exist yet.
1395 In that case, just record the parameter's new value
1396 in the standard place; do not attempt to change the window. */
1398 void
1399 x_set_foreground_color (f, arg, oldval)
1400 struct frame *f;
1401 Lisp_Object arg, oldval;
1403 struct w32_output *x = f->output_data.w32;
1404 PIX_TYPE fg, old_fg;
1406 fg = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1407 old_fg = FRAME_FOREGROUND_PIXEL (f);
1408 FRAME_FOREGROUND_PIXEL (f) = fg;
1410 if (FRAME_W32_WINDOW (f) != 0)
1412 if (x->cursor_pixel == old_fg)
1413 x->cursor_pixel = fg;
1415 update_face_from_frame_parameter (f, Qforeground_color, arg);
1416 if (FRAME_VISIBLE_P (f))
1417 redraw_frame (f);
1421 void
1422 x_set_background_color (f, arg, oldval)
1423 struct frame *f;
1424 Lisp_Object arg, oldval;
1426 FRAME_BACKGROUND_PIXEL (f)
1427 = x_decode_color (f, arg, WHITE_PIX_DEFAULT (f));
1429 if (FRAME_W32_WINDOW (f) != 0)
1431 SetWindowLong (FRAME_W32_WINDOW (f), WND_BACKGROUND_INDEX,
1432 FRAME_BACKGROUND_PIXEL (f));
1434 update_face_from_frame_parameter (f, Qbackground_color, arg);
1436 if (FRAME_VISIBLE_P (f))
1437 redraw_frame (f);
1441 void
1442 x_set_mouse_color (f, arg, oldval)
1443 struct frame *f;
1444 Lisp_Object arg, oldval;
1446 Cursor cursor, nontext_cursor, mode_cursor, hand_cursor;
1447 int count;
1448 int mask_color;
1450 if (!EQ (Qnil, arg))
1451 f->output_data.w32->mouse_pixel
1452 = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1453 mask_color = FRAME_BACKGROUND_PIXEL (f);
1455 /* Don't let pointers be invisible. */
1456 if (mask_color == f->output_data.w32->mouse_pixel
1457 && mask_color == FRAME_BACKGROUND_PIXEL (f))
1458 f->output_data.w32->mouse_pixel = FRAME_FOREGROUND_PIXEL (f);
1460 #if 0 /* TODO : cursor changes */
1461 BLOCK_INPUT;
1463 /* It's not okay to crash if the user selects a screwy cursor. */
1464 count = x_catch_errors (FRAME_W32_DISPLAY (f));
1466 if (!EQ (Qnil, Vx_pointer_shape))
1468 CHECK_NUMBER (Vx_pointer_shape);
1469 cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XINT (Vx_pointer_shape));
1471 else
1472 cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_xterm);
1473 x_check_errors (FRAME_W32_DISPLAY (f), "bad text pointer cursor: %s");
1475 if (!EQ (Qnil, Vx_nontext_pointer_shape))
1477 CHECK_NUMBER (Vx_nontext_pointer_shape);
1478 nontext_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f),
1479 XINT (Vx_nontext_pointer_shape));
1481 else
1482 nontext_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_left_ptr);
1483 x_check_errors (FRAME_W32_DISPLAY (f), "bad nontext pointer cursor: %s");
1485 if (!EQ (Qnil, Vx_hourglass_pointer_shape))
1487 CHECK_NUMBER (Vx_hourglass_pointer_shape);
1488 hourglass_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f),
1489 XINT (Vx_hourglass_pointer_shape));
1491 else
1492 hourglass_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_watch);
1493 x_check_errors (FRAME_W32_DISPLAY (f), "bad busy pointer cursor: %s");
1495 x_check_errors (FRAME_W32_DISPLAY (f), "bad nontext pointer cursor: %s");
1496 if (!EQ (Qnil, Vx_mode_pointer_shape))
1498 CHECK_NUMBER (Vx_mode_pointer_shape);
1499 mode_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f),
1500 XINT (Vx_mode_pointer_shape));
1502 else
1503 mode_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_xterm);
1504 x_check_errors (FRAME_W32_DISPLAY (f), "bad modeline pointer cursor: %s");
1506 if (!EQ (Qnil, Vx_sensitive_text_pointer_shape))
1508 CHECK_NUMBER (Vx_sensitive_text_pointer_shape);
1509 hand_cursor
1510 = XCreateFontCursor (FRAME_W32_DISPLAY (f),
1511 XINT (Vx_sensitive_text_pointer_shape));
1513 else
1514 hand_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_crosshair);
1516 if (!NILP (Vx_window_horizontal_drag_shape))
1518 CHECK_NUMBER (Vx_window_horizontal_drag_shape);
1519 horizontal_drag_cursor
1520 = XCreateFontCursor (FRAME_X_DISPLAY (f),
1521 XINT (Vx_window_horizontal_drag_shape));
1523 else
1524 horizontal_drag_cursor
1525 = XCreateFontCursor (FRAME_X_DISPLAY (f), XC_sb_h_double_arrow);
1527 /* Check and report errors with the above calls. */
1528 x_check_errors (FRAME_W32_DISPLAY (f), "can't set cursor shape: %s");
1529 x_uncatch_errors (FRAME_W32_DISPLAY (f), count);
1532 XColor fore_color, back_color;
1534 fore_color.pixel = f->output_data.w32->mouse_pixel;
1535 back_color.pixel = mask_color;
1536 XQueryColor (FRAME_W32_DISPLAY (f),
1537 DefaultColormap (FRAME_W32_DISPLAY (f),
1538 DefaultScreen (FRAME_W32_DISPLAY (f))),
1539 &fore_color);
1540 XQueryColor (FRAME_W32_DISPLAY (f),
1541 DefaultColormap (FRAME_W32_DISPLAY (f),
1542 DefaultScreen (FRAME_W32_DISPLAY (f))),
1543 &back_color);
1544 XRecolorCursor (FRAME_W32_DISPLAY (f), cursor,
1545 &fore_color, &back_color);
1546 XRecolorCursor (FRAME_W32_DISPLAY (f), nontext_cursor,
1547 &fore_color, &back_color);
1548 XRecolorCursor (FRAME_W32_DISPLAY (f), mode_cursor,
1549 &fore_color, &back_color);
1550 XRecolorCursor (FRAME_W32_DISPLAY (f), hand_cursor,
1551 &fore_color, &back_color);
1552 XRecolorCursor (FRAME_W32_DISPLAY (f), hourglass_cursor,
1553 &fore_color, &back_color);
1556 if (FRAME_W32_WINDOW (f) != 0)
1557 XDefineCursor (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f), cursor);
1559 if (cursor != f->output_data.w32->text_cursor && f->output_data.w32->text_cursor != 0)
1560 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->text_cursor);
1561 f->output_data.w32->text_cursor = cursor;
1563 if (nontext_cursor != f->output_data.w32->nontext_cursor
1564 && f->output_data.w32->nontext_cursor != 0)
1565 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->nontext_cursor);
1566 f->output_data.w32->nontext_cursor = nontext_cursor;
1568 if (hourglass_cursor != f->output_data.w32->hourglass_cursor
1569 && f->output_data.w32->hourglass_cursor != 0)
1570 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->hourglass_cursor);
1571 f->output_data.w32->hourglass_cursor = hourglass_cursor;
1573 if (mode_cursor != f->output_data.w32->modeline_cursor
1574 && f->output_data.w32->modeline_cursor != 0)
1575 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->modeline_cursor);
1576 f->output_data.w32->modeline_cursor = mode_cursor;
1578 if (hand_cursor != f->output_data.w32->hand_cursor
1579 && f->output_data.w32->hand_cursor != 0)
1580 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->hand_cursor);
1581 f->output_data.w32->hand_cursor = hand_cursor;
1583 XFlush (FRAME_W32_DISPLAY (f));
1584 UNBLOCK_INPUT;
1586 update_face_from_frame_parameter (f, Qmouse_color, arg);
1587 #endif /* TODO */
1590 void
1591 x_set_cursor_color (f, arg, oldval)
1592 struct frame *f;
1593 Lisp_Object arg, oldval;
1595 unsigned long fore_pixel, pixel;
1597 if (!NILP (Vx_cursor_fore_pixel))
1598 fore_pixel = x_decode_color (f, Vx_cursor_fore_pixel,
1599 WHITE_PIX_DEFAULT (f));
1600 else
1601 fore_pixel = FRAME_BACKGROUND_PIXEL (f);
1603 pixel = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1605 /* Make sure that the cursor color differs from the background color. */
1606 if (pixel == FRAME_BACKGROUND_PIXEL (f))
1608 pixel = f->output_data.w32->mouse_pixel;
1609 if (pixel == fore_pixel)
1610 fore_pixel = FRAME_BACKGROUND_PIXEL (f);
1613 f->output_data.w32->cursor_foreground_pixel = fore_pixel;
1614 f->output_data.w32->cursor_pixel = pixel;
1616 if (FRAME_W32_WINDOW (f) != 0)
1618 BLOCK_INPUT;
1619 /* Update frame's cursor_gc. */
1620 f->output_data.w32->cursor_gc->foreground = fore_pixel;
1621 f->output_data.w32->cursor_gc->background = pixel;
1623 UNBLOCK_INPUT;
1625 if (FRAME_VISIBLE_P (f))
1627 x_update_cursor (f, 0);
1628 x_update_cursor (f, 1);
1632 update_face_from_frame_parameter (f, Qcursor_color, arg);
1635 /* Set the border-color of frame F to pixel value PIX.
1636 Note that this does not fully take effect if done before
1637 F has a window. */
1639 void
1640 x_set_border_pixel (f, pix)
1641 struct frame *f;
1642 int pix;
1645 f->output_data.w32->border_pixel = pix;
1647 if (FRAME_W32_WINDOW (f) != 0 && f->border_width > 0)
1649 if (FRAME_VISIBLE_P (f))
1650 redraw_frame (f);
1654 /* Set the border-color of frame F to value described by ARG.
1655 ARG can be a string naming a color.
1656 The border-color is used for the border that is drawn by the server.
1657 Note that this does not fully take effect if done before
1658 F has a window; it must be redone when the window is created. */
1660 void
1661 x_set_border_color (f, arg, oldval)
1662 struct frame *f;
1663 Lisp_Object arg, oldval;
1665 int pix;
1667 CHECK_STRING (arg);
1668 pix = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1669 x_set_border_pixel (f, pix);
1670 update_face_from_frame_parameter (f, Qborder_color, arg);
1674 void
1675 x_set_cursor_type (f, arg, oldval)
1676 FRAME_PTR f;
1677 Lisp_Object arg, oldval;
1679 set_frame_cursor_types (f, arg);
1681 /* Make sure the cursor gets redrawn. */
1682 cursor_type_changed = 1;
1685 void
1686 x_set_icon_type (f, arg, oldval)
1687 struct frame *f;
1688 Lisp_Object arg, oldval;
1690 int result;
1692 if (NILP (arg) && NILP (oldval))
1693 return;
1695 if (STRINGP (arg) && STRINGP (oldval)
1696 && EQ (Fstring_equal (oldval, arg), Qt))
1697 return;
1699 if (SYMBOLP (arg) && SYMBOLP (oldval) && EQ (arg, oldval))
1700 return;
1702 BLOCK_INPUT;
1704 result = x_bitmap_icon (f, arg);
1705 if (result)
1707 UNBLOCK_INPUT;
1708 error ("No icon window available");
1711 UNBLOCK_INPUT;
1714 void
1715 x_set_icon_name (f, arg, oldval)
1716 struct frame *f;
1717 Lisp_Object arg, oldval;
1719 if (STRINGP (arg))
1721 if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
1722 return;
1724 else if (!NILP (arg) || NILP (oldval))
1725 return;
1727 f->icon_name = arg;
1729 #if 0
1730 if (f->output_data.w32->icon_bitmap != 0)
1731 return;
1733 BLOCK_INPUT;
1735 result = x_text_icon (f,
1736 (char *) SDATA ((!NILP (f->icon_name)
1737 ? f->icon_name
1738 : !NILP (f->title)
1739 ? f->title
1740 : f->name)));
1742 if (result)
1744 UNBLOCK_INPUT;
1745 error ("No icon window available");
1748 /* If the window was unmapped (and its icon was mapped),
1749 the new icon is not mapped, so map the window in its stead. */
1750 if (FRAME_VISIBLE_P (f))
1752 #ifdef USE_X_TOOLKIT
1753 XtPopup (f->output_data.w32->widget, XtGrabNone);
1754 #endif
1755 XMapWindow (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f));
1758 XFlush (FRAME_W32_DISPLAY (f));
1759 UNBLOCK_INPUT;
1760 #endif
1764 void
1765 x_set_menu_bar_lines (f, value, oldval)
1766 struct frame *f;
1767 Lisp_Object value, oldval;
1769 int nlines;
1770 int olines = FRAME_MENU_BAR_LINES (f);
1772 /* Right now, menu bars don't work properly in minibuf-only frames;
1773 most of the commands try to apply themselves to the minibuffer
1774 frame itself, and get an error because you can't switch buffers
1775 in or split the minibuffer window. */
1776 if (FRAME_MINIBUF_ONLY_P (f))
1777 return;
1779 if (INTEGERP (value))
1780 nlines = XINT (value);
1781 else
1782 nlines = 0;
1784 FRAME_MENU_BAR_LINES (f) = 0;
1785 if (nlines)
1786 FRAME_EXTERNAL_MENU_BAR (f) = 1;
1787 else
1789 if (FRAME_EXTERNAL_MENU_BAR (f) == 1)
1790 free_frame_menubar (f);
1791 FRAME_EXTERNAL_MENU_BAR (f) = 0;
1793 /* Adjust the frame size so that the client (text) dimensions
1794 remain the same. This depends on FRAME_EXTERNAL_MENU_BAR being
1795 set correctly. */
1796 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
1797 do_pending_window_change (0);
1799 adjust_glyphs (f);
1803 /* Set the number of lines used for the tool bar of frame F to VALUE.
1804 VALUE not an integer, or < 0 means set the lines to zero. OLDVAL
1805 is the old number of tool bar lines. This function changes the
1806 height of all windows on frame F to match the new tool bar height.
1807 The frame's height doesn't change. */
1809 void
1810 x_set_tool_bar_lines (f, value, oldval)
1811 struct frame *f;
1812 Lisp_Object value, oldval;
1814 int delta, nlines, root_height;
1815 Lisp_Object root_window;
1817 /* Treat tool bars like menu bars. */
1818 if (FRAME_MINIBUF_ONLY_P (f))
1819 return;
1821 /* Use VALUE only if an integer >= 0. */
1822 if (INTEGERP (value) && XINT (value) >= 0)
1823 nlines = XFASTINT (value);
1824 else
1825 nlines = 0;
1827 /* Make sure we redisplay all windows in this frame. */
1828 ++windows_or_buffers_changed;
1830 delta = nlines - FRAME_TOOL_BAR_LINES (f);
1832 /* Don't resize the tool-bar to more than we have room for. */
1833 root_window = FRAME_ROOT_WINDOW (f);
1834 root_height = WINDOW_TOTAL_LINES (XWINDOW (root_window));
1835 if (root_height - delta < 1)
1837 delta = root_height - 1;
1838 nlines = FRAME_TOOL_BAR_LINES (f) + delta;
1841 FRAME_TOOL_BAR_LINES (f) = nlines;
1842 change_window_heights (root_window, delta);
1843 adjust_glyphs (f);
1845 /* We also have to make sure that the internal border at the top of
1846 the frame, below the menu bar or tool bar, is redrawn when the
1847 tool bar disappears. This is so because the internal border is
1848 below the tool bar if one is displayed, but is below the menu bar
1849 if there isn't a tool bar. The tool bar draws into the area
1850 below the menu bar. */
1851 if (FRAME_W32_WINDOW (f) && FRAME_TOOL_BAR_LINES (f) == 0)
1853 clear_frame (f);
1854 clear_current_matrices (f);
1857 /* If the tool bar gets smaller, the internal border below it
1858 has to be cleared. It was formerly part of the display
1859 of the larger tool bar, and updating windows won't clear it. */
1860 if (delta < 0)
1862 int height = FRAME_INTERNAL_BORDER_WIDTH (f);
1863 int width = FRAME_PIXEL_WIDTH (f);
1864 int y = nlines * FRAME_LINE_HEIGHT (f);
1866 BLOCK_INPUT;
1868 HDC hdc = get_frame_dc (f);
1869 w32_clear_area (f, hdc, 0, y, width, height);
1870 release_frame_dc (f, hdc);
1872 UNBLOCK_INPUT;
1874 if (WINDOWP (f->tool_bar_window))
1875 clear_glyph_matrix (XWINDOW (f->tool_bar_window)->current_matrix);
1880 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
1881 w32_id_name.
1883 If EXPLICIT is non-zero, that indicates that lisp code is setting the
1884 name; if NAME is a string, set F's name to NAME and set
1885 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
1887 If EXPLICIT is zero, that indicates that Emacs redisplay code is
1888 suggesting a new name, which lisp code should override; if
1889 F->explicit_name is set, ignore the new name; otherwise, set it. */
1891 void
1892 x_set_name (f, name, explicit)
1893 struct frame *f;
1894 Lisp_Object name;
1895 int explicit;
1897 /* Make sure that requests from lisp code override requests from
1898 Emacs redisplay code. */
1899 if (explicit)
1901 /* If we're switching from explicit to implicit, we had better
1902 update the mode lines and thereby update the title. */
1903 if (f->explicit_name && NILP (name))
1904 update_mode_lines = 1;
1906 f->explicit_name = ! NILP (name);
1908 else if (f->explicit_name)
1909 return;
1911 /* If NAME is nil, set the name to the w32_id_name. */
1912 if (NILP (name))
1914 /* Check for no change needed in this very common case
1915 before we do any consing. */
1916 if (!strcmp (FRAME_W32_DISPLAY_INFO (f)->w32_id_name,
1917 SDATA (f->name)))
1918 return;
1919 name = build_string (FRAME_W32_DISPLAY_INFO (f)->w32_id_name);
1921 else
1922 CHECK_STRING (name);
1924 /* Don't change the name if it's already NAME. */
1925 if (! NILP (Fstring_equal (name, f->name)))
1926 return;
1928 f->name = name;
1930 /* For setting the frame title, the title parameter should override
1931 the name parameter. */
1932 if (! NILP (f->title))
1933 name = f->title;
1935 if (FRAME_W32_WINDOW (f))
1937 if (STRING_MULTIBYTE (name))
1938 name = ENCODE_SYSTEM (name);
1940 BLOCK_INPUT;
1941 SetWindowText (FRAME_W32_WINDOW (f), SDATA (name));
1942 UNBLOCK_INPUT;
1946 /* This function should be called when the user's lisp code has
1947 specified a name for the frame; the name will override any set by the
1948 redisplay code. */
1949 void
1950 x_explicitly_set_name (f, arg, oldval)
1951 FRAME_PTR f;
1952 Lisp_Object arg, oldval;
1954 x_set_name (f, arg, 1);
1957 /* This function should be called by Emacs redisplay code to set the
1958 name; names set this way will never override names set by the user's
1959 lisp code. */
1960 void
1961 x_implicitly_set_name (f, arg, oldval)
1962 FRAME_PTR f;
1963 Lisp_Object arg, oldval;
1965 x_set_name (f, arg, 0);
1968 /* Change the title of frame F to NAME.
1969 If NAME is nil, use the frame name as the title. */
1971 void
1972 x_set_title (f, name, old_name)
1973 struct frame *f;
1974 Lisp_Object name, old_name;
1976 /* Don't change the title if it's already NAME. */
1977 if (EQ (name, f->title))
1978 return;
1980 update_mode_lines = 1;
1982 f->title = name;
1984 if (NILP (name))
1985 name = f->name;
1987 if (FRAME_W32_WINDOW (f))
1989 if (STRING_MULTIBYTE (name))
1990 name = ENCODE_SYSTEM (name);
1992 BLOCK_INPUT;
1993 SetWindowText (FRAME_W32_WINDOW (f), SDATA (name));
1994 UNBLOCK_INPUT;
1999 void x_set_scroll_bar_default_width (f)
2000 struct frame *f;
2002 int wid = FRAME_COLUMN_WIDTH (f);
2004 FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = GetSystemMetrics (SM_CXVSCROLL);
2005 FRAME_CONFIG_SCROLL_BAR_COLS (f) = (FRAME_CONFIG_SCROLL_BAR_WIDTH (f) +
2006 wid - 1) / wid;
2010 /* Subroutines of creating a frame. */
2013 /* Return the value of parameter PARAM.
2015 First search ALIST, then Vdefault_frame_alist, then the X defaults
2016 database, using ATTRIBUTE as the attribute name and CLASS as its class.
2018 Convert the resource to the type specified by desired_type.
2020 If no default is specified, return Qunbound. If you call
2021 w32_get_arg, make sure you deal with Qunbound in a reasonable way,
2022 and don't let it get stored in any Lisp-visible variables! */
2024 static Lisp_Object
2025 w32_get_arg (alist, param, attribute, class, type)
2026 Lisp_Object alist, param;
2027 char *attribute;
2028 char *class;
2029 enum resource_types type;
2031 return x_get_arg (check_x_display_info (Qnil),
2032 alist, param, attribute, class, type);
2036 Cursor
2037 w32_load_cursor (LPCTSTR name)
2039 /* Try first to load cursor from application resource. */
2040 Cursor cursor = LoadImage ((HINSTANCE) GetModuleHandle (NULL),
2041 name, IMAGE_CURSOR, 0, 0,
2042 LR_DEFAULTCOLOR | LR_DEFAULTSIZE | LR_SHARED);
2043 if (!cursor)
2045 /* Then try to load a shared predefined cursor. */
2046 cursor = LoadImage (NULL, name, IMAGE_CURSOR, 0, 0,
2047 LR_DEFAULTCOLOR | LR_DEFAULTSIZE | LR_SHARED);
2049 return cursor;
2052 extern LRESULT CALLBACK w32_wnd_proc ();
2054 static BOOL
2055 w32_init_class (hinst)
2056 HINSTANCE hinst;
2058 WNDCLASS wc;
2060 wc.style = CS_HREDRAW | CS_VREDRAW;
2061 wc.lpfnWndProc = (WNDPROC) w32_wnd_proc;
2062 wc.cbClsExtra = 0;
2063 wc.cbWndExtra = WND_EXTRA_BYTES;
2064 wc.hInstance = hinst;
2065 wc.hIcon = LoadIcon (hinst, EMACS_CLASS);
2066 wc.hCursor = w32_load_cursor (IDC_ARROW);
2067 wc.hbrBackground = NULL; /* GetStockObject (WHITE_BRUSH); */
2068 wc.lpszMenuName = NULL;
2069 wc.lpszClassName = EMACS_CLASS;
2071 return (RegisterClass (&wc));
2074 static HWND
2075 w32_createscrollbar (f, bar)
2076 struct frame *f;
2077 struct scroll_bar * bar;
2079 return (CreateWindow ("SCROLLBAR", "", SBS_VERT | WS_CHILD | WS_VISIBLE,
2080 /* Position and size of scroll bar. */
2081 XINT (bar->left) + VERTICAL_SCROLL_BAR_WIDTH_TRIM,
2082 XINT (bar->top),
2083 XINT (bar->width) - VERTICAL_SCROLL_BAR_WIDTH_TRIM * 2,
2084 XINT (bar->height),
2085 FRAME_W32_WINDOW (f),
2086 NULL,
2087 hinst,
2088 NULL));
2091 static void
2092 w32_createwindow (f)
2093 struct frame *f;
2095 HWND hwnd;
2096 RECT rect;
2097 Lisp_Object top = Qunbound;
2098 Lisp_Object left = Qunbound;
2100 rect.left = rect.top = 0;
2101 rect.right = FRAME_PIXEL_WIDTH (f);
2102 rect.bottom = FRAME_PIXEL_HEIGHT (f);
2104 AdjustWindowRect (&rect, f->output_data.w32->dwStyle,
2105 FRAME_EXTERNAL_MENU_BAR (f));
2107 /* Do first time app init */
2109 if (!hprevinst)
2111 w32_init_class (hinst);
2114 if (f->size_hint_flags & USPosition || f->size_hint_flags & PPosition)
2116 XSETINT (left, f->left_pos);
2117 XSETINT (top, f->top_pos);
2119 else if (EQ (left, Qunbound) && EQ (top, Qunbound))
2121 /* When called with RES_TYPE_NUMBER, w32_get_arg will return zero
2122 for anything that is not a number and is not Qunbound. */
2123 left = w32_get_arg (Qnil, Qleft, "left", "Left", RES_TYPE_NUMBER);
2124 top = w32_get_arg (Qnil, Qtop, "top", "Top", RES_TYPE_NUMBER);
2127 FRAME_W32_WINDOW (f) = hwnd
2128 = CreateWindow (EMACS_CLASS,
2129 f->namebuf,
2130 f->output_data.w32->dwStyle | WS_CLIPCHILDREN,
2131 EQ (left, Qunbound) ? CW_USEDEFAULT : XINT (left),
2132 EQ (top, Qunbound) ? CW_USEDEFAULT : XINT (top),
2133 rect.right - rect.left,
2134 rect.bottom - rect.top,
2135 NULL,
2136 NULL,
2137 hinst,
2138 NULL);
2140 if (hwnd)
2142 SetWindowLong (hwnd, WND_FONTWIDTH_INDEX, FRAME_COLUMN_WIDTH (f));
2143 SetWindowLong (hwnd, WND_LINEHEIGHT_INDEX, FRAME_LINE_HEIGHT (f));
2144 SetWindowLong (hwnd, WND_BORDER_INDEX, FRAME_INTERNAL_BORDER_WIDTH (f));
2145 SetWindowLong (hwnd, WND_SCROLLBAR_INDEX, f->scroll_bar_actual_width);
2146 SetWindowLong (hwnd, WND_BACKGROUND_INDEX, FRAME_BACKGROUND_PIXEL (f));
2148 /* Enable drag-n-drop. */
2149 DragAcceptFiles (hwnd, TRUE);
2151 /* Do this to discard the default setting specified by our parent. */
2152 ShowWindow (hwnd, SW_HIDE);
2154 /* Update frame positions. */
2155 GetWindowRect (hwnd, &rect);
2156 f->left_pos = rect.left;
2157 f->top_pos = rect.top;
2161 static void
2162 my_post_msg (wmsg, hwnd, msg, wParam, lParam)
2163 W32Msg * wmsg;
2164 HWND hwnd;
2165 UINT msg;
2166 WPARAM wParam;
2167 LPARAM lParam;
2169 wmsg->msg.hwnd = hwnd;
2170 wmsg->msg.message = msg;
2171 wmsg->msg.wParam = wParam;
2172 wmsg->msg.lParam = lParam;
2173 wmsg->msg.time = GetMessageTime ();
2175 post_msg (wmsg);
2178 /* GetKeyState and MapVirtualKey on Windows 95 do not actually distinguish
2179 between left and right keys as advertised. We test for this
2180 support dynamically, and set a flag when the support is absent. If
2181 absent, we keep track of the left and right control and alt keys
2182 ourselves. This is particularly necessary on keyboards that rely
2183 upon the AltGr key, which is represented as having the left control
2184 and right alt keys pressed. For these keyboards, we need to know
2185 when the left alt key has been pressed in addition to the AltGr key
2186 so that we can properly support M-AltGr-key sequences (such as M-@
2187 on Swedish keyboards). */
2189 #define EMACS_LCONTROL 0
2190 #define EMACS_RCONTROL 1
2191 #define EMACS_LMENU 2
2192 #define EMACS_RMENU 3
2194 static int modifiers[4];
2195 static int modifiers_recorded;
2196 static int modifier_key_support_tested;
2198 static void
2199 test_modifier_support (unsigned int wparam)
2201 unsigned int l, r;
2203 if (wparam != VK_CONTROL && wparam != VK_MENU)
2204 return;
2205 if (wparam == VK_CONTROL)
2207 l = VK_LCONTROL;
2208 r = VK_RCONTROL;
2210 else
2212 l = VK_LMENU;
2213 r = VK_RMENU;
2215 if (!(GetKeyState (l) & 0x8000) && !(GetKeyState (r) & 0x8000))
2216 modifiers_recorded = 1;
2217 else
2218 modifiers_recorded = 0;
2219 modifier_key_support_tested = 1;
2222 static void
2223 record_keydown (unsigned int wparam, unsigned int lparam)
2225 int i;
2227 if (!modifier_key_support_tested)
2228 test_modifier_support (wparam);
2230 if ((wparam != VK_CONTROL && wparam != VK_MENU) || !modifiers_recorded)
2231 return;
2233 if (wparam == VK_CONTROL)
2234 i = (lparam & 0x1000000) ? EMACS_RCONTROL : EMACS_LCONTROL;
2235 else
2236 i = (lparam & 0x1000000) ? EMACS_RMENU : EMACS_LMENU;
2238 modifiers[i] = 1;
2241 static void
2242 record_keyup (unsigned int wparam, unsigned int lparam)
2244 int i;
2246 if ((wparam != VK_CONTROL && wparam != VK_MENU) || !modifiers_recorded)
2247 return;
2249 if (wparam == VK_CONTROL)
2250 i = (lparam & 0x1000000) ? EMACS_RCONTROL : EMACS_LCONTROL;
2251 else
2252 i = (lparam & 0x1000000) ? EMACS_RMENU : EMACS_LMENU;
2254 modifiers[i] = 0;
2257 /* Emacs can lose focus while a modifier key has been pressed. When
2258 it regains focus, be conservative and clear all modifiers since
2259 we cannot reconstruct the left and right modifier state. */
2260 static void
2261 reset_modifiers ()
2263 SHORT ctrl, alt;
2265 if (GetFocus () == NULL)
2266 /* Emacs doesn't have keyboard focus. Do nothing. */
2267 return;
2269 ctrl = GetAsyncKeyState (VK_CONTROL);
2270 alt = GetAsyncKeyState (VK_MENU);
2272 if (!(ctrl & 0x08000))
2273 /* Clear any recorded control modifier state. */
2274 modifiers[EMACS_RCONTROL] = modifiers[EMACS_LCONTROL] = 0;
2276 if (!(alt & 0x08000))
2277 /* Clear any recorded alt modifier state. */
2278 modifiers[EMACS_RMENU] = modifiers[EMACS_LMENU] = 0;
2280 /* Update the state of all modifier keys, because modifiers used in
2281 hot-key combinations can get stuck on if Emacs loses focus as a
2282 result of a hot-key being pressed. */
2284 BYTE keystate[256];
2286 #define CURRENT_STATE(key) ((GetAsyncKeyState (key) & 0x8000) >> 8)
2288 GetKeyboardState (keystate);
2289 keystate[VK_SHIFT] = CURRENT_STATE (VK_SHIFT);
2290 keystate[VK_CONTROL] = CURRENT_STATE (VK_CONTROL);
2291 keystate[VK_LCONTROL] = CURRENT_STATE (VK_LCONTROL);
2292 keystate[VK_RCONTROL] = CURRENT_STATE (VK_RCONTROL);
2293 keystate[VK_MENU] = CURRENT_STATE (VK_MENU);
2294 keystate[VK_LMENU] = CURRENT_STATE (VK_LMENU);
2295 keystate[VK_RMENU] = CURRENT_STATE (VK_RMENU);
2296 keystate[VK_LWIN] = CURRENT_STATE (VK_LWIN);
2297 keystate[VK_RWIN] = CURRENT_STATE (VK_RWIN);
2298 keystate[VK_APPS] = CURRENT_STATE (VK_APPS);
2299 SetKeyboardState (keystate);
2303 /* Synchronize modifier state with what is reported with the current
2304 keystroke. Even if we cannot distinguish between left and right
2305 modifier keys, we know that, if no modifiers are set, then neither
2306 the left or right modifier should be set. */
2307 static void
2308 sync_modifiers ()
2310 if (!modifiers_recorded)
2311 return;
2313 if (!(GetKeyState (VK_CONTROL) & 0x8000))
2314 modifiers[EMACS_RCONTROL] = modifiers[EMACS_LCONTROL] = 0;
2316 if (!(GetKeyState (VK_MENU) & 0x8000))
2317 modifiers[EMACS_RMENU] = modifiers[EMACS_LMENU] = 0;
2320 static int
2321 modifier_set (int vkey)
2323 if (vkey == VK_CAPITAL || vkey == VK_SCROLL)
2324 return (GetKeyState (vkey) & 0x1);
2325 if (!modifiers_recorded)
2326 return (GetKeyState (vkey) & 0x8000);
2328 switch (vkey)
2330 case VK_LCONTROL:
2331 return modifiers[EMACS_LCONTROL];
2332 case VK_RCONTROL:
2333 return modifiers[EMACS_RCONTROL];
2334 case VK_LMENU:
2335 return modifiers[EMACS_LMENU];
2336 case VK_RMENU:
2337 return modifiers[EMACS_RMENU];
2339 return (GetKeyState (vkey) & 0x8000);
2342 /* Convert between the modifier bits W32 uses and the modifier bits
2343 Emacs uses. */
2345 unsigned int
2346 w32_key_to_modifier (int key)
2348 Lisp_Object key_mapping;
2350 switch (key)
2352 case VK_LWIN:
2353 key_mapping = Vw32_lwindow_modifier;
2354 break;
2355 case VK_RWIN:
2356 key_mapping = Vw32_rwindow_modifier;
2357 break;
2358 case VK_APPS:
2359 key_mapping = Vw32_apps_modifier;
2360 break;
2361 case VK_SCROLL:
2362 key_mapping = Vw32_scroll_lock_modifier;
2363 break;
2364 default:
2365 key_mapping = Qnil;
2368 /* NB. This code runs in the input thread, asychronously to the lisp
2369 thread, so we must be careful to ensure access to lisp data is
2370 thread-safe. The following code is safe because the modifier
2371 variable values are updated atomically from lisp and symbols are
2372 not relocated by GC. Also, we don't have to worry about seeing GC
2373 markbits here. */
2374 if (EQ (key_mapping, Qhyper))
2375 return hyper_modifier;
2376 if (EQ (key_mapping, Qsuper))
2377 return super_modifier;
2378 if (EQ (key_mapping, Qmeta))
2379 return meta_modifier;
2380 if (EQ (key_mapping, Qalt))
2381 return alt_modifier;
2382 if (EQ (key_mapping, Qctrl))
2383 return ctrl_modifier;
2384 if (EQ (key_mapping, Qcontrol)) /* synonym for ctrl */
2385 return ctrl_modifier;
2386 if (EQ (key_mapping, Qshift))
2387 return shift_modifier;
2389 /* Don't generate any modifier if not explicitly requested. */
2390 return 0;
2393 static unsigned int
2394 w32_get_modifiers ()
2396 return ((modifier_set (VK_SHIFT) ? shift_modifier : 0) |
2397 (modifier_set (VK_CONTROL) ? ctrl_modifier : 0) |
2398 (modifier_set (VK_LWIN) ? w32_key_to_modifier (VK_LWIN) : 0) |
2399 (modifier_set (VK_RWIN) ? w32_key_to_modifier (VK_RWIN) : 0) |
2400 (modifier_set (VK_APPS) ? w32_key_to_modifier (VK_APPS) : 0) |
2401 (modifier_set (VK_SCROLL) ? w32_key_to_modifier (VK_SCROLL) : 0) |
2402 (modifier_set (VK_MENU) ?
2403 ((NILP (Vw32_alt_is_meta)) ? alt_modifier : meta_modifier) : 0));
2406 /* We map the VK_* modifiers into console modifier constants
2407 so that we can use the same routines to handle both console
2408 and window input. */
2410 static int
2411 construct_console_modifiers ()
2413 int mods;
2415 mods = 0;
2416 mods |= (modifier_set (VK_SHIFT)) ? SHIFT_PRESSED : 0;
2417 mods |= (modifier_set (VK_CAPITAL)) ? CAPSLOCK_ON : 0;
2418 mods |= (modifier_set (VK_SCROLL)) ? SCROLLLOCK_ON : 0;
2419 mods |= (modifier_set (VK_NUMLOCK)) ? NUMLOCK_ON : 0;
2420 mods |= (modifier_set (VK_LCONTROL)) ? LEFT_CTRL_PRESSED : 0;
2421 mods |= (modifier_set (VK_RCONTROL)) ? RIGHT_CTRL_PRESSED : 0;
2422 mods |= (modifier_set (VK_LMENU)) ? LEFT_ALT_PRESSED : 0;
2423 mods |= (modifier_set (VK_RMENU)) ? RIGHT_ALT_PRESSED : 0;
2424 mods |= (modifier_set (VK_LWIN)) ? LEFT_WIN_PRESSED : 0;
2425 mods |= (modifier_set (VK_RWIN)) ? RIGHT_WIN_PRESSED : 0;
2426 mods |= (modifier_set (VK_APPS)) ? APPS_PRESSED : 0;
2428 return mods;
2431 static int
2432 w32_get_key_modifiers (unsigned int wparam, unsigned int lparam)
2434 int mods;
2436 /* Convert to emacs modifiers. */
2437 mods = w32_kbd_mods_to_emacs (construct_console_modifiers (), wparam);
2439 return mods;
2442 unsigned int
2443 map_keypad_keys (unsigned int virt_key, unsigned int extended)
2445 if (virt_key < VK_CLEAR || virt_key > VK_DELETE)
2446 return virt_key;
2448 if (virt_key == VK_RETURN)
2449 return (extended ? VK_NUMPAD_ENTER : VK_RETURN);
2451 if (virt_key >= VK_PRIOR && virt_key <= VK_DOWN)
2452 return (!extended ? (VK_NUMPAD_PRIOR + (virt_key - VK_PRIOR)) : virt_key);
2454 if (virt_key == VK_INSERT || virt_key == VK_DELETE)
2455 return (!extended ? (VK_NUMPAD_INSERT + (virt_key - VK_INSERT)) : virt_key);
2457 if (virt_key == VK_CLEAR)
2458 return (!extended ? VK_NUMPAD_CLEAR : virt_key);
2460 return virt_key;
2463 /* List of special key combinations which w32 would normally capture,
2464 but Emacs should grab instead. Not directly visible to lisp, to
2465 simplify synchronization. Each item is an integer encoding a virtual
2466 key code and modifier combination to capture. */
2467 static Lisp_Object w32_grabbed_keys;
2469 #define HOTKEY(vk, mods) make_number (((vk) & 255) | ((mods) << 8))
2470 #define HOTKEY_ID(k) (XFASTINT (k) & 0xbfff)
2471 #define HOTKEY_VK_CODE(k) (XFASTINT (k) & 255)
2472 #define HOTKEY_MODIFIERS(k) (XFASTINT (k) >> 8)
2474 #define RAW_HOTKEY_ID(k) ((k) & 0xbfff)
2475 #define RAW_HOTKEY_VK_CODE(k) ((k) & 255)
2476 #define RAW_HOTKEY_MODIFIERS(k) ((k) >> 8)
2478 /* Register hot-keys for reserved key combinations when Emacs has
2479 keyboard focus, since this is the only way Emacs can receive key
2480 combinations like Alt-Tab which are used by the system. */
2482 static void
2483 register_hot_keys (hwnd)
2484 HWND hwnd;
2486 Lisp_Object keylist;
2488 /* Use CONSP, since we are called asynchronously. */
2489 for (keylist = w32_grabbed_keys; CONSP (keylist); keylist = XCDR (keylist))
2491 Lisp_Object key = XCAR (keylist);
2493 /* Deleted entries get set to nil. */
2494 if (!INTEGERP (key))
2495 continue;
2497 RegisterHotKey (hwnd, HOTKEY_ID (key),
2498 HOTKEY_MODIFIERS (key), HOTKEY_VK_CODE (key));
2502 static void
2503 unregister_hot_keys (hwnd)
2504 HWND hwnd;
2506 Lisp_Object keylist;
2508 for (keylist = w32_grabbed_keys; CONSP (keylist); keylist = XCDR (keylist))
2510 Lisp_Object key = XCAR (keylist);
2512 if (!INTEGERP (key))
2513 continue;
2515 UnregisterHotKey (hwnd, HOTKEY_ID (key));
2519 /* Main message dispatch loop. */
2521 static void
2522 w32_msg_pump (deferred_msg * msg_buf)
2524 MSG msg;
2525 int result;
2526 HWND focus_window;
2528 msh_mousewheel = RegisterWindowMessage (MSH_MOUSEWHEEL);
2530 while (GetMessage (&msg, NULL, 0, 0))
2532 if (msg.hwnd == NULL)
2534 switch (msg.message)
2536 case WM_NULL:
2537 /* Produced by complete_deferred_msg; just ignore. */
2538 break;
2539 case WM_EMACS_CREATEWINDOW:
2540 /* Initialize COM for this window. Even though we don't use it,
2541 some third party shell extensions can cause it to be used in
2542 system dialogs, which causes a crash if it is not initialized.
2543 This is a known bug in Windows, which was fixed long ago, but
2544 the patch for XP is not publically available until XP SP3,
2545 and older versions will never be patched. */
2546 CoInitialize (NULL);
2547 w32_createwindow ((struct frame *) msg.wParam);
2548 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE, 0, 0))
2549 abort ();
2550 break;
2551 case WM_EMACS_SETLOCALE:
2552 SetThreadLocale (msg.wParam);
2553 /* Reply is not expected. */
2554 break;
2555 case WM_EMACS_SETKEYBOARDLAYOUT:
2556 result = (int) ActivateKeyboardLayout ((HKL) msg.wParam, 0);
2557 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE,
2558 result, 0))
2559 abort ();
2560 break;
2561 case WM_EMACS_REGISTER_HOT_KEY:
2562 focus_window = GetFocus ();
2563 if (focus_window != NULL)
2564 RegisterHotKey (focus_window,
2565 RAW_HOTKEY_ID (msg.wParam),
2566 RAW_HOTKEY_MODIFIERS (msg.wParam),
2567 RAW_HOTKEY_VK_CODE (msg.wParam));
2568 /* Reply is not expected. */
2569 break;
2570 case WM_EMACS_UNREGISTER_HOT_KEY:
2571 focus_window = GetFocus ();
2572 if (focus_window != NULL)
2573 UnregisterHotKey (focus_window, RAW_HOTKEY_ID (msg.wParam));
2574 /* Mark item as erased. NB: this code must be
2575 thread-safe. The next line is okay because the cons
2576 cell is never made into garbage and is not relocated by
2577 GC. */
2578 XSETCAR ((Lisp_Object) ((EMACS_INT) msg.lParam), Qnil);
2579 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE, 0, 0))
2580 abort ();
2581 break;
2582 case WM_EMACS_TOGGLE_LOCK_KEY:
2584 int vk_code = (int) msg.wParam;
2585 int cur_state = (GetKeyState (vk_code) & 1);
2586 Lisp_Object new_state = (Lisp_Object) ((EMACS_INT) msg.lParam);
2588 /* NB: This code must be thread-safe. It is safe to
2589 call NILP because symbols are not relocated by GC,
2590 and pointer here is not touched by GC (so the markbit
2591 can't be set). Numbers are safe because they are
2592 immediate values. */
2593 if (NILP (new_state)
2594 || (NUMBERP (new_state)
2595 && ((XUINT (new_state)) & 1) != cur_state))
2597 one_w32_display_info.faked_key = vk_code;
2599 keybd_event ((BYTE) vk_code,
2600 (BYTE) MapVirtualKey (vk_code, 0),
2601 KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
2602 keybd_event ((BYTE) vk_code,
2603 (BYTE) MapVirtualKey (vk_code, 0),
2604 KEYEVENTF_EXTENDEDKEY | 0, 0);
2605 keybd_event ((BYTE) vk_code,
2606 (BYTE) MapVirtualKey (vk_code, 0),
2607 KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
2608 cur_state = !cur_state;
2610 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE,
2611 cur_state, 0))
2612 abort ();
2614 break;
2615 #ifdef MSG_DEBUG
2616 /* Broadcast messages make it here, so you need to be looking
2617 for something in particular for this to be useful. */
2618 default:
2619 DebPrint (("msg %x not expected by w32_msg_pump\n", msg.message));
2620 #endif
2623 else
2625 DispatchMessage (&msg);
2628 /* Exit nested loop when our deferred message has completed. */
2629 if (msg_buf->completed)
2630 break;
2634 deferred_msg * deferred_msg_head;
2636 static deferred_msg *
2637 find_deferred_msg (HWND hwnd, UINT msg)
2639 deferred_msg * item;
2641 /* Don't actually need synchronization for read access, since
2642 modification of single pointer is always atomic. */
2643 /* enter_crit (); */
2645 for (item = deferred_msg_head; item != NULL; item = item->next)
2646 if (item->w32msg.msg.hwnd == hwnd
2647 && item->w32msg.msg.message == msg)
2648 break;
2650 /* leave_crit (); */
2652 return item;
2655 static LRESULT
2656 send_deferred_msg (deferred_msg * msg_buf,
2657 HWND hwnd,
2658 UINT msg,
2659 WPARAM wParam,
2660 LPARAM lParam)
2662 /* Only input thread can send deferred messages. */
2663 if (GetCurrentThreadId () != dwWindowsThreadId)
2664 abort ();
2666 /* It is an error to send a message that is already deferred. */
2667 if (find_deferred_msg (hwnd, msg) != NULL)
2668 abort ();
2670 /* Enforced synchronization is not needed because this is the only
2671 function that alters deferred_msg_head, and the following critical
2672 section is guaranteed to only be serially reentered (since only the
2673 input thread can call us). */
2675 /* enter_crit (); */
2677 msg_buf->completed = 0;
2678 msg_buf->next = deferred_msg_head;
2679 deferred_msg_head = msg_buf;
2680 my_post_msg (&msg_buf->w32msg, hwnd, msg, wParam, lParam);
2682 /* leave_crit (); */
2684 /* Start a new nested message loop to process other messages until
2685 this one is completed. */
2686 w32_msg_pump (msg_buf);
2688 deferred_msg_head = msg_buf->next;
2690 return msg_buf->result;
2693 void
2694 complete_deferred_msg (HWND hwnd, UINT msg, LRESULT result)
2696 deferred_msg * msg_buf = find_deferred_msg (hwnd, msg);
2698 if (msg_buf == NULL)
2699 /* Message may have been cancelled, so don't abort. */
2700 return;
2702 msg_buf->result = result;
2703 msg_buf->completed = 1;
2705 /* Ensure input thread is woken so it notices the completion. */
2706 PostThreadMessage (dwWindowsThreadId, WM_NULL, 0, 0);
2709 static void
2710 cancel_all_deferred_msgs ()
2712 deferred_msg * item;
2714 /* Don't actually need synchronization for read access, since
2715 modification of single pointer is always atomic. */
2716 /* enter_crit (); */
2718 for (item = deferred_msg_head; item != NULL; item = item->next)
2720 item->result = 0;
2721 item->completed = 1;
2724 /* leave_crit (); */
2726 /* Ensure input thread is woken so it notices the completion. */
2727 PostThreadMessage (dwWindowsThreadId, WM_NULL, 0, 0);
2730 DWORD WINAPI
2731 w32_msg_worker (void *arg)
2733 MSG msg;
2734 deferred_msg dummy_buf;
2736 /* Ensure our message queue is created */
2738 PeekMessage (&msg, NULL, 0, 0, PM_NOREMOVE);
2740 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE, 0, 0))
2741 abort ();
2743 memset (&dummy_buf, 0, sizeof (dummy_buf));
2744 dummy_buf.w32msg.msg.hwnd = NULL;
2745 dummy_buf.w32msg.msg.message = WM_NULL;
2747 /* This is the inital message loop which should only exit when the
2748 application quits. */
2749 w32_msg_pump (&dummy_buf);
2751 return 0;
2754 static void
2755 signal_user_input ()
2757 /* Interrupt any lisp that wants to be interrupted by input. */
2758 if (!NILP (Vthrow_on_input))
2760 Vquit_flag = Vthrow_on_input;
2761 /* If we're inside a function that wants immediate quits,
2762 do it now. */
2763 if (immediate_quit && NILP (Vinhibit_quit))
2765 immediate_quit = 0;
2766 QUIT;
2772 static void
2773 post_character_message (hwnd, msg, wParam, lParam, modifiers)
2774 HWND hwnd;
2775 UINT msg;
2776 WPARAM wParam;
2777 LPARAM lParam;
2778 DWORD modifiers;
2781 W32Msg wmsg;
2783 wmsg.dwModifiers = modifiers;
2785 /* Detect quit_char and set quit-flag directly. Note that we
2786 still need to post a message to ensure the main thread will be
2787 woken up if blocked in sys_select, but we do NOT want to post
2788 the quit_char message itself (because it will usually be as if
2789 the user had typed quit_char twice). Instead, we post a dummy
2790 message that has no particular effect. */
2792 int c = wParam;
2793 if (isalpha (c) && wmsg.dwModifiers == ctrl_modifier)
2794 c = make_ctrl_char (c) & 0377;
2795 if (c == quit_char
2796 || (wmsg.dwModifiers == 0 &&
2797 w32_quit_key && wParam == w32_quit_key))
2799 Vquit_flag = Qt;
2801 /* The choice of message is somewhat arbitrary, as long as
2802 the main thread handler just ignores it. */
2803 msg = WM_NULL;
2805 /* Interrupt any blocking system calls. */
2806 signal_quit ();
2808 /* As a safety precaution, forcibly complete any deferred
2809 messages. This is a kludge, but I don't see any particularly
2810 clean way to handle the situation where a deferred message is
2811 "dropped" in the lisp thread, and will thus never be
2812 completed, eg. by the user trying to activate the menubar
2813 when the lisp thread is busy, and then typing C-g when the
2814 menubar doesn't open promptly (with the result that the
2815 menubar never responds at all because the deferred
2816 WM_INITMENU message is never completed). Another problem
2817 situation is when the lisp thread calls SendMessage (to send
2818 a window manager command) when a message has been deferred;
2819 the lisp thread gets blocked indefinitely waiting for the
2820 deferred message to be completed, which itself is waiting for
2821 the lisp thread to respond.
2823 Note that we don't want to block the input thread waiting for
2824 a reponse from the lisp thread (although that would at least
2825 solve the deadlock problem above), because we want to be able
2826 to receive C-g to interrupt the lisp thread. */
2827 cancel_all_deferred_msgs ();
2829 else
2830 signal_user_input ();
2833 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
2836 /* Main window procedure */
2838 LRESULT CALLBACK
2839 w32_wnd_proc (hwnd, msg, wParam, lParam)
2840 HWND hwnd;
2841 UINT msg;
2842 WPARAM wParam;
2843 LPARAM lParam;
2845 struct frame *f;
2846 struct w32_display_info *dpyinfo = &one_w32_display_info;
2847 W32Msg wmsg;
2848 int windows_translate;
2849 int key;
2851 /* Note that it is okay to call x_window_to_frame, even though we are
2852 not running in the main lisp thread, because frame deletion
2853 requires the lisp thread to synchronize with this thread. Thus, if
2854 a frame struct is returned, it can be used without concern that the
2855 lisp thread might make it disappear while we are using it.
2857 NB. Walking the frame list in this thread is safe (as long as
2858 writes of Lisp_Object slots are atomic, which they are on Windows).
2859 Although delete-frame can destructively modify the frame list while
2860 we are walking it, a garbage collection cannot occur until after
2861 delete-frame has synchronized with this thread.
2863 It is also safe to use functions that make GDI calls, such as
2864 w32_clear_rect, because these functions must obtain a DC handle
2865 from the frame struct using get_frame_dc which is thread-aware. */
2867 switch (msg)
2869 case WM_ERASEBKGND:
2870 f = x_window_to_frame (dpyinfo, hwnd);
2871 if (f)
2873 HDC hdc = get_frame_dc (f);
2874 GetUpdateRect (hwnd, &wmsg.rect, FALSE);
2875 w32_clear_rect (f, hdc, &wmsg.rect);
2876 release_frame_dc (f, hdc);
2878 #if defined (W32_DEBUG_DISPLAY)
2879 DebPrint (("WM_ERASEBKGND (frame %p): erasing %d,%d-%d,%d\n",
2881 wmsg.rect.left, wmsg.rect.top,
2882 wmsg.rect.right, wmsg.rect.bottom));
2883 #endif /* W32_DEBUG_DISPLAY */
2885 return 1;
2886 case WM_PALETTECHANGED:
2887 /* ignore our own changes */
2888 if ((HWND)wParam != hwnd)
2890 f = x_window_to_frame (dpyinfo, hwnd);
2891 if (f)
2892 /* get_frame_dc will realize our palette and force all
2893 frames to be redrawn if needed. */
2894 release_frame_dc (f, get_frame_dc (f));
2896 return 0;
2897 case WM_PAINT:
2899 PAINTSTRUCT paintStruct;
2900 RECT update_rect;
2901 bzero (&update_rect, sizeof (update_rect));
2903 f = x_window_to_frame (dpyinfo, hwnd);
2904 if (f == 0)
2906 DebPrint (("WM_PAINT received for unknown window %p\n", hwnd));
2907 return 0;
2910 /* MSDN Docs say not to call BeginPaint if GetUpdateRect
2911 fails. Apparently this can happen under some
2912 circumstances. */
2913 if (GetUpdateRect (hwnd, &update_rect, FALSE) || !w32_strict_painting)
2915 enter_crit ();
2916 BeginPaint (hwnd, &paintStruct);
2918 /* The rectangles returned by GetUpdateRect and BeginPaint
2919 do not always match. Play it safe by assuming both areas
2920 are invalid. */
2921 UnionRect (&(wmsg.rect), &update_rect, &(paintStruct.rcPaint));
2923 #if defined (W32_DEBUG_DISPLAY)
2924 DebPrint (("WM_PAINT (frame %p): painting %d,%d-%d,%d\n",
2926 wmsg.rect.left, wmsg.rect.top,
2927 wmsg.rect.right, wmsg.rect.bottom));
2928 DebPrint ((" [update region is %d,%d-%d,%d]\n",
2929 update_rect.left, update_rect.top,
2930 update_rect.right, update_rect.bottom));
2931 #endif
2932 EndPaint (hwnd, &paintStruct);
2933 leave_crit ();
2935 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
2937 return 0;
2940 /* If GetUpdateRect returns 0 (meaning there is no update
2941 region), assume the whole window needs to be repainted. */
2942 GetClientRect (hwnd, &wmsg.rect);
2943 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
2944 return 0;
2947 case WM_INPUTLANGCHANGE:
2948 /* Inform lisp thread of keyboard layout changes. */
2949 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
2951 /* Clear dead keys in the keyboard state; for simplicity only
2952 preserve modifier key states. */
2954 int i;
2955 BYTE keystate[256];
2957 GetKeyboardState (keystate);
2958 for (i = 0; i < 256; i++)
2959 if (1
2960 && i != VK_SHIFT
2961 && i != VK_LSHIFT
2962 && i != VK_RSHIFT
2963 && i != VK_CAPITAL
2964 && i != VK_NUMLOCK
2965 && i != VK_SCROLL
2966 && i != VK_CONTROL
2967 && i != VK_LCONTROL
2968 && i != VK_RCONTROL
2969 && i != VK_MENU
2970 && i != VK_LMENU
2971 && i != VK_RMENU
2972 && i != VK_LWIN
2973 && i != VK_RWIN)
2974 keystate[i] = 0;
2975 SetKeyboardState (keystate);
2977 goto dflt;
2979 case WM_HOTKEY:
2980 /* Synchronize hot keys with normal input. */
2981 PostMessage (hwnd, WM_KEYDOWN, HIWORD (lParam), 0);
2982 return (0);
2984 case WM_KEYUP:
2985 case WM_SYSKEYUP:
2986 record_keyup (wParam, lParam);
2987 goto dflt;
2989 case WM_KEYDOWN:
2990 case WM_SYSKEYDOWN:
2991 /* Ignore keystrokes we fake ourself; see below. */
2992 if (dpyinfo->faked_key == wParam)
2994 dpyinfo->faked_key = 0;
2995 /* Make sure TranslateMessage sees them though (as long as
2996 they don't produce WM_CHAR messages). This ensures that
2997 indicator lights are toggled promptly on Windows 9x, for
2998 example. */
2999 if (wParam < 256 && lispy_function_keys[wParam])
3001 windows_translate = 1;
3002 goto translate;
3004 return 0;
3007 /* Synchronize modifiers with current keystroke. */
3008 sync_modifiers ();
3009 record_keydown (wParam, lParam);
3010 wParam = map_keypad_keys (wParam, (lParam & 0x1000000L) != 0);
3012 windows_translate = 0;
3014 switch (wParam)
3016 case VK_LWIN:
3017 if (NILP (Vw32_pass_lwindow_to_system))
3019 /* Prevent system from acting on keyup (which opens the
3020 Start menu if no other key was pressed) by simulating a
3021 press of Space which we will ignore. */
3022 if (GetAsyncKeyState (wParam) & 1)
3024 if (NUMBERP (Vw32_phantom_key_code))
3025 key = XUINT (Vw32_phantom_key_code) & 255;
3026 else
3027 key = VK_SPACE;
3028 dpyinfo->faked_key = key;
3029 keybd_event (key, (BYTE) MapVirtualKey (key, 0), 0, 0);
3032 if (!NILP (Vw32_lwindow_modifier))
3033 return 0;
3034 break;
3035 case VK_RWIN:
3036 if (NILP (Vw32_pass_rwindow_to_system))
3038 if (GetAsyncKeyState (wParam) & 1)
3040 if (NUMBERP (Vw32_phantom_key_code))
3041 key = XUINT (Vw32_phantom_key_code) & 255;
3042 else
3043 key = VK_SPACE;
3044 dpyinfo->faked_key = key;
3045 keybd_event (key, (BYTE) MapVirtualKey (key, 0), 0, 0);
3048 if (!NILP (Vw32_rwindow_modifier))
3049 return 0;
3050 break;
3051 case VK_APPS:
3052 if (!NILP (Vw32_apps_modifier))
3053 return 0;
3054 break;
3055 case VK_MENU:
3056 if (NILP (Vw32_pass_alt_to_system))
3057 /* Prevent DefWindowProc from activating the menu bar if an
3058 Alt key is pressed and released by itself. */
3059 return 0;
3060 windows_translate = 1;
3061 break;
3062 case VK_CAPITAL:
3063 /* Decide whether to treat as modifier or function key. */
3064 if (NILP (Vw32_enable_caps_lock))
3065 goto disable_lock_key;
3066 windows_translate = 1;
3067 break;
3068 case VK_NUMLOCK:
3069 /* Decide whether to treat as modifier or function key. */
3070 if (NILP (Vw32_enable_num_lock))
3071 goto disable_lock_key;
3072 windows_translate = 1;
3073 break;
3074 case VK_SCROLL:
3075 /* Decide whether to treat as modifier or function key. */
3076 if (NILP (Vw32_scroll_lock_modifier))
3077 goto disable_lock_key;
3078 windows_translate = 1;
3079 break;
3080 disable_lock_key:
3081 /* Ensure the appropriate lock key state (and indicator light)
3082 remains in the same state. We do this by faking another
3083 press of the relevant key. Apparently, this really is the
3084 only way to toggle the state of the indicator lights. */
3085 dpyinfo->faked_key = wParam;
3086 keybd_event ((BYTE) wParam, (BYTE) MapVirtualKey (wParam, 0),
3087 KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
3088 keybd_event ((BYTE) wParam, (BYTE) MapVirtualKey (wParam, 0),
3089 KEYEVENTF_EXTENDEDKEY | 0, 0);
3090 keybd_event ((BYTE) wParam, (BYTE) MapVirtualKey (wParam, 0),
3091 KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
3092 /* Ensure indicator lights are updated promptly on Windows 9x
3093 (TranslateMessage apparently does this), after forwarding
3094 input event. */
3095 post_character_message (hwnd, msg, wParam, lParam,
3096 w32_get_key_modifiers (wParam, lParam));
3097 windows_translate = 1;
3098 break;
3099 case VK_CONTROL:
3100 case VK_SHIFT:
3101 case VK_PROCESSKEY: /* Generated by IME. */
3102 windows_translate = 1;
3103 break;
3104 case VK_CANCEL:
3105 /* Windows maps Ctrl-Pause (aka Ctrl-Break) into VK_CANCEL,
3106 which is confusing for purposes of key binding; convert
3107 VK_CANCEL events into VK_PAUSE events. */
3108 wParam = VK_PAUSE;
3109 break;
3110 case VK_PAUSE:
3111 /* Windows maps Ctrl-NumLock into VK_PAUSE, which is confusing
3112 for purposes of key binding; convert these back into
3113 VK_NUMLOCK events, at least when we want to see NumLock key
3114 presses. (Note that there is never any possibility that
3115 VK_PAUSE with Ctrl really is C-Pause as per above.) */
3116 if (NILP (Vw32_enable_num_lock) && modifier_set (VK_CONTROL))
3117 wParam = VK_NUMLOCK;
3118 break;
3119 default:
3120 /* If not defined as a function key, change it to a WM_CHAR message. */
3121 if (wParam > 255 || !lispy_function_keys[wParam])
3123 DWORD modifiers = construct_console_modifiers ();
3125 if (!NILP (Vw32_recognize_altgr)
3126 && modifier_set (VK_LCONTROL) && modifier_set (VK_RMENU))
3128 /* Always let TranslateMessage handle AltGr key chords;
3129 for some reason, ToAscii doesn't always process AltGr
3130 chords correctly. */
3131 windows_translate = 1;
3133 else if ((modifiers & (~SHIFT_PRESSED & ~CAPSLOCK_ON)) != 0)
3135 /* Handle key chords including any modifiers other
3136 than shift directly, in order to preserve as much
3137 modifier information as possible. */
3138 if ('A' <= wParam && wParam <= 'Z')
3140 /* Don't translate modified alphabetic keystrokes,
3141 so the user doesn't need to constantly switch
3142 layout to type control or meta keystrokes when
3143 the normal layout translates alphabetic
3144 characters to non-ascii characters. */
3145 if (!modifier_set (VK_SHIFT))
3146 wParam += ('a' - 'A');
3147 msg = WM_CHAR;
3149 else
3151 /* Try to handle other keystrokes by determining the
3152 base character (ie. translating the base key plus
3153 shift modifier). */
3154 int add;
3155 int isdead = 0;
3156 KEY_EVENT_RECORD key;
3158 key.bKeyDown = TRUE;
3159 key.wRepeatCount = 1;
3160 key.wVirtualKeyCode = wParam;
3161 key.wVirtualScanCode = (lParam & 0xFF0000) >> 16;
3162 key.uChar.AsciiChar = 0;
3163 key.dwControlKeyState = modifiers;
3165 add = w32_kbd_patch_key (&key);
3166 /* 0 means an unrecognised keycode, negative means
3167 dead key. Ignore both. */
3168 while (--add >= 0)
3170 /* Forward asciified character sequence. */
3171 post_character_message
3172 (hwnd, WM_CHAR,
3173 (unsigned char) key.uChar.AsciiChar, lParam,
3174 w32_get_key_modifiers (wParam, lParam));
3175 w32_kbd_patch_key (&key);
3177 return 0;
3180 else
3182 /* Let TranslateMessage handle everything else. */
3183 windows_translate = 1;
3188 translate:
3189 if (windows_translate)
3191 MSG windows_msg = { hwnd, msg, wParam, lParam, 0, {0,0} };
3192 windows_msg.time = GetMessageTime ();
3193 TranslateMessage (&windows_msg);
3194 goto dflt;
3197 /* Fall through */
3199 case WM_SYSCHAR:
3200 case WM_CHAR:
3201 post_character_message (hwnd, msg, wParam, lParam,
3202 w32_get_key_modifiers (wParam, lParam));
3203 break;
3205 case WM_UNICHAR:
3206 /* WM_UNICHAR looks promising from the docs, but the exact
3207 circumstances in which TranslateMessage sends it is one of those
3208 Microsoft secret API things that EU and US courts are supposed
3209 to have put a stop to already. Spy++ shows it being sent to Notepad
3210 and other MS apps, but never to Emacs.
3212 Some third party IMEs send it in accordance with the official
3213 documentation though, so handle it here.
3215 UNICODE_NOCHAR is used to test for support for this message.
3216 TRUE indicates that the message is supported. */
3217 if (wParam == UNICODE_NOCHAR)
3218 return TRUE;
3221 W32Msg wmsg;
3222 wmsg.dwModifiers = w32_get_key_modifiers (wParam, lParam);
3223 signal_user_input ();
3224 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3226 break;
3228 case WM_IME_CHAR:
3229 /* If we can't get the IME result as unicode, use default processing,
3230 which will at least allow characters decodable in the system locale
3231 get through. */
3232 if (!get_composition_string_fn)
3233 goto dflt;
3235 else if (!ignore_ime_char)
3237 wchar_t * buffer;
3238 int size, i;
3239 W32Msg wmsg;
3240 HIMC context = get_ime_context_fn (hwnd);
3241 wmsg.dwModifiers = w32_get_key_modifiers (wParam, lParam);
3242 /* Get buffer size. */
3243 size = get_composition_string_fn (context, GCS_RESULTSTR, buffer, 0);
3244 buffer = alloca(size);
3245 size = get_composition_string_fn (context, GCS_RESULTSTR,
3246 buffer, size);
3247 signal_user_input ();
3248 for (i = 0; i < size / sizeof (wchar_t); i++)
3250 my_post_msg (&wmsg, hwnd, WM_UNICHAR, (WPARAM) buffer[i],
3251 lParam);
3253 /* We output the whole string above, so ignore following ones
3254 until we are notified of the end of composition. */
3255 ignore_ime_char = 1;
3257 break;
3259 case WM_IME_ENDCOMPOSITION:
3260 ignore_ime_char = 0;
3261 goto dflt;
3263 /* Simulate middle mouse button events when left and right buttons
3264 are used together, but only if user has two button mouse. */
3265 case WM_LBUTTONDOWN:
3266 case WM_RBUTTONDOWN:
3267 if (w32_num_mouse_buttons > 2)
3268 goto handle_plain_button;
3271 int this = (msg == WM_LBUTTONDOWN) ? LMOUSE : RMOUSE;
3272 int other = (msg == WM_LBUTTONDOWN) ? RMOUSE : LMOUSE;
3274 if (button_state & this)
3275 return 0;
3277 if (button_state == 0)
3278 SetCapture (hwnd);
3280 button_state |= this;
3282 if (button_state & other)
3284 if (mouse_button_timer)
3286 KillTimer (hwnd, mouse_button_timer);
3287 mouse_button_timer = 0;
3289 /* Generate middle mouse event instead. */
3290 msg = WM_MBUTTONDOWN;
3291 button_state |= MMOUSE;
3293 else if (button_state & MMOUSE)
3295 /* Ignore button event if we've already generated a
3296 middle mouse down event. This happens if the
3297 user releases and press one of the two buttons
3298 after we've faked a middle mouse event. */
3299 return 0;
3301 else
3303 /* Flush out saved message. */
3304 post_msg (&saved_mouse_button_msg);
3306 wmsg.dwModifiers = w32_get_modifiers ();
3307 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3308 signal_user_input ();
3310 /* Clear message buffer. */
3311 saved_mouse_button_msg.msg.hwnd = 0;
3313 else
3315 /* Hold onto message for now. */
3316 mouse_button_timer =
3317 SetTimer (hwnd, MOUSE_BUTTON_ID,
3318 w32_mouse_button_tolerance, NULL);
3319 saved_mouse_button_msg.msg.hwnd = hwnd;
3320 saved_mouse_button_msg.msg.message = msg;
3321 saved_mouse_button_msg.msg.wParam = wParam;
3322 saved_mouse_button_msg.msg.lParam = lParam;
3323 saved_mouse_button_msg.msg.time = GetMessageTime ();
3324 saved_mouse_button_msg.dwModifiers = w32_get_modifiers ();
3327 return 0;
3329 case WM_LBUTTONUP:
3330 case WM_RBUTTONUP:
3331 if (w32_num_mouse_buttons > 2)
3332 goto handle_plain_button;
3335 int this = (msg == WM_LBUTTONUP) ? LMOUSE : RMOUSE;
3336 int other = (msg == WM_LBUTTONUP) ? RMOUSE : LMOUSE;
3338 if ((button_state & this) == 0)
3339 return 0;
3341 button_state &= ~this;
3343 if (button_state & MMOUSE)
3345 /* Only generate event when second button is released. */
3346 if ((button_state & other) == 0)
3348 msg = WM_MBUTTONUP;
3349 button_state &= ~MMOUSE;
3351 if (button_state) abort ();
3353 else
3354 return 0;
3356 else
3358 /* Flush out saved message if necessary. */
3359 if (saved_mouse_button_msg.msg.hwnd)
3361 post_msg (&saved_mouse_button_msg);
3364 wmsg.dwModifiers = w32_get_modifiers ();
3365 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3366 signal_user_input ();
3368 /* Always clear message buffer and cancel timer. */
3369 saved_mouse_button_msg.msg.hwnd = 0;
3370 KillTimer (hwnd, mouse_button_timer);
3371 mouse_button_timer = 0;
3373 if (button_state == 0)
3374 ReleaseCapture ();
3376 return 0;
3378 case WM_XBUTTONDOWN:
3379 case WM_XBUTTONUP:
3380 if (w32_pass_extra_mouse_buttons_to_system)
3381 goto dflt;
3382 /* else fall through and process them. */
3383 case WM_MBUTTONDOWN:
3384 case WM_MBUTTONUP:
3385 handle_plain_button:
3387 BOOL up;
3388 int button;
3390 /* Ignore middle and extra buttons as long as the menu is active. */
3391 f = x_window_to_frame (dpyinfo, hwnd);
3392 if (f && f->output_data.w32->menubar_active)
3393 return 0;
3395 if (parse_button (msg, HIWORD (wParam), &button, &up))
3397 if (up) ReleaseCapture ();
3398 else SetCapture (hwnd);
3399 button = (button == 0) ? LMOUSE :
3400 ((button == 1) ? MMOUSE : RMOUSE);
3401 if (up)
3402 button_state &= ~button;
3403 else
3404 button_state |= button;
3408 wmsg.dwModifiers = w32_get_modifiers ();
3409 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3410 signal_user_input ();
3412 /* Need to return true for XBUTTON messages, false for others,
3413 to indicate that we processed the message. */
3414 return (msg == WM_XBUTTONDOWN || msg == WM_XBUTTONUP);
3416 case WM_MOUSEMOVE:
3417 /* Ignore mouse movements as long as the menu is active. These
3418 movements are processed by the window manager anyway, and
3419 it's wrong to handle them as if they happened on the
3420 underlying frame. */
3421 f = x_window_to_frame (dpyinfo, hwnd);
3422 if (f && f->output_data.w32->menubar_active)
3423 return 0;
3425 /* If the mouse has just moved into the frame, start tracking
3426 it, so we will be notified when it leaves the frame. Mouse
3427 tracking only works under W98 and NT4 and later. On earlier
3428 versions, there is no way of telling when the mouse leaves the
3429 frame, so we just have to put up with help-echo and mouse
3430 highlighting remaining while the frame is not active. */
3431 if (track_mouse_event_fn && !track_mouse_window)
3433 TRACKMOUSEEVENT tme;
3434 tme.cbSize = sizeof (tme);
3435 tme.dwFlags = TME_LEAVE;
3436 tme.hwndTrack = hwnd;
3438 track_mouse_event_fn (&tme);
3439 track_mouse_window = hwnd;
3441 case WM_VSCROLL:
3442 if (w32_mouse_move_interval <= 0
3443 || (msg == WM_MOUSEMOVE && button_state == 0))
3445 wmsg.dwModifiers = w32_get_modifiers ();
3446 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3447 return 0;
3450 /* Hang onto mouse move and scroll messages for a bit, to avoid
3451 sending such events to Emacs faster than it can process them.
3452 If we get more events before the timer from the first message
3453 expires, we just replace the first message. */
3455 if (saved_mouse_move_msg.msg.hwnd == 0)
3456 mouse_move_timer =
3457 SetTimer (hwnd, MOUSE_MOVE_ID,
3458 w32_mouse_move_interval, NULL);
3460 /* Hold onto message for now. */
3461 saved_mouse_move_msg.msg.hwnd = hwnd;
3462 saved_mouse_move_msg.msg.message = msg;
3463 saved_mouse_move_msg.msg.wParam = wParam;
3464 saved_mouse_move_msg.msg.lParam = lParam;
3465 saved_mouse_move_msg.msg.time = GetMessageTime ();
3466 saved_mouse_move_msg.dwModifiers = w32_get_modifiers ();
3468 return 0;
3470 case WM_MOUSEWHEEL:
3471 case WM_DROPFILES:
3472 wmsg.dwModifiers = w32_get_modifiers ();
3473 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3474 signal_user_input ();
3475 return 0;
3477 case WM_APPCOMMAND:
3478 if (w32_pass_multimedia_buttons_to_system)
3479 goto dflt;
3480 /* Otherwise, pass to lisp, the same way we do with mousehwheel. */
3481 case WM_MOUSEHWHEEL:
3482 wmsg.dwModifiers = w32_get_modifiers ();
3483 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3484 signal_user_input ();
3485 /* Non-zero must be returned when WM_MOUSEHWHEEL messages are
3486 handled, to prevent the system trying to handle it by faking
3487 scroll bar events. */
3488 return 1;
3490 case WM_TIMER:
3491 /* Flush out saved messages if necessary. */
3492 if (wParam == mouse_button_timer)
3494 if (saved_mouse_button_msg.msg.hwnd)
3496 post_msg (&saved_mouse_button_msg);
3497 signal_user_input ();
3498 saved_mouse_button_msg.msg.hwnd = 0;
3500 KillTimer (hwnd, mouse_button_timer);
3501 mouse_button_timer = 0;
3503 else if (wParam == mouse_move_timer)
3505 if (saved_mouse_move_msg.msg.hwnd)
3507 post_msg (&saved_mouse_move_msg);
3508 saved_mouse_move_msg.msg.hwnd = 0;
3510 KillTimer (hwnd, mouse_move_timer);
3511 mouse_move_timer = 0;
3513 else if (wParam == menu_free_timer)
3515 KillTimer (hwnd, menu_free_timer);
3516 menu_free_timer = 0;
3517 f = x_window_to_frame (dpyinfo, hwnd);
3518 /* If a popup menu is active, don't wipe its strings. */
3519 if (menubar_in_use
3520 && current_popup_menu == NULL)
3522 /* Free memory used by owner-drawn and help-echo strings. */
3523 w32_free_menu_strings (hwnd);
3524 f->output_data.w32->menubar_active = 0;
3525 menubar_in_use = 0;
3528 return 0;
3530 case WM_NCACTIVATE:
3531 /* Windows doesn't send us focus messages when putting up and
3532 taking down a system popup dialog as for Ctrl-Alt-Del on Windows 95.
3533 The only indication we get that something happened is receiving
3534 this message afterwards. So this is a good time to reset our
3535 keyboard modifiers' state. */
3536 reset_modifiers ();
3537 goto dflt;
3539 case WM_INITMENU:
3540 button_state = 0;
3541 ReleaseCapture ();
3542 /* We must ensure menu bar is fully constructed and up to date
3543 before allowing user interaction with it. To achieve this
3544 we send this message to the lisp thread and wait for a
3545 reply (whose value is not actually needed) to indicate that
3546 the menu bar is now ready for use, so we can now return.
3548 To remain responsive in the meantime, we enter a nested message
3549 loop that can process all other messages.
3551 However, we skip all this if the message results from calling
3552 TrackPopupMenu - in fact, we must NOT attempt to send the lisp
3553 thread a message because it is blocked on us at this point. We
3554 set menubar_active before calling TrackPopupMenu to indicate
3555 this (there is no possibility of confusion with real menubar
3556 being active). */
3558 f = x_window_to_frame (dpyinfo, hwnd);
3559 if (f
3560 && (f->output_data.w32->menubar_active
3561 /* We can receive this message even in the absence of a
3562 menubar (ie. when the system menu is activated) - in this
3563 case we do NOT want to forward the message, otherwise it
3564 will cause the menubar to suddenly appear when the user
3565 had requested it to be turned off! */
3566 || f->output_data.w32->menubar_widget == NULL))
3567 return 0;
3570 deferred_msg msg_buf;
3572 /* Detect if message has already been deferred; in this case
3573 we cannot return any sensible value to ignore this. */
3574 if (find_deferred_msg (hwnd, msg) != NULL)
3575 abort ();
3577 menubar_in_use = 1;
3579 return send_deferred_msg (&msg_buf, hwnd, msg, wParam, lParam);
3582 case WM_EXITMENULOOP:
3583 f = x_window_to_frame (dpyinfo, hwnd);
3585 /* If a menu is still active, check again after a short delay,
3586 since Windows often (always?) sends the WM_EXITMENULOOP
3587 before the corresponding WM_COMMAND message.
3588 Don't do this if a popup menu is active, since it is only
3589 menubar menus that require cleaning up in this way.
3591 if (f && menubar_in_use && current_popup_menu == NULL)
3592 menu_free_timer = SetTimer (hwnd, MENU_FREE_ID, MENU_FREE_DELAY, NULL);
3593 goto dflt;
3595 case WM_MENUSELECT:
3596 /* Direct handling of help_echo in menus. Should be safe now
3597 that we generate the help_echo by placing a help event in the
3598 keyboard buffer. */
3600 HMENU menu = (HMENU) lParam;
3601 UINT menu_item = (UINT) LOWORD (wParam);
3602 UINT flags = (UINT) HIWORD (wParam);
3604 w32_menu_display_help (hwnd, menu, menu_item, flags);
3606 return 0;
3608 case WM_MEASUREITEM:
3609 f = x_window_to_frame (dpyinfo, hwnd);
3610 if (f)
3612 MEASUREITEMSTRUCT * pMis = (MEASUREITEMSTRUCT *) lParam;
3614 if (pMis->CtlType == ODT_MENU)
3616 /* Work out dimensions for popup menu titles. */
3617 char * title = (char *) pMis->itemData;
3618 HDC hdc = GetDC (hwnd);
3619 HFONT menu_font = GetCurrentObject (hdc, OBJ_FONT);
3620 LOGFONT menu_logfont;
3621 HFONT old_font;
3622 SIZE size;
3624 GetObject (menu_font, sizeof (menu_logfont), &menu_logfont);
3625 menu_logfont.lfWeight = FW_BOLD;
3626 menu_font = CreateFontIndirect (&menu_logfont);
3627 old_font = SelectObject (hdc, menu_font);
3629 pMis->itemHeight = GetSystemMetrics (SM_CYMENUSIZE);
3630 if (title)
3632 if (unicode_append_menu)
3633 GetTextExtentPoint32W (hdc, (WCHAR *) title,
3634 wcslen ((WCHAR *) title),
3635 &size);
3636 else
3637 GetTextExtentPoint32 (hdc, title, strlen (title), &size);
3639 pMis->itemWidth = size.cx;
3640 if (pMis->itemHeight < size.cy)
3641 pMis->itemHeight = size.cy;
3643 else
3644 pMis->itemWidth = 0;
3646 SelectObject (hdc, old_font);
3647 DeleteObject (menu_font);
3648 ReleaseDC (hwnd, hdc);
3649 return TRUE;
3652 return 0;
3654 case WM_DRAWITEM:
3655 f = x_window_to_frame (dpyinfo, hwnd);
3656 if (f)
3658 DRAWITEMSTRUCT * pDis = (DRAWITEMSTRUCT *) lParam;
3660 if (pDis->CtlType == ODT_MENU)
3662 /* Draw popup menu title. */
3663 char * title = (char *) pDis->itemData;
3664 if (title)
3666 HDC hdc = pDis->hDC;
3667 HFONT menu_font = GetCurrentObject (hdc, OBJ_FONT);
3668 LOGFONT menu_logfont;
3669 HFONT old_font;
3671 GetObject (menu_font, sizeof (menu_logfont), &menu_logfont);
3672 menu_logfont.lfWeight = FW_BOLD;
3673 menu_font = CreateFontIndirect (&menu_logfont);
3674 old_font = SelectObject (hdc, menu_font);
3676 /* Always draw title as if not selected. */
3677 if (unicode_append_menu)
3678 ExtTextOutW (hdc,
3679 pDis->rcItem.left
3680 + GetSystemMetrics (SM_CXMENUCHECK),
3681 pDis->rcItem.top,
3682 ETO_OPAQUE, &pDis->rcItem,
3683 (WCHAR *) title,
3684 wcslen ((WCHAR *) title), NULL);
3685 else
3686 ExtTextOut (hdc,
3687 pDis->rcItem.left
3688 + GetSystemMetrics (SM_CXMENUCHECK),
3689 pDis->rcItem.top,
3690 ETO_OPAQUE, &pDis->rcItem,
3691 title, strlen (title), NULL);
3693 SelectObject (hdc, old_font);
3694 DeleteObject (menu_font);
3696 return TRUE;
3699 return 0;
3701 #if 0
3702 /* Still not right - can't distinguish between clicks in the
3703 client area of the frame from clicks forwarded from the scroll
3704 bars - may have to hook WM_NCHITTEST to remember the mouse
3705 position and then check if it is in the client area ourselves. */
3706 case WM_MOUSEACTIVATE:
3707 /* Discard the mouse click that activates a frame, allowing the
3708 user to click anywhere without changing point (or worse!).
3709 Don't eat mouse clicks on scrollbars though!! */
3710 if (LOWORD (lParam) == HTCLIENT )
3711 return MA_ACTIVATEANDEAT;
3712 goto dflt;
3713 #endif
3715 case WM_MOUSELEAVE:
3716 /* No longer tracking mouse. */
3717 track_mouse_window = NULL;
3719 case WM_ACTIVATEAPP:
3720 case WM_ACTIVATE:
3721 case WM_WINDOWPOSCHANGED:
3722 case WM_SHOWWINDOW:
3723 /* Inform lisp thread that a frame might have just been obscured
3724 or exposed, so should recheck visibility of all frames. */
3725 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3726 goto dflt;
3728 case WM_SETFOCUS:
3729 dpyinfo->faked_key = 0;
3730 reset_modifiers ();
3731 register_hot_keys (hwnd);
3732 goto command;
3733 case WM_KILLFOCUS:
3734 unregister_hot_keys (hwnd);
3735 button_state = 0;
3736 ReleaseCapture ();
3737 /* Relinquish the system caret. */
3738 if (w32_system_caret_hwnd)
3740 w32_visible_system_caret_hwnd = NULL;
3741 w32_system_caret_hwnd = NULL;
3742 DestroyCaret ();
3744 goto command;
3745 case WM_COMMAND:
3746 menubar_in_use = 0;
3747 f = x_window_to_frame (dpyinfo, hwnd);
3748 if (f && HIWORD (wParam) == 0)
3750 if (menu_free_timer)
3752 KillTimer (hwnd, menu_free_timer);
3753 menu_free_timer = 0;
3756 case WM_MOVE:
3757 case WM_SIZE:
3758 command:
3759 wmsg.dwModifiers = w32_get_modifiers ();
3760 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3761 goto dflt;
3763 case WM_DESTROY:
3764 CoUninitialize ();
3765 return 0;
3767 case WM_CLOSE:
3768 wmsg.dwModifiers = w32_get_modifiers ();
3769 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3770 return 0;
3772 case WM_WINDOWPOSCHANGING:
3773 /* Don't restrict the sizing of tip frames. */
3774 if (hwnd == tip_window)
3775 return 0;
3777 WINDOWPLACEMENT wp;
3778 LPWINDOWPOS lppos = (WINDOWPOS *) lParam;
3780 wp.length = sizeof (WINDOWPLACEMENT);
3781 GetWindowPlacement (hwnd, &wp);
3783 if (wp.showCmd != SW_SHOWMINIMIZED && (lppos->flags & SWP_NOSIZE) == 0)
3785 RECT rect;
3786 int wdiff;
3787 int hdiff;
3788 DWORD font_width;
3789 DWORD line_height;
3790 DWORD internal_border;
3791 DWORD scrollbar_extra;
3792 RECT wr;
3794 wp.length = sizeof (wp);
3795 GetWindowRect (hwnd, &wr);
3797 enter_crit ();
3799 font_width = GetWindowLong (hwnd, WND_FONTWIDTH_INDEX);
3800 line_height = GetWindowLong (hwnd, WND_LINEHEIGHT_INDEX);
3801 internal_border = GetWindowLong (hwnd, WND_BORDER_INDEX);
3802 scrollbar_extra = GetWindowLong (hwnd, WND_SCROLLBAR_INDEX);
3804 leave_crit ();
3806 memset (&rect, 0, sizeof (rect));
3807 AdjustWindowRect (&rect, GetWindowLong (hwnd, GWL_STYLE),
3808 GetMenu (hwnd) != NULL);
3810 /* Force width and height of client area to be exact
3811 multiples of the character cell dimensions. */
3812 wdiff = (lppos->cx - (rect.right - rect.left)
3813 - 2 * internal_border - scrollbar_extra)
3814 % font_width;
3815 hdiff = (lppos->cy - (rect.bottom - rect.top)
3816 - 2 * internal_border)
3817 % line_height;
3819 if (wdiff || hdiff)
3821 /* For right/bottom sizing we can just fix the sizes.
3822 However for top/left sizing we will need to fix the X
3823 and Y positions as well. */
3825 int cx_mintrack = GetSystemMetrics (SM_CXMINTRACK);
3826 int cy_mintrack = GetSystemMetrics (SM_CYMINTRACK);
3828 lppos->cx = max (lppos->cx - wdiff, cx_mintrack);
3829 lppos->cy = max (lppos->cy - hdiff, cy_mintrack);
3831 if (wp.showCmd != SW_SHOWMAXIMIZED
3832 && (lppos->flags & SWP_NOMOVE) == 0)
3834 if (lppos->x != wr.left || lppos->y != wr.top)
3836 lppos->x += wdiff;
3837 lppos->y += hdiff;
3839 else
3841 lppos->flags |= SWP_NOMOVE;
3845 return 0;
3850 goto dflt;
3852 case WM_GETMINMAXINFO:
3853 /* Hack to allow resizing the Emacs frame above the screen size.
3854 Note that Windows 9x limits coordinates to 16-bits. */
3855 ((LPMINMAXINFO) lParam)->ptMaxTrackSize.x = 32767;
3856 ((LPMINMAXINFO) lParam)->ptMaxTrackSize.y = 32767;
3857 return 0;
3859 case WM_SETCURSOR:
3860 if (LOWORD (lParam) == HTCLIENT)
3861 return 0;
3863 goto dflt;
3865 case WM_EMACS_SETCURSOR:
3867 Cursor cursor = (Cursor) wParam;
3868 if (cursor)
3869 SetCursor (cursor);
3870 return 0;
3873 case WM_EMACS_CREATESCROLLBAR:
3874 return (LRESULT) w32_createscrollbar ((struct frame *) wParam,
3875 (struct scroll_bar *) lParam);
3877 case WM_EMACS_SHOWWINDOW:
3878 return ShowWindow ((HWND) wParam, (WPARAM) lParam);
3880 case WM_EMACS_SETFOREGROUND:
3882 HWND foreground_window;
3883 DWORD foreground_thread, retval;
3885 /* On NT 5.0, and apparently Windows 98, it is necessary to
3886 attach to the thread that currently has focus in order to
3887 pull the focus away from it. */
3888 foreground_window = GetForegroundWindow ();
3889 foreground_thread = GetWindowThreadProcessId (foreground_window, NULL);
3890 if (!foreground_window
3891 || foreground_thread == GetCurrentThreadId ()
3892 || !AttachThreadInput (GetCurrentThreadId (),
3893 foreground_thread, TRUE))
3894 foreground_thread = 0;
3896 retval = SetForegroundWindow ((HWND) wParam);
3898 /* Detach from the previous foreground thread. */
3899 if (foreground_thread)
3900 AttachThreadInput (GetCurrentThreadId (),
3901 foreground_thread, FALSE);
3903 return retval;
3906 case WM_EMACS_SETWINDOWPOS:
3908 WINDOWPOS * pos = (WINDOWPOS *) wParam;
3909 return SetWindowPos (hwnd, pos->hwndInsertAfter,
3910 pos->x, pos->y, pos->cx, pos->cy, pos->flags);
3913 case WM_EMACS_DESTROYWINDOW:
3914 DragAcceptFiles ((HWND) wParam, FALSE);
3915 return DestroyWindow ((HWND) wParam);
3917 case WM_EMACS_HIDE_CARET:
3918 return HideCaret (hwnd);
3920 case WM_EMACS_SHOW_CARET:
3921 return ShowCaret (hwnd);
3923 case WM_EMACS_DESTROY_CARET:
3924 w32_system_caret_hwnd = NULL;
3925 w32_visible_system_caret_hwnd = NULL;
3926 return DestroyCaret ();
3928 case WM_EMACS_TRACK_CARET:
3929 /* If there is currently no system caret, create one. */
3930 if (w32_system_caret_hwnd == NULL)
3932 /* Use the default caret width, and avoid changing it
3933 unneccesarily, as it confuses screen reader software. */
3934 w32_system_caret_hwnd = hwnd;
3935 CreateCaret (hwnd, NULL, 0,
3936 w32_system_caret_height);
3939 if (!SetCaretPos (w32_system_caret_x, w32_system_caret_y))
3940 return 0;
3941 /* Ensure visible caret gets turned on when requested. */
3942 else if (w32_use_visible_system_caret
3943 && w32_visible_system_caret_hwnd != hwnd)
3945 w32_visible_system_caret_hwnd = hwnd;
3946 return ShowCaret (hwnd);
3948 /* Ensure visible caret gets turned off when requested. */
3949 else if (!w32_use_visible_system_caret
3950 && w32_visible_system_caret_hwnd)
3952 w32_visible_system_caret_hwnd = NULL;
3953 return HideCaret (hwnd);
3955 else
3956 return 1;
3958 case WM_EMACS_TRACKPOPUPMENU:
3960 UINT flags;
3961 POINT *pos;
3962 int retval;
3963 pos = (POINT *)lParam;
3964 flags = TPM_CENTERALIGN;
3965 if (button_state & LMOUSE)
3966 flags |= TPM_LEFTBUTTON;
3967 else if (button_state & RMOUSE)
3968 flags |= TPM_RIGHTBUTTON;
3970 /* Remember we did a SetCapture on the initial mouse down event,
3971 so for safety, we make sure the capture is cancelled now. */
3972 ReleaseCapture ();
3973 button_state = 0;
3975 /* Use menubar_active to indicate that WM_INITMENU is from
3976 TrackPopupMenu below, and should be ignored. */
3977 f = x_window_to_frame (dpyinfo, hwnd);
3978 if (f)
3979 f->output_data.w32->menubar_active = 1;
3981 if (TrackPopupMenu ((HMENU)wParam, flags, pos->x, pos->y,
3982 0, hwnd, NULL))
3984 MSG amsg;
3985 /* Eat any mouse messages during popupmenu */
3986 while (PeekMessage (&amsg, hwnd, WM_MOUSEFIRST, WM_MOUSELAST,
3987 PM_REMOVE));
3988 /* Get the menu selection, if any */
3989 if (PeekMessage (&amsg, hwnd, WM_COMMAND, WM_COMMAND, PM_REMOVE))
3991 retval = LOWORD (amsg.wParam);
3993 else
3995 retval = 0;
3998 else
4000 retval = -1;
4003 return retval;
4006 default:
4007 /* Check for messages registered at runtime. */
4008 if (msg == msh_mousewheel)
4010 wmsg.dwModifiers = w32_get_modifiers ();
4011 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4012 signal_user_input ();
4013 return 0;
4016 dflt:
4017 return DefWindowProc (hwnd, msg, wParam, lParam);
4021 /* The most common default return code for handled messages is 0. */
4022 return 0;
4025 static void
4026 my_create_window (f)
4027 struct frame * f;
4029 MSG msg;
4031 if (!PostThreadMessage (dwWindowsThreadId, WM_EMACS_CREATEWINDOW, (WPARAM)f, 0))
4032 abort ();
4033 GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE);
4037 /* Create a tooltip window. Unlike my_create_window, we do not do this
4038 indirectly via the Window thread, as we do not need to process Window
4039 messages for the tooltip. Creating tooltips indirectly also creates
4040 deadlocks when tooltips are created for menu items. */
4041 static void
4042 my_create_tip_window (f)
4043 struct frame *f;
4045 RECT rect;
4047 rect.left = rect.top = 0;
4048 rect.right = FRAME_PIXEL_WIDTH (f);
4049 rect.bottom = FRAME_PIXEL_HEIGHT (f);
4051 AdjustWindowRect (&rect, f->output_data.w32->dwStyle,
4052 FRAME_EXTERNAL_MENU_BAR (f));
4054 tip_window = FRAME_W32_WINDOW (f)
4055 = CreateWindow (EMACS_CLASS,
4056 f->namebuf,
4057 f->output_data.w32->dwStyle,
4058 f->left_pos,
4059 f->top_pos,
4060 rect.right - rect.left,
4061 rect.bottom - rect.top,
4062 FRAME_W32_WINDOW (SELECTED_FRAME ()), /* owner */
4063 NULL,
4064 hinst,
4065 NULL);
4067 if (tip_window)
4069 SetWindowLong (tip_window, WND_FONTWIDTH_INDEX, FRAME_COLUMN_WIDTH (f));
4070 SetWindowLong (tip_window, WND_LINEHEIGHT_INDEX, FRAME_LINE_HEIGHT (f));
4071 SetWindowLong (tip_window, WND_BORDER_INDEX, FRAME_INTERNAL_BORDER_WIDTH (f));
4072 SetWindowLong (tip_window, WND_BACKGROUND_INDEX, FRAME_BACKGROUND_PIXEL (f));
4074 /* Tip frames have no scrollbars. */
4075 SetWindowLong (tip_window, WND_SCROLLBAR_INDEX, 0);
4077 /* Do this to discard the default setting specified by our parent. */
4078 ShowWindow (tip_window, SW_HIDE);
4083 /* Create and set up the w32 window for frame F. */
4085 static void
4086 w32_window (f, window_prompting, minibuffer_only)
4087 struct frame *f;
4088 long window_prompting;
4089 int minibuffer_only;
4091 BLOCK_INPUT;
4093 /* Use the resource name as the top-level window name
4094 for looking up resources. Make a non-Lisp copy
4095 for the window manager, so GC relocation won't bother it.
4097 Elsewhere we specify the window name for the window manager. */
4100 char *str = (char *) SDATA (Vx_resource_name);
4101 f->namebuf = (char *) xmalloc (strlen (str) + 1);
4102 strcpy (f->namebuf, str);
4105 my_create_window (f);
4107 validate_x_resource_name ();
4109 /* x_set_name normally ignores requests to set the name if the
4110 requested name is the same as the current name. This is the one
4111 place where that assumption isn't correct; f->name is set, but
4112 the server hasn't been told. */
4114 Lisp_Object name;
4115 int explicit = f->explicit_name;
4117 f->explicit_name = 0;
4118 name = f->name;
4119 f->name = Qnil;
4120 x_set_name (f, name, explicit);
4123 UNBLOCK_INPUT;
4125 if (!minibuffer_only && FRAME_EXTERNAL_MENU_BAR (f))
4126 initialize_frame_menubar (f);
4128 if (FRAME_W32_WINDOW (f) == 0)
4129 error ("Unable to create window");
4132 /* Handle the icon stuff for this window. Perhaps later we might
4133 want an x_set_icon_position which can be called interactively as
4134 well. */
4136 static void
4137 x_icon (f, parms)
4138 struct frame *f;
4139 Lisp_Object parms;
4141 Lisp_Object icon_x, icon_y;
4143 /* Set the position of the icon. Note that Windows 95 groups all
4144 icons in the tray. */
4145 icon_x = w32_get_arg (parms, Qicon_left, 0, 0, RES_TYPE_NUMBER);
4146 icon_y = w32_get_arg (parms, Qicon_top, 0, 0, RES_TYPE_NUMBER);
4147 if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
4149 CHECK_NUMBER (icon_x);
4150 CHECK_NUMBER (icon_y);
4152 else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
4153 error ("Both left and top icon corners of icon must be specified");
4155 BLOCK_INPUT;
4157 if (! EQ (icon_x, Qunbound))
4158 x_wm_set_icon_position (f, XINT (icon_x), XINT (icon_y));
4160 #if 0 /* TODO */
4161 /* Start up iconic or window? */
4162 x_wm_set_window_state
4163 (f, (EQ (w32_get_arg (parms, Qvisibility, 0, 0, RES_TYPE_SYMBOL), Qicon)
4164 ? IconicState
4165 : NormalState));
4167 x_text_icon (f, (char *) SDATA ((!NILP (f->icon_name)
4168 ? f->icon_name
4169 : f->name)));
4170 #endif
4172 UNBLOCK_INPUT;
4176 static void
4177 x_make_gc (f)
4178 struct frame *f;
4180 XGCValues gc_values;
4182 BLOCK_INPUT;
4184 /* Create the GC's of this frame.
4185 Note that many default values are used. */
4187 /* Normal video */
4188 gc_values.font = FRAME_FONT (f);
4190 /* Cursor has cursor-color background, background-color foreground. */
4191 gc_values.foreground = FRAME_BACKGROUND_PIXEL (f);
4192 gc_values.background = f->output_data.w32->cursor_pixel;
4193 f->output_data.w32->cursor_gc
4194 = XCreateGC (NULL, FRAME_W32_WINDOW (f),
4195 (GCFont | GCForeground | GCBackground),
4196 &gc_values);
4198 /* Reliefs. */
4199 f->output_data.w32->white_relief.gc = 0;
4200 f->output_data.w32->black_relief.gc = 0;
4202 UNBLOCK_INPUT;
4206 /* Handler for signals raised during x_create_frame and
4207 x_create_top_frame. FRAME is the frame which is partially
4208 constructed. */
4210 static Lisp_Object
4211 unwind_create_frame (frame)
4212 Lisp_Object frame;
4214 struct frame *f = XFRAME (frame);
4216 /* If frame is ``official'', nothing to do. */
4217 if (!CONSP (Vframe_list) || !EQ (XCAR (Vframe_list), frame))
4219 #ifdef GLYPH_DEBUG
4220 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
4221 #endif
4223 x_free_frame_resources (f);
4225 /* Check that reference counts are indeed correct. */
4226 xassert (dpyinfo->reference_count == dpyinfo_refcount);
4227 xassert (dpyinfo->image_cache->refcount == image_cache_refcount);
4229 return Qt;
4232 return Qnil;
4235 #ifdef USE_FONT_BACKEND
4236 static void
4237 x_default_font_parameter (f, parms)
4238 struct frame *f;
4239 Lisp_Object parms;
4241 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
4242 Lisp_Object font = x_get_arg (dpyinfo, parms, Qfont, "font", "Font",
4243 RES_TYPE_STRING);
4245 if (!STRINGP (font))
4247 int i;
4248 static char *names[]
4249 = { "Courier New-10",
4250 "-*-Courier-normal-r-*-*-13-*-*-*-c-*-iso8859-1",
4251 "-*-Fixedsys-normal-r-*-*-12-*-*-*-c-*-iso8859-1",
4252 "Fixedsys",
4253 NULL };
4255 for (i = 0; names[i]; i++)
4257 font = font_open_by_name (f, names[i]);
4258 if (! NILP (font))
4259 break;
4261 if (NILP (font))
4262 error ("No suitable font was found");
4264 x_default_parameter (f, parms, Qfont, font, "font", "Font", RES_TYPE_STRING);
4266 #endif
4268 DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
4269 1, 1, 0,
4270 doc: /* Make a new window, which is called a \"frame\" in Emacs terms.
4271 Return an Emacs frame object.
4272 PARAMETERS is an alist of frame parameters.
4273 If the parameters specify that the frame should not have a minibuffer,
4274 and do not specify a specific minibuffer window to use,
4275 then `default-minibuffer-frame' must be a frame whose minibuffer can
4276 be shared by the new frame.
4278 This function is an internal primitive--use `make-frame' instead. */)
4279 (parameters)
4280 Lisp_Object parameters;
4282 struct frame *f;
4283 Lisp_Object frame, tem;
4284 Lisp_Object name;
4285 int minibuffer_only = 0;
4286 long window_prompting = 0;
4287 int width, height;
4288 int count = SPECPDL_INDEX ();
4289 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
4290 Lisp_Object display;
4291 struct w32_display_info *dpyinfo = NULL;
4292 Lisp_Object parent;
4293 struct kboard *kb;
4295 check_w32 ();
4297 /* Make copy of frame parameters because the original is in pure
4298 storage now. */
4299 parameters = Fcopy_alist (parameters);
4301 /* Use this general default value to start with
4302 until we know if this frame has a specified name. */
4303 Vx_resource_name = Vinvocation_name;
4305 display = w32_get_arg (parameters, Qdisplay, 0, 0, RES_TYPE_STRING);
4306 if (EQ (display, Qunbound))
4307 display = Qnil;
4308 dpyinfo = check_x_display_info (display);
4309 #ifdef MULTI_KBOARD
4310 kb = dpyinfo->terminal->kboard;
4311 #else
4312 kb = &the_only_kboard;
4313 #endif
4315 name = w32_get_arg (parameters, Qname, "name", "Name", RES_TYPE_STRING);
4316 if (!STRINGP (name)
4317 && ! EQ (name, Qunbound)
4318 && ! NILP (name))
4319 error ("Invalid frame name--not a string or nil");
4321 if (STRINGP (name))
4322 Vx_resource_name = name;
4324 /* See if parent window is specified. */
4325 parent = w32_get_arg (parameters, Qparent_id, NULL, NULL, RES_TYPE_NUMBER);
4326 if (EQ (parent, Qunbound))
4327 parent = Qnil;
4328 if (! NILP (parent))
4329 CHECK_NUMBER (parent);
4331 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
4332 /* No need to protect DISPLAY because that's not used after passing
4333 it to make_frame_without_minibuffer. */
4334 frame = Qnil;
4335 GCPRO4 (parameters, parent, name, frame);
4336 tem = w32_get_arg (parameters, Qminibuffer, "minibuffer", "Minibuffer",
4337 RES_TYPE_SYMBOL);
4338 if (EQ (tem, Qnone) || NILP (tem))
4339 f = make_frame_without_minibuffer (Qnil, kb, display);
4340 else if (EQ (tem, Qonly))
4342 f = make_minibuffer_frame ();
4343 minibuffer_only = 1;
4345 else if (WINDOWP (tem))
4346 f = make_frame_without_minibuffer (tem, kb, display);
4347 else
4348 f = make_frame (1);
4350 XSETFRAME (frame, f);
4352 /* Note that Windows does support scroll bars. */
4353 FRAME_CAN_HAVE_SCROLL_BARS (f) = 1;
4355 /* By default, make scrollbars the system standard width. */
4356 FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = GetSystemMetrics (SM_CXVSCROLL);
4358 f->terminal = dpyinfo->terminal;
4359 f->terminal->reference_count++;
4361 f->output_method = output_w32;
4362 f->output_data.w32 =
4363 (struct w32_output *) xmalloc (sizeof (struct w32_output));
4364 bzero (f->output_data.w32, sizeof (struct w32_output));
4365 FRAME_FONTSET (f) = -1;
4366 record_unwind_protect (unwind_create_frame, frame);
4368 f->icon_name
4369 = w32_get_arg (parameters, Qicon_name, "iconName", "Title", RES_TYPE_STRING);
4370 if (! STRINGP (f->icon_name))
4371 f->icon_name = Qnil;
4373 /* FRAME_W32_DISPLAY_INFO (f) = dpyinfo; */
4374 #ifdef MULTI_KBOARD
4375 FRAME_KBOARD (f) = kb;
4376 #endif
4378 /* Specify the parent under which to make this window. */
4380 if (!NILP (parent))
4382 f->output_data.w32->parent_desc = (Window) XFASTINT (parent);
4383 f->output_data.w32->explicit_parent = 1;
4385 else
4387 f->output_data.w32->parent_desc = FRAME_W32_DISPLAY_INFO (f)->root_window;
4388 f->output_data.w32->explicit_parent = 0;
4391 /* Set the name; the functions to which we pass f expect the name to
4392 be set. */
4393 if (EQ (name, Qunbound) || NILP (name))
4395 f->name = build_string (dpyinfo->w32_id_name);
4396 f->explicit_name = 0;
4398 else
4400 f->name = name;
4401 f->explicit_name = 1;
4402 /* use the frame's title when getting resources for this frame. */
4403 specbind (Qx_resource_name, name);
4406 f->resx = dpyinfo->resx;
4407 f->resy = dpyinfo->resy;
4409 #ifdef USE_FONT_BACKEND
4410 if (enable_font_backend)
4412 /* Perhaps, we must allow frame parameter, say `font-backend',
4413 to specify which font backends to use. */
4414 register_font_driver (&w32font_driver, f);
4416 x_default_parameter (f, parameters, Qfont_backend, Qnil,
4417 "fontBackend", "FontBackend", RES_TYPE_STRING);
4419 #endif /* USE_FONT_BACKEND */
4421 /* Extract the window parameters from the supplied values
4422 that are needed to determine window geometry. */
4423 #ifdef USE_FONT_BACKEND
4424 if (enable_font_backend)
4425 x_default_font_parameter (f, parameters);
4426 else
4427 #endif
4429 Lisp_Object font;
4431 font = w32_get_arg (parameters, Qfont, "font", "Font", RES_TYPE_STRING);
4433 BLOCK_INPUT;
4434 /* First, try whatever font the caller has specified. */
4435 if (STRINGP (font))
4437 tem = Fquery_fontset (font, Qnil);
4438 if (STRINGP (tem))
4439 font = x_new_fontset (f, tem);
4440 else
4441 font = x_new_font (f, SDATA (font));
4443 /* Try out a font which we hope has bold and italic variations. */
4444 if (!STRINGP (font))
4445 font = x_new_font (f, "-*-Courier New-normal-r-*-*-*-100-*-*-c-*-iso8859-1");
4446 if (! STRINGP (font))
4447 font = x_new_font (f, "-*-Courier-normal-r-*-*-13-*-*-*-c-*-iso8859-1");
4448 /* If those didn't work, look for something which will at least work. */
4449 if (! STRINGP (font))
4450 font = x_new_font (f, "-*-Fixedsys-normal-r-*-*-12-*-*-*-c-*-iso8859-1");
4451 UNBLOCK_INPUT;
4452 if (! STRINGP (font))
4453 font = build_string ("Fixedsys");
4455 x_default_parameter (f, parameters, Qfont, font,
4456 "font", "Font", RES_TYPE_STRING);
4459 x_default_parameter (f, parameters, Qborder_width, make_number (2),
4460 "borderWidth", "BorderWidth", RES_TYPE_NUMBER);
4461 /* This defaults to 2 in order to match xterm. We recognize either
4462 internalBorderWidth or internalBorder (which is what xterm calls
4463 it). */
4464 if (NILP (Fassq (Qinternal_border_width, parameters)))
4466 Lisp_Object value;
4468 value = w32_get_arg (parameters, Qinternal_border_width,
4469 "internalBorder", "InternalBorder", RES_TYPE_NUMBER);
4470 if (! EQ (value, Qunbound))
4471 parameters = Fcons (Fcons (Qinternal_border_width, value),
4472 parameters);
4474 /* Default internalBorderWidth to 0 on Windows to match other programs. */
4475 x_default_parameter (f, parameters, Qinternal_border_width, make_number (0),
4476 "internalBorderWidth", "InternalBorder", RES_TYPE_NUMBER);
4477 x_default_parameter (f, parameters, Qvertical_scroll_bars, Qright,
4478 "verticalScrollBars", "ScrollBars", RES_TYPE_SYMBOL);
4480 /* Also do the stuff which must be set before the window exists. */
4481 x_default_parameter (f, parameters, Qforeground_color, build_string ("black"),
4482 "foreground", "Foreground", RES_TYPE_STRING);
4483 x_default_parameter (f, parameters, Qbackground_color, build_string ("white"),
4484 "background", "Background", RES_TYPE_STRING);
4485 x_default_parameter (f, parameters, Qmouse_color, build_string ("black"),
4486 "pointerColor", "Foreground", RES_TYPE_STRING);
4487 x_default_parameter (f, parameters, Qcursor_color, build_string ("black"),
4488 "cursorColor", "Foreground", RES_TYPE_STRING);
4489 x_default_parameter (f, parameters, Qborder_color, build_string ("black"),
4490 "borderColor", "BorderColor", RES_TYPE_STRING);
4491 x_default_parameter (f, parameters, Qscreen_gamma, Qnil,
4492 "screenGamma", "ScreenGamma", RES_TYPE_FLOAT);
4493 x_default_parameter (f, parameters, Qline_spacing, Qnil,
4494 "lineSpacing", "LineSpacing", RES_TYPE_NUMBER);
4495 x_default_parameter (f, parameters, Qleft_fringe, Qnil,
4496 "leftFringe", "LeftFringe", RES_TYPE_NUMBER);
4497 x_default_parameter (f, parameters, Qright_fringe, Qnil,
4498 "rightFringe", "RightFringe", RES_TYPE_NUMBER);
4501 /* Init faces before x_default_parameter is called for scroll-bar
4502 parameters because that function calls x_set_scroll_bar_width,
4503 which calls change_frame_size, which calls Fset_window_buffer,
4504 which runs hooks, which call Fvertical_motion. At the end, we
4505 end up in init_iterator with a null face cache, which should not
4506 happen. */
4507 init_frame_faces (f);
4509 x_default_parameter (f, parameters, Qmenu_bar_lines, make_number (1),
4510 "menuBar", "MenuBar", RES_TYPE_NUMBER);
4511 x_default_parameter (f, parameters, Qtool_bar_lines, make_number (1),
4512 "toolBar", "ToolBar", RES_TYPE_NUMBER);
4514 x_default_parameter (f, parameters, Qbuffer_predicate, Qnil,
4515 "bufferPredicate", "BufferPredicate", RES_TYPE_SYMBOL);
4516 x_default_parameter (f, parameters, Qtitle, Qnil,
4517 "title", "Title", RES_TYPE_STRING);
4518 x_default_parameter (f, parameters, Qfullscreen, Qnil,
4519 "fullscreen", "Fullscreen", RES_TYPE_SYMBOL);
4521 f->output_data.w32->dwStyle = WS_OVERLAPPEDWINDOW;
4522 f->output_data.w32->parent_desc = FRAME_W32_DISPLAY_INFO (f)->root_window;
4524 f->output_data.w32->text_cursor = w32_load_cursor (IDC_IBEAM);
4525 f->output_data.w32->nontext_cursor = w32_load_cursor (IDC_ARROW);
4526 f->output_data.w32->modeline_cursor = w32_load_cursor (IDC_ARROW);
4527 f->output_data.w32->hand_cursor = w32_load_cursor (IDC_HAND);
4528 f->output_data.w32->hourglass_cursor = w32_load_cursor (IDC_WAIT);
4529 f->output_data.w32->horizontal_drag_cursor = w32_load_cursor (IDC_SIZEWE);
4531 window_prompting = x_figure_window_size (f, parameters, 1);
4533 tem = w32_get_arg (parameters, Qunsplittable, 0, 0, RES_TYPE_BOOLEAN);
4534 f->no_split = minibuffer_only || EQ (tem, Qt);
4536 w32_window (f, window_prompting, minibuffer_only);
4537 x_icon (f, parameters);
4539 x_make_gc (f);
4541 /* Now consider the frame official. */
4542 FRAME_W32_DISPLAY_INFO (f)->reference_count++;
4543 Vframe_list = Fcons (frame, Vframe_list);
4545 /* We need to do this after creating the window, so that the
4546 icon-creation functions can say whose icon they're describing. */
4547 x_default_parameter (f, parameters, Qicon_type, Qnil,
4548 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL);
4550 x_default_parameter (f, parameters, Qauto_raise, Qnil,
4551 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN);
4552 x_default_parameter (f, parameters, Qauto_lower, Qnil,
4553 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN);
4554 x_default_parameter (f, parameters, Qcursor_type, Qbox,
4555 "cursorType", "CursorType", RES_TYPE_SYMBOL);
4556 x_default_parameter (f, parameters, Qscroll_bar_width, Qnil,
4557 "scrollBarWidth", "ScrollBarWidth", RES_TYPE_NUMBER);
4559 /* Dimensions, especially FRAME_LINES (f), must be done via change_frame_size.
4560 Change will not be effected unless different from the current
4561 FRAME_LINES (f). */
4562 width = FRAME_COLS (f);
4563 height = FRAME_LINES (f);
4565 FRAME_LINES (f) = 0;
4566 SET_FRAME_COLS (f, 0);
4567 change_frame_size (f, height, width, 1, 0, 0);
4569 /* Tell the server what size and position, etc, we want, and how
4570 badly we want them. This should be done after we have the menu
4571 bar so that its size can be taken into account. */
4572 BLOCK_INPUT;
4573 x_wm_set_size_hint (f, window_prompting, 0);
4574 UNBLOCK_INPUT;
4576 /* Make the window appear on the frame and enable display, unless
4577 the caller says not to. However, with explicit parent, Emacs
4578 cannot control visibility, so don't try. */
4579 if (! f->output_data.w32->explicit_parent)
4581 Lisp_Object visibility;
4583 visibility = w32_get_arg (parameters, Qvisibility, 0, 0, RES_TYPE_SYMBOL);
4584 if (EQ (visibility, Qunbound))
4585 visibility = Qt;
4587 if (EQ (visibility, Qicon))
4588 x_iconify_frame (f);
4589 else if (! NILP (visibility))
4590 x_make_frame_visible (f);
4591 else
4592 /* Must have been Qnil. */
4596 /* Initialize `default-minibuffer-frame' in case this is the first
4597 frame on this terminal. */
4598 if (FRAME_HAS_MINIBUF_P (f)
4599 && (!FRAMEP (kb->Vdefault_minibuffer_frame)
4600 || !FRAME_LIVE_P (XFRAME (kb->Vdefault_minibuffer_frame))))
4601 kb->Vdefault_minibuffer_frame = frame;
4603 /* All remaining specified parameters, which have not been "used"
4604 by x_get_arg and friends, now go in the misc. alist of the frame. */
4605 for (tem = parameters; CONSP (tem); tem = XCDR (tem))
4606 if (CONSP (XCAR (tem)) && !NILP (XCAR (XCAR (tem))))
4607 f->param_alist = Fcons (XCAR (tem), f->param_alist);
4609 UNGCPRO;
4611 /* Make sure windows on this frame appear in calls to next-window
4612 and similar functions. */
4613 Vwindow_list = Qnil;
4615 return unbind_to (count, frame);
4618 /* FRAME is used only to get a handle on the X display. We don't pass the
4619 display info directly because we're called from frame.c, which doesn't
4620 know about that structure. */
4621 Lisp_Object
4622 x_get_focus_frame (frame)
4623 struct frame *frame;
4625 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (frame);
4626 Lisp_Object xfocus;
4627 if (! dpyinfo->w32_focus_frame)
4628 return Qnil;
4630 XSETFRAME (xfocus, dpyinfo->w32_focus_frame);
4631 return xfocus;
4634 DEFUN ("x-focus-frame", Fx_focus_frame, Sx_focus_frame, 1, 1, 0,
4635 doc: /* Give FRAME input focus, raising to foreground if necessary. */)
4636 (frame)
4637 Lisp_Object frame;
4639 x_focus_on_frame (check_x_frame (frame));
4640 return Qnil;
4644 /* Return the charset portion of a font name. */
4645 char *
4646 xlfd_charset_of_font (char * fontname)
4648 char *charset, *encoding;
4650 encoding = strrchr (fontname, '-');
4651 if (!encoding || encoding == fontname)
4652 return NULL;
4654 for (charset = encoding - 1; charset >= fontname; charset--)
4655 if (*charset == '-')
4656 break;
4658 if (charset == fontname || strcmp (charset, "-*-*") == 0)
4659 return NULL;
4661 return charset + 1;
4664 struct font_info *w32_load_bdf_font (struct frame *f, char *fontname,
4665 int size, char* filename);
4666 static Lisp_Object w32_list_bdf_fonts (Lisp_Object pattern, int max_names);
4667 static BOOL w32_to_x_font (LOGFONT * lplf, char * lpxstr, int len,
4668 char * charset);
4669 static BOOL x_to_w32_font (char *lpxstr, LOGFONT *lplogfont);
4671 static struct font_info *
4672 w32_load_system_font (f, fontname, size)
4673 struct frame *f;
4674 char * fontname;
4675 int size;
4677 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
4678 Lisp_Object font_names;
4680 /* Get a list of all the fonts that match this name. Once we
4681 have a list of matching fonts, we compare them against the fonts
4682 we already have loaded by comparing names. */
4683 font_names = w32_list_fonts (f, build_string (fontname), size, 100);
4685 if (!NILP (font_names))
4687 Lisp_Object tail;
4688 int i;
4690 /* First check if any are already loaded, as that is cheaper
4691 than loading another one. */
4692 for (i = 0; i < dpyinfo->n_fonts; i++)
4693 for (tail = font_names; CONSP (tail); tail = XCDR (tail))
4694 if (dpyinfo->font_table[i].name
4695 && (!strcmp (dpyinfo->font_table[i].name,
4696 SDATA (XCAR (tail)))
4697 || !strcmp (dpyinfo->font_table[i].full_name,
4698 SDATA (XCAR (tail)))))
4699 return (dpyinfo->font_table + i);
4701 fontname = (char *) SDATA (XCAR (font_names));
4703 else if (w32_strict_fontnames)
4705 /* If EnumFontFamiliesEx was available, we got a full list of
4706 fonts back so stop now to avoid the possibility of loading a
4707 random font. If we had to fall back to EnumFontFamilies, the
4708 list is incomplete, so continue whether the font we want was
4709 listed or not. */
4710 HMODULE gdi32 = GetModuleHandle ("gdi32.dll");
4711 FARPROC enum_font_families_ex
4712 = GetProcAddress (gdi32, "EnumFontFamiliesExA");
4713 if (enum_font_families_ex)
4714 return NULL;
4717 /* Load the font and add it to the table. */
4719 char *full_name, *encoding, *charset;
4720 XFontStruct *font;
4721 struct font_info *fontp;
4722 LOGFONT lf;
4723 BOOL ok;
4724 int codepage;
4725 int i;
4727 if (!fontname || !x_to_w32_font (fontname, &lf))
4728 return (NULL);
4730 if (!*lf.lfFaceName)
4731 /* If no name was specified for the font, we get a random font
4732 from CreateFontIndirect - this is not particularly
4733 desirable, especially since CreateFontIndirect does not
4734 fill out the missing name in lf, so we never know what we
4735 ended up with. */
4736 return NULL;
4738 lf.lfQuality = DEFAULT_QUALITY;
4740 font = (XFontStruct *) xmalloc (sizeof (XFontStruct));
4741 bzero (font, sizeof (*font));
4743 /* Set bdf to NULL to indicate that this is a Windows font. */
4744 font->bdf = NULL;
4746 BLOCK_INPUT;
4748 font->hfont = CreateFontIndirect (&lf);
4750 if (font->hfont == NULL)
4752 ok = FALSE;
4754 else
4756 HDC hdc;
4757 HANDLE oldobj;
4759 codepage = w32_codepage_for_font (fontname);
4761 hdc = GetDC (dpyinfo->root_window);
4762 oldobj = SelectObject (hdc, font->hfont);
4764 ok = GetTextMetrics (hdc, &font->tm);
4765 if (codepage == CP_UNICODE)
4766 font->double_byte_p = 1;
4767 else
4769 /* Unfortunately, some fonts (eg. MingLiU, a big5 ttf font)
4770 don't report themselves as double byte fonts, when
4771 patently they are. So instead of trusting
4772 GetFontLanguageInfo, we check the properties of the
4773 codepage directly, since that is ultimately what we are
4774 working from anyway. */
4775 /* font->double_byte_p = GetFontLanguageInfo (hdc) & GCP_DBCS; */
4776 CPINFO cpi = {0};
4777 GetCPInfo (codepage, &cpi);
4778 font->double_byte_p = cpi.MaxCharSize > 1;
4781 SelectObject (hdc, oldobj);
4782 ReleaseDC (dpyinfo->root_window, hdc);
4783 /* Fill out details in lf according to the font that was
4784 actually loaded. */
4785 lf.lfHeight = font->tm.tmInternalLeading - font->tm.tmHeight;
4786 lf.lfWidth = font->tm.tmMaxCharWidth;
4787 lf.lfWeight = font->tm.tmWeight;
4788 lf.lfItalic = font->tm.tmItalic;
4789 lf.lfCharSet = font->tm.tmCharSet;
4790 lf.lfPitchAndFamily = ((font->tm.tmPitchAndFamily & TMPF_FIXED_PITCH)
4791 ? VARIABLE_PITCH : FIXED_PITCH);
4792 lf.lfOutPrecision = ((font->tm.tmPitchAndFamily & TMPF_VECTOR)
4793 ? OUT_STROKE_PRECIS : OUT_STRING_PRECIS);
4795 w32_cache_char_metrics (font);
4798 UNBLOCK_INPUT;
4800 if (!ok)
4802 w32_unload_font (dpyinfo, font);
4803 return (NULL);
4806 /* Find a free slot in the font table. */
4807 for (i = 0; i < dpyinfo->n_fonts; ++i)
4808 if (dpyinfo->font_table[i].name == NULL)
4809 break;
4811 /* If no free slot found, maybe enlarge the font table. */
4812 if (i == dpyinfo->n_fonts
4813 && dpyinfo->n_fonts == dpyinfo->font_table_size)
4815 int sz;
4816 dpyinfo->font_table_size = max (16, 2 * dpyinfo->font_table_size);
4817 sz = dpyinfo->font_table_size * sizeof *dpyinfo->font_table;
4818 dpyinfo->font_table
4819 = (struct font_info *) xrealloc (dpyinfo->font_table, sz);
4822 fontp = dpyinfo->font_table + i;
4823 if (i == dpyinfo->n_fonts)
4824 ++dpyinfo->n_fonts;
4826 /* Now fill in the slots of *FONTP. */
4827 BLOCK_INPUT;
4828 bzero (fontp, sizeof (*fontp));
4829 fontp->font = font;
4830 fontp->font_idx = i;
4831 fontp->name = (char *) xmalloc (strlen (fontname) + 1);
4832 bcopy (fontname, fontp->name, strlen (fontname) + 1);
4834 if ((lf.lfPitchAndFamily & 0x03) == FIXED_PITCH)
4836 /* Fixed width font. */
4837 fontp->average_width = fontp->space_width = FONT_AVG_WIDTH (font);
4839 else
4841 wchar_t space = 32;
4842 XCharStruct* pcm;
4843 pcm = w32_per_char_metric (font, &space, ANSI_FONT);
4844 if (pcm)
4845 fontp->space_width = pcm->width;
4846 else
4847 fontp->space_width = FONT_AVG_WIDTH (font);
4849 fontp->average_width = font->tm.tmAveCharWidth;
4852 fontp->charset = -1;
4853 charset = xlfd_charset_of_font (fontname);
4855 /* Cache the W32 codepage for a font. This makes w32_encode_char
4856 (called for every glyph during redisplay) much faster. */
4857 fontp->codepage = codepage;
4859 /* Work out the font's full name. */
4860 full_name = (char *)xmalloc (100);
4861 if (full_name && w32_to_x_font (&lf, full_name, 100, charset))
4862 fontp->full_name = full_name;
4863 else
4865 /* If all else fails - just use the name we used to load it. */
4866 xfree (full_name);
4867 fontp->full_name = fontp->name;
4870 fontp->size = FONT_WIDTH (font);
4871 fontp->height = FONT_HEIGHT (font);
4873 /* The slot `encoding' specifies how to map a character
4874 code-points (0x20..0x7F or 0x2020..0x7F7F) of each charset to
4875 the font code-points (0:0x20..0x7F, 1:0xA0..0xFF), or
4876 (0:0x20..0x7F, 1:0xA0..0xFF,
4877 (0:0x2020..0x7F7F, 1:0xA0A0..0xFFFF, 3:0x20A0..0x7FFF,
4878 2:0xA020..0xFF7F). For the moment, we don't know which charset
4879 uses this font. So, we set information in fontp->encoding_type
4880 which is never used by any charset. If mapping can't be
4881 decided, set FONT_ENCODING_NOT_DECIDED. */
4883 /* SJIS fonts need to be set to type 4, all others seem to work as
4884 type FONT_ENCODING_NOT_DECIDED. */
4885 encoding = strrchr (fontp->name, '-');
4886 if (encoding && strnicmp (encoding+1, "sjis", 4) == 0)
4887 fontp->encoding_type = 4;
4888 else
4889 fontp->encoding_type = FONT_ENCODING_NOT_DECIDED;
4891 /* The following three values are set to 0 under W32, which is
4892 what they get set to if XGetFontProperty fails under X. */
4893 fontp->baseline_offset = 0;
4894 fontp->relative_compose = 0;
4895 fontp->default_ascent = 0;
4897 /* Set global flag fonts_changed_p to non-zero if the font loaded
4898 has a character with a smaller width than any other character
4899 before, or if the font loaded has a smaller height than any
4900 other font loaded before. If this happens, it will make a
4901 glyph matrix reallocation necessary. */
4902 fonts_changed_p |= x_compute_min_glyph_bounds (f);
4903 UNBLOCK_INPUT;
4904 return fontp;
4908 /* Load font named FONTNAME of size SIZE for frame F, and return a
4909 pointer to the structure font_info while allocating it dynamically.
4910 If loading fails, return NULL. */
4911 struct font_info *
4912 w32_load_font (f, fontname, size)
4913 struct frame *f;
4914 char * fontname;
4915 int size;
4917 Lisp_Object bdf_fonts;
4918 struct font_info *retval = NULL;
4919 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
4921 bdf_fonts = w32_list_bdf_fonts (build_string (fontname), 1);
4923 while (!retval && CONSP (bdf_fonts))
4925 char *bdf_name, *bdf_file;
4926 Lisp_Object bdf_pair;
4927 int i;
4929 bdf_name = SDATA (XCAR (bdf_fonts));
4930 bdf_pair = Fassoc (XCAR (bdf_fonts), Vw32_bdf_filename_alist);
4931 bdf_file = SDATA (XCDR (bdf_pair));
4933 /* If the font is already loaded, do not load it again. */
4934 for (i = 0; i < dpyinfo->n_fonts; i++)
4936 if ((dpyinfo->font_table[i].name
4937 && !strcmp (dpyinfo->font_table[i].name, bdf_name))
4938 || (dpyinfo->font_table[i].full_name
4939 && !strcmp (dpyinfo->font_table[i].full_name, bdf_name)))
4940 return dpyinfo->font_table + i;
4943 retval = w32_load_bdf_font (f, bdf_name, size, bdf_file);
4945 bdf_fonts = XCDR (bdf_fonts);
4948 if (retval)
4949 return retval;
4951 return w32_load_system_font (f, fontname, size);
4955 void
4956 w32_unload_font (dpyinfo, font)
4957 struct w32_display_info *dpyinfo;
4958 XFontStruct * font;
4960 if (font)
4962 if (font->per_char) xfree (font->per_char);
4963 if (font->bdf) w32_free_bdf_font (font->bdf);
4965 if (font->hfont) DeleteObject (font->hfont);
4966 xfree (font);
4970 /* The font conversion stuff between x and w32 */
4972 /* X font string is as follows (from faces.el)
4973 * (let ((- "[-?]")
4974 * (foundry "[^-]+")
4975 * (family "[^-]+")
4976 * (weight "\\(bold\\|demibold\\|medium\\)") ; 1
4977 * (weight\? "\\([^-]*\\)") ; 1
4978 * (slant "\\([ior]\\)") ; 2
4979 * (slant\? "\\([^-]?\\)") ; 2
4980 * (swidth "\\([^-]*\\)") ; 3
4981 * (adstyle "[^-]*") ; 4
4982 * (pixelsize "[0-9]+")
4983 * (pointsize "[0-9][0-9]+")
4984 * (resx "[0-9][0-9]+")
4985 * (resy "[0-9][0-9]+")
4986 * (spacing "[cmp?*]")
4987 * (avgwidth "[0-9]+")
4988 * (registry "[^-]+")
4989 * (encoding "[^-]+")
4993 static LONG
4994 x_to_w32_weight (lpw)
4995 char * lpw;
4997 if (!lpw) return (FW_DONTCARE);
4999 if (stricmp (lpw, "heavy") == 0) return FW_HEAVY;
5000 else if (stricmp (lpw, "extrabold") == 0) return FW_EXTRABOLD;
5001 else if (stricmp (lpw, "bold") == 0) return FW_BOLD;
5002 else if (stricmp (lpw, "demibold") == 0) return FW_SEMIBOLD;
5003 else if (stricmp (lpw, "semibold") == 0) return FW_SEMIBOLD;
5004 else if (stricmp (lpw, "medium") == 0) return FW_MEDIUM;
5005 else if (stricmp (lpw, "normal") == 0) return FW_NORMAL;
5006 else if (stricmp (lpw, "light") == 0) return FW_LIGHT;
5007 else if (stricmp (lpw, "extralight") == 0) return FW_EXTRALIGHT;
5008 else if (stricmp (lpw, "thin") == 0) return FW_THIN;
5009 else
5010 return FW_DONTCARE;
5014 static char *
5015 w32_to_x_weight (fnweight)
5016 int fnweight;
5018 if (fnweight >= FW_HEAVY) return "heavy";
5019 if (fnweight >= FW_EXTRABOLD) return "extrabold";
5020 if (fnweight >= FW_BOLD) return "bold";
5021 if (fnweight >= FW_SEMIBOLD) return "demibold";
5022 if (fnweight >= FW_MEDIUM) return "medium";
5023 if (fnweight >= FW_NORMAL) return "normal";
5024 if (fnweight >= FW_LIGHT) return "light";
5025 if (fnweight >= FW_EXTRALIGHT) return "extralight";
5026 if (fnweight >= FW_THIN) return "thin";
5027 else
5028 return "*";
5031 LONG
5032 x_to_w32_charset (lpcs)
5033 char * lpcs;
5035 Lisp_Object this_entry, w32_charset;
5036 char *charset;
5037 int len = strlen (lpcs);
5039 /* Support "*-#nnn" format for unknown charsets. */
5040 if (strncmp (lpcs, "*-#", 3) == 0)
5041 return atoi (lpcs + 3);
5043 /* All Windows fonts qualify as unicode. */
5044 if (!strncmp (lpcs, "iso10646", 8))
5045 return DEFAULT_CHARSET;
5047 /* Handle wildcards by ignoring them; eg. treat "big5*-*" as "big5". */
5048 charset = alloca (len + 1);
5049 strcpy (charset, lpcs);
5050 lpcs = strchr (charset, '*');
5051 if (lpcs)
5052 *lpcs = '\0';
5054 /* Look through w32-charset-info-alist for the character set.
5055 Format of each entry is
5056 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
5058 this_entry = Fassoc (build_string (charset), Vw32_charset_info_alist);
5060 if (NILP (this_entry))
5062 /* At startup, we want iso8859-1 fonts to come up properly. */
5063 if (stricmp (charset, "iso8859-1") == 0)
5064 return ANSI_CHARSET;
5065 else
5066 return DEFAULT_CHARSET;
5069 w32_charset = Fcar (Fcdr (this_entry));
5071 /* Translate Lisp symbol to number. */
5072 if (EQ (w32_charset, Qw32_charset_ansi))
5073 return ANSI_CHARSET;
5074 if (EQ (w32_charset, Qw32_charset_symbol))
5075 return SYMBOL_CHARSET;
5076 if (EQ (w32_charset, Qw32_charset_shiftjis))
5077 return SHIFTJIS_CHARSET;
5078 if (EQ (w32_charset, Qw32_charset_hangeul))
5079 return HANGEUL_CHARSET;
5080 if (EQ (w32_charset, Qw32_charset_chinesebig5))
5081 return CHINESEBIG5_CHARSET;
5082 if (EQ (w32_charset, Qw32_charset_gb2312))
5083 return GB2312_CHARSET;
5084 if (EQ (w32_charset, Qw32_charset_oem))
5085 return OEM_CHARSET;
5086 #ifdef JOHAB_CHARSET
5087 if (EQ (w32_charset, Qw32_charset_johab))
5088 return JOHAB_CHARSET;
5089 if (EQ (w32_charset, Qw32_charset_easteurope))
5090 return EASTEUROPE_CHARSET;
5091 if (EQ (w32_charset, Qw32_charset_turkish))
5092 return TURKISH_CHARSET;
5093 if (EQ (w32_charset, Qw32_charset_baltic))
5094 return BALTIC_CHARSET;
5095 if (EQ (w32_charset, Qw32_charset_russian))
5096 return RUSSIAN_CHARSET;
5097 if (EQ (w32_charset, Qw32_charset_arabic))
5098 return ARABIC_CHARSET;
5099 if (EQ (w32_charset, Qw32_charset_greek))
5100 return GREEK_CHARSET;
5101 if (EQ (w32_charset, Qw32_charset_hebrew))
5102 return HEBREW_CHARSET;
5103 if (EQ (w32_charset, Qw32_charset_vietnamese))
5104 return VIETNAMESE_CHARSET;
5105 if (EQ (w32_charset, Qw32_charset_thai))
5106 return THAI_CHARSET;
5107 if (EQ (w32_charset, Qw32_charset_mac))
5108 return MAC_CHARSET;
5109 #endif /* JOHAB_CHARSET */
5110 #ifdef UNICODE_CHARSET
5111 if (EQ (w32_charset, Qw32_charset_unicode))
5112 return UNICODE_CHARSET;
5113 #endif
5115 return DEFAULT_CHARSET;
5119 char *
5120 w32_to_x_charset (fncharset, matching)
5121 int fncharset;
5122 char *matching;
5124 static char buf[32];
5125 Lisp_Object charset_type;
5126 int match_len = 0;
5128 if (matching)
5130 /* If fully specified, accept it as it is. Otherwise use a
5131 substring match. */
5132 char *wildcard = strchr (matching, '*');
5133 if (wildcard)
5134 *wildcard = '\0';
5135 else if (strchr (matching, '-'))
5136 return matching;
5138 match_len = strlen (matching);
5141 switch (fncharset)
5143 case ANSI_CHARSET:
5144 /* Handle startup case of w32-charset-info-alist not
5145 being set up yet. */
5146 if (NILP (Vw32_charset_info_alist))
5147 return "iso8859-1";
5148 charset_type = Qw32_charset_ansi;
5149 break;
5150 case DEFAULT_CHARSET:
5151 charset_type = Qw32_charset_default;
5152 break;
5153 case SYMBOL_CHARSET:
5154 charset_type = Qw32_charset_symbol;
5155 break;
5156 case SHIFTJIS_CHARSET:
5157 charset_type = Qw32_charset_shiftjis;
5158 break;
5159 case HANGEUL_CHARSET:
5160 charset_type = Qw32_charset_hangeul;
5161 break;
5162 case GB2312_CHARSET:
5163 charset_type = Qw32_charset_gb2312;
5164 break;
5165 case CHINESEBIG5_CHARSET:
5166 charset_type = Qw32_charset_chinesebig5;
5167 break;
5168 case OEM_CHARSET:
5169 charset_type = Qw32_charset_oem;
5170 break;
5172 /* More recent versions of Windows (95 and NT4.0) define more
5173 character sets. */
5174 #ifdef EASTEUROPE_CHARSET
5175 case EASTEUROPE_CHARSET:
5176 charset_type = Qw32_charset_easteurope;
5177 break;
5178 case TURKISH_CHARSET:
5179 charset_type = Qw32_charset_turkish;
5180 break;
5181 case BALTIC_CHARSET:
5182 charset_type = Qw32_charset_baltic;
5183 break;
5184 case RUSSIAN_CHARSET:
5185 charset_type = Qw32_charset_russian;
5186 break;
5187 case ARABIC_CHARSET:
5188 charset_type = Qw32_charset_arabic;
5189 break;
5190 case GREEK_CHARSET:
5191 charset_type = Qw32_charset_greek;
5192 break;
5193 case HEBREW_CHARSET:
5194 charset_type = Qw32_charset_hebrew;
5195 break;
5196 case VIETNAMESE_CHARSET:
5197 charset_type = Qw32_charset_vietnamese;
5198 break;
5199 case THAI_CHARSET:
5200 charset_type = Qw32_charset_thai;
5201 break;
5202 case MAC_CHARSET:
5203 charset_type = Qw32_charset_mac;
5204 break;
5205 case JOHAB_CHARSET:
5206 charset_type = Qw32_charset_johab;
5207 break;
5208 #endif
5210 #ifdef UNICODE_CHARSET
5211 case UNICODE_CHARSET:
5212 charset_type = Qw32_charset_unicode;
5213 break;
5214 #endif
5215 default:
5216 /* Encode numerical value of unknown charset. */
5217 sprintf (buf, "*-#%u", fncharset);
5218 return buf;
5222 Lisp_Object rest;
5223 char * best_match = NULL;
5224 int matching_found = 0;
5226 /* Look through w32-charset-info-alist for the character set.
5227 Prefer ISO codepages, and prefer lower numbers in the ISO
5228 range. Only return charsets for codepages which are installed.
5230 Format of each entry is
5231 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
5233 for (rest = Vw32_charset_info_alist; CONSP (rest); rest = XCDR (rest))
5235 char * x_charset;
5236 Lisp_Object w32_charset;
5237 Lisp_Object codepage;
5239 Lisp_Object this_entry = XCAR (rest);
5241 /* Skip invalid entries in alist. */
5242 if (!CONSP (this_entry) || !STRINGP (XCAR (this_entry))
5243 || !CONSP (XCDR (this_entry))
5244 || !SYMBOLP (XCAR (XCDR (this_entry))))
5245 continue;
5247 x_charset = SDATA (XCAR (this_entry));
5248 w32_charset = XCAR (XCDR (this_entry));
5249 codepage = XCDR (XCDR (this_entry));
5251 /* Look for Same charset and a valid codepage (or non-int
5252 which means ignore). */
5253 if (EQ (w32_charset, charset_type)
5254 && (!INTEGERP (codepage) || XINT (codepage) == CP_DEFAULT
5255 || IsValidCodePage (XINT (codepage))))
5257 /* If we don't have a match already, then this is the
5258 best. */
5259 if (!best_match)
5261 best_match = x_charset;
5262 if (matching && !strnicmp (x_charset, matching, match_len))
5263 matching_found = 1;
5265 /* If we already found a match for MATCHING, then
5266 only consider other matches. */
5267 else if (matching_found
5268 && strnicmp (x_charset, matching, match_len))
5269 continue;
5270 /* If this matches what we want, and the best so far doesn't,
5271 then this is better. */
5272 else if (!matching_found && matching
5273 && !strnicmp (x_charset, matching, match_len))
5275 best_match = x_charset;
5276 matching_found = 1;
5278 /* If this is fully specified, and the best so far isn't,
5279 then this is better. */
5280 else if ((!strchr (best_match, '-') && strchr (x_charset, '-'))
5281 /* If this is an ISO codepage, and the best so far isn't,
5282 then this is better, but only if it fully specifies the
5283 encoding. */
5284 || (strnicmp (best_match, "iso", 3) != 0
5285 && strnicmp (x_charset, "iso", 3) == 0
5286 && strchr (x_charset, '-')))
5287 best_match = x_charset;
5288 /* If both are ISO8859 codepages, choose the one with the
5289 lowest number in the encoding field. */
5290 else if (strnicmp (best_match, "iso8859-", 8) == 0
5291 && strnicmp (x_charset, "iso8859-", 8) == 0)
5293 int best_enc = atoi (best_match + 8);
5294 int this_enc = atoi (x_charset + 8);
5295 if (this_enc > 0 && this_enc < best_enc)
5296 best_match = x_charset;
5301 /* If no match, encode the numeric value. */
5302 if (!best_match)
5304 sprintf (buf, "*-#%u", fncharset);
5305 return buf;
5308 strncpy (buf, best_match, 31);
5309 /* If the charset is not fully specified, put -0 on the end. */
5310 if (!strchr (best_match, '-'))
5312 int pos = strlen (best_match);
5313 /* Charset specifiers shouldn't be very long. If it is a made
5314 up one, truncating it should not do any harm since it isn't
5315 recognized anyway. */
5316 if (pos > 29)
5317 pos = 29;
5318 strcpy (buf + pos, "-0");
5320 buf[31] = '\0';
5321 return buf;
5326 /* Return all the X charsets that map to a font. */
5327 static Lisp_Object
5328 w32_to_all_x_charsets (fncharset)
5329 int fncharset;
5331 static char buf[32];
5332 Lisp_Object charset_type;
5333 Lisp_Object retval = Qnil;
5335 switch (fncharset)
5337 case ANSI_CHARSET:
5338 /* Handle startup case of w32-charset-info-alist not
5339 being set up yet. */
5340 if (NILP (Vw32_charset_info_alist))
5341 return Fcons (build_string ("iso8859-1"), Qnil);
5343 charset_type = Qw32_charset_ansi;
5344 break;
5345 case DEFAULT_CHARSET:
5346 charset_type = Qw32_charset_default;
5347 break;
5348 case SYMBOL_CHARSET:
5349 charset_type = Qw32_charset_symbol;
5350 break;
5351 case SHIFTJIS_CHARSET:
5352 charset_type = Qw32_charset_shiftjis;
5353 break;
5354 case HANGEUL_CHARSET:
5355 charset_type = Qw32_charset_hangeul;
5356 break;
5357 case GB2312_CHARSET:
5358 charset_type = Qw32_charset_gb2312;
5359 break;
5360 case CHINESEBIG5_CHARSET:
5361 charset_type = Qw32_charset_chinesebig5;
5362 break;
5363 case OEM_CHARSET:
5364 charset_type = Qw32_charset_oem;
5365 break;
5367 /* More recent versions of Windows (95 and NT4.0) define more
5368 character sets. */
5369 #ifdef EASTEUROPE_CHARSET
5370 case EASTEUROPE_CHARSET:
5371 charset_type = Qw32_charset_easteurope;
5372 break;
5373 case TURKISH_CHARSET:
5374 charset_type = Qw32_charset_turkish;
5375 break;
5376 case BALTIC_CHARSET:
5377 charset_type = Qw32_charset_baltic;
5378 break;
5379 case RUSSIAN_CHARSET:
5380 charset_type = Qw32_charset_russian;
5381 break;
5382 case ARABIC_CHARSET:
5383 charset_type = Qw32_charset_arabic;
5384 break;
5385 case GREEK_CHARSET:
5386 charset_type = Qw32_charset_greek;
5387 break;
5388 case HEBREW_CHARSET:
5389 charset_type = Qw32_charset_hebrew;
5390 break;
5391 case VIETNAMESE_CHARSET:
5392 charset_type = Qw32_charset_vietnamese;
5393 break;
5394 case THAI_CHARSET:
5395 charset_type = Qw32_charset_thai;
5396 break;
5397 case MAC_CHARSET:
5398 charset_type = Qw32_charset_mac;
5399 break;
5400 case JOHAB_CHARSET:
5401 charset_type = Qw32_charset_johab;
5402 break;
5403 #endif
5405 #ifdef UNICODE_CHARSET
5406 case UNICODE_CHARSET:
5407 charset_type = Qw32_charset_unicode;
5408 break;
5409 #endif
5410 default:
5411 /* Encode numerical value of unknown charset. */
5412 sprintf (buf, "*-#%u", fncharset);
5413 return Fcons (build_string (buf), Qnil);
5417 Lisp_Object rest;
5418 /* Look through w32-charset-info-alist for the character set.
5419 Only return fully specified charsets for codepages which are
5420 installed.
5422 Format of each entry in Vw32_charset_info_alist is
5423 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
5425 for (rest = Vw32_charset_info_alist; CONSP (rest); rest = XCDR (rest))
5427 Lisp_Object x_charset;
5428 Lisp_Object w32_charset;
5429 Lisp_Object codepage;
5431 Lisp_Object this_entry = XCAR (rest);
5433 /* Skip invalid entries in alist. */
5434 if (!CONSP (this_entry) || !STRINGP (XCAR (this_entry))
5435 || !CONSP (XCDR (this_entry))
5436 || !SYMBOLP (XCAR (XCDR (this_entry))))
5437 continue;
5439 x_charset = XCAR (this_entry);
5440 w32_charset = XCAR (XCDR (this_entry));
5441 codepage = XCDR (XCDR (this_entry));
5443 if (!strchr (SDATA (x_charset), '-'))
5444 continue;
5446 /* Look for Same charset and a valid codepage (or non-int
5447 which means ignore). */
5448 if (EQ (w32_charset, charset_type)
5449 && (!INTEGERP (codepage) || XINT (codepage) == CP_DEFAULT
5450 || IsValidCodePage (XINT (codepage))))
5452 retval = Fcons (x_charset, retval);
5456 /* If no match, encode the numeric value. */
5457 if (NILP (retval))
5459 sprintf (buf, "*-#%u", fncharset);
5460 return Fcons (build_string (buf), Qnil);
5463 return retval;
5467 /* Get the Windows codepage corresponding to the specified font. The
5468 charset info in the font name is used to look up
5469 w32-charset-to-codepage-alist. */
5471 w32_codepage_for_font (char *fontname)
5473 Lisp_Object codepage, entry;
5474 char *charset_str, *charset, *end;
5476 /* Extract charset part of font string. */
5477 charset = xlfd_charset_of_font (fontname);
5479 if (!charset)
5480 return CP_UNKNOWN;
5482 charset_str = (char *) alloca (strlen (charset) + 1);
5483 strcpy (charset_str, charset);
5485 #if 0
5486 /* Remove leading "*-". */
5487 if (strncmp ("*-", charset_str, 2) == 0)
5488 charset = charset_str + 2;
5489 else
5490 #endif
5491 charset = charset_str;
5493 /* Stop match at wildcard (including preceding '-'). */
5494 if (end = strchr (charset, '*'))
5496 if (end > charset && *(end-1) == '-')
5497 end--;
5498 *end = '\0';
5501 if (!strcmp (charset, "iso10646"))
5502 return CP_UNICODE;
5504 if (NILP (Vw32_charset_info_alist))
5505 return CP_DEFAULT;
5507 entry = Fassoc (build_string(charset), Vw32_charset_info_alist);
5508 if (NILP (entry))
5509 return CP_UNKNOWN;
5511 codepage = Fcdr (Fcdr (entry));
5513 if (NILP (codepage))
5514 return CP_8BIT;
5515 else if (XFASTINT (codepage) == XFASTINT (Qt))
5516 return CP_UNICODE;
5517 else if (INTEGERP (codepage))
5518 return XINT (codepage);
5519 else
5520 return CP_UNKNOWN;
5524 static BOOL
5525 w32_to_x_font (lplogfont, lpxstr, len, specific_charset)
5526 LOGFONT * lplogfont;
5527 char * lpxstr;
5528 int len;
5529 char * specific_charset;
5531 char* fonttype;
5532 char *fontname;
5533 char height_pixels[8];
5534 char height_dpi[8];
5535 char width_pixels[8];
5536 char *fontname_dash;
5537 int display_resy = (int) one_w32_display_info.resy;
5538 int display_resx = (int) one_w32_display_info.resx;
5539 struct coding_system coding;
5541 if (!lpxstr) abort ();
5543 if (!lplogfont)
5544 return FALSE;
5546 if (lplogfont->lfOutPrecision == OUT_STRING_PRECIS)
5547 fonttype = "raster";
5548 else if (lplogfont->lfOutPrecision == OUT_STROKE_PRECIS)
5549 fonttype = "outline";
5550 else
5551 fonttype = "unknown";
5553 setup_coding_system (Fcheck_coding_system (Vlocale_coding_system),
5554 &coding);
5555 coding.src_multibyte = 0;
5556 coding.dst_multibyte = 1;
5557 coding.mode |= CODING_MODE_LAST_BLOCK;
5558 /* We explicitely disable composition handling because selection
5559 data should not contain any composition sequence. */
5560 coding.common_flags &= ~CODING_ANNOTATION_MASK;
5562 coding.dst_bytes = LF_FACESIZE * 2;
5563 coding.destination = (unsigned char *) xmalloc (coding.dst_bytes + 1);
5564 decode_coding_c_string (&coding, lplogfont->lfFaceName,
5565 strlen(lplogfont->lfFaceName), Qnil);
5566 fontname = coding.destination;
5568 *(fontname + coding.produced) = '\0';
5570 /* Replace dashes with underscores so the dashes are not
5571 misinterpreted. */
5572 fontname_dash = fontname;
5573 while (fontname_dash = strchr (fontname_dash, '-'))
5574 *fontname_dash = '_';
5576 if (lplogfont->lfHeight)
5578 sprintf (height_pixels, "%u", eabs (lplogfont->lfHeight));
5579 sprintf (height_dpi, "%u",
5580 eabs (lplogfont->lfHeight) * 720 / display_resy);
5582 else
5584 strcpy (height_pixels, "*");
5585 strcpy (height_dpi, "*");
5588 #if 0 /* Never put the width in the xfld. It fails on fonts with
5589 double-width characters. */
5590 if (lplogfont->lfWidth)
5591 sprintf (width_pixels, "%u", lplogfont->lfWidth * 10);
5592 else
5593 #endif
5594 strcpy (width_pixels, "*");
5596 _snprintf (lpxstr, len - 1,
5597 "-%s-%s-%s-%c-normal-normal-%s-%s-%d-%d-%c-%s-%s",
5598 fonttype, /* foundry */
5599 fontname, /* family */
5600 w32_to_x_weight (lplogfont->lfWeight), /* weight */
5601 lplogfont->lfItalic?'i':'r', /* slant */
5602 /* setwidth name */
5603 /* add style name */
5604 height_pixels, /* pixel size */
5605 height_dpi, /* point size */
5606 display_resx, /* resx */
5607 display_resy, /* resy */
5608 ((lplogfont->lfPitchAndFamily & 0x3) == VARIABLE_PITCH)
5609 ? 'p' : 'c', /* spacing */
5610 width_pixels, /* avg width */
5611 w32_to_x_charset (lplogfont->lfCharSet, specific_charset)
5612 /* charset registry and encoding */
5615 lpxstr[len - 1] = 0; /* just to be sure */
5616 return (TRUE);
5619 static BOOL
5620 x_to_w32_font (lpxstr, lplogfont)
5621 char * lpxstr;
5622 LOGFONT * lplogfont;
5624 struct coding_system coding;
5626 if (!lplogfont) return (FALSE);
5628 memset (lplogfont, 0, sizeof (*lplogfont));
5630 /* Set default value for each field. */
5631 #if 1
5632 lplogfont->lfOutPrecision = OUT_DEFAULT_PRECIS;
5633 lplogfont->lfClipPrecision = CLIP_DEFAULT_PRECIS;
5634 lplogfont->lfQuality = DEFAULT_QUALITY;
5635 #else
5636 /* go for maximum quality */
5637 lplogfont->lfOutPrecision = OUT_STROKE_PRECIS;
5638 lplogfont->lfClipPrecision = CLIP_STROKE_PRECIS;
5639 lplogfont->lfQuality = PROOF_QUALITY;
5640 #endif
5642 lplogfont->lfCharSet = DEFAULT_CHARSET;
5643 lplogfont->lfWeight = FW_DONTCARE;
5644 lplogfont->lfPitchAndFamily = DEFAULT_PITCH | FF_DONTCARE;
5646 if (!lpxstr)
5647 return FALSE;
5649 /* Provide a simple escape mechanism for specifying Windows font names
5650 * directly -- if font spec does not beginning with '-', assume this
5651 * format:
5652 * "<font name>[:height in pixels[:width in pixels[:weight]]]"
5655 if (*lpxstr == '-')
5657 int fields, tem;
5658 char name[50], weight[20], slant, pitch, pixels[10], height[10],
5659 width[10], resy[10], remainder[50];
5660 char * encoding;
5661 int dpi = (int) one_w32_display_info.resy;
5663 fields = sscanf (lpxstr,
5664 "-%*[^-]-%49[^-]-%19[^-]-%c-%*[^-]-%*[^-]-%9[^-]-%9[^-]-%*[^-]-%9[^-]-%c-%9[^-]-%49s",
5665 name, weight, &slant, pixels, height, resy, &pitch, width, remainder);
5666 if (fields == EOF)
5667 return (FALSE);
5669 /* In the general case when wildcards cover more than one field,
5670 we don't know which field is which, so don't fill any in.
5671 However, we need to cope with this particular form, which is
5672 generated by font_list_1 (invoked by try_font_list):
5673 "-raster-6x10-*-gb2312*-*"
5674 and make sure to correctly parse the charset field. */
5675 if (fields == 3)
5677 fields = sscanf (lpxstr,
5678 "-%*[^-]-%49[^-]-*-%49s",
5679 name, remainder);
5681 else if (fields < 9)
5683 fields = 0;
5684 remainder[0] = 0;
5687 if (fields > 0 && name[0] != '*')
5689 Lisp_Object string = build_string (name);
5690 setup_coding_system
5691 (Fcheck_coding_system (Vlocale_coding_system), &coding);
5692 coding.mode |= (CODING_MODE_SAFE_ENCODING | CODING_MODE_LAST_BLOCK);
5693 /* Disable composition/charset annotation. */
5694 coding.common_flags &= ~CODING_ANNOTATION_MASK;
5695 coding.dst_bytes = SCHARS (string) * 2;
5697 coding.destination = (unsigned char *) xmalloc (coding.dst_bytes);
5698 encode_coding_object (&coding, string, 0, 0,
5699 SCHARS (string), SBYTES (string), Qnil);
5700 if (coding.produced >= LF_FACESIZE)
5701 coding.produced = LF_FACESIZE - 1;
5703 coding.destination[coding.produced] = '\0';
5705 strcpy (lplogfont->lfFaceName, coding.destination);
5706 xfree (coding.destination);
5708 else
5710 lplogfont->lfFaceName[0] = '\0';
5713 fields--;
5715 lplogfont->lfWeight = x_to_w32_weight ((fields > 0 ? weight : ""));
5717 fields--;
5719 lplogfont->lfItalic = (fields > 0 && slant == 'i');
5721 fields--;
5723 if (fields > 0 && pixels[0] != '*')
5724 lplogfont->lfHeight = atoi (pixels);
5726 fields--;
5727 fields--;
5728 if (fields > 0 && resy[0] != '*')
5730 tem = atoi (resy);
5731 if (tem > 0) dpi = tem;
5734 if (fields > -1 && lplogfont->lfHeight == 0 && height[0] != '*')
5735 lplogfont->lfHeight = atoi (height) * dpi / 720;
5737 if (fields > 0)
5739 if (pitch == 'p')
5740 lplogfont->lfPitchAndFamily = VARIABLE_PITCH | FF_DONTCARE;
5741 else if (pitch == 'c')
5742 lplogfont->lfPitchAndFamily = FIXED_PITCH | FF_DONTCARE;
5745 fields--;
5747 if (fields > 0 && width[0] != '*')
5748 lplogfont->lfWidth = atoi (width) / 10;
5750 fields--;
5752 /* Strip the trailing '-' if present. (it shouldn't be, as it
5753 fails the test against xlfd-tight-regexp in fontset.el). */
5755 int len = strlen (remainder);
5756 if (len > 0 && remainder[len-1] == '-')
5757 remainder[len-1] = 0;
5759 encoding = remainder;
5760 #if 0
5761 if (strncmp (encoding, "*-", 2) == 0)
5762 encoding += 2;
5763 #endif
5764 lplogfont->lfCharSet = x_to_w32_charset (encoding);
5766 else
5768 int fields;
5769 char name[100], height[10], width[10], weight[20];
5771 fields = sscanf (lpxstr,
5772 "%99[^:]:%9[^:]:%9[^:]:%19s",
5773 name, height, width, weight);
5775 if (fields == EOF) return (FALSE);
5777 if (fields > 0)
5779 strncpy (lplogfont->lfFaceName, name, LF_FACESIZE);
5780 lplogfont->lfFaceName[LF_FACESIZE-1] = 0;
5782 else
5784 lplogfont->lfFaceName[0] = 0;
5787 fields--;
5789 if (fields > 0)
5790 lplogfont->lfHeight = atoi (height);
5792 fields--;
5794 if (fields > 0)
5795 lplogfont->lfWidth = atoi (width);
5797 fields--;
5799 lplogfont->lfWeight = x_to_w32_weight ((fields > 0 ? weight : ""));
5802 /* This makes TrueType fonts work better. */
5803 lplogfont->lfHeight = - eabs (lplogfont->lfHeight);
5805 return (TRUE);
5808 /* Strip the pixel height and point height from the given xlfd, and
5809 return the pixel height. If no pixel height is specified, calculate
5810 one from the point height, or if that isn't defined either, return
5811 0 (which usually signifies a scalable font).
5813 static int
5814 xlfd_strip_height (char *fontname)
5816 int pixel_height, field_number;
5817 char *read_from, *write_to;
5819 xassert (fontname);
5821 pixel_height = field_number = 0;
5822 write_to = NULL;
5824 /* Look for height fields. */
5825 for (read_from = fontname; *read_from; read_from++)
5827 if (*read_from == '-')
5829 field_number++;
5830 if (field_number == 7) /* Pixel height. */
5832 read_from++;
5833 write_to = read_from;
5835 /* Find end of field. */
5836 for (;*read_from && *read_from != '-'; read_from++)
5839 /* Split the fontname at end of field. */
5840 if (*read_from)
5842 *read_from = '\0';
5843 read_from++;
5845 pixel_height = atoi (write_to);
5846 /* Blank out field. */
5847 if (read_from > write_to)
5849 *write_to = '-';
5850 write_to++;
5852 /* If the pixel height field is at the end (partial xlfd),
5853 return now. */
5854 else
5855 return pixel_height;
5857 /* If we got a pixel height, the point height can be
5858 ignored. Just blank it out and break now. */
5859 if (pixel_height)
5861 /* Find end of point size field. */
5862 for (; *read_from && *read_from != '-'; read_from++)
5865 if (*read_from)
5866 read_from++;
5868 /* Blank out the point size field. */
5869 if (read_from > write_to)
5871 *write_to = '-';
5872 write_to++;
5874 else
5875 return pixel_height;
5877 break;
5879 /* If the point height is already blank, break now. */
5880 if (*read_from == '-')
5882 read_from++;
5883 break;
5886 else if (field_number == 8)
5888 /* If we didn't get a pixel height, try to get the point
5889 height and convert that. */
5890 int point_size;
5891 char *point_size_start = read_from++;
5893 /* Find end of field. */
5894 for (; *read_from && *read_from != '-'; read_from++)
5897 if (*read_from)
5899 *read_from = '\0';
5900 read_from++;
5903 point_size = atoi (point_size_start);
5905 /* Convert to pixel height. */
5906 pixel_height = point_size
5907 * one_w32_display_info.height_in / 720;
5909 /* Blank out this field and break. */
5910 *write_to = '-';
5911 write_to++;
5912 break;
5917 /* Shift the rest of the font spec into place. */
5918 if (write_to && read_from > write_to)
5920 for (; *read_from; read_from++, write_to++)
5921 *write_to = *read_from;
5922 *write_to = '\0';
5925 return pixel_height;
5928 /* Assume parameter 1 is fully qualified, no wildcards. */
5929 static BOOL
5930 w32_font_match (fontname, pattern)
5931 char * fontname;
5932 char * pattern;
5934 char *ptr;
5935 char *font_name_copy;
5936 char *regex = alloca (strlen (pattern) * 2 + 3);
5938 font_name_copy = alloca (strlen (fontname) + 1);
5939 strcpy (font_name_copy, fontname);
5941 ptr = regex;
5942 *ptr++ = '^';
5944 /* Turn pattern into a regexp and do a regexp match. */
5945 for (; *pattern; pattern++)
5947 if (*pattern == '?')
5948 *ptr++ = '.';
5949 else if (*pattern == '*')
5951 *ptr++ = '.';
5952 *ptr++ = '*';
5954 else
5955 *ptr++ = *pattern;
5957 *ptr = '$';
5958 *(ptr + 1) = '\0';
5960 /* Strip out font heights and compare them seperately, since
5961 rounding error can cause mismatches. This also allows a
5962 comparison between a font that declares only a pixel height and a
5963 pattern that declares the point height.
5966 int font_height, pattern_height;
5968 font_height = xlfd_strip_height (font_name_copy);
5969 pattern_height = xlfd_strip_height (regex);
5971 /* Compare now, and don't bother doing expensive regexp matching
5972 if the heights differ. */
5973 if (font_height && pattern_height && (font_height != pattern_height))
5974 return FALSE;
5977 return (fast_string_match_ignore_case (build_string (regex),
5978 build_string (font_name_copy)) >= 0);
5981 /* Callback functions, and a structure holding info they need, for
5982 listing system fonts on W32. We need one set of functions to do the
5983 job properly, but these don't work on NT 3.51 and earlier, so we
5984 have a second set which don't handle character sets properly to
5985 fall back on.
5987 In both cases, there are two passes made. The first pass gets one
5988 font from each family, the second pass lists all the fonts from
5989 each family. */
5991 typedef struct enumfont_t
5993 HDC hdc;
5994 int numFonts;
5995 LOGFONT logfont;
5996 XFontStruct *size_ref;
5997 Lisp_Object pattern;
5998 Lisp_Object list;
5999 } enumfont_t;
6002 static void
6003 enum_font_maybe_add_to_list (enumfont_t *, LOGFONT *, char *, Lisp_Object);
6006 static int CALLBACK
6007 enum_font_cb2 (lplf, lptm, FontType, lpef)
6008 ENUMLOGFONT * lplf;
6009 NEWTEXTMETRIC * lptm;
6010 int FontType;
6011 enumfont_t * lpef;
6013 /* Ignore struck out and underlined versions of fonts. */
6014 if (lplf->elfLogFont.lfStrikeOut || lplf->elfLogFont.lfUnderline)
6015 return 1;
6017 /* Only return fonts with names starting with @ if they were
6018 explicitly specified, since Microsoft uses an initial @ to
6019 denote fonts for vertical writing, without providing a more
6020 convenient way of identifying them. */
6021 if (lplf->elfLogFont.lfFaceName[0] == '@'
6022 && lpef->logfont.lfFaceName[0] != '@')
6023 return 1;
6025 /* Check that the character set matches if it was specified */
6026 if (lpef->logfont.lfCharSet != DEFAULT_CHARSET &&
6027 lplf->elfLogFont.lfCharSet != lpef->logfont.lfCharSet)
6028 return 1;
6030 if (FontType == RASTER_FONTTYPE)
6032 /* DBCS raster fonts have problems displaying, so skip them. */
6033 int charset = lplf->elfLogFont.lfCharSet;
6034 if (charset == SHIFTJIS_CHARSET
6035 || charset == HANGEUL_CHARSET
6036 || charset == CHINESEBIG5_CHARSET
6037 || charset == GB2312_CHARSET
6038 #ifdef JOHAB_CHARSET
6039 || charset == JOHAB_CHARSET
6040 #endif
6042 return 1;
6046 char buf[100];
6047 Lisp_Object width = Qnil;
6048 Lisp_Object charset_list = Qnil;
6049 char *charset = NULL;
6051 /* Truetype fonts do not report their true metrics until loaded */
6052 if (FontType != RASTER_FONTTYPE)
6054 if (!NILP (lpef->pattern))
6056 /* Scalable fonts are as big as you want them to be. */
6057 lplf->elfLogFont.lfHeight = lpef->logfont.lfHeight;
6058 lplf->elfLogFont.lfWidth = lpef->logfont.lfWidth;
6059 width = make_number (lpef->logfont.lfWidth);
6061 else
6063 lplf->elfLogFont.lfHeight = 0;
6064 lplf->elfLogFont.lfWidth = 0;
6068 /* Make sure the height used here is the same as everywhere
6069 else (ie character height, not cell height). */
6070 if (lplf->elfLogFont.lfHeight > 0)
6072 /* lptm can be trusted for RASTER fonts, but not scalable ones. */
6073 if (FontType == RASTER_FONTTYPE)
6074 lplf->elfLogFont.lfHeight = lptm->tmInternalLeading - lptm->tmHeight;
6075 else
6076 lplf->elfLogFont.lfHeight = -lplf->elfLogFont.lfHeight;
6079 if (!NILP (lpef->pattern))
6081 charset = xlfd_charset_of_font (SDATA (lpef->pattern));
6083 /* We already checked charsets above, but DEFAULT_CHARSET
6084 slipped through. So only allow exact matches for DEFAULT_CHARSET. */
6085 if (charset
6086 && strncmp (charset, "*-*", 3) != 0
6087 && lpef->logfont.lfCharSet == DEFAULT_CHARSET
6088 && strcmp (charset, w32_to_x_charset (DEFAULT_CHARSET, NULL)) != 0)
6089 return 1;
6091 /* Reject raster fonts if we are looking for a unicode font. */
6092 if (charset
6093 && FontType == RASTER_FONTTYPE
6094 && strncmp (charset, "iso10646", 8) == 0)
6095 return 1;
6098 if (charset)
6099 charset_list = Fcons (build_string (charset), Qnil);
6100 else
6101 /* Always prefer unicode. */
6102 charset_list
6103 = Fcons (build_string ("iso10646-1"),
6104 w32_to_all_x_charsets (lplf->elfLogFont.lfCharSet));
6106 /* Loop through the charsets. */
6107 for ( ; CONSP (charset_list); charset_list = Fcdr (charset_list))
6109 Lisp_Object this_charset = Fcar (charset_list);
6110 charset = SDATA (this_charset);
6112 /* Don't list raster fonts as unicode. */
6113 if (charset
6114 && FontType == RASTER_FONTTYPE
6115 && strncmp (charset, "iso10646", 8) == 0)
6116 continue;
6118 enum_font_maybe_add_to_list (lpef, &(lplf->elfLogFont),
6119 charset, width);
6121 /* List bold and italic variations if w32-enable-synthesized-fonts
6122 is non-nil and this is a plain font. */
6123 if (w32_enable_synthesized_fonts
6124 && lplf->elfLogFont.lfWeight == FW_NORMAL
6125 && lplf->elfLogFont.lfItalic == FALSE)
6127 /* bold. */
6128 lplf->elfLogFont.lfWeight = FW_BOLD;
6129 enum_font_maybe_add_to_list (lpef, &(lplf->elfLogFont),
6130 charset, width);
6131 /* bold italic. */
6132 lplf->elfLogFont.lfItalic = TRUE;
6133 enum_font_maybe_add_to_list (lpef, &(lplf->elfLogFont),
6134 charset, width);
6135 /* italic. */
6136 lplf->elfLogFont.lfWeight = FW_NORMAL;
6137 enum_font_maybe_add_to_list (lpef, &(lplf->elfLogFont),
6138 charset, width);
6143 return 1;
6146 static void
6147 enum_font_maybe_add_to_list (lpef, logfont, match_charset, width)
6148 enumfont_t * lpef;
6149 LOGFONT * logfont;
6150 char * match_charset;
6151 Lisp_Object width;
6153 char buf[100];
6155 if (!w32_to_x_font (logfont, buf, 100, match_charset))
6156 return;
6158 if (NILP (lpef->pattern)
6159 || w32_font_match (buf, SDATA (lpef->pattern)))
6161 /* Check if we already listed this font. This may happen if
6162 w32_enable_synthesized_fonts is non-nil, and there are real
6163 bold and italic versions of the font. */
6164 Lisp_Object font_name = build_string (buf);
6165 if (NILP (Fmember (font_name, lpef->list)))
6167 Lisp_Object entry = Fcons (font_name, width);
6168 lpef->list = Fcons (entry, lpef->list);
6169 lpef->numFonts++;
6175 static int CALLBACK
6176 enum_font_cb1 (lplf, lptm, FontType, lpef)
6177 ENUMLOGFONT * lplf;
6178 NEWTEXTMETRIC * lptm;
6179 int FontType;
6180 enumfont_t * lpef;
6182 return EnumFontFamilies (lpef->hdc,
6183 lplf->elfLogFont.lfFaceName,
6184 (FONTENUMPROC) enum_font_cb2,
6185 (LPARAM) lpef);
6189 static int CALLBACK
6190 enum_fontex_cb2 (lplf, lptm, font_type, lpef)
6191 ENUMLOGFONTEX * lplf;
6192 NEWTEXTMETRICEX * lptm;
6193 int font_type;
6194 enumfont_t * lpef;
6196 /* We are not interested in the extra info we get back from the 'Ex
6197 version - only the fact that we get character set variations
6198 enumerated seperately. */
6199 return enum_font_cb2 ((ENUMLOGFONT *) lplf, (NEWTEXTMETRIC *) lptm,
6200 font_type, lpef);
6203 static int CALLBACK
6204 enum_fontex_cb1 (lplf, lptm, font_type, lpef)
6205 ENUMLOGFONTEX * lplf;
6206 NEWTEXTMETRICEX * lptm;
6207 int font_type;
6208 enumfont_t * lpef;
6210 HMODULE gdi32 = GetModuleHandle ("gdi32.dll");
6211 FARPROC enum_font_families_ex
6212 = GetProcAddress ( gdi32, "EnumFontFamiliesExA");
6213 /* We don't really expect EnumFontFamiliesEx to disappear once we
6214 get here, so don't bother handling it gracefully. */
6215 if (enum_font_families_ex == NULL)
6216 error ("gdi32.dll has disappeared!");
6217 return enum_font_families_ex (lpef->hdc,
6218 &lplf->elfLogFont,
6219 (FONTENUMPROC) enum_fontex_cb2,
6220 (LPARAM) lpef, 0);
6223 /* Interface to fontset handler. (adapted from mw32font.c in Meadow
6224 and xterm.c in Emacs 20.3) */
6226 static Lisp_Object
6227 w32_list_bdf_fonts (Lisp_Object pattern, int max_names)
6229 char *fontname, *ptnstr;
6230 Lisp_Object list, tem, newlist = Qnil;
6231 int n_fonts = 0;
6233 list = Vw32_bdf_filename_alist;
6234 ptnstr = SDATA (pattern);
6236 for ( ; CONSP (list); list = XCDR (list))
6238 tem = XCAR (list);
6239 if (CONSP (tem))
6240 fontname = SDATA (XCAR (tem));
6241 else if (STRINGP (tem))
6242 fontname = SDATA (tem);
6243 else
6244 continue;
6246 if (w32_font_match (fontname, ptnstr))
6248 newlist = Fcons (XCAR (tem), newlist);
6249 n_fonts++;
6250 if (max_names >= 0 && n_fonts >= max_names)
6251 break;
6255 return newlist;
6259 /* Return a list of names of available fonts matching PATTERN on frame
6260 F. If SIZE is not 0, it is the size (maximum bound width) of fonts
6261 to be listed. Frame F NULL means we have not yet created any
6262 frame, which means we can't get proper size info, as we don't have
6263 a device context to use for GetTextMetrics.
6264 MAXNAMES sets a limit on how many fonts to match. If MAXNAMES is
6265 negative, then all matching fonts are returned. */
6267 Lisp_Object
6268 w32_list_fonts (f, pattern, size, maxnames)
6269 struct frame *f;
6270 Lisp_Object pattern;
6271 int size;
6272 int maxnames;
6274 Lisp_Object patterns, key = Qnil, tem, tpat;
6275 Lisp_Object list = Qnil, newlist = Qnil, second_best = Qnil;
6276 struct w32_display_info *dpyinfo = &one_w32_display_info;
6277 int n_fonts = 0;
6279 patterns = Fassoc (pattern, Valternate_fontname_alist);
6280 if (NILP (patterns))
6281 patterns = Fcons (pattern, Qnil);
6283 for (; CONSP (patterns); patterns = XCDR (patterns))
6285 enumfont_t ef;
6286 int codepage;
6288 tpat = XCAR (patterns);
6290 if (!STRINGP (tpat))
6291 continue;
6293 /* Avoid expensive EnumFontFamilies functions if we are not
6294 going to be able to output one of these anyway. */
6295 codepage = w32_codepage_for_font (SDATA (tpat));
6296 if (codepage != CP_8BIT && codepage != CP_UNICODE
6297 && codepage != CP_DEFAULT && codepage != CP_UNKNOWN
6298 && !IsValidCodePage (codepage))
6299 continue;
6301 /* See if we cached the result for this particular query.
6302 The cache is an alist of the form:
6303 ((PATTERN (FONTNAME . WIDTH) ...) ...)
6305 if (tem = XCDR (dpyinfo->name_list_element),
6306 !NILP (list = Fassoc (tpat, tem)))
6308 list = Fcdr_safe (list);
6309 /* We have a cached list. Don't have to get the list again. */
6310 goto label_cached;
6313 BLOCK_INPUT;
6314 /* At first, put PATTERN in the cache. */
6315 ef.pattern = tpat;
6316 ef.list = Qnil;
6317 ef.numFonts = 0;
6319 /* Use EnumFontFamiliesEx where it is available, as it knows
6320 about character sets. Fall back to EnumFontFamilies for
6321 older versions of NT that don't support the 'Ex function. */
6322 x_to_w32_font (SDATA (tpat), &ef.logfont);
6324 LOGFONT font_match_pattern;
6325 HMODULE gdi32 = GetModuleHandle ("gdi32.dll");
6326 FARPROC enum_font_families_ex
6327 = GetProcAddress ( gdi32, "EnumFontFamiliesExA");
6329 /* We do our own pattern matching so we can handle wildcards. */
6330 font_match_pattern.lfFaceName[0] = 0;
6331 font_match_pattern.lfPitchAndFamily = 0;
6332 /* We can use the charset, because if it is a wildcard it will
6333 be DEFAULT_CHARSET anyway. */
6334 font_match_pattern.lfCharSet = ef.logfont.lfCharSet;
6336 ef.hdc = GetDC (dpyinfo->root_window);
6338 if (enum_font_families_ex)
6339 enum_font_families_ex (ef.hdc,
6340 &font_match_pattern,
6341 (FONTENUMPROC) enum_fontex_cb1,
6342 (LPARAM) &ef, 0);
6343 else
6344 EnumFontFamilies (ef.hdc, NULL, (FONTENUMPROC) enum_font_cb1,
6345 (LPARAM)&ef);
6347 ReleaseDC (dpyinfo->root_window, ef.hdc);
6350 UNBLOCK_INPUT;
6351 list = ef.list;
6353 /* Make a list of the fonts we got back.
6354 Store that in the font cache for the display. */
6355 XSETCDR (dpyinfo->name_list_element,
6356 Fcons (Fcons (tpat, list),
6357 XCDR (dpyinfo->name_list_element)));
6359 label_cached:
6360 if (NILP (list)) continue; /* Try the remaining alternatives. */
6362 newlist = second_best = Qnil;
6364 /* Make a list of the fonts that have the right width. */
6365 for (; CONSP (list); list = XCDR (list))
6367 int found_size;
6368 tem = XCAR (list);
6370 if (!CONSP (tem))
6371 continue;
6372 if (NILP (XCAR (tem)))
6373 continue;
6374 if (!size)
6376 newlist = Fcons (XCAR (tem), newlist);
6377 n_fonts++;
6378 if (maxnames >= 0 && n_fonts >= maxnames)
6379 break;
6380 else
6381 continue;
6383 if (!INTEGERP (XCDR (tem)))
6385 /* Since we don't yet know the size of the font, we must
6386 load it and try GetTextMetrics. */
6387 W32FontStruct thisinfo;
6388 LOGFONT lf;
6389 HDC hdc;
6390 HANDLE oldobj;
6392 if (!x_to_w32_font (SDATA (XCAR (tem)), &lf))
6393 continue;
6395 BLOCK_INPUT;
6396 thisinfo.bdf = NULL;
6397 thisinfo.hfont = CreateFontIndirect (&lf);
6398 if (thisinfo.hfont == NULL)
6399 continue;
6401 hdc = GetDC (dpyinfo->root_window);
6402 oldobj = SelectObject (hdc, thisinfo.hfont);
6403 if (GetTextMetrics (hdc, &thisinfo.tm))
6404 XSETCDR (tem, make_number (FONT_AVG_WIDTH (&thisinfo)));
6405 else
6406 XSETCDR (tem, make_number (0));
6407 SelectObject (hdc, oldobj);
6408 ReleaseDC (dpyinfo->root_window, hdc);
6409 DeleteObject (thisinfo.hfont);
6410 UNBLOCK_INPUT;
6412 found_size = XINT (XCDR (tem));
6413 if (found_size == size)
6415 newlist = Fcons (XCAR (tem), newlist);
6416 n_fonts++;
6417 if (maxnames >= 0 && n_fonts >= maxnames)
6418 break;
6420 /* keep track of the closest matching size in case
6421 no exact match is found. */
6422 else if (found_size > 0)
6424 if (NILP (second_best))
6425 second_best = tem;
6427 else if (found_size < size)
6429 if (XINT (XCDR (second_best)) > size
6430 || XINT (XCDR (second_best)) < found_size)
6431 second_best = tem;
6433 else
6435 if (XINT (XCDR (second_best)) > size
6436 && XINT (XCDR (second_best)) >
6437 found_size)
6438 second_best = tem;
6443 if (!NILP (newlist))
6444 break;
6445 else if (!NILP (second_best))
6447 newlist = Fcons (XCAR (second_best), Qnil);
6448 break;
6452 /* Include any bdf fonts. */
6453 if (n_fonts < maxnames || maxnames < 0)
6455 Lisp_Object combined[2];
6456 combined[0] = w32_list_bdf_fonts (pattern, maxnames - n_fonts);
6457 combined[1] = newlist;
6458 newlist = Fnconc (2, combined);
6461 return newlist;
6465 /* Return a pointer to struct font_info of font FONT_IDX of frame F. */
6466 struct font_info *
6467 w32_get_font_info (f, font_idx)
6468 FRAME_PTR f;
6469 int font_idx;
6471 return (FRAME_W32_FONT_TABLE (f) + font_idx);
6475 struct font_info*
6476 w32_query_font (struct frame *f, char *fontname)
6478 int i;
6479 struct font_info *pfi;
6481 pfi = FRAME_W32_FONT_TABLE (f);
6483 for (i = 0; i < one_w32_display_info.n_fonts ;i++, pfi++)
6485 if (stricmp (pfi->name, fontname) == 0) return pfi;
6488 return NULL;
6491 /* Find a CCL program for a font specified by FONTP, and set the member
6492 `encoder' of the structure. */
6494 void
6495 w32_find_ccl_program (fontp)
6496 struct font_info *fontp;
6498 Lisp_Object list, elt;
6500 for (list = Vfont_ccl_encoder_alist; CONSP (list); list = XCDR (list))
6502 elt = XCAR (list);
6503 if (CONSP (elt)
6504 && STRINGP (XCAR (elt))
6505 && (fast_c_string_match_ignore_case (XCAR (elt), fontp->name)
6506 >= 0))
6507 break;
6509 if (! NILP (list))
6511 struct ccl_program *ccl
6512 = (struct ccl_program *) xmalloc (sizeof (struct ccl_program));
6514 if (setup_ccl_program (ccl, XCDR (elt)) < 0)
6515 xfree (ccl);
6516 else
6517 fontp->font_encoder = ccl;
6521 /* directory-files from dired.c. */
6522 Lisp_Object Fdirectory_files P_ ((Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object));
6525 /* Find BDF files in a specified directory. (use GCPRO when calling,
6526 as this calls lisp to get a directory listing). */
6527 static Lisp_Object
6528 w32_find_bdf_fonts_in_dir (Lisp_Object directory)
6530 Lisp_Object filelist, list = Qnil;
6531 char fontname[100];
6533 if (!STRINGP (directory))
6534 return Qnil;
6536 filelist = Fdirectory_files (directory, Qt,
6537 build_string (".*\\.[bB][dD][fF]"), Qt);
6539 for ( ; CONSP (filelist); filelist = XCDR (filelist))
6541 Lisp_Object filename = XCAR (filelist);
6542 if (w32_BDF_to_x_font (SDATA (filename), fontname, 100))
6543 store_in_alist (&list, build_string (fontname), filename);
6545 return list;
6548 DEFUN ("w32-find-bdf-fonts", Fw32_find_bdf_fonts, Sw32_find_bdf_fonts,
6549 1, 1, 0,
6550 doc: /* Return a list of BDF fonts in DIRECTORY.
6551 The list is suitable for appending to `w32-bdf-filename-alist'.
6552 Fonts which do not contain an xlfd description will not be included
6553 in the list. DIRECTORY may be a list of directories. */)
6554 (directory)
6555 Lisp_Object directory;
6557 Lisp_Object list = Qnil;
6558 struct gcpro gcpro1, gcpro2;
6560 if (!CONSP (directory))
6561 return w32_find_bdf_fonts_in_dir (directory);
6563 for ( ; CONSP (directory); directory = XCDR (directory))
6565 Lisp_Object pair[2];
6566 pair[0] = list;
6567 pair[1] = Qnil;
6568 GCPRO2 (directory, list);
6569 pair[1] = w32_find_bdf_fonts_in_dir ( XCAR (directory) );
6570 list = Fnconc ( 2, pair );
6571 UNGCPRO;
6573 return list;
6577 DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1, 2, 0,
6578 doc: /* Internal function called by `color-defined-p', which see. */)
6579 (color, frame)
6580 Lisp_Object color, frame;
6582 XColor foo;
6583 FRAME_PTR f = check_x_frame (frame);
6585 CHECK_STRING (color);
6587 if (w32_defined_color (f, SDATA (color), &foo, 0))
6588 return Qt;
6589 else
6590 return Qnil;
6593 DEFUN ("xw-color-values", Fxw_color_values, Sxw_color_values, 1, 2, 0,
6594 doc: /* Internal function called by `color-values', which see. */)
6595 (color, frame)
6596 Lisp_Object color, frame;
6598 XColor foo;
6599 FRAME_PTR f = check_x_frame (frame);
6601 CHECK_STRING (color);
6603 if (w32_defined_color (f, SDATA (color), &foo, 0))
6604 return list3 (make_number ((GetRValue (foo.pixel) << 8)
6605 | GetRValue (foo.pixel)),
6606 make_number ((GetGValue (foo.pixel) << 8)
6607 | GetGValue (foo.pixel)),
6608 make_number ((GetBValue (foo.pixel) << 8)
6609 | GetBValue (foo.pixel)));
6610 else
6611 return Qnil;
6614 DEFUN ("xw-display-color-p", Fxw_display_color_p, Sxw_display_color_p, 0, 1, 0,
6615 doc: /* Internal function called by `display-color-p', which see. */)
6616 (display)
6617 Lisp_Object display;
6619 struct w32_display_info *dpyinfo = check_x_display_info (display);
6621 if ((dpyinfo->n_planes * dpyinfo->n_cbits) <= 2)
6622 return Qnil;
6624 return Qt;
6627 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p,
6628 Sx_display_grayscale_p, 0, 1, 0,
6629 doc: /* Return t if DISPLAY supports shades of gray.
6630 Note that color displays do support shades of gray.
6631 The optional argument DISPLAY specifies which display to ask about.
6632 DISPLAY should be either a frame or a display name (a string).
6633 If omitted or nil, that stands for the selected frame's display. */)
6634 (display)
6635 Lisp_Object display;
6637 struct w32_display_info *dpyinfo = check_x_display_info (display);
6639 if ((dpyinfo->n_planes * dpyinfo->n_cbits) <= 1)
6640 return Qnil;
6642 return Qt;
6645 DEFUN ("x-display-pixel-width", Fx_display_pixel_width,
6646 Sx_display_pixel_width, 0, 1, 0,
6647 doc: /* Return the width in pixels of DISPLAY.
6648 The optional argument DISPLAY specifies which display to ask about.
6649 DISPLAY should be either a frame or a display name (a string).
6650 If omitted or nil, that stands for the selected frame's display. */)
6651 (display)
6652 Lisp_Object display;
6654 struct w32_display_info *dpyinfo = check_x_display_info (display);
6656 return make_number (dpyinfo->width);
6659 DEFUN ("x-display-pixel-height", Fx_display_pixel_height,
6660 Sx_display_pixel_height, 0, 1, 0,
6661 doc: /* Return the height in pixels of DISPLAY.
6662 The optional argument DISPLAY specifies which display to ask about.
6663 DISPLAY should be either a frame or a display name (a string).
6664 If omitted or nil, that stands for the selected frame's display. */)
6665 (display)
6666 Lisp_Object display;
6668 struct w32_display_info *dpyinfo = check_x_display_info (display);
6670 return make_number (dpyinfo->height);
6673 DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes,
6674 0, 1, 0,
6675 doc: /* Return the number of bitplanes of DISPLAY.
6676 The optional argument DISPLAY specifies which display to ask about.
6677 DISPLAY should be either a frame or a display name (a string).
6678 If omitted or nil, that stands for the selected frame's display. */)
6679 (display)
6680 Lisp_Object display;
6682 struct w32_display_info *dpyinfo = check_x_display_info (display);
6684 return make_number (dpyinfo->n_planes * dpyinfo->n_cbits);
6687 DEFUN ("x-display-color-cells", Fx_display_color_cells, Sx_display_color_cells,
6688 0, 1, 0,
6689 doc: /* Return the number of color cells of DISPLAY.
6690 The optional argument DISPLAY specifies which display to ask about.
6691 DISPLAY should be either a frame or a display name (a string).
6692 If omitted or nil, that stands for the selected frame's display. */)
6693 (display)
6694 Lisp_Object display;
6696 struct w32_display_info *dpyinfo = check_x_display_info (display);
6697 HDC hdc;
6698 int cap;
6700 hdc = GetDC (dpyinfo->root_window);
6701 if (dpyinfo->has_palette)
6702 cap = GetDeviceCaps (hdc, SIZEPALETTE);
6703 else
6704 cap = GetDeviceCaps (hdc, NUMCOLORS);
6706 /* We force 24+ bit depths to 24-bit, both to prevent an overflow
6707 and because probably is more meaningful on Windows anyway */
6708 if (cap < 0)
6709 cap = 1 << min (dpyinfo->n_planes * dpyinfo->n_cbits, 24);
6711 ReleaseDC (dpyinfo->root_window, hdc);
6713 return make_number (cap);
6716 DEFUN ("x-server-max-request-size", Fx_server_max_request_size,
6717 Sx_server_max_request_size,
6718 0, 1, 0,
6719 doc: /* Return the maximum request size of the server of DISPLAY.
6720 The optional argument DISPLAY specifies which display to ask about.
6721 DISPLAY should be either a frame or a display name (a string).
6722 If omitted or nil, that stands for the selected frame's display. */)
6723 (display)
6724 Lisp_Object display;
6726 struct w32_display_info *dpyinfo = check_x_display_info (display);
6728 return make_number (1);
6731 DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0,
6732 doc: /* Return the "vendor ID" string of the W32 system (Microsoft).
6733 The optional argument DISPLAY specifies which display to ask about.
6734 DISPLAY should be either a frame or a display name (a string).
6735 If omitted or nil, that stands for the selected frame's display. */)
6736 (display)
6737 Lisp_Object display;
6739 return build_string ("Microsoft Corp.");
6742 DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0,
6743 doc: /* Return the version numbers of the server of DISPLAY.
6744 The value is a list of three integers: the major and minor
6745 version numbers of the X Protocol in use, and the distributor-specific
6746 release number. See also the function `x-server-vendor'.
6748 The optional argument DISPLAY specifies which display to ask about.
6749 DISPLAY should be either a frame or a display name (a string).
6750 If omitted or nil, that stands for the selected frame's display. */)
6751 (display)
6752 Lisp_Object display;
6754 return Fcons (make_number (w32_major_version),
6755 Fcons (make_number (w32_minor_version),
6756 Fcons (make_number (w32_build_number), Qnil)));
6759 DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0,
6760 doc: /* Return the number of screens on the server of DISPLAY.
6761 The optional argument DISPLAY specifies which display to ask about.
6762 DISPLAY should be either a frame or a display name (a string).
6763 If omitted or nil, that stands for the selected frame's display. */)
6764 (display)
6765 Lisp_Object display;
6767 return make_number (1);
6770 DEFUN ("x-display-mm-height", Fx_display_mm_height,
6771 Sx_display_mm_height, 0, 1, 0,
6772 doc: /* Return the height in millimeters of DISPLAY.
6773 The optional argument DISPLAY specifies which display to ask about.
6774 DISPLAY should be either a frame or a display name (a string).
6775 If omitted or nil, that stands for the selected frame's display. */)
6776 (display)
6777 Lisp_Object display;
6779 struct w32_display_info *dpyinfo = check_x_display_info (display);
6780 HDC hdc;
6781 int cap;
6783 hdc = GetDC (dpyinfo->root_window);
6785 cap = GetDeviceCaps (hdc, VERTSIZE);
6787 ReleaseDC (dpyinfo->root_window, hdc);
6789 return make_number (cap);
6792 DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0,
6793 doc: /* Return the width in millimeters of DISPLAY.
6794 The optional argument DISPLAY specifies which display to ask about.
6795 DISPLAY should be either a frame or a display name (a string).
6796 If omitted or nil, that stands for the selected frame's display. */)
6797 (display)
6798 Lisp_Object display;
6800 struct w32_display_info *dpyinfo = check_x_display_info (display);
6802 HDC hdc;
6803 int cap;
6805 hdc = GetDC (dpyinfo->root_window);
6807 cap = GetDeviceCaps (hdc, HORZSIZE);
6809 ReleaseDC (dpyinfo->root_window, hdc);
6811 return make_number (cap);
6814 DEFUN ("x-display-backing-store", Fx_display_backing_store,
6815 Sx_display_backing_store, 0, 1, 0,
6816 doc: /* Return an indication of whether DISPLAY does backing store.
6817 The value may be `always', `when-mapped', or `not-useful'.
6818 The optional argument DISPLAY specifies which display to ask about.
6819 DISPLAY should be either a frame or a display name (a string).
6820 If omitted or nil, that stands for the selected frame's display. */)
6821 (display)
6822 Lisp_Object display;
6824 return intern ("not-useful");
6827 DEFUN ("x-display-visual-class", Fx_display_visual_class,
6828 Sx_display_visual_class, 0, 1, 0,
6829 doc: /* Return the visual class of DISPLAY.
6830 The value is one of the symbols `static-gray', `gray-scale',
6831 `static-color', `pseudo-color', `true-color', or `direct-color'.
6833 The optional argument DISPLAY specifies which display to ask about.
6834 DISPLAY should be either a frame or a display name (a string).
6835 If omitted or nil, that stands for the selected frame's display. */)
6836 (display)
6837 Lisp_Object display;
6839 struct w32_display_info *dpyinfo = check_x_display_info (display);
6840 Lisp_Object result = Qnil;
6842 if (dpyinfo->has_palette)
6843 result = intern ("pseudo-color");
6844 else if (dpyinfo->n_planes * dpyinfo->n_cbits == 1)
6845 result = intern ("static-grey");
6846 else if (dpyinfo->n_planes * dpyinfo->n_cbits == 4)
6847 result = intern ("static-color");
6848 else if (dpyinfo->n_planes * dpyinfo->n_cbits > 8)
6849 result = intern ("true-color");
6851 return result;
6854 DEFUN ("x-display-save-under", Fx_display_save_under,
6855 Sx_display_save_under, 0, 1, 0,
6856 doc: /* Return t if DISPLAY supports the save-under feature.
6857 The optional argument DISPLAY specifies which display to ask about.
6858 DISPLAY should be either a frame or a display name (a string).
6859 If omitted or nil, that stands for the selected frame's display. */)
6860 (display)
6861 Lisp_Object display;
6863 return Qnil;
6867 x_pixel_width (f)
6868 register struct frame *f;
6870 return FRAME_PIXEL_WIDTH (f);
6874 x_pixel_height (f)
6875 register struct frame *f;
6877 return FRAME_PIXEL_HEIGHT (f);
6881 x_char_width (f)
6882 register struct frame *f;
6884 return FRAME_COLUMN_WIDTH (f);
6888 x_char_height (f)
6889 register struct frame *f;
6891 return FRAME_LINE_HEIGHT (f);
6895 x_screen_planes (f)
6896 register struct frame *f;
6898 return FRAME_W32_DISPLAY_INFO (f)->n_planes;
6901 /* Return the display structure for the display named NAME.
6902 Open a new connection if necessary. */
6904 struct w32_display_info *
6905 x_display_info_for_name (name)
6906 Lisp_Object name;
6908 Lisp_Object names;
6909 struct w32_display_info *dpyinfo;
6911 CHECK_STRING (name);
6913 for (dpyinfo = &one_w32_display_info, names = w32_display_name_list;
6914 dpyinfo;
6915 dpyinfo = dpyinfo->next, names = XCDR (names))
6917 Lisp_Object tem;
6918 tem = Fstring_equal (XCAR (XCAR (names)), name);
6919 if (!NILP (tem))
6920 return dpyinfo;
6923 /* Use this general default value to start with. */
6924 Vx_resource_name = Vinvocation_name;
6926 validate_x_resource_name ();
6928 dpyinfo = w32_term_init (name, (unsigned char *)0,
6929 (char *) SDATA (Vx_resource_name));
6931 if (dpyinfo == 0)
6932 error ("Cannot connect to server %s", SDATA (name));
6934 w32_in_use = 1;
6935 XSETFASTINT (Vwindow_system_version, 3);
6937 return dpyinfo;
6940 DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
6941 1, 3, 0, doc: /* Open a connection to a server.
6942 DISPLAY is the name of the display to connect to.
6943 Optional second arg XRM-STRING is a string of resources in xrdb format.
6944 If the optional third arg MUST-SUCCEED is non-nil,
6945 terminate Emacs if we can't open the connection. */)
6946 (display, xrm_string, must_succeed)
6947 Lisp_Object display, xrm_string, must_succeed;
6949 unsigned char *xrm_option;
6950 struct w32_display_info *dpyinfo;
6952 /* If initialization has already been done, return now to avoid
6953 overwriting critical parts of one_w32_display_info. */
6954 if (w32_in_use)
6955 return Qnil;
6957 CHECK_STRING (display);
6958 if (! NILP (xrm_string))
6959 CHECK_STRING (xrm_string);
6961 #if 0
6962 if (! EQ (Vwindow_system, intern ("w32")))
6963 error ("Not using Microsoft Windows");
6964 #endif
6966 /* Allow color mapping to be defined externally; first look in user's
6967 HOME directory, then in Emacs etc dir for a file called rgb.txt. */
6969 Lisp_Object color_file;
6970 struct gcpro gcpro1;
6972 color_file = build_string ("~/rgb.txt");
6974 GCPRO1 (color_file);
6976 if (NILP (Ffile_readable_p (color_file)))
6977 color_file =
6978 Fexpand_file_name (build_string ("rgb.txt"),
6979 Fsymbol_value (intern ("data-directory")));
6981 Vw32_color_map = Fw32_load_color_file (color_file);
6983 UNGCPRO;
6985 if (NILP (Vw32_color_map))
6986 Vw32_color_map = Fw32_default_color_map ();
6988 /* Merge in system logical colors. */
6989 add_system_logical_colors_to_map (&Vw32_color_map);
6991 if (! NILP (xrm_string))
6992 xrm_option = (unsigned char *) SDATA (xrm_string);
6993 else
6994 xrm_option = (unsigned char *) 0;
6996 /* Use this general default value to start with. */
6997 /* First remove .exe suffix from invocation-name - it looks ugly. */
6999 char basename[ MAX_PATH ], *str;
7001 strcpy (basename, SDATA (Vinvocation_name));
7002 str = strrchr (basename, '.');
7003 if (str) *str = 0;
7004 Vinvocation_name = build_string (basename);
7006 Vx_resource_name = Vinvocation_name;
7008 validate_x_resource_name ();
7010 /* This is what opens the connection and sets x_current_display.
7011 This also initializes many symbols, such as those used for input. */
7012 dpyinfo = w32_term_init (display, xrm_option,
7013 (char *) SDATA (Vx_resource_name));
7015 if (dpyinfo == 0)
7017 if (!NILP (must_succeed))
7018 fatal ("Cannot connect to server %s.\n",
7019 SDATA (display));
7020 else
7021 error ("Cannot connect to server %s", SDATA (display));
7024 w32_in_use = 1;
7026 XSETFASTINT (Vwindow_system_version, 3);
7027 return Qnil;
7030 DEFUN ("x-close-connection", Fx_close_connection,
7031 Sx_close_connection, 1, 1, 0,
7032 doc: /* Close the connection to DISPLAY's server.
7033 For DISPLAY, specify either a frame or a display name (a string).
7034 If DISPLAY is nil, that stands for the selected frame's display. */)
7035 (display)
7036 Lisp_Object display;
7038 struct w32_display_info *dpyinfo = check_x_display_info (display);
7039 int i;
7041 if (dpyinfo->reference_count > 0)
7042 error ("Display still has frames on it");
7044 BLOCK_INPUT;
7045 /* Free the fonts in the font table. */
7046 for (i = 0; i < dpyinfo->n_fonts; i++)
7047 if (dpyinfo->font_table[i].name)
7049 if (dpyinfo->font_table[i].name != dpyinfo->font_table[i].full_name)
7050 xfree (dpyinfo->font_table[i].full_name);
7051 xfree (dpyinfo->font_table[i].name);
7052 w32_unload_font (dpyinfo, dpyinfo->font_table[i].font);
7054 x_destroy_all_bitmaps (dpyinfo);
7056 x_delete_display (dpyinfo);
7057 UNBLOCK_INPUT;
7059 return Qnil;
7062 DEFUN ("x-display-list", Fx_display_list, Sx_display_list, 0, 0, 0,
7063 doc: /* Return the list of display names that Emacs has connections to. */)
7066 Lisp_Object tail, result;
7068 result = Qnil;
7069 for (tail = w32_display_name_list; CONSP (tail); tail = XCDR (tail))
7070 result = Fcons (XCAR (XCAR (tail)), result);
7072 return result;
7075 DEFUN ("x-synchronize", Fx_synchronize, Sx_synchronize, 1, 2, 0,
7076 doc: /* This is a noop on W32 systems. */)
7077 (on, display)
7078 Lisp_Object display, on;
7080 return Qnil;
7085 /***********************************************************************
7086 Window properties
7087 ***********************************************************************/
7089 DEFUN ("x-change-window-property", Fx_change_window_property,
7090 Sx_change_window_property, 2, 6, 0,
7091 doc: /* Change window property PROP to VALUE on the X window of FRAME.
7092 VALUE may be a string or a list of conses, numbers and/or strings.
7093 If an element in the list is a string, it is converted to
7094 an Atom and the value of the Atom is used. If an element is a cons,
7095 it is converted to a 32 bit number where the car is the 16 top bits and the
7096 cdr is the lower 16 bits.
7097 FRAME nil or omitted means use the selected frame.
7098 If TYPE is given and non-nil, it is the name of the type of VALUE.
7099 If TYPE is not given or nil, the type is STRING.
7100 FORMAT gives the size in bits of each element if VALUE is a list.
7101 It must be one of 8, 16 or 32.
7102 If VALUE is a string or FORMAT is nil or not given, FORMAT defaults to 8.
7103 If OUTER_P is non-nil, the property is changed for the outer X window of
7104 FRAME. Default is to change on the edit X window.
7106 Value is VALUE. */)
7107 (prop, value, frame, type, format, outer_p)
7108 Lisp_Object prop, value, frame, type, format, outer_p;
7110 #if 0 /* TODO : port window properties to W32 */
7111 struct frame *f = check_x_frame (frame);
7112 Atom prop_atom;
7114 CHECK_STRING (prop);
7115 CHECK_STRING (value);
7117 BLOCK_INPUT;
7118 prop_atom = XInternAtom (FRAME_W32_DISPLAY (f), SDATA (prop), False);
7119 XChangeProperty (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f),
7120 prop_atom, XA_STRING, 8, PropModeReplace,
7121 SDATA (value), SCHARS (value));
7123 /* Make sure the property is set when we return. */
7124 XFlush (FRAME_W32_DISPLAY (f));
7125 UNBLOCK_INPUT;
7127 #endif /* TODO */
7129 return value;
7133 DEFUN ("x-delete-window-property", Fx_delete_window_property,
7134 Sx_delete_window_property, 1, 2, 0,
7135 doc: /* Remove window property PROP from X window of FRAME.
7136 FRAME nil or omitted means use the selected frame. Value is PROP. */)
7137 (prop, frame)
7138 Lisp_Object prop, frame;
7140 #if 0 /* TODO : port window properties to W32 */
7142 struct frame *f = check_x_frame (frame);
7143 Atom prop_atom;
7145 CHECK_STRING (prop);
7146 BLOCK_INPUT;
7147 prop_atom = XInternAtom (FRAME_W32_DISPLAY (f), SDATA (prop), False);
7148 XDeleteProperty (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f), prop_atom);
7150 /* Make sure the property is removed when we return. */
7151 XFlush (FRAME_W32_DISPLAY (f));
7152 UNBLOCK_INPUT;
7153 #endif /* TODO */
7155 return prop;
7159 DEFUN ("x-window-property", Fx_window_property, Sx_window_property,
7160 1, 2, 0,
7161 doc: /* Value is the value of window property PROP on FRAME.
7162 If FRAME is nil or omitted, use the selected frame. Value is nil
7163 if FRAME hasn't a property with name PROP or if PROP has no string
7164 value. */)
7165 (prop, frame)
7166 Lisp_Object prop, frame;
7168 #if 0 /* TODO : port window properties to W32 */
7170 struct frame *f = check_x_frame (frame);
7171 Atom prop_atom;
7172 int rc;
7173 Lisp_Object prop_value = Qnil;
7174 char *tmp_data = NULL;
7175 Atom actual_type;
7176 int actual_format;
7177 unsigned long actual_size, bytes_remaining;
7179 CHECK_STRING (prop);
7180 BLOCK_INPUT;
7181 prop_atom = XInternAtom (FRAME_W32_DISPLAY (f), SDATA (prop), False);
7182 rc = XGetWindowProperty (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f),
7183 prop_atom, 0, 0, False, XA_STRING,
7184 &actual_type, &actual_format, &actual_size,
7185 &bytes_remaining, (unsigned char **) &tmp_data);
7186 if (rc == Success)
7188 int size = bytes_remaining;
7190 XFree (tmp_data);
7191 tmp_data = NULL;
7193 rc = XGetWindowProperty (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f),
7194 prop_atom, 0, bytes_remaining,
7195 False, XA_STRING,
7196 &actual_type, &actual_format,
7197 &actual_size, &bytes_remaining,
7198 (unsigned char **) &tmp_data);
7199 if (rc == Success)
7200 prop_value = make_string (tmp_data, size);
7202 XFree (tmp_data);
7205 UNBLOCK_INPUT;
7207 return prop_value;
7209 #endif /* TODO */
7210 return Qnil;
7215 /***********************************************************************
7216 Busy cursor
7217 ***********************************************************************/
7219 /* If non-null, an asynchronous timer that, when it expires, displays
7220 an hourglass cursor on all frames. */
7222 static struct atimer *hourglass_atimer;
7224 /* Non-zero means an hourglass cursor is currently shown. */
7226 static int hourglass_shown_p;
7228 /* Number of seconds to wait before displaying an hourglass cursor. */
7230 static Lisp_Object Vhourglass_delay;
7232 /* Default number of seconds to wait before displaying an hourglass
7233 cursor. */
7235 #define DEFAULT_HOURGLASS_DELAY 1
7237 /* Function prototypes. */
7239 static void show_hourglass P_ ((struct atimer *));
7240 static void hide_hourglass P_ ((void));
7243 /* Cancel a currently active hourglass timer, and start a new one. */
7245 void
7246 start_hourglass ()
7248 #if 0 /* TODO: cursor shape changes. */
7249 EMACS_TIME delay;
7250 int secs, usecs = 0;
7252 cancel_hourglass ();
7254 if (INTEGERP (Vhourglass_delay)
7255 && XINT (Vhourglass_delay) > 0)
7256 secs = XFASTINT (Vhourglass_delay);
7257 else if (FLOATP (Vhourglass_delay)
7258 && XFLOAT_DATA (Vhourglass_delay) > 0)
7260 Lisp_Object tem;
7261 tem = Ftruncate (Vhourglass_delay, Qnil);
7262 secs = XFASTINT (tem);
7263 usecs = (XFLOAT_DATA (Vhourglass_delay) - secs) * 1000000;
7265 else
7266 secs = DEFAULT_HOURGLASS_DELAY;
7268 EMACS_SET_SECS_USECS (delay, secs, usecs);
7269 hourglass_atimer = start_atimer (ATIMER_RELATIVE, delay,
7270 show_hourglass, NULL);
7271 #endif
7275 /* Cancel the hourglass cursor timer if active, hide an hourglass
7276 cursor if shown. */
7278 void
7279 cancel_hourglass ()
7281 if (hourglass_atimer)
7283 cancel_atimer (hourglass_atimer);
7284 hourglass_atimer = NULL;
7287 if (hourglass_shown_p)
7288 hide_hourglass ();
7292 /* Timer function of hourglass_atimer. TIMER is equal to
7293 hourglass_atimer.
7295 Display an hourglass cursor on all frames by mapping the frames'
7296 hourglass_window. Set the hourglass_p flag in the frames'
7297 output_data.x structure to indicate that an hourglass cursor is
7298 shown on the frames. */
7300 static void
7301 show_hourglass (timer)
7302 struct atimer *timer;
7304 #if 0 /* TODO: cursor shape changes. */
7305 /* The timer implementation will cancel this timer automatically
7306 after this function has run. Set hourglass_atimer to null
7307 so that we know the timer doesn't have to be canceled. */
7308 hourglass_atimer = NULL;
7310 if (!hourglass_shown_p)
7312 Lisp_Object rest, frame;
7314 BLOCK_INPUT;
7316 FOR_EACH_FRAME (rest, frame)
7317 if (FRAME_W32_P (XFRAME (frame)))
7319 struct frame *f = XFRAME (frame);
7321 f->output_data.w32->hourglass_p = 1;
7323 if (!f->output_data.w32->hourglass_window)
7325 unsigned long mask = CWCursor;
7326 XSetWindowAttributes attrs;
7328 attrs.cursor = f->output_data.w32->hourglass_cursor;
7330 f->output_data.w32->hourglass_window
7331 = XCreateWindow (FRAME_X_DISPLAY (f),
7332 FRAME_OUTER_WINDOW (f),
7333 0, 0, 32000, 32000, 0, 0,
7334 InputOnly,
7335 CopyFromParent,
7336 mask, &attrs);
7339 XMapRaised (FRAME_X_DISPLAY (f),
7340 f->output_data.w32->hourglass_window);
7341 XFlush (FRAME_X_DISPLAY (f));
7344 hourglass_shown_p = 1;
7345 UNBLOCK_INPUT;
7347 #endif
7351 /* Hide the hourglass cursor on all frames, if it is currently shown. */
7353 static void
7354 hide_hourglass ()
7356 #if 0 /* TODO: cursor shape changes. */
7357 if (hourglass_shown_p)
7359 Lisp_Object rest, frame;
7361 BLOCK_INPUT;
7362 FOR_EACH_FRAME (rest, frame)
7364 struct frame *f = XFRAME (frame);
7366 if (FRAME_W32_P (f)
7367 /* Watch out for newly created frames. */
7368 && f->output_data.x->hourglass_window)
7370 XUnmapWindow (FRAME_X_DISPLAY (f),
7371 f->output_data.x->hourglass_window);
7372 /* Sync here because XTread_socket looks at the
7373 hourglass_p flag that is reset to zero below. */
7374 XSync (FRAME_X_DISPLAY (f), False);
7375 f->output_data.x->hourglass_p = 0;
7379 hourglass_shown_p = 0;
7380 UNBLOCK_INPUT;
7382 #endif
7387 /***********************************************************************
7388 Tool tips
7389 ***********************************************************************/
7391 static Lisp_Object x_create_tip_frame P_ ((struct w32_display_info *,
7392 Lisp_Object, Lisp_Object));
7393 static void compute_tip_xy P_ ((struct frame *, Lisp_Object, Lisp_Object,
7394 Lisp_Object, int, int, int *, int *));
7396 /* The frame of a currently visible tooltip. */
7398 Lisp_Object tip_frame;
7400 /* If non-nil, a timer started that hides the last tooltip when it
7401 fires. */
7403 Lisp_Object tip_timer;
7404 Window tip_window;
7406 /* If non-nil, a vector of 3 elements containing the last args
7407 with which x-show-tip was called. See there. */
7409 Lisp_Object last_show_tip_args;
7411 /* Maximum size for tooltips; a cons (COLUMNS . ROWS). */
7413 Lisp_Object Vx_max_tooltip_size;
7416 static Lisp_Object
7417 unwind_create_tip_frame (frame)
7418 Lisp_Object frame;
7420 Lisp_Object deleted;
7422 deleted = unwind_create_frame (frame);
7423 if (EQ (deleted, Qt))
7425 tip_window = NULL;
7426 tip_frame = Qnil;
7429 return deleted;
7433 /* Create a frame for a tooltip on the display described by DPYINFO.
7434 PARMS is a list of frame parameters. TEXT is the string to
7435 display in the tip frame. Value is the frame.
7437 Note that functions called here, esp. x_default_parameter can
7438 signal errors, for instance when a specified color name is
7439 undefined. We have to make sure that we're in a consistent state
7440 when this happens. */
7442 static Lisp_Object
7443 x_create_tip_frame (dpyinfo, parms, text)
7444 struct w32_display_info *dpyinfo;
7445 Lisp_Object parms, text;
7447 struct frame *f;
7448 Lisp_Object frame, tem;
7449 Lisp_Object name;
7450 long window_prompting = 0;
7451 int width, height;
7452 int count = SPECPDL_INDEX ();
7453 struct gcpro gcpro1, gcpro2, gcpro3;
7454 struct kboard *kb;
7455 int face_change_count_before = face_change_count;
7456 Lisp_Object buffer;
7457 struct buffer *old_buffer;
7459 check_w32 ();
7461 /* Use this general default value to start with until we know if
7462 this frame has a specified name. */
7463 Vx_resource_name = Vinvocation_name;
7465 #ifdef MULTI_KBOARD
7466 kb = dpyinfo->terminal->kboard;
7467 #else
7468 kb = &the_only_kboard;
7469 #endif
7471 /* Get the name of the frame to use for resource lookup. */
7472 name = w32_get_arg (parms, Qname, "name", "Name", RES_TYPE_STRING);
7473 if (!STRINGP (name)
7474 && !EQ (name, Qunbound)
7475 && !NILP (name))
7476 error ("Invalid frame name--not a string or nil");
7477 Vx_resource_name = name;
7479 frame = Qnil;
7480 GCPRO3 (parms, name, frame);
7481 /* Make a frame without minibuffer nor mode-line. */
7482 f = make_frame (0);
7483 f->wants_modeline = 0;
7484 XSETFRAME (frame, f);
7486 buffer = Fget_buffer_create (build_string (" *tip*"));
7487 Fset_window_buffer (FRAME_ROOT_WINDOW (f), buffer, Qnil);
7488 old_buffer = current_buffer;
7489 set_buffer_internal_1 (XBUFFER (buffer));
7490 current_buffer->truncate_lines = Qnil;
7491 specbind (Qinhibit_read_only, Qt);
7492 specbind (Qinhibit_modification_hooks, Qt);
7493 Ferase_buffer ();
7494 Finsert (1, &text);
7495 set_buffer_internal_1 (old_buffer);
7497 FRAME_CAN_HAVE_SCROLL_BARS (f) = 0;
7498 record_unwind_protect (unwind_create_tip_frame, frame);
7500 /* By setting the output method, we're essentially saying that
7501 the frame is live, as per FRAME_LIVE_P. If we get a signal
7502 from this point on, x_destroy_window might screw up reference
7503 counts etc. */
7504 f->terminal = dpyinfo->terminal;
7505 f->terminal->reference_count++;
7506 f->output_method = output_w32;
7507 f->output_data.w32 =
7508 (struct w32_output *) xmalloc (sizeof (struct w32_output));
7509 bzero (f->output_data.w32, sizeof (struct w32_output));
7511 FRAME_FONTSET (f) = -1;
7512 f->icon_name = Qnil;
7514 #if 0 /* GLYPH_DEBUG TODO: image support. */
7515 image_cache_refcount = FRAME_IMAGE_CACHE (f)->refcount;
7516 dpyinfo_refcount = dpyinfo->reference_count;
7517 #endif /* GLYPH_DEBUG */
7518 #ifdef MULTI_KBOARD
7519 FRAME_KBOARD (f) = kb;
7520 #endif
7521 f->output_data.w32->parent_desc = FRAME_W32_DISPLAY_INFO (f)->root_window;
7522 f->output_data.w32->explicit_parent = 0;
7524 /* Set the name; the functions to which we pass f expect the name to
7525 be set. */
7526 if (EQ (name, Qunbound) || NILP (name))
7528 f->name = build_string (dpyinfo->w32_id_name);
7529 f->explicit_name = 0;
7531 else
7533 f->name = name;
7534 f->explicit_name = 1;
7535 /* use the frame's title when getting resources for this frame. */
7536 specbind (Qx_resource_name, name);
7539 f->resx = dpyinfo->resx;
7540 f->resy = dpyinfo->resy;
7542 #ifdef USE_FONT_BACKEND
7543 if (enable_font_backend)
7545 /* Perhaps, we must allow frame parameter, say `font-backend',
7546 to specify which font backends to use. */
7547 register_font_driver (&w32font_driver, f);
7549 x_default_parameter (f, parms, Qfont_backend, Qnil,
7550 "fontBackend", "FontBackend", RES_TYPE_STRING);
7552 #endif /* USE_FONT_BACKEND */
7554 /* Extract the window parameters from the supplied values
7555 that are needed to determine window geometry. */
7556 #ifdef USE_FONT_BACKEND
7557 if (enable_font_backend)
7558 x_default_font_parameter (f, parms);
7559 else
7560 #endif /* USE_FONT_BACKEND */
7562 Lisp_Object font;
7564 font = w32_get_arg (parms, Qfont, "font", "Font", RES_TYPE_STRING);
7566 BLOCK_INPUT;
7567 /* First, try whatever font the caller has specified. */
7568 if (STRINGP (font))
7570 tem = Fquery_fontset (font, Qnil);
7571 if (STRINGP (tem))
7572 font = x_new_fontset (f, tem);
7573 else
7574 font = x_new_font (f, SDATA (font));
7577 /* Try out a font which we hope has bold and italic variations. */
7578 if (!STRINGP (font))
7579 font = x_new_font (f, "-*-Courier New-normal-r-*-*-*-100-*-*-c-*-iso8859-1");
7580 if (! STRINGP (font))
7581 font = x_new_font (f, "-*-Courier-normal-r-*-*-13-*-*-*-c-*-iso8859-1");
7582 /* If those didn't work, look for something which will at least work. */
7583 if (! STRINGP (font))
7584 font = x_new_font (f, "-*-Fixedsys-normal-r-*-*-12-*-*-*-c-*-iso8859-1");
7585 UNBLOCK_INPUT;
7586 if (! STRINGP (font))
7587 font = build_string ("Fixedsys");
7589 x_default_parameter (f, parms, Qfont, font,
7590 "font", "Font", RES_TYPE_STRING);
7593 x_default_parameter (f, parms, Qborder_width, make_number (2),
7594 "borderWidth", "BorderWidth", RES_TYPE_NUMBER);
7595 /* This defaults to 2 in order to match xterm. We recognize either
7596 internalBorderWidth or internalBorder (which is what xterm calls
7597 it). */
7598 if (NILP (Fassq (Qinternal_border_width, parms)))
7600 Lisp_Object value;
7602 value = w32_get_arg (parms, Qinternal_border_width,
7603 "internalBorder", "internalBorder", RES_TYPE_NUMBER);
7604 if (! EQ (value, Qunbound))
7605 parms = Fcons (Fcons (Qinternal_border_width, value),
7606 parms);
7608 x_default_parameter (f, parms, Qinternal_border_width, make_number (1),
7609 "internalBorderWidth", "internalBorderWidth",
7610 RES_TYPE_NUMBER);
7612 /* Also do the stuff which must be set before the window exists. */
7613 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
7614 "foreground", "Foreground", RES_TYPE_STRING);
7615 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
7616 "background", "Background", RES_TYPE_STRING);
7617 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
7618 "pointerColor", "Foreground", RES_TYPE_STRING);
7619 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
7620 "cursorColor", "Foreground", RES_TYPE_STRING);
7621 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
7622 "borderColor", "BorderColor", RES_TYPE_STRING);
7624 /* Init faces before x_default_parameter is called for scroll-bar
7625 parameters because that function calls x_set_scroll_bar_width,
7626 which calls change_frame_size, which calls Fset_window_buffer,
7627 which runs hooks, which call Fvertical_motion. At the end, we
7628 end up in init_iterator with a null face cache, which should not
7629 happen. */
7630 init_frame_faces (f);
7632 f->output_data.w32->dwStyle = WS_BORDER | WS_POPUP | WS_DISABLED;
7633 f->output_data.w32->parent_desc = FRAME_W32_DISPLAY_INFO (f)->root_window;
7635 window_prompting = x_figure_window_size (f, parms, 0);
7637 /* No fringes on tip frame. */
7638 f->fringe_cols = 0;
7639 f->left_fringe_width = 0;
7640 f->right_fringe_width = 0;
7642 BLOCK_INPUT;
7643 my_create_tip_window (f);
7644 UNBLOCK_INPUT;
7646 x_make_gc (f);
7648 x_default_parameter (f, parms, Qauto_raise, Qnil,
7649 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN);
7650 x_default_parameter (f, parms, Qauto_lower, Qnil,
7651 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN);
7652 x_default_parameter (f, parms, Qcursor_type, Qbox,
7653 "cursorType", "CursorType", RES_TYPE_SYMBOL);
7655 /* Dimensions, especially FRAME_LINES (f), must be done via change_frame_size.
7656 Change will not be effected unless different from the current
7657 FRAME_LINES (f). */
7658 width = FRAME_COLS (f);
7659 height = FRAME_LINES (f);
7660 FRAME_LINES (f) = 0;
7661 SET_FRAME_COLS (f, 0);
7662 change_frame_size (f, height, width, 1, 0, 0);
7664 /* Add `tooltip' frame parameter's default value. */
7665 if (NILP (Fframe_parameter (frame, intern ("tooltip"))))
7666 Fmodify_frame_parameters (frame, Fcons (Fcons (intern ("tooltip"), Qt),
7667 Qnil));
7669 /* Set up faces after all frame parameters are known. This call
7670 also merges in face attributes specified for new frames.
7672 Frame parameters may be changed if .Xdefaults contains
7673 specifications for the default font. For example, if there is an
7674 `Emacs.default.attributeBackground: pink', the `background-color'
7675 attribute of the frame get's set, which let's the internal border
7676 of the tooltip frame appear in pink. Prevent this. */
7678 Lisp_Object bg = Fframe_parameter (frame, Qbackground_color);
7680 /* Set tip_frame here, so that */
7681 tip_frame = frame;
7682 call1 (Qface_set_after_frame_default, frame);
7684 if (!EQ (bg, Fframe_parameter (frame, Qbackground_color)))
7685 Fmodify_frame_parameters (frame, Fcons (Fcons (Qbackground_color, bg),
7686 Qnil));
7689 f->no_split = 1;
7691 UNGCPRO;
7693 /* It is now ok to make the frame official even if we get an error
7694 below. And the frame needs to be on Vframe_list or making it
7695 visible won't work. */
7696 Vframe_list = Fcons (frame, Vframe_list);
7698 /* Now that the frame is official, it counts as a reference to
7699 its display. */
7700 FRAME_W32_DISPLAY_INFO (f)->reference_count++;
7702 /* Setting attributes of faces of the tooltip frame from resources
7703 and similar will increment face_change_count, which leads to the
7704 clearing of all current matrices. Since this isn't necessary
7705 here, avoid it by resetting face_change_count to the value it
7706 had before we created the tip frame. */
7707 face_change_count = face_change_count_before;
7709 /* Discard the unwind_protect. */
7710 return unbind_to (count, frame);
7714 /* Compute where to display tip frame F. PARMS is the list of frame
7715 parameters for F. DX and DY are specified offsets from the current
7716 location of the mouse. WIDTH and HEIGHT are the width and height
7717 of the tooltip. Return coordinates relative to the root window of
7718 the display in *ROOT_X, and *ROOT_Y. */
7720 static void
7721 compute_tip_xy (f, parms, dx, dy, width, height, root_x, root_y)
7722 struct frame *f;
7723 Lisp_Object parms, dx, dy;
7724 int width, height;
7725 int *root_x, *root_y;
7727 Lisp_Object left, top;
7728 int min_x, min_y, max_x, max_y;
7730 /* User-specified position? */
7731 left = Fcdr (Fassq (Qleft, parms));
7732 top = Fcdr (Fassq (Qtop, parms));
7734 /* Move the tooltip window where the mouse pointer is. Resize and
7735 show it. */
7736 if (!INTEGERP (left) || !INTEGERP (top))
7738 POINT pt;
7740 /* Default min and max values. */
7741 min_x = 0;
7742 min_y = 0;
7743 max_x = FRAME_W32_DISPLAY_INFO (f)->width;
7744 max_y = FRAME_W32_DISPLAY_INFO (f)->height;
7746 BLOCK_INPUT;
7747 GetCursorPos (&pt);
7748 *root_x = pt.x;
7749 *root_y = pt.y;
7750 UNBLOCK_INPUT;
7752 /* If multiple monitor support is available, constrain the tip onto
7753 the current monitor. This improves the above by allowing negative
7754 co-ordinates if monitor positions are such that they are valid, and
7755 snaps a tooltip onto a single monitor if we are close to the edge
7756 where it would otherwise flow onto the other monitor (or into
7757 nothingness if there is a gap in the overlap). */
7758 if (monitor_from_point_fn && get_monitor_info_fn)
7760 struct MONITOR_INFO info;
7761 HMONITOR monitor
7762 = monitor_from_point_fn (pt, MONITOR_DEFAULT_TO_NEAREST);
7763 info.cbSize = sizeof (info);
7765 if (get_monitor_info_fn (monitor, &info))
7767 min_x = info.rcWork.left;
7768 min_y = info.rcWork.top;
7769 max_x = info.rcWork.right;
7770 max_y = info.rcWork.bottom;
7775 if (INTEGERP (top))
7776 *root_y = XINT (top);
7777 else if (*root_y + XINT (dy) <= min_y)
7778 *root_y = min_y; /* Can happen for negative dy */
7779 else if (*root_y + XINT (dy) + height <= max_y)
7780 /* It fits below the pointer */
7781 *root_y += XINT (dy);
7782 else if (height + XINT (dy) + min_y <= *root_y)
7783 /* It fits above the pointer. */
7784 *root_y -= height + XINT (dy);
7785 else
7786 /* Put it on the top. */
7787 *root_y = min_y;
7789 if (INTEGERP (left))
7790 *root_x = XINT (left);
7791 else if (*root_x + XINT (dx) <= min_x)
7792 *root_x = 0; /* Can happen for negative dx */
7793 else if (*root_x + XINT (dx) + width <= max_x)
7794 /* It fits to the right of the pointer. */
7795 *root_x += XINT (dx);
7796 else if (width + XINT (dx) + min_x <= *root_x)
7797 /* It fits to the left of the pointer. */
7798 *root_x -= width + XINT (dx);
7799 else
7800 /* Put it left justified on the screen -- it ought to fit that way. */
7801 *root_x = min_x;
7805 DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0,
7806 doc: /* Show STRING in a \"tooltip\" window on frame FRAME.
7807 A tooltip window is a small window displaying a string.
7809 This is an internal function; Lisp code should call `tooltip-show'.
7811 FRAME nil or omitted means use the selected frame.
7813 PARMS is an optional list of frame parameters which can be
7814 used to change the tooltip's appearance.
7816 Automatically hide the tooltip after TIMEOUT seconds. TIMEOUT nil
7817 means use the default timeout of 5 seconds.
7819 If the list of frame parameters PARMS contains a `left' parameter,
7820 the tooltip is displayed at that x-position. Otherwise it is
7821 displayed at the mouse position, with offset DX added (default is 5 if
7822 DX isn't specified). Likewise for the y-position; if a `top' frame
7823 parameter is specified, it determines the y-position of the tooltip
7824 window, otherwise it is displayed at the mouse position, with offset
7825 DY added (default is -10).
7827 A tooltip's maximum size is specified by `x-max-tooltip-size'.
7828 Text larger than the specified size is clipped. */)
7829 (string, frame, parms, timeout, dx, dy)
7830 Lisp_Object string, frame, parms, timeout, dx, dy;
7832 struct frame *f;
7833 struct window *w;
7834 int root_x, root_y;
7835 struct buffer *old_buffer;
7836 struct text_pos pos;
7837 int i, width, height;
7838 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
7839 int old_windows_or_buffers_changed = windows_or_buffers_changed;
7840 int count = SPECPDL_INDEX ();
7842 specbind (Qinhibit_redisplay, Qt);
7844 GCPRO4 (string, parms, frame, timeout);
7846 CHECK_STRING (string);
7847 f = check_x_frame (frame);
7848 if (NILP (timeout))
7849 timeout = make_number (5);
7850 else
7851 CHECK_NATNUM (timeout);
7853 if (NILP (dx))
7854 dx = make_number (5);
7855 else
7856 CHECK_NUMBER (dx);
7858 if (NILP (dy))
7859 dy = make_number (-10);
7860 else
7861 CHECK_NUMBER (dy);
7863 if (NILP (last_show_tip_args))
7864 last_show_tip_args = Fmake_vector (make_number (3), Qnil);
7866 if (!NILP (tip_frame))
7868 Lisp_Object last_string = AREF (last_show_tip_args, 0);
7869 Lisp_Object last_frame = AREF (last_show_tip_args, 1);
7870 Lisp_Object last_parms = AREF (last_show_tip_args, 2);
7872 if (EQ (frame, last_frame)
7873 && !NILP (Fequal (last_string, string))
7874 && !NILP (Fequal (last_parms, parms)))
7876 struct frame *f = XFRAME (tip_frame);
7878 /* Only DX and DY have changed. */
7879 if (!NILP (tip_timer))
7881 Lisp_Object timer = tip_timer;
7882 tip_timer = Qnil;
7883 call1 (Qcancel_timer, timer);
7886 BLOCK_INPUT;
7887 compute_tip_xy (f, parms, dx, dy, FRAME_PIXEL_WIDTH (f),
7888 FRAME_PIXEL_HEIGHT (f), &root_x, &root_y);
7890 /* Put tooltip in topmost group and in position. */
7891 SetWindowPos (FRAME_W32_WINDOW (f), HWND_TOPMOST,
7892 root_x, root_y, 0, 0,
7893 SWP_NOSIZE | SWP_NOACTIVATE);
7895 /* Ensure tooltip is on top of other topmost windows (eg menus). */
7896 SetWindowPos (FRAME_W32_WINDOW (f), HWND_TOP,
7897 0, 0, 0, 0,
7898 SWP_NOMOVE | SWP_NOSIZE | SWP_NOACTIVATE);
7900 UNBLOCK_INPUT;
7901 goto start_timer;
7905 /* Hide a previous tip, if any. */
7906 Fx_hide_tip ();
7908 ASET (last_show_tip_args, 0, string);
7909 ASET (last_show_tip_args, 1, frame);
7910 ASET (last_show_tip_args, 2, parms);
7912 /* Add default values to frame parameters. */
7913 if (NILP (Fassq (Qname, parms)))
7914 parms = Fcons (Fcons (Qname, build_string ("tooltip")), parms);
7915 if (NILP (Fassq (Qinternal_border_width, parms)))
7916 parms = Fcons (Fcons (Qinternal_border_width, make_number (3)), parms);
7917 if (NILP (Fassq (Qborder_width, parms)))
7918 parms = Fcons (Fcons (Qborder_width, make_number (1)), parms);
7919 if (NILP (Fassq (Qborder_color, parms)))
7920 parms = Fcons (Fcons (Qborder_color, build_string ("lightyellow")), parms);
7921 if (NILP (Fassq (Qbackground_color, parms)))
7922 parms = Fcons (Fcons (Qbackground_color, build_string ("lightyellow")),
7923 parms);
7925 /* Block input until the tip has been fully drawn, to avoid crashes
7926 when drawing tips in menus. */
7927 BLOCK_INPUT;
7929 /* Create a frame for the tooltip, and record it in the global
7930 variable tip_frame. */
7931 frame = x_create_tip_frame (FRAME_W32_DISPLAY_INFO (f), parms, string);
7932 f = XFRAME (frame);
7934 /* Set up the frame's root window. */
7935 w = XWINDOW (FRAME_ROOT_WINDOW (f));
7936 w->left_col = w->top_line = make_number (0);
7938 if (CONSP (Vx_max_tooltip_size)
7939 && INTEGERP (XCAR (Vx_max_tooltip_size))
7940 && XINT (XCAR (Vx_max_tooltip_size)) > 0
7941 && INTEGERP (XCDR (Vx_max_tooltip_size))
7942 && XINT (XCDR (Vx_max_tooltip_size)) > 0)
7944 w->total_cols = XCAR (Vx_max_tooltip_size);
7945 w->total_lines = XCDR (Vx_max_tooltip_size);
7947 else
7949 w->total_cols = make_number (80);
7950 w->total_lines = make_number (40);
7953 FRAME_TOTAL_COLS (f) = XINT (w->total_cols);
7954 adjust_glyphs (f);
7955 w->pseudo_window_p = 1;
7957 /* Display the tooltip text in a temporary buffer. */
7958 old_buffer = current_buffer;
7959 set_buffer_internal_1 (XBUFFER (XWINDOW (FRAME_ROOT_WINDOW (f))->buffer));
7960 current_buffer->truncate_lines = Qnil;
7961 clear_glyph_matrix (w->desired_matrix);
7962 clear_glyph_matrix (w->current_matrix);
7963 SET_TEXT_POS (pos, BEGV, BEGV_BYTE);
7964 try_window (FRAME_ROOT_WINDOW (f), pos, 0);
7966 /* Compute width and height of the tooltip. */
7967 width = height = 0;
7968 for (i = 0; i < w->desired_matrix->nrows; ++i)
7970 struct glyph_row *row = &w->desired_matrix->rows[i];
7971 struct glyph *last;
7972 int row_width;
7974 /* Stop at the first empty row at the end. */
7975 if (!row->enabled_p || !row->displays_text_p)
7976 break;
7978 /* Let the row go over the full width of the frame. */
7979 row->full_width_p = 1;
7981 #ifdef TODO /* Investigate why some fonts need more width than is
7982 calculated for some tooltips. */
7983 /* There's a glyph at the end of rows that is use to place
7984 the cursor there. Don't include the width of this glyph. */
7985 if (row->used[TEXT_AREA])
7987 last = &row->glyphs[TEXT_AREA][row->used[TEXT_AREA] - 1];
7988 row_width = row->pixel_width - last->pixel_width;
7990 else
7991 #endif
7992 row_width = row->pixel_width;
7994 /* TODO: find why tips do not draw along baseline as instructed. */
7995 height += row->height;
7996 width = max (width, row_width);
7999 /* Add the frame's internal border to the width and height the X
8000 window should have. */
8001 height += 2 * FRAME_INTERNAL_BORDER_WIDTH (f);
8002 width += 2 * FRAME_INTERNAL_BORDER_WIDTH (f);
8004 /* Move the tooltip window where the mouse pointer is. Resize and
8005 show it. */
8006 compute_tip_xy (f, parms, dx, dy, width, height, &root_x, &root_y);
8009 /* Adjust Window size to take border into account. */
8010 RECT rect;
8011 rect.left = rect.top = 0;
8012 rect.right = width;
8013 rect.bottom = height;
8014 AdjustWindowRect (&rect, f->output_data.w32->dwStyle,
8015 FRAME_EXTERNAL_MENU_BAR (f));
8017 /* Position and size tooltip, and put it in the topmost group.
8018 The add-on of 3 to the 5th argument is a kludge: without it,
8019 some fonts cause the last character of the tip to be truncated,
8020 for some obscure reason. */
8021 SetWindowPos (FRAME_W32_WINDOW (f), HWND_TOPMOST,
8022 root_x, root_y, rect.right - rect.left + 3,
8023 rect.bottom - rect.top, SWP_NOACTIVATE);
8025 /* Ensure tooltip is on top of other topmost windows (eg menus). */
8026 SetWindowPos (FRAME_W32_WINDOW (f), HWND_TOP,
8027 0, 0, 0, 0,
8028 SWP_NOMOVE | SWP_NOSIZE | SWP_NOACTIVATE);
8030 /* Let redisplay know that we have made the frame visible already. */
8031 f->async_visible = 1;
8033 ShowWindow (FRAME_W32_WINDOW (f), SW_SHOWNOACTIVATE);
8036 /* Draw into the window. */
8037 w->must_be_updated_p = 1;
8038 update_single_window (w, 1);
8040 UNBLOCK_INPUT;
8042 /* Restore original current buffer. */
8043 set_buffer_internal_1 (old_buffer);
8044 windows_or_buffers_changed = old_windows_or_buffers_changed;
8046 start_timer:
8047 /* Let the tip disappear after timeout seconds. */
8048 tip_timer = call3 (intern ("run-at-time"), timeout, Qnil,
8049 intern ("x-hide-tip"));
8051 UNGCPRO;
8052 return unbind_to (count, Qnil);
8056 DEFUN ("x-hide-tip", Fx_hide_tip, Sx_hide_tip, 0, 0, 0,
8057 doc: /* Hide the current tooltip window, if there is any.
8058 Value is t if tooltip was open, nil otherwise. */)
8061 int count;
8062 Lisp_Object deleted, frame, timer;
8063 struct gcpro gcpro1, gcpro2;
8065 /* Return quickly if nothing to do. */
8066 if (NILP (tip_timer) && NILP (tip_frame))
8067 return Qnil;
8069 frame = tip_frame;
8070 timer = tip_timer;
8071 GCPRO2 (frame, timer);
8072 tip_frame = tip_timer = deleted = Qnil;
8074 count = SPECPDL_INDEX ();
8075 specbind (Qinhibit_redisplay, Qt);
8076 specbind (Qinhibit_quit, Qt);
8078 if (!NILP (timer))
8079 call1 (Qcancel_timer, timer);
8081 if (FRAMEP (frame))
8083 Fdelete_frame (frame, Qnil);
8084 deleted = Qt;
8087 UNGCPRO;
8088 return unbind_to (count, deleted);
8093 /***********************************************************************
8094 File selection dialog
8095 ***********************************************************************/
8096 extern Lisp_Object Qfile_name_history;
8098 /* Callback for altering the behaviour of the Open File dialog.
8099 Makes the Filename text field contain "Current Directory" and be
8100 read-only when "Directories" is selected in the filter. This
8101 allows us to work around the fact that the standard Open File
8102 dialog does not support directories. */
8103 UINT CALLBACK
8104 file_dialog_callback (hwnd, msg, wParam, lParam)
8105 HWND hwnd;
8106 UINT msg;
8107 WPARAM wParam;
8108 LPARAM lParam;
8110 if (msg == WM_NOTIFY)
8112 OFNOTIFY * notify = (OFNOTIFY *)lParam;
8113 /* Detect when the Filter dropdown is changed. */
8114 if (notify->hdr.code == CDN_TYPECHANGE
8115 || notify->hdr.code == CDN_INITDONE)
8117 HWND dialog = GetParent (hwnd);
8118 HWND edit_control = GetDlgItem (dialog, FILE_NAME_TEXT_FIELD);
8120 /* Directories is in index 2. */
8121 if (notify->lpOFN->nFilterIndex == 2)
8123 CommDlg_OpenSave_SetControlText (dialog, FILE_NAME_TEXT_FIELD,
8124 "Current Directory");
8125 EnableWindow (edit_control, FALSE);
8127 else
8129 /* Don't override default filename on init done. */
8130 if (notify->hdr.code == CDN_TYPECHANGE)
8131 CommDlg_OpenSave_SetControlText (dialog,
8132 FILE_NAME_TEXT_FIELD, "");
8133 EnableWindow (edit_control, TRUE);
8137 return 0;
8140 /* Since we compile with _WIN32_WINNT set to 0x0400 (for NT4 compatibility)
8141 we end up with the old file dialogs. Define a big enough struct for the
8142 new dialog to trick GetOpenFileName into giving us the new dialogs on
8143 Windows 2000 and XP. */
8144 typedef struct
8146 OPENFILENAME real_details;
8147 void * pReserved;
8148 DWORD dwReserved;
8149 DWORD FlagsEx;
8150 } NEWOPENFILENAME;
8153 DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 5, 0,
8154 doc: /* Read file name, prompting with PROMPT in directory DIR.
8155 Use a file selection dialog.
8156 Select DEFAULT-FILENAME in the dialog's file selection box, if
8157 specified. Ensure that file exists if MUSTMATCH is non-nil.
8158 If ONLY-DIR-P is non-nil, the user can only select directories. */)
8159 (prompt, dir, default_filename, mustmatch, only_dir_p)
8160 Lisp_Object prompt, dir, default_filename, mustmatch, only_dir_p;
8162 struct frame *f = SELECTED_FRAME ();
8163 Lisp_Object file = Qnil;
8164 int count = SPECPDL_INDEX ();
8165 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
8166 char filename[MAX_PATH + 1];
8167 char init_dir[MAX_PATH + 1];
8168 int default_filter_index = 1; /* 1: All Files, 2: Directories only */
8170 GCPRO6 (prompt, dir, default_filename, mustmatch, only_dir_p, file);
8171 CHECK_STRING (prompt);
8172 CHECK_STRING (dir);
8174 /* Create the dialog with PROMPT as title, using DIR as initial
8175 directory and using "*" as pattern. */
8176 dir = Fexpand_file_name (dir, Qnil);
8177 strncpy (init_dir, SDATA (ENCODE_FILE (dir)), MAX_PATH);
8178 init_dir[MAX_PATH] = '\0';
8179 unixtodos_filename (init_dir);
8181 if (STRINGP (default_filename))
8183 char *file_name_only;
8184 char *full_path_name = SDATA (ENCODE_FILE (default_filename));
8186 unixtodos_filename (full_path_name);
8188 file_name_only = strrchr (full_path_name, '\\');
8189 if (!file_name_only)
8190 file_name_only = full_path_name;
8191 else
8192 file_name_only++;
8194 strncpy (filename, file_name_only, MAX_PATH);
8195 filename[MAX_PATH] = '\0';
8197 else
8198 filename[0] = '\0';
8201 NEWOPENFILENAME new_file_details;
8202 BOOL file_opened = FALSE;
8203 OPENFILENAME * file_details = &new_file_details.real_details;
8205 /* Prevent redisplay. */
8206 specbind (Qinhibit_redisplay, Qt);
8207 BLOCK_INPUT;
8209 bzero (&new_file_details, sizeof (new_file_details));
8210 /* Apparently NT4 crashes if you give it an unexpected size.
8211 I'm not sure about Windows 9x, so play it safe. */
8212 if (w32_major_version > 4 && w32_major_version < 95)
8213 file_details->lStructSize = sizeof (NEWOPENFILENAME);
8214 else
8215 file_details->lStructSize = sizeof (OPENFILENAME);
8217 file_details->hwndOwner = FRAME_W32_WINDOW (f);
8218 /* Undocumented Bug in Common File Dialog:
8219 If a filter is not specified, shell links are not resolved. */
8220 file_details->lpstrFilter = "All Files (*.*)\0*.*\0Directories\0*|*\0\0";
8221 file_details->lpstrFile = filename;
8222 file_details->nMaxFile = sizeof (filename);
8223 file_details->lpstrInitialDir = init_dir;
8224 file_details->lpstrTitle = SDATA (prompt);
8226 if (! NILP (only_dir_p))
8227 default_filter_index = 2;
8229 file_details->nFilterIndex = default_filter_index;
8231 file_details->Flags = (OFN_HIDEREADONLY | OFN_NOCHANGEDIR
8232 | OFN_EXPLORER | OFN_ENABLEHOOK);
8233 if (!NILP (mustmatch))
8235 /* Require that the path to the parent directory exists. */
8236 file_details->Flags |= OFN_PATHMUSTEXIST;
8237 /* If we are looking for a file, require that it exists. */
8238 if (NILP (only_dir_p))
8239 file_details->Flags |= OFN_FILEMUSTEXIST;
8242 file_details->lpfnHook = (LPOFNHOOKPROC) file_dialog_callback;
8244 file_opened = GetOpenFileName (file_details);
8246 UNBLOCK_INPUT;
8248 if (file_opened)
8250 dostounix_filename (filename);
8252 if (file_details->nFilterIndex == 2)
8254 /* "Directories" selected - strip dummy file name. */
8255 char * last = strrchr (filename, '/');
8256 *last = '\0';
8259 file = DECODE_FILE (build_string (filename));
8261 /* User cancelled the dialog without making a selection. */
8262 else if (!CommDlgExtendedError ())
8263 file = Qnil;
8264 /* An error occurred, fallback on reading from the mini-buffer. */
8265 else
8266 file = Fcompleting_read (prompt, intern ("read-file-name-internal"),
8267 dir, mustmatch, dir, Qfile_name_history,
8268 default_filename, Qnil);
8270 file = unbind_to (count, file);
8273 UNGCPRO;
8275 /* Make "Cancel" equivalent to C-g. */
8276 if (NILP (file))
8277 Fsignal (Qquit, Qnil);
8279 return unbind_to (count, file);
8284 /***********************************************************************
8285 w32 specialized functions
8286 ***********************************************************************/
8288 DEFUN ("w32-select-font", Fw32_select_font, Sw32_select_font, 0, 2, 0,
8289 doc: /* Select a font for the named FRAME using the W32 font dialog.
8290 Return an X-style font string corresponding to the selection.
8292 If FRAME is omitted or nil, it defaults to the selected frame.
8293 If INCLUDE-PROPORTIONAL is non-nil, include proportional fonts
8294 in the font selection dialog. */)
8295 (frame, include_proportional)
8296 Lisp_Object frame, include_proportional;
8298 FRAME_PTR f = check_x_frame (frame);
8299 CHOOSEFONT cf;
8300 LOGFONT lf;
8301 TEXTMETRIC tm;
8302 HDC hdc;
8303 HANDLE oldobj;
8304 char buf[100];
8306 bzero (&cf, sizeof (cf));
8307 bzero (&lf, sizeof (lf));
8309 cf.lStructSize = sizeof (cf);
8310 cf.hwndOwner = FRAME_W32_WINDOW (f);
8311 cf.Flags = CF_FORCEFONTEXIST | CF_SCREENFONTS | CF_NOVERTFONTS;
8313 /* Unless include_proportional is non-nil, limit the selection to
8314 monospaced fonts. */
8315 if (NILP (include_proportional))
8316 cf.Flags |= CF_FIXEDPITCHONLY;
8318 cf.lpLogFont = &lf;
8320 /* Initialize as much of the font details as we can from the current
8321 default font. */
8322 hdc = GetDC (FRAME_W32_WINDOW (f));
8323 oldobj = SelectObject (hdc, FRAME_FONT (f)->hfont);
8324 GetTextFace (hdc, LF_FACESIZE, lf.lfFaceName);
8325 if (GetTextMetrics (hdc, &tm))
8327 lf.lfHeight = tm.tmInternalLeading - tm.tmHeight;
8328 lf.lfWeight = tm.tmWeight;
8329 lf.lfItalic = tm.tmItalic;
8330 lf.lfUnderline = tm.tmUnderlined;
8331 lf.lfStrikeOut = tm.tmStruckOut;
8332 lf.lfCharSet = tm.tmCharSet;
8333 cf.Flags |= CF_INITTOLOGFONTSTRUCT;
8335 SelectObject (hdc, oldobj);
8336 ReleaseDC (FRAME_W32_WINDOW (f), hdc);
8338 if (!ChooseFont (&cf) || !w32_to_x_font (&lf, buf, 100, NULL))
8339 return Qnil;
8341 return build_string (buf);
8344 DEFUN ("w32-send-sys-command", Fw32_send_sys_command,
8345 Sw32_send_sys_command, 1, 2, 0,
8346 doc: /* Send frame a Windows WM_SYSCOMMAND message of type COMMAND.
8347 Some useful values for COMMAND are #xf030 to maximize frame (#xf020
8348 to minimize), #xf120 to restore frame to original size, and #xf100
8349 to activate the menubar for keyboard access. #xf140 activates the
8350 screen saver if defined.
8352 If optional parameter FRAME is not specified, use selected frame. */)
8353 (command, frame)
8354 Lisp_Object command, frame;
8356 FRAME_PTR f = check_x_frame (frame);
8358 CHECK_NUMBER (command);
8360 PostMessage (FRAME_W32_WINDOW (f), WM_SYSCOMMAND, XINT (command), 0);
8362 return Qnil;
8365 DEFUN ("w32-shell-execute", Fw32_shell_execute, Sw32_shell_execute, 2, 4, 0,
8366 doc: /* Get Windows to perform OPERATION on DOCUMENT.
8367 This is a wrapper around the ShellExecute system function, which
8368 invokes the application registered to handle OPERATION for DOCUMENT.
8370 OPERATION is either nil or a string that names a supported operation.
8371 What operations can be used depends on the particular DOCUMENT and its
8372 handler application, but typically it is one of the following common
8373 operations:
8375 \"open\" - open DOCUMENT, which could be a file, a directory, or an
8376 executable program. If it is an application, that
8377 application is launched in the current buffer's default
8378 directory. Otherwise, the application associated with
8379 DOCUMENT is launched in the buffer's default directory.
8380 \"print\" - print DOCUMENT, which must be a file
8381 \"explore\" - start the Windows Explorer on DOCUMENT
8382 \"edit\" - launch an editor and open DOCUMENT for editing; which
8383 editor is launched depends on the association for the
8384 specified DOCUMENT
8385 \"find\" - initiate search starting from DOCUMENT which must specify
8386 a directory
8387 nil - invoke the default OPERATION, or \"open\" if default is
8388 not defined or unavailable
8390 DOCUMENT is typically the name of a document file or a URL, but can
8391 also be a program executable to run, or a directory to open in the
8392 Windows Explorer.
8394 If DOCUMENT is a program executable, the optional third arg PARAMETERS
8395 can be a string containing command line parameters that will be passed
8396 to the program; otherwise, PARAMETERS should be nil or unspecified.
8398 Optional fourth argument SHOW-FLAG can be used to control how the
8399 application will be displayed when it is invoked. If SHOW-FLAG is nil
8400 or unspecified, the application is displayed normally, otherwise it is
8401 an integer representing a ShowWindow flag:
8403 0 - start hidden
8404 1 - start normally
8405 3 - start maximized
8406 6 - start minimized */)
8407 (operation, document, parameters, show_flag)
8408 Lisp_Object operation, document, parameters, show_flag;
8410 Lisp_Object current_dir;
8412 CHECK_STRING (document);
8414 /* Encode filename, current directory and parameters. */
8415 current_dir = ENCODE_FILE (current_buffer->directory);
8416 document = ENCODE_FILE (document);
8417 if (STRINGP (parameters))
8418 parameters = ENCODE_SYSTEM (parameters);
8420 if ((int) ShellExecute (NULL,
8421 (STRINGP (operation) ?
8422 SDATA (operation) : NULL),
8423 SDATA (document),
8424 (STRINGP (parameters) ?
8425 SDATA (parameters) : NULL),
8426 SDATA (current_dir),
8427 (INTEGERP (show_flag) ?
8428 XINT (show_flag) : SW_SHOWDEFAULT))
8429 > 32)
8430 return Qt;
8431 error ("ShellExecute failed: %s", w32_strerror (0));
8434 /* Lookup virtual keycode from string representing the name of a
8435 non-ascii keystroke into the corresponding virtual key, using
8436 lispy_function_keys. */
8437 static int
8438 lookup_vk_code (char *key)
8440 int i;
8442 for (i = 0; i < 256; i++)
8443 if (lispy_function_keys[i]
8444 && strcmp (lispy_function_keys[i], key) == 0)
8445 return i;
8447 return -1;
8450 /* Convert a one-element vector style key sequence to a hot key
8451 definition. */
8452 static Lisp_Object
8453 w32_parse_hot_key (key)
8454 Lisp_Object key;
8456 /* Copied from Fdefine_key and store_in_keymap. */
8457 register Lisp_Object c;
8458 int vk_code;
8459 int lisp_modifiers;
8460 int w32_modifiers;
8461 struct gcpro gcpro1;
8463 CHECK_VECTOR (key);
8465 if (XFASTINT (Flength (key)) != 1)
8466 return Qnil;
8468 GCPRO1 (key);
8470 c = Faref (key, make_number (0));
8472 if (CONSP (c) && lucid_event_type_list_p (c))
8473 c = Fevent_convert_list (c);
8475 UNGCPRO;
8477 if (! INTEGERP (c) && ! SYMBOLP (c))
8478 error ("Key definition is invalid");
8480 /* Work out the base key and the modifiers. */
8481 if (SYMBOLP (c))
8483 c = parse_modifiers (c);
8484 lisp_modifiers = XINT (Fcar (Fcdr (c)));
8485 c = Fcar (c);
8486 if (!SYMBOLP (c))
8487 abort ();
8488 vk_code = lookup_vk_code (SDATA (SYMBOL_NAME (c)));
8490 else if (INTEGERP (c))
8492 lisp_modifiers = XINT (c) & ~CHARACTERBITS;
8493 /* Many ascii characters are their own virtual key code. */
8494 vk_code = XINT (c) & CHARACTERBITS;
8497 if (vk_code < 0 || vk_code > 255)
8498 return Qnil;
8500 if ((lisp_modifiers & meta_modifier) != 0
8501 && !NILP (Vw32_alt_is_meta))
8502 lisp_modifiers |= alt_modifier;
8504 /* Supply defs missing from mingw32. */
8505 #ifndef MOD_ALT
8506 #define MOD_ALT 0x0001
8507 #define MOD_CONTROL 0x0002
8508 #define MOD_SHIFT 0x0004
8509 #define MOD_WIN 0x0008
8510 #endif
8512 /* Convert lisp modifiers to Windows hot-key form. */
8513 w32_modifiers = (lisp_modifiers & hyper_modifier) ? MOD_WIN : 0;
8514 w32_modifiers |= (lisp_modifiers & alt_modifier) ? MOD_ALT : 0;
8515 w32_modifiers |= (lisp_modifiers & ctrl_modifier) ? MOD_CONTROL : 0;
8516 w32_modifiers |= (lisp_modifiers & shift_modifier) ? MOD_SHIFT : 0;
8518 return HOTKEY (vk_code, w32_modifiers);
8521 DEFUN ("w32-register-hot-key", Fw32_register_hot_key,
8522 Sw32_register_hot_key, 1, 1, 0,
8523 doc: /* Register KEY as a hot-key combination.
8524 Certain key combinations like Alt-Tab are reserved for system use on
8525 Windows, and therefore are normally intercepted by the system. However,
8526 most of these key combinations can be received by registering them as
8527 hot-keys, overriding their special meaning.
8529 KEY must be a one element key definition in vector form that would be
8530 acceptable to `define-key' (e.g. [A-tab] for Alt-Tab). The meta
8531 modifier is interpreted as Alt if `w32-alt-is-meta' is t, and hyper
8532 is always interpreted as the Windows modifier keys.
8534 The return value is the hotkey-id if registered, otherwise nil. */)
8535 (key)
8536 Lisp_Object key;
8538 key = w32_parse_hot_key (key);
8540 if (!NILP (key) && NILP (Fmemq (key, w32_grabbed_keys)))
8542 /* Reuse an empty slot if possible. */
8543 Lisp_Object item = Fmemq (Qnil, w32_grabbed_keys);
8545 /* Safe to add new key to list, even if we have focus. */
8546 if (NILP (item))
8547 w32_grabbed_keys = Fcons (key, w32_grabbed_keys);
8548 else
8549 XSETCAR (item, key);
8551 /* Notify input thread about new hot-key definition, so that it
8552 takes effect without needing to switch focus. */
8553 #ifdef USE_LISP_UNION_TYPE
8554 PostThreadMessage (dwWindowsThreadId, WM_EMACS_REGISTER_HOT_KEY,
8555 (WPARAM) key.i, 0);
8556 #else
8557 PostThreadMessage (dwWindowsThreadId, WM_EMACS_REGISTER_HOT_KEY,
8558 (WPARAM) key, 0);
8559 #endif
8562 return key;
8565 DEFUN ("w32-unregister-hot-key", Fw32_unregister_hot_key,
8566 Sw32_unregister_hot_key, 1, 1, 0,
8567 doc: /* Unregister KEY as a hot-key combination. */)
8568 (key)
8569 Lisp_Object key;
8571 Lisp_Object item;
8573 if (!INTEGERP (key))
8574 key = w32_parse_hot_key (key);
8576 item = Fmemq (key, w32_grabbed_keys);
8578 if (!NILP (item))
8580 /* Notify input thread about hot-key definition being removed, so
8581 that it takes effect without needing focus switch. */
8582 #ifdef USE_LISP_UNION_TYPE
8583 if (PostThreadMessage (dwWindowsThreadId, WM_EMACS_UNREGISTER_HOT_KEY,
8584 (WPARAM) XINT (XCAR (item)), (LPARAM) item.i))
8585 #else
8586 if (PostThreadMessage (dwWindowsThreadId, WM_EMACS_UNREGISTER_HOT_KEY,
8587 (WPARAM) XINT (XCAR (item)), (LPARAM) item))
8588 #endif
8590 MSG msg;
8591 GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE);
8593 return Qt;
8595 return Qnil;
8598 DEFUN ("w32-registered-hot-keys", Fw32_registered_hot_keys,
8599 Sw32_registered_hot_keys, 0, 0, 0,
8600 doc: /* Return list of registered hot-key IDs. */)
8603 return Fdelq (Qnil, Fcopy_sequence (w32_grabbed_keys));
8606 DEFUN ("w32-reconstruct-hot-key", Fw32_reconstruct_hot_key,
8607 Sw32_reconstruct_hot_key, 1, 1, 0,
8608 doc: /* Convert hot-key ID to a lisp key combination.
8609 usage: (w32-reconstruct-hot-key ID) */)
8610 (hotkeyid)
8611 Lisp_Object hotkeyid;
8613 int vk_code, w32_modifiers;
8614 Lisp_Object key;
8616 CHECK_NUMBER (hotkeyid);
8618 vk_code = HOTKEY_VK_CODE (hotkeyid);
8619 w32_modifiers = HOTKEY_MODIFIERS (hotkeyid);
8621 if (vk_code < 256 && lispy_function_keys[vk_code])
8622 key = intern (lispy_function_keys[vk_code]);
8623 else
8624 key = make_number (vk_code);
8626 key = Fcons (key, Qnil);
8627 if (w32_modifiers & MOD_SHIFT)
8628 key = Fcons (Qshift, key);
8629 if (w32_modifiers & MOD_CONTROL)
8630 key = Fcons (Qctrl, key);
8631 if (w32_modifiers & MOD_ALT)
8632 key = Fcons (NILP (Vw32_alt_is_meta) ? Qalt : Qmeta, key);
8633 if (w32_modifiers & MOD_WIN)
8634 key = Fcons (Qhyper, key);
8636 return key;
8639 DEFUN ("w32-toggle-lock-key", Fw32_toggle_lock_key,
8640 Sw32_toggle_lock_key, 1, 2, 0,
8641 doc: /* Toggle the state of the lock key KEY.
8642 KEY can be `capslock', `kp-numlock', or `scroll'.
8643 If the optional parameter NEW-STATE is a number, then the state of KEY
8644 is set to off if the low bit of NEW-STATE is zero, otherwise on. */)
8645 (key, new_state)
8646 Lisp_Object key, new_state;
8648 int vk_code;
8650 if (EQ (key, intern ("capslock")))
8651 vk_code = VK_CAPITAL;
8652 else if (EQ (key, intern ("kp-numlock")))
8653 vk_code = VK_NUMLOCK;
8654 else if (EQ (key, intern ("scroll")))
8655 vk_code = VK_SCROLL;
8656 else
8657 return Qnil;
8659 if (!dwWindowsThreadId)
8660 return make_number (w32_console_toggle_lock_key (vk_code, new_state));
8662 #ifdef USE_LISP_UNION_TYPE
8663 if (PostThreadMessage (dwWindowsThreadId, WM_EMACS_TOGGLE_LOCK_KEY,
8664 (WPARAM) vk_code, (LPARAM) new_state.i))
8665 #else
8666 if (PostThreadMessage (dwWindowsThreadId, WM_EMACS_TOGGLE_LOCK_KEY,
8667 (WPARAM) vk_code, (LPARAM) new_state))
8668 #endif
8670 MSG msg;
8671 GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE);
8672 return make_number (msg.wParam);
8674 return Qnil;
8677 DEFUN ("w32-window-exists-p", Fw32_window_exists_p, Sw32_window_exists_p,
8678 2, 2, 0,
8679 doc: /* Return non-nil if a window exists with the specified CLASS and NAME.
8681 This is a direct interface to the Windows API FindWindow function. */)
8682 (class, name)
8683 Lisp_Object class, name;
8685 HWND hnd;
8687 if (!NILP (class))
8688 CHECK_STRING (class);
8689 if (!NILP (name))
8690 CHECK_STRING (name);
8692 hnd = FindWindow (STRINGP (class) ? ((LPCTSTR) SDATA (class)) : NULL,
8693 STRINGP (name) ? ((LPCTSTR) SDATA (name)) : NULL);
8694 if (!hnd)
8695 return Qnil;
8696 return Qt;
8701 DEFUN ("file-system-info", Ffile_system_info, Sfile_system_info, 1, 1, 0,
8702 doc: /* Return storage information about the file system FILENAME is on.
8703 Value is a list of floats (TOTAL FREE AVAIL), where TOTAL is the total
8704 storage of the file system, FREE is the free storage, and AVAIL is the
8705 storage available to a non-superuser. All 3 numbers are in bytes.
8706 If the underlying system call fails, value is nil. */)
8707 (filename)
8708 Lisp_Object filename;
8710 Lisp_Object encoded, value;
8712 CHECK_STRING (filename);
8713 filename = Fexpand_file_name (filename, Qnil);
8714 encoded = ENCODE_FILE (filename);
8716 value = Qnil;
8718 /* Determining the required information on Windows turns out, sadly,
8719 to be more involved than one would hope. The original Win32 api
8720 call for this will return bogus information on some systems, but we
8721 must dynamically probe for the replacement api, since that was
8722 added rather late on. */
8724 HMODULE hKernel = GetModuleHandle ("kernel32");
8725 BOOL (*pfn_GetDiskFreeSpaceEx)
8726 (char *, PULARGE_INTEGER, PULARGE_INTEGER, PULARGE_INTEGER)
8727 = (void *) GetProcAddress (hKernel, "GetDiskFreeSpaceEx");
8729 /* On Windows, we may need to specify the root directory of the
8730 volume holding FILENAME. */
8731 char rootname[MAX_PATH];
8732 char *name = SDATA (encoded);
8734 /* find the root name of the volume if given */
8735 if (isalpha (name[0]) && name[1] == ':')
8737 rootname[0] = name[0];
8738 rootname[1] = name[1];
8739 rootname[2] = '\\';
8740 rootname[3] = 0;
8742 else if (IS_DIRECTORY_SEP (name[0]) && IS_DIRECTORY_SEP (name[1]))
8744 char *str = rootname;
8745 int slashes = 4;
8748 if (IS_DIRECTORY_SEP (*name) && --slashes == 0)
8749 break;
8750 *str++ = *name++;
8752 while ( *name );
8754 *str++ = '\\';
8755 *str = 0;
8758 if (pfn_GetDiskFreeSpaceEx)
8760 /* Unsigned large integers cannot be cast to double, so
8761 use signed ones instead. */
8762 LARGE_INTEGER availbytes;
8763 LARGE_INTEGER freebytes;
8764 LARGE_INTEGER totalbytes;
8766 if (pfn_GetDiskFreeSpaceEx (rootname,
8767 (ULARGE_INTEGER *)&availbytes,
8768 (ULARGE_INTEGER *)&totalbytes,
8769 (ULARGE_INTEGER *)&freebytes))
8770 value = list3 (make_float ((double) totalbytes.QuadPart),
8771 make_float ((double) freebytes.QuadPart),
8772 make_float ((double) availbytes.QuadPart));
8774 else
8776 DWORD sectors_per_cluster;
8777 DWORD bytes_per_sector;
8778 DWORD free_clusters;
8779 DWORD total_clusters;
8781 if (GetDiskFreeSpace (rootname,
8782 &sectors_per_cluster,
8783 &bytes_per_sector,
8784 &free_clusters,
8785 &total_clusters))
8786 value = list3 (make_float ((double) total_clusters
8787 * sectors_per_cluster * bytes_per_sector),
8788 make_float ((double) free_clusters
8789 * sectors_per_cluster * bytes_per_sector),
8790 make_float ((double) free_clusters
8791 * sectors_per_cluster * bytes_per_sector));
8795 return value;
8798 DEFUN ("default-printer-name", Fdefault_printer_name, Sdefault_printer_name,
8799 0, 0, 0, doc: /* Return the name of Windows default printer device. */)
8802 static char pname_buf[256];
8803 int err;
8804 HANDLE hPrn;
8805 PRINTER_INFO_2 *ppi2 = NULL;
8806 DWORD dwNeeded = 0, dwReturned = 0;
8808 /* Retrieve the default string from Win.ini (the registry).
8809 * String will be in form "printername,drivername,portname".
8810 * This is the most portable way to get the default printer. */
8811 if (GetProfileString ("windows", "device", ",,", pname_buf, sizeof (pname_buf)) <= 0)
8812 return Qnil;
8813 /* printername precedes first "," character */
8814 strtok (pname_buf, ",");
8815 /* We want to know more than the printer name */
8816 if (!OpenPrinter (pname_buf, &hPrn, NULL))
8817 return Qnil;
8818 GetPrinter (hPrn, 2, NULL, 0, &dwNeeded);
8819 if (dwNeeded == 0)
8821 ClosePrinter (hPrn);
8822 return Qnil;
8824 /* Allocate memory for the PRINTER_INFO_2 struct */
8825 ppi2 = (PRINTER_INFO_2 *) xmalloc (dwNeeded);
8826 if (!ppi2)
8828 ClosePrinter (hPrn);
8829 return Qnil;
8831 /* Call GetPrinter again with big enouth memory block */
8832 err = GetPrinter (hPrn, 2, (LPBYTE)ppi2, dwNeeded, &dwReturned);
8833 ClosePrinter (hPrn);
8834 if (!err)
8836 xfree (ppi2);
8837 return Qnil;
8840 if (ppi2)
8842 if (ppi2->Attributes & PRINTER_ATTRIBUTE_SHARED && ppi2->pServerName)
8844 /* a remote printer */
8845 if (*ppi2->pServerName == '\\')
8846 _snprintf (pname_buf, sizeof (pname_buf), "%s\\%s", ppi2->pServerName,
8847 ppi2->pShareName);
8848 else
8849 _snprintf (pname_buf, sizeof (pname_buf), "\\\\%s\\%s", ppi2->pServerName,
8850 ppi2->pShareName);
8851 pname_buf[sizeof (pname_buf) - 1] = '\0';
8853 else
8855 /* a local printer */
8856 strncpy (pname_buf, ppi2->pPortName, sizeof (pname_buf));
8857 pname_buf[sizeof (pname_buf) - 1] = '\0';
8858 /* `pPortName' can include several ports, delimited by ','.
8859 * we only use the first one. */
8860 strtok (pname_buf, ",");
8862 xfree (ppi2);
8865 return build_string (pname_buf);
8868 /***********************************************************************
8869 Initialization
8870 ***********************************************************************/
8872 /* Keep this list in the same order as frame_parms in frame.c.
8873 Use 0 for unsupported frame parameters. */
8875 frame_parm_handler w32_frame_parm_handlers[] =
8877 x_set_autoraise,
8878 x_set_autolower,
8879 x_set_background_color,
8880 x_set_border_color,
8881 x_set_border_width,
8882 x_set_cursor_color,
8883 x_set_cursor_type,
8884 x_set_font,
8885 x_set_foreground_color,
8886 x_set_icon_name,
8887 x_set_icon_type,
8888 x_set_internal_border_width,
8889 x_set_menu_bar_lines,
8890 x_set_mouse_color,
8891 x_explicitly_set_name,
8892 x_set_scroll_bar_width,
8893 x_set_title,
8894 x_set_unsplittable,
8895 x_set_vertical_scroll_bars,
8896 x_set_visibility,
8897 x_set_tool_bar_lines,
8898 0, /* x_set_scroll_bar_foreground, */
8899 0, /* x_set_scroll_bar_background, */
8900 x_set_screen_gamma,
8901 x_set_line_spacing,
8902 x_set_fringe_width,
8903 x_set_fringe_width,
8904 0, /* x_set_wait_for_wm, */
8905 x_set_fullscreen,
8906 #ifdef USE_FONT_BACKEND
8907 x_set_font_backend
8908 #endif
8911 void
8912 syms_of_w32fns ()
8914 globals_of_w32fns ();
8915 /* This is zero if not using MS-Windows. */
8916 w32_in_use = 0;
8917 track_mouse_window = NULL;
8919 w32_visible_system_caret_hwnd = NULL;
8921 DEFSYM (Qnone, "none");
8922 DEFSYM (Qsuppress_icon, "suppress-icon");
8923 DEFSYM (Qundefined_color, "undefined-color");
8924 DEFSYM (Qcancel_timer, "cancel-timer");
8925 DEFSYM (Qhyper, "hyper");
8926 DEFSYM (Qsuper, "super");
8927 DEFSYM (Qmeta, "meta");
8928 DEFSYM (Qalt, "alt");
8929 DEFSYM (Qctrl, "ctrl");
8930 DEFSYM (Qcontrol, "control");
8931 DEFSYM (Qshift, "shift");
8932 /* This is the end of symbol initialization. */
8934 /* Text property `display' should be nonsticky by default. */
8935 Vtext_property_default_nonsticky
8936 = Fcons (Fcons (Qdisplay, Qt), Vtext_property_default_nonsticky);
8939 Fput (Qundefined_color, Qerror_conditions,
8940 Fcons (Qundefined_color, Fcons (Qerror, Qnil)));
8941 Fput (Qundefined_color, Qerror_message,
8942 build_string ("Undefined color"));
8944 staticpro (&w32_grabbed_keys);
8945 w32_grabbed_keys = Qnil;
8947 DEFVAR_LISP ("w32-color-map", &Vw32_color_map,
8948 doc: /* An array of color name mappings for Windows. */);
8949 Vw32_color_map = Qnil;
8951 DEFVAR_LISP ("w32-pass-alt-to-system", &Vw32_pass_alt_to_system,
8952 doc: /* Non-nil if Alt key presses are passed on to Windows.
8953 When non-nil, for example, Alt pressed and released and then space will
8954 open the System menu. When nil, Emacs processes the Alt key events, and
8955 then silently swallows them. */);
8956 Vw32_pass_alt_to_system = Qnil;
8958 DEFVAR_LISP ("w32-alt-is-meta", &Vw32_alt_is_meta,
8959 doc: /* Non-nil if the Alt key is to be considered the same as the META key.
8960 When nil, Emacs will translate the Alt key to the ALT modifier, not to META. */);
8961 Vw32_alt_is_meta = Qt;
8963 DEFVAR_INT ("w32-quit-key", &w32_quit_key,
8964 doc: /* If non-zero, the virtual key code for an alternative quit key. */);
8965 w32_quit_key = 0;
8967 DEFVAR_LISP ("w32-pass-lwindow-to-system",
8968 &Vw32_pass_lwindow_to_system,
8969 doc: /* If non-nil, the left \"Windows\" key is passed on to Windows.
8971 When non-nil, the Start menu is opened by tapping the key.
8972 If you set this to nil, the left \"Windows\" key is processed by Emacs
8973 according to the value of `w32-lwindow-modifier', which see.
8975 Note that some combinations of the left \"Windows\" key with other keys are
8976 caught by Windows at low level, and so binding them in Emacs will have no
8977 effect. For example, <lwindow>-r always pops up the Windows Run dialog,
8978 <lwindow>-<Pause> pops up the "System Properties" dialog, etc. However, see
8979 the doc string of `w32-phantom-key-code'. */);
8980 Vw32_pass_lwindow_to_system = Qt;
8982 DEFVAR_LISP ("w32-pass-rwindow-to-system",
8983 &Vw32_pass_rwindow_to_system,
8984 doc: /* If non-nil, the right \"Windows\" key is passed on to Windows.
8986 When non-nil, the Start menu is opened by tapping the key.
8987 If you set this to nil, the right \"Windows\" key is processed by Emacs
8988 according to the value of `w32-rwindow-modifier', which see.
8990 Note that some combinations of the right \"Windows\" key with other keys are
8991 caught by Windows at low level, and so binding them in Emacs will have no
8992 effect. For example, <rwindow>-r always pops up the Windows Run dialog,
8993 <rwindow>-<Pause> pops up the "System Properties" dialog, etc. However, see
8994 the doc string of `w32-phantom-key-code'. */);
8995 Vw32_pass_rwindow_to_system = Qt;
8997 DEFVAR_LISP ("w32-phantom-key-code",
8998 &Vw32_phantom_key_code,
8999 doc: /* Virtual key code used to generate \"phantom\" key presses.
9000 Value is a number between 0 and 255.
9002 Phantom key presses are generated in order to stop the system from
9003 acting on \"Windows\" key events when `w32-pass-lwindow-to-system' or
9004 `w32-pass-rwindow-to-system' is nil. */);
9005 /* Although 255 is technically not a valid key code, it works and
9006 means that this hack won't interfere with any real key code. */
9007 XSETINT (Vw32_phantom_key_code, 255);
9009 DEFVAR_LISP ("w32-enable-num-lock",
9010 &Vw32_enable_num_lock,
9011 doc: /* If non-nil, the Num Lock key acts normally.
9012 Set to nil to handle Num Lock as the `kp-numlock' key. */);
9013 Vw32_enable_num_lock = Qt;
9015 DEFVAR_LISP ("w32-enable-caps-lock",
9016 &Vw32_enable_caps_lock,
9017 doc: /* If non-nil, the Caps Lock key acts normally.
9018 Set to nil to handle Caps Lock as the `capslock' key. */);
9019 Vw32_enable_caps_lock = Qt;
9021 DEFVAR_LISP ("w32-scroll-lock-modifier",
9022 &Vw32_scroll_lock_modifier,
9023 doc: /* Modifier to use for the Scroll Lock ON state.
9024 The value can be hyper, super, meta, alt, control or shift for the
9025 respective modifier, or nil to handle Scroll Lock as the `scroll' key.
9026 Any other value will cause the Scroll Lock key to be ignored. */);
9027 Vw32_scroll_lock_modifier = Qt;
9029 DEFVAR_LISP ("w32-lwindow-modifier",
9030 &Vw32_lwindow_modifier,
9031 doc: /* Modifier to use for the left \"Windows\" key.
9032 The value can be hyper, super, meta, alt, control or shift for the
9033 respective modifier, or nil to appear as the `lwindow' key.
9034 Any other value will cause the key to be ignored. */);
9035 Vw32_lwindow_modifier = Qnil;
9037 DEFVAR_LISP ("w32-rwindow-modifier",
9038 &Vw32_rwindow_modifier,
9039 doc: /* Modifier to use for the right \"Windows\" key.
9040 The value can be hyper, super, meta, alt, control or shift for the
9041 respective modifier, or nil to appear as the `rwindow' key.
9042 Any other value will cause the key to be ignored. */);
9043 Vw32_rwindow_modifier = Qnil;
9045 DEFVAR_LISP ("w32-apps-modifier",
9046 &Vw32_apps_modifier,
9047 doc: /* Modifier to use for the \"Apps\" key.
9048 The value can be hyper, super, meta, alt, control or shift for the
9049 respective modifier, or nil to appear as the `apps' key.
9050 Any other value will cause the key to be ignored. */);
9051 Vw32_apps_modifier = Qnil;
9053 DEFVAR_BOOL ("w32-enable-synthesized-fonts", &w32_enable_synthesized_fonts,
9054 doc: /* Non-nil enables selection of artificially italicized and bold fonts. */);
9055 w32_enable_synthesized_fonts = 0;
9057 DEFVAR_LISP ("w32-enable-palette", &Vw32_enable_palette,
9058 doc: /* Non-nil enables Windows palette management to map colors exactly. */);
9059 Vw32_enable_palette = Qt;
9061 DEFVAR_INT ("w32-mouse-button-tolerance",
9062 &w32_mouse_button_tolerance,
9063 doc: /* Analogue of double click interval for faking middle mouse events.
9064 The value is the minimum time in milliseconds that must elapse between
9065 left and right button down events before they are considered distinct events.
9066 If both mouse buttons are depressed within this interval, a middle mouse
9067 button down event is generated instead. */);
9068 w32_mouse_button_tolerance = GetDoubleClickTime () / 2;
9070 DEFVAR_INT ("w32-mouse-move-interval",
9071 &w32_mouse_move_interval,
9072 doc: /* Minimum interval between mouse move events.
9073 The value is the minimum time in milliseconds that must elapse between
9074 successive mouse move (or scroll bar drag) events before they are
9075 reported as lisp events. */);
9076 w32_mouse_move_interval = 0;
9078 DEFVAR_BOOL ("w32-pass-extra-mouse-buttons-to-system",
9079 &w32_pass_extra_mouse_buttons_to_system,
9080 doc: /* If non-nil, the fourth and fifth mouse buttons are passed to Windows.
9081 Recent versions of Windows support mice with up to five buttons.
9082 Since most applications don't support these extra buttons, most mouse
9083 drivers will allow you to map them to functions at the system level.
9084 If this variable is non-nil, Emacs will pass them on, allowing the
9085 system to handle them. */);
9086 w32_pass_extra_mouse_buttons_to_system = 0;
9088 DEFVAR_BOOL ("w32-pass-multimedia-buttons-to-system",
9089 &w32_pass_multimedia_buttons_to_system,
9090 doc: /* If non-nil, media buttons are passed to Windows.
9091 Some modern keyboards contain buttons for controlling media players, web
9092 browsers and other applications. Generally these buttons are handled on a
9093 system wide basis, but by setting this to nil they are made available
9094 to Emacs for binding. Depending on your keyboard, additional keys that
9095 may be available are:
9097 browser-back, browser-forward, browser-refresh, browser-stop,
9098 browser-search, browser-favorites, browser-home,
9099 mail, mail-reply, mail-forward, mail-send,
9100 app-1, app-2,
9101 help, find, new, open, close, save, print, undo, redo, copy, cut, paste,
9102 spell-check, correction-list, toggle-dictate-command,
9103 media-next, media-previous, media-stop, media-play-pause, media-select,
9104 media-play, media-pause, media-record, media-fast-forward, media-rewind,
9105 media-channel-up, media-channel-down,
9106 volume-mute, volume-up, volume-down,
9107 mic-volume-mute, mic-volume-down, mic-volume-up, mic-toggle,
9108 bass-down, bass-boost, bass-up, treble-down, treble-up */);
9109 w32_pass_multimedia_buttons_to_system = 1;
9111 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape,
9112 doc: /* The shape of the pointer when over text.
9113 Changing the value does not affect existing frames
9114 unless you set the mouse color. */);
9115 Vx_pointer_shape = Qnil;
9117 Vx_nontext_pointer_shape = Qnil;
9119 Vx_mode_pointer_shape = Qnil;
9121 DEFVAR_LISP ("x-hourglass-pointer-shape", &Vx_hourglass_pointer_shape,
9122 doc: /* The shape of the pointer when Emacs is busy.
9123 This variable takes effect when you create a new frame
9124 or when you set the mouse color. */);
9125 Vx_hourglass_pointer_shape = Qnil;
9127 DEFVAR_BOOL ("display-hourglass", &display_hourglass_p,
9128 doc: /* Non-zero means Emacs displays an hourglass pointer on window systems. */);
9129 display_hourglass_p = 1;
9131 DEFVAR_LISP ("hourglass-delay", &Vhourglass_delay,
9132 doc: /* *Seconds to wait before displaying an hourglass pointer.
9133 Value must be an integer or float. */);
9134 Vhourglass_delay = make_number (DEFAULT_HOURGLASS_DELAY);
9136 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
9137 &Vx_sensitive_text_pointer_shape,
9138 doc: /* The shape of the pointer when over mouse-sensitive text.
9139 This variable takes effect when you create a new frame
9140 or when you set the mouse color. */);
9141 Vx_sensitive_text_pointer_shape = Qnil;
9143 DEFVAR_LISP ("x-window-horizontal-drag-cursor",
9144 &Vx_window_horizontal_drag_shape,
9145 doc: /* Pointer shape to use for indicating a window can be dragged horizontally.
9146 This variable takes effect when you create a new frame
9147 or when you set the mouse color. */);
9148 Vx_window_horizontal_drag_shape = Qnil;
9150 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel,
9151 doc: /* A string indicating the foreground color of the cursor box. */);
9152 Vx_cursor_fore_pixel = Qnil;
9154 DEFVAR_LISP ("x-max-tooltip-size", &Vx_max_tooltip_size,
9155 doc: /* Maximum size for tooltips.
9156 Value is a pair (COLUMNS . ROWS). Text larger than this is clipped. */);
9157 Vx_max_tooltip_size = Fcons (make_number (80), make_number (40));
9159 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager,
9160 doc: /* Non-nil if no window manager is in use.
9161 Emacs doesn't try to figure this out; this is always nil
9162 unless you set it to something else. */);
9163 /* We don't have any way to find this out, so set it to nil
9164 and maybe the user would like to set it to t. */
9165 Vx_no_window_manager = Qnil;
9167 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
9168 &Vx_pixel_size_width_font_regexp,
9169 doc: /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'.
9171 Since Emacs gets width of a font matching with this regexp from
9172 PIXEL_SIZE field of the name, font finding mechanism gets faster for
9173 such a font. This is especially effective for such large fonts as
9174 Chinese, Japanese, and Korean. */);
9175 Vx_pixel_size_width_font_regexp = Qnil;
9177 DEFVAR_LISP ("w32-bdf-filename-alist",
9178 &Vw32_bdf_filename_alist,
9179 doc: /* List of bdf fonts and their corresponding filenames. */);
9180 Vw32_bdf_filename_alist = Qnil;
9182 DEFVAR_BOOL ("w32-strict-fontnames",
9183 &w32_strict_fontnames,
9184 doc: /* Non-nil means only use fonts that are exact matches for those requested.
9185 Default is nil, which allows old fontnames that are not XLFD compliant,
9186 and allows third-party CJK display to work by specifying false charset
9187 fields to trick Emacs into translating to Big5, SJIS etc.
9188 Setting this to t will prevent wrong fonts being selected when
9189 fontsets are automatically created. */);
9190 w32_strict_fontnames = 0;
9192 DEFVAR_BOOL ("w32-strict-painting",
9193 &w32_strict_painting,
9194 doc: /* Non-nil means use strict rules for repainting frames.
9195 Set this to nil to get the old behavior for repainting; this should
9196 only be necessary if the default setting causes problems. */);
9197 w32_strict_painting = 1;
9199 DEFVAR_LISP ("w32-charset-info-alist",
9200 &Vw32_charset_info_alist,
9201 doc: /* Alist linking Emacs character sets to Windows fonts and codepages.
9202 Each entry should be of the form:
9204 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE))
9206 where CHARSET_NAME is a string used in font names to identify the charset,
9207 WINDOWS_CHARSET is a symbol that can be one of:
9208 w32-charset-ansi, w32-charset-default, w32-charset-symbol,
9209 w32-charset-shiftjis, w32-charset-hangeul, w32-charset-gb2312,
9210 w32-charset-chinesebig5,
9211 w32-charset-johab, w32-charset-hebrew,
9212 w32-charset-arabic, w32-charset-greek, w32-charset-turkish,
9213 w32-charset-vietnamese, w32-charset-thai, w32-charset-easteurope,
9214 w32-charset-russian, w32-charset-mac, w32-charset-baltic,
9215 w32-charset-unicode,
9216 or w32-charset-oem.
9217 CODEPAGE should be an integer specifying the codepage that should be used
9218 to display the character set, t to do no translation and output as Unicode,
9219 or nil to do no translation and output as 8 bit (or multibyte on far-east
9220 versions of Windows) characters. */);
9221 Vw32_charset_info_alist = Qnil;
9223 DEFSYM (Qw32_charset_ansi, "w32-charset-ansi");
9224 DEFSYM (Qw32_charset_symbol, "w32-charset-symbol");
9225 DEFSYM (Qw32_charset_default, "w32-charset-default");
9226 DEFSYM (Qw32_charset_shiftjis, "w32-charset-shiftjis");
9227 DEFSYM (Qw32_charset_hangeul, "w32-charset-hangeul");
9228 DEFSYM (Qw32_charset_chinesebig5, "w32-charset-chinesebig5");
9229 DEFSYM (Qw32_charset_gb2312, "w32-charset-gb2312");
9230 DEFSYM (Qw32_charset_oem, "w32-charset-oem");
9232 #ifdef JOHAB_CHARSET
9234 static int w32_extra_charsets_defined = 1;
9235 DEFVAR_BOOL ("w32-extra-charsets-defined", &w32_extra_charsets_defined,
9236 doc: /* Internal variable. */);
9238 DEFSYM (Qw32_charset_johab, "w32-charset-johab");
9239 DEFSYM (Qw32_charset_easteurope, "w32-charset-easteurope");
9240 DEFSYM (Qw32_charset_turkish, "w32-charset-turkish");
9241 DEFSYM (Qw32_charset_baltic, "w32-charset-baltic");
9242 DEFSYM (Qw32_charset_russian, "w32-charset-russian");
9243 DEFSYM (Qw32_charset_arabic, "w32-charset-arabic");
9244 DEFSYM (Qw32_charset_greek, "w32-charset-greek");
9245 DEFSYM (Qw32_charset_hebrew, "w32-charset-hebrew");
9246 DEFSYM (Qw32_charset_vietnamese, "w32-charset-vietnamese");
9247 DEFSYM (Qw32_charset_thai, "w32-charset-thai");
9248 DEFSYM (Qw32_charset_mac, "w32-charset-mac");
9250 #endif
9252 #ifdef UNICODE_CHARSET
9254 static int w32_unicode_charset_defined = 1;
9255 DEFVAR_BOOL ("w32-unicode-charset-defined",
9256 &w32_unicode_charset_defined,
9257 doc: /* Internal variable. */);
9258 DEFSYM (Qw32_charset_unicode, "w32-charset-unicode");
9260 #endif
9262 #if 0 /* TODO: Port to W32 */
9263 defsubr (&Sx_change_window_property);
9264 defsubr (&Sx_delete_window_property);
9265 defsubr (&Sx_window_property);
9266 #endif
9267 defsubr (&Sxw_display_color_p);
9268 defsubr (&Sx_display_grayscale_p);
9269 defsubr (&Sxw_color_defined_p);
9270 defsubr (&Sxw_color_values);
9271 defsubr (&Sx_server_max_request_size);
9272 defsubr (&Sx_server_vendor);
9273 defsubr (&Sx_server_version);
9274 defsubr (&Sx_display_pixel_width);
9275 defsubr (&Sx_display_pixel_height);
9276 defsubr (&Sx_display_mm_width);
9277 defsubr (&Sx_display_mm_height);
9278 defsubr (&Sx_display_screens);
9279 defsubr (&Sx_display_planes);
9280 defsubr (&Sx_display_color_cells);
9281 defsubr (&Sx_display_visual_class);
9282 defsubr (&Sx_display_backing_store);
9283 defsubr (&Sx_display_save_under);
9284 defsubr (&Sx_create_frame);
9285 defsubr (&Sx_open_connection);
9286 defsubr (&Sx_close_connection);
9287 defsubr (&Sx_display_list);
9288 defsubr (&Sx_synchronize);
9289 defsubr (&Sx_focus_frame);
9291 /* W32 specific functions */
9293 defsubr (&Sw32_select_font);
9294 defsubr (&Sw32_define_rgb_color);
9295 defsubr (&Sw32_default_color_map);
9296 defsubr (&Sw32_load_color_file);
9297 defsubr (&Sw32_send_sys_command);
9298 defsubr (&Sw32_shell_execute);
9299 defsubr (&Sw32_register_hot_key);
9300 defsubr (&Sw32_unregister_hot_key);
9301 defsubr (&Sw32_registered_hot_keys);
9302 defsubr (&Sw32_reconstruct_hot_key);
9303 defsubr (&Sw32_toggle_lock_key);
9304 defsubr (&Sw32_window_exists_p);
9305 defsubr (&Sw32_find_bdf_fonts);
9307 defsubr (&Sfile_system_info);
9308 defsubr (&Sdefault_printer_name);
9310 /* Setting callback functions for fontset handler. */
9311 get_font_info_func = w32_get_font_info;
9313 #if 0 /* This function pointer doesn't seem to be used anywhere.
9314 And the pointer assigned has the wrong type, anyway. */
9315 list_fonts_func = w32_list_fonts;
9316 #endif
9318 load_font_func = w32_load_font;
9319 find_ccl_program_func = w32_find_ccl_program;
9320 query_font_func = w32_query_font;
9321 set_frame_fontset_func = x_set_font;
9322 get_font_repertory_func = x_get_font_repertory;
9323 check_window_system_func = check_w32;
9326 hourglass_atimer = NULL;
9327 hourglass_shown_p = 0;
9328 defsubr (&Sx_show_tip);
9329 defsubr (&Sx_hide_tip);
9330 tip_timer = Qnil;
9331 staticpro (&tip_timer);
9332 tip_frame = Qnil;
9333 staticpro (&tip_frame);
9335 last_show_tip_args = Qnil;
9336 staticpro (&last_show_tip_args);
9338 defsubr (&Sx_file_dialog);
9343 globals_of_w32fns is used to initialize those global variables that
9344 must always be initialized on startup even when the global variable
9345 initialized is non zero (see the function main in emacs.c).
9346 globals_of_w32fns is called from syms_of_w32fns when the global
9347 variable initialized is 0 and directly from main when initialized
9348 is non zero.
9350 void
9351 globals_of_w32fns ()
9353 HMODULE user32_lib = GetModuleHandle ("user32.dll");
9355 TrackMouseEvent not available in all versions of Windows, so must load
9356 it dynamically. Do it once, here, instead of every time it is used.
9358 track_mouse_event_fn = (TrackMouseEvent_Proc)
9359 GetProcAddress (user32_lib, "TrackMouseEvent");
9360 /* ditto for GetClipboardSequenceNumber. */
9361 clipboard_sequence_fn = (ClipboardSequence_Proc)
9362 GetProcAddress (user32_lib, "GetClipboardSequenceNumber");
9364 monitor_from_point_fn = (MonitorFromPoint_Proc)
9365 GetProcAddress (user32_lib, "MonitorFromPoint");
9366 get_monitor_info_fn = (GetMonitorInfo_Proc)
9367 GetProcAddress (user32_lib, "GetMonitorInfoA");
9370 HMODULE imm32_lib = GetModuleHandle ("imm32.dll");
9371 get_composition_string_fn = (ImmGetCompositionString_Proc)
9372 GetProcAddress (imm32_lib, "ImmGetCompositionStringW");
9373 get_ime_context_fn = (ImmGetContext_Proc)
9374 GetProcAddress (imm32_lib, "ImmGetContext");
9376 DEFVAR_INT ("w32-ansi-code-page",
9377 &w32_ansi_code_page,
9378 doc: /* The ANSI code page used by the system. */);
9379 w32_ansi_code_page = GetACP ();
9381 /* MessageBox does not work without this when linked to comctl32.dll 6.0. */
9382 InitCommonControls ();
9385 #undef abort
9387 void
9388 w32_abort ()
9390 int button;
9391 button = MessageBox (NULL,
9392 "A fatal error has occurred!\n\n"
9393 "Would you like to attach a debugger?\n\n"
9394 "Select YES to debug, NO to abort Emacs"
9395 #if __GNUC__
9396 "\n\n(type \"gdb -p <emacs-PID>\" and\n"
9397 "\"continue\" inside GDB before clicking YES.)"
9398 #endif
9399 , "Emacs Abort Dialog",
9400 MB_ICONEXCLAMATION | MB_TASKMODAL
9401 | MB_SETFOREGROUND | MB_YESNO);
9402 switch (button)
9404 case IDYES:
9405 DebugBreak ();
9406 exit (2); /* tell the compiler we will never return */
9407 case IDNO:
9408 default:
9409 abort ();
9410 break;
9414 /* For convenience when debugging. */
9416 w32_last_error ()
9418 return GetLastError ();
9421 /* arch-tag: 707589ab-b9be-4638-8cdd-74629cc9b446
9422 (do not change this comment) */