Subject: * lisp/progmodes/prolog.el: Improve handling of if/then/else
[emacs.git] / src / w32fns.c
blob99fd3ba33fdd2411a35cb4d0567bb834bcdf1afe
1 /* Graphical user interface functions for the Microsoft Windows API.
3 Copyright (C) 1989, 1992-2015 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software: you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation, either version 3 of the License, or
10 (at your option) any later version.
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
20 /* Added by Kevin Gallo */
22 #include <config.h>
24 #include <signal.h>
25 #include <stdio.h>
26 #include <limits.h>
27 #include <errno.h>
28 #include <math.h>
29 #include <fcntl.h>
30 #include <unistd.h>
32 #include <c-ctype.h>
34 #include "lisp.h"
35 #include "w32term.h"
36 #include "frame.h"
37 #include "window.h"
38 #include "character.h"
39 #include "buffer.h"
40 #include "intervals.h"
41 #include "dispextern.h"
42 #include "keyboard.h"
43 #include "blockinput.h"
44 #include "epaths.h"
45 #include "charset.h"
46 #include "coding.h"
47 #include "ccl.h"
48 #include "fontset.h"
49 #include "systime.h"
50 #include "termhooks.h"
52 #include "w32common.h"
54 #ifdef WINDOWSNT
55 #include "w32heap.h"
56 #include <mbstring.h>
57 #endif /* WINDOWSNT */
59 #if CYGWIN
60 #include "cygw32.h"
61 #else
62 #include "w32.h"
63 #endif
65 #include "bitmaps/gray.xbm"
67 #include <commctrl.h>
68 #include <commdlg.h>
69 #include <shellapi.h>
70 #include <ctype.h>
71 #include <winspool.h>
72 #include <objbase.h>
74 #include <dlgs.h>
75 #include <imm.h>
76 #include <windowsx.h>
78 #include "font.h"
79 #include "w32font.h"
81 #ifndef FOF_NO_CONNECTED_ELEMENTS
82 #define FOF_NO_CONNECTED_ELEMENTS 0x2000
83 #endif
85 void syms_of_w32fns (void);
86 void globals_of_w32fns (void);
88 extern void free_frame_menubar (struct frame *);
89 extern int w32_console_toggle_lock_key (int, Lisp_Object);
90 extern void w32_menu_display_help (HWND, HMENU, UINT, UINT);
91 extern void w32_free_menu_strings (HWND);
92 extern const char *map_w32_filename (const char *, const char **);
93 extern char * w32_strerror (int error_no);
95 #ifndef IDC_HAND
96 #define IDC_HAND MAKEINTRESOURCE(32649)
97 #endif
99 /* Prefix for system colors. */
100 #define SYSTEM_COLOR_PREFIX "System"
101 #define SYSTEM_COLOR_PREFIX_LEN (sizeof (SYSTEM_COLOR_PREFIX) - 1)
103 /* State variables for emulating a three button mouse. */
104 #define LMOUSE 1
105 #define MMOUSE 2
106 #define RMOUSE 4
108 static int button_state = 0;
109 static W32Msg saved_mouse_button_msg;
110 static unsigned mouse_button_timer = 0; /* non-zero when timer is active */
111 static W32Msg saved_mouse_move_msg;
112 static unsigned mouse_move_timer = 0;
114 /* Window that is tracking the mouse. */
115 static HWND track_mouse_window;
117 /* Multi-monitor API definitions that are not pulled from the headers
118 since we are compiling for NT 4. */
119 #ifndef MONITOR_DEFAULT_TO_NEAREST
120 #define MONITOR_DEFAULT_TO_NEAREST 2
121 #endif
122 #ifndef MONITORINFOF_PRIMARY
123 #define MONITORINFOF_PRIMARY 1
124 #endif
125 #ifndef SM_XVIRTUALSCREEN
126 #define SM_XVIRTUALSCREEN 76
127 #endif
128 #ifndef SM_YVIRTUALSCREEN
129 #define SM_YVIRTUALSCREEN 77
130 #endif
131 /* MinGW headers define MONITORINFO unconditionally, but MSVC ones don't.
132 To avoid a compile error on one or the other, redefine with a new name. */
133 struct MONITOR_INFO
135 DWORD cbSize;
136 RECT rcMonitor;
137 RECT rcWork;
138 DWORD dwFlags;
141 #if _WIN32_WINDOWS >= 0x0410
142 #define C_CHILDREN_TITLEBAR CCHILDREN_TITLEBAR
143 typedef TITLEBARINFO TITLEBAR_INFO;
144 #else
145 #define C_CHILDREN_TITLEBAR 5
146 typedef struct
148 DWORD cbSize;
149 RECT rcTitleBar;
150 DWORD rgstate[C_CHILDREN_TITLEBAR+1];
151 } TITLEBAR_INFO, *PTITLEBAR_INFO;
152 #endif
154 #ifndef CCHDEVICENAME
155 #define CCHDEVICENAME 32
156 #endif
157 struct MONITOR_INFO_EX
159 DWORD cbSize;
160 RECT rcMonitor;
161 RECT rcWork;
162 DWORD dwFlags;
163 char szDevice[CCHDEVICENAME];
166 /* Reportedly, MSVC does not have this in its headers. */
167 #if defined (_MSC_VER) && _WIN32_WINNT < 0x0500
168 DECLARE_HANDLE(HMONITOR);
169 #endif
171 typedef BOOL (WINAPI * TrackMouseEvent_Proc)
172 (IN OUT LPTRACKMOUSEEVENT lpEventTrack);
173 typedef LONG (WINAPI * ImmGetCompositionString_Proc)
174 (IN HIMC context, IN DWORD index, OUT LPVOID buffer, IN DWORD bufLen);
175 typedef HIMC (WINAPI * ImmGetContext_Proc) (IN HWND window);
176 typedef BOOL (WINAPI * ImmReleaseContext_Proc) (IN HWND wnd, IN HIMC context);
177 typedef BOOL (WINAPI * ImmSetCompositionWindow_Proc) (IN HIMC context,
178 IN COMPOSITIONFORM *form);
179 typedef HMONITOR (WINAPI * MonitorFromPoint_Proc) (IN POINT pt, IN DWORD flags);
180 typedef BOOL (WINAPI * GetMonitorInfo_Proc)
181 (IN HMONITOR monitor, OUT struct MONITOR_INFO* info);
182 typedef HMONITOR (WINAPI * MonitorFromWindow_Proc)
183 (IN HWND hwnd, IN DWORD dwFlags);
184 typedef BOOL CALLBACK (* MonitorEnum_Proc)
185 (IN HMONITOR monitor, IN HDC hdc, IN RECT *rcMonitor, IN LPARAM dwData);
186 typedef BOOL (WINAPI * EnumDisplayMonitors_Proc)
187 (IN HDC hdc, IN RECT *rcClip, IN MonitorEnum_Proc fnEnum, IN LPARAM dwData);
188 typedef BOOL (WINAPI * GetTitleBarInfo_Proc)
189 (IN HWND hwnd, OUT TITLEBAR_INFO* info);
191 TrackMouseEvent_Proc track_mouse_event_fn = NULL;
192 ImmGetCompositionString_Proc get_composition_string_fn = NULL;
193 ImmGetContext_Proc get_ime_context_fn = NULL;
194 ImmReleaseContext_Proc release_ime_context_fn = NULL;
195 ImmSetCompositionWindow_Proc set_ime_composition_window_fn = NULL;
196 MonitorFromPoint_Proc monitor_from_point_fn = NULL;
197 GetMonitorInfo_Proc get_monitor_info_fn = NULL;
198 MonitorFromWindow_Proc monitor_from_window_fn = NULL;
199 EnumDisplayMonitors_Proc enum_display_monitors_fn = NULL;
200 GetTitleBarInfo_Proc get_title_bar_info_fn = NULL;
202 #ifdef NTGUI_UNICODE
203 #define unicode_append_menu AppendMenuW
204 #else /* !NTGUI_UNICODE */
205 extern AppendMenuW_Proc unicode_append_menu;
206 #endif /* NTGUI_UNICODE */
208 /* Flag to selectively ignore WM_IME_CHAR messages. */
209 static int ignore_ime_char = 0;
211 /* W95 mousewheel handler */
212 unsigned int msh_mousewheel = 0;
214 /* Timers */
215 #define MOUSE_BUTTON_ID 1
216 #define MOUSE_MOVE_ID 2
217 #define MENU_FREE_ID 3
218 /* The delay (milliseconds) before a menu is freed after WM_EXITMENULOOP
219 is received. */
220 #define MENU_FREE_DELAY 1000
221 static unsigned menu_free_timer = 0;
223 #ifdef GLYPH_DEBUG
224 static ptrdiff_t image_cache_refcount;
225 static int dpyinfo_refcount;
226 #endif
228 static HWND w32_visible_system_caret_hwnd;
230 static int w32_unicode_gui;
232 /* From w32menu.c */
233 extern HMENU current_popup_menu;
234 int menubar_in_use = 0;
236 /* From w32uniscribe.c */
237 extern void syms_of_w32uniscribe (void);
238 extern int uniscribe_available;
240 #ifdef WINDOWSNT
241 /* From w32inevt.c */
242 extern int faked_key;
243 #endif /* WINDOWSNT */
245 /* This gives us the page size and the size of the allocation unit on NT. */
246 SYSTEM_INFO sysinfo_cache;
248 /* This gives us version, build, and platform identification. */
249 OSVERSIONINFO osinfo_cache;
251 DWORD_PTR syspage_mask = 0;
253 /* The major and minor versions of NT. */
254 int w32_major_version;
255 int w32_minor_version;
256 int w32_build_number;
258 /* Distinguish between Windows NT and Windows 95. */
259 int os_subtype;
261 #ifdef HAVE_NTGUI
262 HINSTANCE hinst = NULL;
263 #endif
265 static unsigned int sound_type = 0xFFFFFFFF;
266 #define MB_EMACS_SILENT (0xFFFFFFFF - 1)
268 /* Let the user specify a display with a frame.
269 nil stands for the selected frame--or, if that is not a w32 frame,
270 the first display on the list. */
272 struct w32_display_info *
273 check_x_display_info (Lisp_Object object)
275 if (NILP (object))
277 struct frame *sf = XFRAME (selected_frame);
279 if (FRAME_W32_P (sf) && FRAME_LIVE_P (sf))
280 return FRAME_DISPLAY_INFO (sf);
281 else
282 return &one_w32_display_info;
284 else if (TERMINALP (object))
286 struct terminal *t = decode_live_terminal (object);
288 if (t->type != output_w32)
289 error ("Terminal %d is not a W32 display", t->id);
291 return t->display_info.w32;
293 else if (STRINGP (object))
294 return x_display_info_for_name (object);
295 else
297 struct frame *f;
299 CHECK_LIVE_FRAME (object);
300 f = XFRAME (object);
301 if (! FRAME_W32_P (f))
302 error ("Non-W32 frame used");
303 return FRAME_DISPLAY_INFO (f);
307 /* Return the Emacs frame-object corresponding to an w32 window.
308 It could be the frame's main window or an icon window. */
310 struct frame *
311 x_window_to_frame (struct w32_display_info *dpyinfo, HWND wdesc)
313 Lisp_Object tail, frame;
314 struct frame *f;
316 FOR_EACH_FRAME (tail, frame)
318 f = XFRAME (frame);
319 if (!FRAME_W32_P (f) || FRAME_DISPLAY_INFO (f) != dpyinfo)
320 continue;
322 if (FRAME_W32_WINDOW (f) == wdesc)
323 return f;
325 return 0;
329 static Lisp_Object unwind_create_frame (Lisp_Object);
330 static void unwind_create_tip_frame (Lisp_Object);
331 static void my_create_window (struct frame *);
332 static void my_create_tip_window (struct frame *);
334 /* TODO: Native Input Method support; see x_create_im. */
335 void x_set_foreground_color (struct frame *, Lisp_Object, Lisp_Object);
336 void x_set_background_color (struct frame *, Lisp_Object, Lisp_Object);
337 void x_set_mouse_color (struct frame *, Lisp_Object, Lisp_Object);
338 void x_set_cursor_color (struct frame *, Lisp_Object, Lisp_Object);
339 void x_set_border_color (struct frame *, Lisp_Object, Lisp_Object);
340 void x_set_cursor_type (struct frame *, Lisp_Object, Lisp_Object);
341 void x_set_icon_type (struct frame *, Lisp_Object, Lisp_Object);
342 void x_set_icon_name (struct frame *, Lisp_Object, Lisp_Object);
343 void x_explicitly_set_name (struct frame *, Lisp_Object, Lisp_Object);
344 void x_set_menu_bar_lines (struct frame *, Lisp_Object, Lisp_Object);
345 void x_set_title (struct frame *, Lisp_Object, Lisp_Object);
346 void x_set_tool_bar_lines (struct frame *, Lisp_Object, Lisp_Object);
347 void x_set_internal_border_width (struct frame *f, Lisp_Object, Lisp_Object);
350 /* Store the screen positions of frame F into XPTR and YPTR.
351 These are the positions of the containing window manager window,
352 not Emacs's own window. */
354 void
355 x_real_positions (struct frame *f, int *xptr, int *yptr)
357 POINT pt;
358 RECT rect;
360 /* Get the bounds of the WM window. */
361 GetWindowRect (FRAME_W32_WINDOW (f), &rect);
363 pt.x = 0;
364 pt.y = 0;
366 /* Convert (0, 0) in the client area to screen co-ordinates. */
367 ClientToScreen (FRAME_W32_WINDOW (f), &pt);
369 *xptr = rect.left;
370 *yptr = rect.top;
373 /* Returns the window rectangle appropriate for the given fullscreen mode.
374 The normal rect parameter was the window's rectangle prior to entering
375 fullscreen mode. If multiple monitor support is available, the nearest
376 monitor to the window is chosen. */
378 void
379 w32_fullscreen_rect (HWND hwnd, int fsmode, RECT normal, RECT *rect)
381 struct MONITOR_INFO mi = { sizeof(mi) };
382 if (monitor_from_window_fn && get_monitor_info_fn)
384 HMONITOR monitor =
385 monitor_from_window_fn (hwnd, MONITOR_DEFAULT_TO_NEAREST);
386 get_monitor_info_fn (monitor, &mi);
388 else
390 mi.rcMonitor.left = 0;
391 mi.rcMonitor.top = 0;
392 mi.rcMonitor.right = GetSystemMetrics (SM_CXSCREEN);
393 mi.rcMonitor.bottom = GetSystemMetrics (SM_CYSCREEN);
394 mi.rcWork.left = 0;
395 mi.rcWork.top = 0;
396 mi.rcWork.right = GetSystemMetrics (SM_CXMAXIMIZED);
397 mi.rcWork.bottom = GetSystemMetrics (SM_CYMAXIMIZED);
400 switch (fsmode)
402 case FULLSCREEN_BOTH:
403 rect->left = mi.rcMonitor.left;
404 rect->top = mi.rcMonitor.top;
405 rect->right = mi.rcMonitor.right;
406 rect->bottom = mi.rcMonitor.bottom;
407 break;
408 case FULLSCREEN_WIDTH:
409 rect->left = mi.rcWork.left;
410 rect->top = normal.top;
411 rect->right = mi.rcWork.right;
412 rect->bottom = normal.bottom;
413 break;
414 case FULLSCREEN_HEIGHT:
415 rect->left = normal.left;
416 rect->top = mi.rcWork.top;
417 rect->right = normal.right;
418 rect->bottom = mi.rcWork.bottom;
419 break;
420 default:
421 *rect = normal;
422 break;
428 DEFUN ("w32-define-rgb-color", Fw32_define_rgb_color,
429 Sw32_define_rgb_color, 4, 4, 0,
430 doc: /* Convert RGB numbers to a Windows color reference and associate with NAME.
431 This adds or updates a named color to `w32-color-map', making it
432 available for use. The original entry's RGB ref is returned, or nil
433 if the entry is new. */)
434 (Lisp_Object red, Lisp_Object green, Lisp_Object blue, Lisp_Object name)
436 Lisp_Object rgb;
437 Lisp_Object oldrgb = Qnil;
438 Lisp_Object entry;
440 CHECK_NUMBER (red);
441 CHECK_NUMBER (green);
442 CHECK_NUMBER (blue);
443 CHECK_STRING (name);
445 XSETINT (rgb, RGB (XUINT (red), XUINT (green), XUINT (blue)));
447 block_input ();
449 /* replace existing entry in w32-color-map or add new entry. */
450 entry = Fassoc (name, Vw32_color_map);
451 if (NILP (entry))
453 entry = Fcons (name, rgb);
454 Vw32_color_map = Fcons (entry, Vw32_color_map);
456 else
458 oldrgb = Fcdr (entry);
459 Fsetcdr (entry, rgb);
462 unblock_input ();
464 return (oldrgb);
467 /* The default colors for the w32 color map */
468 typedef struct colormap_t
470 char *name;
471 COLORREF colorref;
472 } colormap_t;
474 colormap_t w32_color_map[] =
476 {"snow" , PALETTERGB (255,250,250)},
477 {"ghost white" , PALETTERGB (248,248,255)},
478 {"GhostWhite" , PALETTERGB (248,248,255)},
479 {"white smoke" , PALETTERGB (245,245,245)},
480 {"WhiteSmoke" , PALETTERGB (245,245,245)},
481 {"gainsboro" , PALETTERGB (220,220,220)},
482 {"floral white" , PALETTERGB (255,250,240)},
483 {"FloralWhite" , PALETTERGB (255,250,240)},
484 {"old lace" , PALETTERGB (253,245,230)},
485 {"OldLace" , PALETTERGB (253,245,230)},
486 {"linen" , PALETTERGB (250,240,230)},
487 {"antique white" , PALETTERGB (250,235,215)},
488 {"AntiqueWhite" , PALETTERGB (250,235,215)},
489 {"papaya whip" , PALETTERGB (255,239,213)},
490 {"PapayaWhip" , PALETTERGB (255,239,213)},
491 {"blanched almond" , PALETTERGB (255,235,205)},
492 {"BlanchedAlmond" , PALETTERGB (255,235,205)},
493 {"bisque" , PALETTERGB (255,228,196)},
494 {"peach puff" , PALETTERGB (255,218,185)},
495 {"PeachPuff" , PALETTERGB (255,218,185)},
496 {"navajo white" , PALETTERGB (255,222,173)},
497 {"NavajoWhite" , PALETTERGB (255,222,173)},
498 {"moccasin" , PALETTERGB (255,228,181)},
499 {"cornsilk" , PALETTERGB (255,248,220)},
500 {"ivory" , PALETTERGB (255,255,240)},
501 {"lemon chiffon" , PALETTERGB (255,250,205)},
502 {"LemonChiffon" , PALETTERGB (255,250,205)},
503 {"seashell" , PALETTERGB (255,245,238)},
504 {"honeydew" , PALETTERGB (240,255,240)},
505 {"mint cream" , PALETTERGB (245,255,250)},
506 {"MintCream" , PALETTERGB (245,255,250)},
507 {"azure" , PALETTERGB (240,255,255)},
508 {"alice blue" , PALETTERGB (240,248,255)},
509 {"AliceBlue" , PALETTERGB (240,248,255)},
510 {"lavender" , PALETTERGB (230,230,250)},
511 {"lavender blush" , PALETTERGB (255,240,245)},
512 {"LavenderBlush" , PALETTERGB (255,240,245)},
513 {"misty rose" , PALETTERGB (255,228,225)},
514 {"MistyRose" , PALETTERGB (255,228,225)},
515 {"white" , PALETTERGB (255,255,255)},
516 {"black" , PALETTERGB ( 0, 0, 0)},
517 {"dark slate gray" , PALETTERGB ( 47, 79, 79)},
518 {"DarkSlateGray" , PALETTERGB ( 47, 79, 79)},
519 {"dark slate grey" , PALETTERGB ( 47, 79, 79)},
520 {"DarkSlateGrey" , PALETTERGB ( 47, 79, 79)},
521 {"dim gray" , PALETTERGB (105,105,105)},
522 {"DimGray" , PALETTERGB (105,105,105)},
523 {"dim grey" , PALETTERGB (105,105,105)},
524 {"DimGrey" , PALETTERGB (105,105,105)},
525 {"slate gray" , PALETTERGB (112,128,144)},
526 {"SlateGray" , PALETTERGB (112,128,144)},
527 {"slate grey" , PALETTERGB (112,128,144)},
528 {"SlateGrey" , PALETTERGB (112,128,144)},
529 {"light slate gray" , PALETTERGB (119,136,153)},
530 {"LightSlateGray" , PALETTERGB (119,136,153)},
531 {"light slate grey" , PALETTERGB (119,136,153)},
532 {"LightSlateGrey" , PALETTERGB (119,136,153)},
533 {"gray" , PALETTERGB (190,190,190)},
534 {"grey" , PALETTERGB (190,190,190)},
535 {"light grey" , PALETTERGB (211,211,211)},
536 {"LightGrey" , PALETTERGB (211,211,211)},
537 {"light gray" , PALETTERGB (211,211,211)},
538 {"LightGray" , PALETTERGB (211,211,211)},
539 {"midnight blue" , PALETTERGB ( 25, 25,112)},
540 {"MidnightBlue" , PALETTERGB ( 25, 25,112)},
541 {"navy" , PALETTERGB ( 0, 0,128)},
542 {"navy blue" , PALETTERGB ( 0, 0,128)},
543 {"NavyBlue" , PALETTERGB ( 0, 0,128)},
544 {"cornflower blue" , PALETTERGB (100,149,237)},
545 {"CornflowerBlue" , PALETTERGB (100,149,237)},
546 {"dark slate blue" , PALETTERGB ( 72, 61,139)},
547 {"DarkSlateBlue" , PALETTERGB ( 72, 61,139)},
548 {"slate blue" , PALETTERGB (106, 90,205)},
549 {"SlateBlue" , PALETTERGB (106, 90,205)},
550 {"medium slate blue" , PALETTERGB (123,104,238)},
551 {"MediumSlateBlue" , PALETTERGB (123,104,238)},
552 {"light slate blue" , PALETTERGB (132,112,255)},
553 {"LightSlateBlue" , PALETTERGB (132,112,255)},
554 {"medium blue" , PALETTERGB ( 0, 0,205)},
555 {"MediumBlue" , PALETTERGB ( 0, 0,205)},
556 {"royal blue" , PALETTERGB ( 65,105,225)},
557 {"RoyalBlue" , PALETTERGB ( 65,105,225)},
558 {"blue" , PALETTERGB ( 0, 0,255)},
559 {"dodger blue" , PALETTERGB ( 30,144,255)},
560 {"DodgerBlue" , PALETTERGB ( 30,144,255)},
561 {"deep sky blue" , PALETTERGB ( 0,191,255)},
562 {"DeepSkyBlue" , PALETTERGB ( 0,191,255)},
563 {"sky blue" , PALETTERGB (135,206,235)},
564 {"SkyBlue" , PALETTERGB (135,206,235)},
565 {"light sky blue" , PALETTERGB (135,206,250)},
566 {"LightSkyBlue" , PALETTERGB (135,206,250)},
567 {"steel blue" , PALETTERGB ( 70,130,180)},
568 {"SteelBlue" , PALETTERGB ( 70,130,180)},
569 {"light steel blue" , PALETTERGB (176,196,222)},
570 {"LightSteelBlue" , PALETTERGB (176,196,222)},
571 {"light blue" , PALETTERGB (173,216,230)},
572 {"LightBlue" , PALETTERGB (173,216,230)},
573 {"powder blue" , PALETTERGB (176,224,230)},
574 {"PowderBlue" , PALETTERGB (176,224,230)},
575 {"pale turquoise" , PALETTERGB (175,238,238)},
576 {"PaleTurquoise" , PALETTERGB (175,238,238)},
577 {"dark turquoise" , PALETTERGB ( 0,206,209)},
578 {"DarkTurquoise" , PALETTERGB ( 0,206,209)},
579 {"medium turquoise" , PALETTERGB ( 72,209,204)},
580 {"MediumTurquoise" , PALETTERGB ( 72,209,204)},
581 {"turquoise" , PALETTERGB ( 64,224,208)},
582 {"cyan" , PALETTERGB ( 0,255,255)},
583 {"light cyan" , PALETTERGB (224,255,255)},
584 {"LightCyan" , PALETTERGB (224,255,255)},
585 {"cadet blue" , PALETTERGB ( 95,158,160)},
586 {"CadetBlue" , PALETTERGB ( 95,158,160)},
587 {"medium aquamarine" , PALETTERGB (102,205,170)},
588 {"MediumAquamarine" , PALETTERGB (102,205,170)},
589 {"aquamarine" , PALETTERGB (127,255,212)},
590 {"dark green" , PALETTERGB ( 0,100, 0)},
591 {"DarkGreen" , PALETTERGB ( 0,100, 0)},
592 {"dark olive green" , PALETTERGB ( 85,107, 47)},
593 {"DarkOliveGreen" , PALETTERGB ( 85,107, 47)},
594 {"dark sea green" , PALETTERGB (143,188,143)},
595 {"DarkSeaGreen" , PALETTERGB (143,188,143)},
596 {"sea green" , PALETTERGB ( 46,139, 87)},
597 {"SeaGreen" , PALETTERGB ( 46,139, 87)},
598 {"medium sea green" , PALETTERGB ( 60,179,113)},
599 {"MediumSeaGreen" , PALETTERGB ( 60,179,113)},
600 {"light sea green" , PALETTERGB ( 32,178,170)},
601 {"LightSeaGreen" , PALETTERGB ( 32,178,170)},
602 {"pale green" , PALETTERGB (152,251,152)},
603 {"PaleGreen" , PALETTERGB (152,251,152)},
604 {"spring green" , PALETTERGB ( 0,255,127)},
605 {"SpringGreen" , PALETTERGB ( 0,255,127)},
606 {"lawn green" , PALETTERGB (124,252, 0)},
607 {"LawnGreen" , PALETTERGB (124,252, 0)},
608 {"green" , PALETTERGB ( 0,255, 0)},
609 {"chartreuse" , PALETTERGB (127,255, 0)},
610 {"medium spring green" , PALETTERGB ( 0,250,154)},
611 {"MediumSpringGreen" , PALETTERGB ( 0,250,154)},
612 {"green yellow" , PALETTERGB (173,255, 47)},
613 {"GreenYellow" , PALETTERGB (173,255, 47)},
614 {"lime green" , PALETTERGB ( 50,205, 50)},
615 {"LimeGreen" , PALETTERGB ( 50,205, 50)},
616 {"yellow green" , PALETTERGB (154,205, 50)},
617 {"YellowGreen" , PALETTERGB (154,205, 50)},
618 {"forest green" , PALETTERGB ( 34,139, 34)},
619 {"ForestGreen" , PALETTERGB ( 34,139, 34)},
620 {"olive drab" , PALETTERGB (107,142, 35)},
621 {"OliveDrab" , PALETTERGB (107,142, 35)},
622 {"dark khaki" , PALETTERGB (189,183,107)},
623 {"DarkKhaki" , PALETTERGB (189,183,107)},
624 {"khaki" , PALETTERGB (240,230,140)},
625 {"pale goldenrod" , PALETTERGB (238,232,170)},
626 {"PaleGoldenrod" , PALETTERGB (238,232,170)},
627 {"light goldenrod yellow" , PALETTERGB (250,250,210)},
628 {"LightGoldenrodYellow" , PALETTERGB (250,250,210)},
629 {"light yellow" , PALETTERGB (255,255,224)},
630 {"LightYellow" , PALETTERGB (255,255,224)},
631 {"yellow" , PALETTERGB (255,255, 0)},
632 {"gold" , PALETTERGB (255,215, 0)},
633 {"light goldenrod" , PALETTERGB (238,221,130)},
634 {"LightGoldenrod" , PALETTERGB (238,221,130)},
635 {"goldenrod" , PALETTERGB (218,165, 32)},
636 {"dark goldenrod" , PALETTERGB (184,134, 11)},
637 {"DarkGoldenrod" , PALETTERGB (184,134, 11)},
638 {"rosy brown" , PALETTERGB (188,143,143)},
639 {"RosyBrown" , PALETTERGB (188,143,143)},
640 {"indian red" , PALETTERGB (205, 92, 92)},
641 {"IndianRed" , PALETTERGB (205, 92, 92)},
642 {"saddle brown" , PALETTERGB (139, 69, 19)},
643 {"SaddleBrown" , PALETTERGB (139, 69, 19)},
644 {"sienna" , PALETTERGB (160, 82, 45)},
645 {"peru" , PALETTERGB (205,133, 63)},
646 {"burlywood" , PALETTERGB (222,184,135)},
647 {"beige" , PALETTERGB (245,245,220)},
648 {"wheat" , PALETTERGB (245,222,179)},
649 {"sandy brown" , PALETTERGB (244,164, 96)},
650 {"SandyBrown" , PALETTERGB (244,164, 96)},
651 {"tan" , PALETTERGB (210,180,140)},
652 {"chocolate" , PALETTERGB (210,105, 30)},
653 {"firebrick" , PALETTERGB (178,34, 34)},
654 {"brown" , PALETTERGB (165,42, 42)},
655 {"dark salmon" , PALETTERGB (233,150,122)},
656 {"DarkSalmon" , PALETTERGB (233,150,122)},
657 {"salmon" , PALETTERGB (250,128,114)},
658 {"light salmon" , PALETTERGB (255,160,122)},
659 {"LightSalmon" , PALETTERGB (255,160,122)},
660 {"orange" , PALETTERGB (255,165, 0)},
661 {"dark orange" , PALETTERGB (255,140, 0)},
662 {"DarkOrange" , PALETTERGB (255,140, 0)},
663 {"coral" , PALETTERGB (255,127, 80)},
664 {"light coral" , PALETTERGB (240,128,128)},
665 {"LightCoral" , PALETTERGB (240,128,128)},
666 {"tomato" , PALETTERGB (255, 99, 71)},
667 {"orange red" , PALETTERGB (255, 69, 0)},
668 {"OrangeRed" , PALETTERGB (255, 69, 0)},
669 {"red" , PALETTERGB (255, 0, 0)},
670 {"hot pink" , PALETTERGB (255,105,180)},
671 {"HotPink" , PALETTERGB (255,105,180)},
672 {"deep pink" , PALETTERGB (255, 20,147)},
673 {"DeepPink" , PALETTERGB (255, 20,147)},
674 {"pink" , PALETTERGB (255,192,203)},
675 {"light pink" , PALETTERGB (255,182,193)},
676 {"LightPink" , PALETTERGB (255,182,193)},
677 {"pale violet red" , PALETTERGB (219,112,147)},
678 {"PaleVioletRed" , PALETTERGB (219,112,147)},
679 {"maroon" , PALETTERGB (176, 48, 96)},
680 {"medium violet red" , PALETTERGB (199, 21,133)},
681 {"MediumVioletRed" , PALETTERGB (199, 21,133)},
682 {"violet red" , PALETTERGB (208, 32,144)},
683 {"VioletRed" , PALETTERGB (208, 32,144)},
684 {"magenta" , PALETTERGB (255, 0,255)},
685 {"violet" , PALETTERGB (238,130,238)},
686 {"plum" , PALETTERGB (221,160,221)},
687 {"orchid" , PALETTERGB (218,112,214)},
688 {"medium orchid" , PALETTERGB (186, 85,211)},
689 {"MediumOrchid" , PALETTERGB (186, 85,211)},
690 {"dark orchid" , PALETTERGB (153, 50,204)},
691 {"DarkOrchid" , PALETTERGB (153, 50,204)},
692 {"dark violet" , PALETTERGB (148, 0,211)},
693 {"DarkViolet" , PALETTERGB (148, 0,211)},
694 {"blue violet" , PALETTERGB (138, 43,226)},
695 {"BlueViolet" , PALETTERGB (138, 43,226)},
696 {"purple" , PALETTERGB (160, 32,240)},
697 {"medium purple" , PALETTERGB (147,112,219)},
698 {"MediumPurple" , PALETTERGB (147,112,219)},
699 {"thistle" , PALETTERGB (216,191,216)},
700 {"gray0" , PALETTERGB ( 0, 0, 0)},
701 {"grey0" , PALETTERGB ( 0, 0, 0)},
702 {"dark grey" , PALETTERGB (169,169,169)},
703 {"DarkGrey" , PALETTERGB (169,169,169)},
704 {"dark gray" , PALETTERGB (169,169,169)},
705 {"DarkGray" , PALETTERGB (169,169,169)},
706 {"dark blue" , PALETTERGB ( 0, 0,139)},
707 {"DarkBlue" , PALETTERGB ( 0, 0,139)},
708 {"dark cyan" , PALETTERGB ( 0,139,139)},
709 {"DarkCyan" , PALETTERGB ( 0,139,139)},
710 {"dark magenta" , PALETTERGB (139, 0,139)},
711 {"DarkMagenta" , PALETTERGB (139, 0,139)},
712 {"dark red" , PALETTERGB (139, 0, 0)},
713 {"DarkRed" , PALETTERGB (139, 0, 0)},
714 {"light green" , PALETTERGB (144,238,144)},
715 {"LightGreen" , PALETTERGB (144,238,144)},
718 static Lisp_Object
719 w32_default_color_map (void)
721 int i;
722 colormap_t *pc = w32_color_map;
723 Lisp_Object cmap;
725 block_input ();
727 cmap = Qnil;
729 for (i = 0; i < ARRAYELTS (w32_color_map); pc++, i++)
730 cmap = Fcons (Fcons (build_string (pc->name),
731 make_number (pc->colorref)),
732 cmap);
734 unblock_input ();
736 return (cmap);
739 DEFUN ("w32-default-color-map", Fw32_default_color_map, Sw32_default_color_map,
740 0, 0, 0, doc: /* Return the default color map. */)
741 (void)
743 return w32_default_color_map ();
746 static Lisp_Object
747 w32_color_map_lookup (const char *colorname)
749 Lisp_Object tail, ret = Qnil;
751 block_input ();
753 for (tail = Vw32_color_map; CONSP (tail); tail = XCDR (tail))
755 register Lisp_Object elt, tem;
757 elt = XCAR (tail);
758 if (!CONSP (elt)) continue;
760 tem = XCAR (elt);
762 if (lstrcmpi (SDATA (tem), colorname) == 0)
764 ret = Fcdr (elt);
765 break;
768 QUIT;
771 unblock_input ();
773 return ret;
777 static void
778 add_system_logical_colors_to_map (Lisp_Object *system_colors)
780 HKEY colors_key;
782 /* Other registry operations are done with input blocked. */
783 block_input ();
785 /* Look for "Control Panel/Colors" under User and Machine registry
786 settings. */
787 if (RegOpenKeyEx (HKEY_CURRENT_USER, "Control Panel\\Colors", 0,
788 KEY_READ, &colors_key) == ERROR_SUCCESS
789 || RegOpenKeyEx (HKEY_LOCAL_MACHINE, "Control Panel\\Colors", 0,
790 KEY_READ, &colors_key) == ERROR_SUCCESS)
792 /* List all keys. */
793 char color_buffer[64];
794 char full_name_buffer[MAX_PATH + SYSTEM_COLOR_PREFIX_LEN];
795 int index = 0;
796 DWORD name_size, color_size;
797 char *name_buffer = full_name_buffer + SYSTEM_COLOR_PREFIX_LEN;
799 name_size = sizeof (full_name_buffer) - SYSTEM_COLOR_PREFIX_LEN;
800 color_size = sizeof (color_buffer);
802 strcpy (full_name_buffer, SYSTEM_COLOR_PREFIX);
804 while (RegEnumValueA (colors_key, index, name_buffer, &name_size,
805 NULL, NULL, color_buffer, &color_size)
806 == ERROR_SUCCESS)
808 int r, g, b;
809 if (sscanf (color_buffer, " %u %u %u", &r, &g, &b) == 3)
810 *system_colors = Fcons (Fcons (build_string (full_name_buffer),
811 make_number (RGB (r, g, b))),
812 *system_colors);
814 name_size = sizeof (full_name_buffer) - SYSTEM_COLOR_PREFIX_LEN;
815 color_size = sizeof (color_buffer);
816 index++;
818 RegCloseKey (colors_key);
821 unblock_input ();
825 static Lisp_Object
826 x_to_w32_color (const char * colorname)
828 register Lisp_Object ret = Qnil;
830 block_input ();
832 if (colorname[0] == '#')
834 /* Could be an old-style RGB Device specification. */
835 int size = strlen (colorname + 1);
836 char *color = alloca (size + 1);
838 strcpy (color, colorname + 1);
839 if (size == 3 || size == 6 || size == 9 || size == 12)
841 UINT colorval;
842 int i, pos;
843 pos = 0;
844 size /= 3;
845 colorval = 0;
847 for (i = 0; i < 3; i++)
849 char *end;
850 char t;
851 unsigned long value;
853 /* The check for 'x' in the following conditional takes into
854 account the fact that strtol allows a "0x" in front of
855 our numbers, and we don't. */
856 if (!isxdigit (color[0]) || color[1] == 'x')
857 break;
858 t = color[size];
859 color[size] = '\0';
860 value = strtoul (color, &end, 16);
861 color[size] = t;
862 if (errno == ERANGE || end - color != size)
863 break;
864 switch (size)
866 case 1:
867 value = value * 0x10;
868 break;
869 case 2:
870 break;
871 case 3:
872 value /= 0x10;
873 break;
874 case 4:
875 value /= 0x100;
876 break;
878 colorval |= (value << pos);
879 pos += 0x8;
880 if (i == 2)
882 unblock_input ();
883 XSETINT (ret, colorval);
884 return ret;
886 color = end;
890 else if (strnicmp (colorname, "rgb:", 4) == 0)
892 const char *color;
893 UINT colorval;
894 int i, pos;
895 pos = 0;
897 colorval = 0;
898 color = colorname + 4;
899 for (i = 0; i < 3; i++)
901 char *end;
902 unsigned long value;
904 /* The check for 'x' in the following conditional takes into
905 account the fact that strtol allows a "0x" in front of
906 our numbers, and we don't. */
907 if (!isxdigit (color[0]) || color[1] == 'x')
908 break;
909 value = strtoul (color, &end, 16);
910 if (errno == ERANGE)
911 break;
912 switch (end - color)
914 case 1:
915 value = value * 0x10 + value;
916 break;
917 case 2:
918 break;
919 case 3:
920 value /= 0x10;
921 break;
922 case 4:
923 value /= 0x100;
924 break;
925 default:
926 value = ULONG_MAX;
928 if (value == ULONG_MAX)
929 break;
930 colorval |= (value << pos);
931 pos += 0x8;
932 if (i == 2)
934 if (*end != '\0')
935 break;
936 unblock_input ();
937 XSETINT (ret, colorval);
938 return ret;
940 if (*end != '/')
941 break;
942 color = end + 1;
945 else if (strnicmp (colorname, "rgbi:", 5) == 0)
947 /* This is an RGB Intensity specification. */
948 const char *color;
949 UINT colorval;
950 int i, pos;
951 pos = 0;
953 colorval = 0;
954 color = colorname + 5;
955 for (i = 0; i < 3; i++)
957 char *end;
958 double value;
959 UINT val;
961 value = strtod (color, &end);
962 if (errno == ERANGE)
963 break;
964 if (value < 0.0 || value > 1.0)
965 break;
966 val = (UINT)(0x100 * value);
967 /* We used 0x100 instead of 0xFF to give a continuous
968 range between 0.0 and 1.0 inclusive. The next statement
969 fixes the 1.0 case. */
970 if (val == 0x100)
971 val = 0xFF;
972 colorval |= (val << pos);
973 pos += 0x8;
974 if (i == 2)
976 if (*end != '\0')
977 break;
978 unblock_input ();
979 XSETINT (ret, colorval);
980 return ret;
982 if (*end != '/')
983 break;
984 color = end + 1;
987 /* I am not going to attempt to handle any of the CIE color schemes
988 or TekHVC, since I don't know the algorithms for conversion to
989 RGB. */
991 /* If we fail to lookup the color name in w32_color_map, then check the
992 colorname to see if it can be crudely approximated: If the X color
993 ends in a number (e.g., "darkseagreen2"), strip the number and
994 return the result of looking up the base color name. */
995 ret = w32_color_map_lookup (colorname);
996 if (NILP (ret))
998 int len = strlen (colorname);
1000 if (isdigit (colorname[len - 1]))
1002 char *ptr, *approx = alloca (len + 1);
1004 strcpy (approx, colorname);
1005 ptr = &approx[len - 1];
1006 while (ptr > approx && isdigit (*ptr))
1007 *ptr-- = '\0';
1009 ret = w32_color_map_lookup (approx);
1013 unblock_input ();
1014 return ret;
1017 void
1018 w32_regenerate_palette (struct frame *f)
1020 struct w32_palette_entry * list;
1021 LOGPALETTE * log_palette;
1022 HPALETTE new_palette;
1023 int i;
1025 /* don't bother trying to create palette if not supported */
1026 if (! FRAME_DISPLAY_INFO (f)->has_palette)
1027 return;
1029 log_palette = (LOGPALETTE *)
1030 alloca (sizeof (LOGPALETTE) +
1031 FRAME_DISPLAY_INFO (f)->num_colors * sizeof (PALETTEENTRY));
1032 log_palette->palVersion = 0x300;
1033 log_palette->palNumEntries = FRAME_DISPLAY_INFO (f)->num_colors;
1035 list = FRAME_DISPLAY_INFO (f)->color_list;
1036 for (i = 0;
1037 i < FRAME_DISPLAY_INFO (f)->num_colors;
1038 i++, list = list->next)
1039 log_palette->palPalEntry[i] = list->entry;
1041 new_palette = CreatePalette (log_palette);
1043 enter_crit ();
1045 if (FRAME_DISPLAY_INFO (f)->palette)
1046 DeleteObject (FRAME_DISPLAY_INFO (f)->palette);
1047 FRAME_DISPLAY_INFO (f)->palette = new_palette;
1049 /* Realize display palette and garbage all frames. */
1050 release_frame_dc (f, get_frame_dc (f));
1052 leave_crit ();
1055 #define W32_COLOR(pe) RGB (pe.peRed, pe.peGreen, pe.peBlue)
1056 #define SET_W32_COLOR(pe, color) \
1057 do \
1059 pe.peRed = GetRValue (color); \
1060 pe.peGreen = GetGValue (color); \
1061 pe.peBlue = GetBValue (color); \
1062 pe.peFlags = 0; \
1063 } while (0)
1065 #if 0
1066 /* Keep these around in case we ever want to track color usage. */
1067 void
1068 w32_map_color (struct frame *f, COLORREF color)
1070 struct w32_palette_entry * list = FRAME_DISPLAY_INFO (f)->color_list;
1072 if (NILP (Vw32_enable_palette))
1073 return;
1075 /* check if color is already mapped */
1076 while (list)
1078 if (W32_COLOR (list->entry) == color)
1080 ++list->refcount;
1081 return;
1083 list = list->next;
1086 /* not already mapped, so add to list and recreate Windows palette */
1087 list = xmalloc (sizeof (struct w32_palette_entry));
1088 SET_W32_COLOR (list->entry, color);
1089 list->refcount = 1;
1090 list->next = FRAME_DISPLAY_INFO (f)->color_list;
1091 FRAME_DISPLAY_INFO (f)->color_list = list;
1092 FRAME_DISPLAY_INFO (f)->num_colors++;
1094 /* set flag that palette must be regenerated */
1095 FRAME_DISPLAY_INFO (f)->regen_palette = TRUE;
1098 void
1099 w32_unmap_color (struct frame *f, COLORREF color)
1101 struct w32_palette_entry * list = FRAME_DISPLAY_INFO (f)->color_list;
1102 struct w32_palette_entry **prev = &FRAME_DISPLAY_INFO (f)->color_list;
1104 if (NILP (Vw32_enable_palette))
1105 return;
1107 /* check if color is already mapped */
1108 while (list)
1110 if (W32_COLOR (list->entry) == color)
1112 if (--list->refcount == 0)
1114 *prev = list->next;
1115 xfree (list);
1116 FRAME_DISPLAY_INFO (f)->num_colors--;
1117 break;
1119 else
1120 return;
1122 prev = &list->next;
1123 list = list->next;
1126 /* set flag that palette must be regenerated */
1127 FRAME_DISPLAY_INFO (f)->regen_palette = TRUE;
1129 #endif
1132 /* Gamma-correct COLOR on frame F. */
1134 void
1135 gamma_correct (struct frame *f, COLORREF *color)
1137 if (f->gamma)
1139 *color = PALETTERGB (
1140 pow (GetRValue (*color) / 255.0, f->gamma) * 255.0 + 0.5,
1141 pow (GetGValue (*color) / 255.0, f->gamma) * 255.0 + 0.5,
1142 pow (GetBValue (*color) / 255.0, f->gamma) * 255.0 + 0.5);
1147 /* Decide if color named COLOR is valid for the display associated with
1148 the selected frame; if so, return the rgb values in COLOR_DEF.
1149 If ALLOC is nonzero, allocate a new colormap cell. */
1152 w32_defined_color (struct frame *f, const char *color, XColor *color_def,
1153 bool alloc_p)
1155 register Lisp_Object tem;
1156 COLORREF w32_color_ref;
1158 tem = x_to_w32_color (color);
1160 if (!NILP (tem))
1162 if (f)
1164 /* Apply gamma correction. */
1165 w32_color_ref = XUINT (tem);
1166 gamma_correct (f, &w32_color_ref);
1167 XSETINT (tem, w32_color_ref);
1170 /* Map this color to the palette if it is enabled. */
1171 if (!NILP (Vw32_enable_palette))
1173 struct w32_palette_entry * entry =
1174 one_w32_display_info.color_list;
1175 struct w32_palette_entry ** prev =
1176 &one_w32_display_info.color_list;
1178 /* check if color is already mapped */
1179 while (entry)
1181 if (W32_COLOR (entry->entry) == XUINT (tem))
1182 break;
1183 prev = &entry->next;
1184 entry = entry->next;
1187 if (entry == NULL && alloc_p)
1189 /* not already mapped, so add to list */
1190 entry = xmalloc (sizeof (struct w32_palette_entry));
1191 SET_W32_COLOR (entry->entry, XUINT (tem));
1192 entry->next = NULL;
1193 *prev = entry;
1194 one_w32_display_info.num_colors++;
1196 /* set flag that palette must be regenerated */
1197 one_w32_display_info.regen_palette = TRUE;
1200 /* Ensure COLORREF value is snapped to nearest color in (default)
1201 palette by simulating the PALETTERGB macro. This works whether
1202 or not the display device has a palette. */
1203 w32_color_ref = XUINT (tem) | 0x2000000;
1205 color_def->pixel = w32_color_ref;
1206 color_def->red = GetRValue (w32_color_ref) * 256;
1207 color_def->green = GetGValue (w32_color_ref) * 256;
1208 color_def->blue = GetBValue (w32_color_ref) * 256;
1210 return 1;
1212 else
1214 return 0;
1218 /* Given a string ARG naming a color, compute a pixel value from it
1219 suitable for screen F.
1220 If F is not a color screen, return DEF (default) regardless of what
1221 ARG says. */
1224 x_decode_color (struct frame *f, Lisp_Object arg, int def)
1226 XColor cdef;
1228 CHECK_STRING (arg);
1230 if (strcmp (SDATA (arg), "black") == 0)
1231 return BLACK_PIX_DEFAULT (f);
1232 else if (strcmp (SDATA (arg), "white") == 0)
1233 return WHITE_PIX_DEFAULT (f);
1235 if ((FRAME_DISPLAY_INFO (f)->n_planes * FRAME_DISPLAY_INFO (f)->n_cbits) == 1)
1236 return def;
1238 /* w32_defined_color is responsible for coping with failures
1239 by looking for a near-miss. */
1240 if (w32_defined_color (f, SDATA (arg), &cdef, true))
1241 return cdef.pixel;
1243 /* defined_color failed; return an ultimate default. */
1244 return def;
1249 /* Functions called only from `x_set_frame_param'
1250 to set individual parameters.
1252 If FRAME_W32_WINDOW (f) is 0,
1253 the frame is being created and its window does not exist yet.
1254 In that case, just record the parameter's new value
1255 in the standard place; do not attempt to change the window. */
1257 void
1258 x_set_foreground_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
1260 struct w32_output *x = f->output_data.w32;
1261 PIX_TYPE fg, old_fg;
1263 fg = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1264 old_fg = FRAME_FOREGROUND_PIXEL (f);
1265 FRAME_FOREGROUND_PIXEL (f) = fg;
1267 if (FRAME_W32_WINDOW (f) != 0)
1269 if (x->cursor_pixel == old_fg)
1271 x->cursor_pixel = fg;
1272 x->cursor_gc->background = fg;
1275 update_face_from_frame_parameter (f, Qforeground_color, arg);
1276 if (FRAME_VISIBLE_P (f))
1277 redraw_frame (f);
1281 void
1282 x_set_background_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
1284 FRAME_BACKGROUND_PIXEL (f)
1285 = x_decode_color (f, arg, WHITE_PIX_DEFAULT (f));
1287 if (FRAME_W32_WINDOW (f) != 0)
1289 SetWindowLong (FRAME_W32_WINDOW (f), WND_BACKGROUND_INDEX,
1290 FRAME_BACKGROUND_PIXEL (f));
1292 update_face_from_frame_parameter (f, Qbackground_color, arg);
1294 if (FRAME_VISIBLE_P (f))
1295 redraw_frame (f);
1299 void
1300 x_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
1302 Cursor cursor, nontext_cursor, mode_cursor, hand_cursor;
1303 int count;
1304 int mask_color;
1306 if (!EQ (Qnil, arg))
1307 f->output_data.w32->mouse_pixel
1308 = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1309 mask_color = FRAME_BACKGROUND_PIXEL (f);
1311 /* Don't let pointers be invisible. */
1312 if (mask_color == f->output_data.w32->mouse_pixel
1313 && mask_color == FRAME_BACKGROUND_PIXEL (f))
1314 f->output_data.w32->mouse_pixel = FRAME_FOREGROUND_PIXEL (f);
1316 #if 0 /* TODO : Mouse cursor customization. */
1317 block_input ();
1319 /* It's not okay to crash if the user selects a screwy cursor. */
1320 count = x_catch_errors (FRAME_W32_DISPLAY (f));
1322 if (!EQ (Qnil, Vx_pointer_shape))
1324 CHECK_NUMBER (Vx_pointer_shape);
1325 cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XINT (Vx_pointer_shape));
1327 else
1328 cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_xterm);
1329 x_check_errors (FRAME_W32_DISPLAY (f), "bad text pointer cursor: %s");
1331 if (!EQ (Qnil, Vx_nontext_pointer_shape))
1333 CHECK_NUMBER (Vx_nontext_pointer_shape);
1334 nontext_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f),
1335 XINT (Vx_nontext_pointer_shape));
1337 else
1338 nontext_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_left_ptr);
1339 x_check_errors (FRAME_W32_DISPLAY (f), "bad nontext pointer cursor: %s");
1341 if (!EQ (Qnil, Vx_hourglass_pointer_shape))
1343 CHECK_NUMBER (Vx_hourglass_pointer_shape);
1344 hourglass_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f),
1345 XINT (Vx_hourglass_pointer_shape));
1347 else
1348 hourglass_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_watch);
1349 x_check_errors (FRAME_W32_DISPLAY (f), "bad busy pointer cursor: %s");
1351 x_check_errors (FRAME_W32_DISPLAY (f), "bad nontext pointer cursor: %s");
1352 if (!EQ (Qnil, Vx_mode_pointer_shape))
1354 CHECK_NUMBER (Vx_mode_pointer_shape);
1355 mode_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f),
1356 XINT (Vx_mode_pointer_shape));
1358 else
1359 mode_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_xterm);
1360 x_check_errors (FRAME_W32_DISPLAY (f), "bad modeline pointer cursor: %s");
1362 if (!EQ (Qnil, Vx_sensitive_text_pointer_shape))
1364 CHECK_NUMBER (Vx_sensitive_text_pointer_shape);
1365 hand_cursor
1366 = XCreateFontCursor (FRAME_W32_DISPLAY (f),
1367 XINT (Vx_sensitive_text_pointer_shape));
1369 else
1370 hand_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_crosshair);
1372 if (!NILP (Vx_window_horizontal_drag_shape))
1374 CHECK_NUMBER (Vx_window_horizontal_drag_shape);
1375 horizontal_drag_cursor
1376 = XCreateFontCursor (FRAME_W32_DISPLAY (f),
1377 XINT (Vx_window_horizontal_drag_shape));
1379 else
1380 horizontal_drag_cursor
1381 = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_sb_h_double_arrow);
1383 if (!NILP (Vx_window_vertical_drag_shape))
1385 CHECK_NUMBER (Vx_window_vertical_drag_shape);
1386 vertical_drag_cursor
1387 = XCreateFontCursor (FRAME_W32_DISPLAY (f),
1388 XINT (Vx_window_vertical_drag_shape));
1390 else
1391 vertical_drag_cursor
1392 = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_sb_v_double_arrow);
1394 /* Check and report errors with the above calls. */
1395 x_check_errors (FRAME_W32_DISPLAY (f), "can't set cursor shape: %s");
1396 x_uncatch_errors (FRAME_W32_DISPLAY (f), count);
1399 XColor fore_color, back_color;
1401 fore_color.pixel = f->output_data.w32->mouse_pixel;
1402 back_color.pixel = mask_color;
1403 XQueryColor (FRAME_W32_DISPLAY (f),
1404 DefaultColormap (FRAME_W32_DISPLAY (f),
1405 DefaultScreen (FRAME_W32_DISPLAY (f))),
1406 &fore_color);
1407 XQueryColor (FRAME_W32_DISPLAY (f),
1408 DefaultColormap (FRAME_W32_DISPLAY (f),
1409 DefaultScreen (FRAME_W32_DISPLAY (f))),
1410 &back_color);
1411 XRecolorCursor (FRAME_W32_DISPLAY (f), cursor,
1412 &fore_color, &back_color);
1413 XRecolorCursor (FRAME_W32_DISPLAY (f), nontext_cursor,
1414 &fore_color, &back_color);
1415 XRecolorCursor (FRAME_W32_DISPLAY (f), mode_cursor,
1416 &fore_color, &back_color);
1417 XRecolorCursor (FRAME_W32_DISPLAY (f), hand_cursor,
1418 &fore_color, &back_color);
1419 XRecolorCursor (FRAME_W32_DISPLAY (f), hourglass_cursor,
1420 &fore_color, &back_color);
1423 if (FRAME_W32_WINDOW (f) != 0)
1424 XDefineCursor (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f), cursor);
1426 if (cursor != f->output_data.w32->text_cursor && f->output_data.w32->text_cursor != 0)
1427 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->text_cursor);
1428 f->output_data.w32->text_cursor = cursor;
1430 if (nontext_cursor != f->output_data.w32->nontext_cursor
1431 && f->output_data.w32->nontext_cursor != 0)
1432 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->nontext_cursor);
1433 f->output_data.w32->nontext_cursor = nontext_cursor;
1435 if (hourglass_cursor != f->output_data.w32->hourglass_cursor
1436 && f->output_data.w32->hourglass_cursor != 0)
1437 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->hourglass_cursor);
1438 f->output_data.w32->hourglass_cursor = hourglass_cursor;
1440 if (mode_cursor != f->output_data.w32->modeline_cursor
1441 && f->output_data.w32->modeline_cursor != 0)
1442 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->modeline_cursor);
1443 f->output_data.w32->modeline_cursor = mode_cursor;
1445 if (hand_cursor != f->output_data.w32->hand_cursor
1446 && f->output_data.w32->hand_cursor != 0)
1447 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->hand_cursor);
1448 f->output_data.w32->hand_cursor = hand_cursor;
1450 XFlush (FRAME_W32_DISPLAY (f));
1451 unblock_input ();
1453 update_face_from_frame_parameter (f, Qmouse_color, arg);
1454 #endif /* TODO */
1457 void
1458 x_set_cursor_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
1460 unsigned long fore_pixel, pixel;
1462 if (!NILP (Vx_cursor_fore_pixel))
1463 fore_pixel = x_decode_color (f, Vx_cursor_fore_pixel,
1464 WHITE_PIX_DEFAULT (f));
1465 else
1466 fore_pixel = FRAME_BACKGROUND_PIXEL (f);
1468 pixel = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1470 /* Make sure that the cursor color differs from the background color. */
1471 if (pixel == FRAME_BACKGROUND_PIXEL (f))
1473 pixel = f->output_data.w32->mouse_pixel;
1474 if (pixel == fore_pixel)
1475 fore_pixel = FRAME_BACKGROUND_PIXEL (f);
1478 f->output_data.w32->cursor_foreground_pixel = fore_pixel;
1479 f->output_data.w32->cursor_pixel = pixel;
1481 if (FRAME_W32_WINDOW (f) != 0)
1483 block_input ();
1484 /* Update frame's cursor_gc. */
1485 f->output_data.w32->cursor_gc->foreground = fore_pixel;
1486 f->output_data.w32->cursor_gc->background = pixel;
1488 unblock_input ();
1490 if (FRAME_VISIBLE_P (f))
1492 x_update_cursor (f, 0);
1493 x_update_cursor (f, 1);
1497 update_face_from_frame_parameter (f, Qcursor_color, arg);
1500 /* Set the border-color of frame F to pixel value PIX.
1501 Note that this does not fully take effect if done before
1502 F has a window. */
1504 void
1505 x_set_border_pixel (struct frame *f, int pix)
1508 f->output_data.w32->border_pixel = pix;
1510 if (FRAME_W32_WINDOW (f) != 0 && f->border_width > 0)
1512 if (FRAME_VISIBLE_P (f))
1513 redraw_frame (f);
1517 /* Set the border-color of frame F to value described by ARG.
1518 ARG can be a string naming a color.
1519 The border-color is used for the border that is drawn by the server.
1520 Note that this does not fully take effect if done before
1521 F has a window; it must be redone when the window is created. */
1523 void
1524 x_set_border_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
1526 int pix;
1528 CHECK_STRING (arg);
1529 pix = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1530 x_set_border_pixel (f, pix);
1531 update_face_from_frame_parameter (f, Qborder_color, arg);
1535 void
1536 x_set_cursor_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
1538 set_frame_cursor_types (f, arg);
1541 void
1542 x_set_icon_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
1544 bool result;
1546 if (NILP (arg) && NILP (oldval))
1547 return;
1549 if (STRINGP (arg) && STRINGP (oldval)
1550 && EQ (Fstring_equal (oldval, arg), Qt))
1551 return;
1553 if (SYMBOLP (arg) && SYMBOLP (oldval) && EQ (arg, oldval))
1554 return;
1556 block_input ();
1558 result = x_bitmap_icon (f, arg);
1559 if (result)
1561 unblock_input ();
1562 error ("No icon window available");
1565 unblock_input ();
1568 void
1569 x_set_icon_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
1571 if (STRINGP (arg))
1573 if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
1574 return;
1576 else if (!NILP (arg) || NILP (oldval))
1577 return;
1579 fset_icon_name (f, arg);
1581 #if 0
1582 if (f->output_data.w32->icon_bitmap != 0)
1583 return;
1585 block_input ();
1587 result = x_text_icon (f,
1588 SSDATA ((!NILP (f->icon_name)
1589 ? f->icon_name
1590 : !NILP (f->title)
1591 ? f->title
1592 : f->name)));
1594 if (result)
1596 unblock_input ();
1597 error ("No icon window available");
1600 /* If the window was unmapped (and its icon was mapped),
1601 the new icon is not mapped, so map the window in its stead. */
1602 if (FRAME_VISIBLE_P (f))
1604 #ifdef USE_X_TOOLKIT
1605 XtPopup (f->output_data.w32->widget, XtGrabNone);
1606 #endif
1607 XMapWindow (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f));
1610 XFlush (FRAME_W32_DISPLAY (f));
1611 unblock_input ();
1612 #endif
1615 void
1616 x_clear_under_internal_border (struct frame *f)
1618 int border = FRAME_INTERNAL_BORDER_WIDTH (f);
1620 /* Clear border if it's larger than before. */
1621 if (border != 0)
1623 HDC hdc = get_frame_dc (f);
1624 int width = FRAME_PIXEL_WIDTH (f);
1625 int height = FRAME_PIXEL_HEIGHT (f);
1627 block_input ();
1628 w32_clear_area (f, hdc, 0, FRAME_TOP_MARGIN_HEIGHT (f), width, border);
1629 w32_clear_area (f, hdc, 0, 0, border, height);
1630 w32_clear_area (f, hdc, width - border, 0, border, height);
1631 w32_clear_area (f, hdc, 0, height - border, width, border);
1632 release_frame_dc (f, hdc);
1633 unblock_input ();
1638 void
1639 x_set_internal_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
1641 int border;
1643 CHECK_TYPE_RANGED_INTEGER (int, arg);
1644 border = max (XINT (arg), 0);
1646 if (border != FRAME_INTERNAL_BORDER_WIDTH (f))
1648 FRAME_INTERNAL_BORDER_WIDTH (f) = border;
1650 if (FRAME_X_WINDOW (f) != 0)
1652 adjust_frame_size (f, -1, -1, 3, false, Qinternal_border_width);
1654 if (FRAME_VISIBLE_P (f))
1655 x_clear_under_internal_border (f);
1661 void
1662 x_set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
1664 int nlines;
1666 /* Right now, menu bars don't work properly in minibuf-only frames;
1667 most of the commands try to apply themselves to the minibuffer
1668 frame itself, and get an error because you can't switch buffers
1669 in or split the minibuffer window. */
1670 if (FRAME_MINIBUF_ONLY_P (f))
1671 return;
1673 if (INTEGERP (value))
1674 nlines = XINT (value);
1675 else
1676 nlines = 0;
1678 FRAME_MENU_BAR_LINES (f) = 0;
1679 FRAME_MENU_BAR_HEIGHT (f) = 0;
1680 if (nlines)
1682 FRAME_EXTERNAL_MENU_BAR (f) = 1;
1683 windows_or_buffers_changed = 23;
1685 else
1687 if (FRAME_EXTERNAL_MENU_BAR (f) == 1)
1688 free_frame_menubar (f);
1689 FRAME_EXTERNAL_MENU_BAR (f) = 0;
1691 /* Adjust the frame size so that the client (text) dimensions
1692 remain the same. This depends on FRAME_EXTERNAL_MENU_BAR being
1693 set correctly. Note that we resize twice: The first time upon
1694 a request from the window manager who wants to keep the height
1695 of the outer rectangle (including decorations) unchanged, and a
1696 second time because we want to keep the height of the inner
1697 rectangle (without the decorations unchanged). */
1698 adjust_frame_size (f, -1, -1, 2, true, Qmenu_bar_lines);
1700 /* Not sure whether this is needed. */
1701 x_clear_under_internal_border (f);
1706 /* Set the number of lines used for the tool bar of frame F to VALUE.
1707 VALUE not an integer, or < 0 means set the lines to zero. OLDVAL is
1708 the old number of tool bar lines (and is unused). This function may
1709 change the height of all windows on frame F to match the new tool bar
1710 height. By design, the frame's height doesn't change (but maybe it
1711 should if we don't get enough space otherwise). */
1713 void
1714 x_set_tool_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
1716 int nlines;
1718 /* Treat tool bars like menu bars. */
1719 if (FRAME_MINIBUF_ONLY_P (f))
1720 return;
1722 /* Use VALUE only if an integer >= 0. */
1723 if (INTEGERP (value) && XINT (value) >= 0)
1724 nlines = XFASTINT (value);
1725 else
1726 nlines = 0;
1728 x_change_tool_bar_height (f, nlines * FRAME_LINE_HEIGHT (f));
1732 /* Set the pixel height of the tool bar of frame F to HEIGHT. */
1733 void
1734 x_change_tool_bar_height (struct frame *f, int height)
1736 Lisp_Object frame;
1737 int unit = FRAME_LINE_HEIGHT (f);
1738 int old_height = FRAME_TOOL_BAR_HEIGHT (f);
1739 int lines = (height + unit - 1) / unit;
1740 int old_text_height = FRAME_TEXT_HEIGHT (f);
1741 Lisp_Object fullscreen;
1743 /* Make sure we redisplay all windows in this frame. */
1744 windows_or_buffers_changed = 23;
1746 /* Recalculate tool bar and frame text sizes. */
1747 FRAME_TOOL_BAR_HEIGHT (f) = height;
1748 FRAME_TOOL_BAR_LINES (f) = lines;
1749 /* Store `tool-bar-lines' and `height' frame parameters. */
1750 store_frame_param (f, Qtool_bar_lines, make_number (lines));
1751 store_frame_param (f, Qheight, make_number (FRAME_LINES (f)));
1753 if (FRAME_W32_WINDOW (f) && FRAME_TOOL_BAR_HEIGHT (f) == 0)
1755 clear_frame (f);
1756 clear_current_matrices (f);
1759 if ((height < old_height) && WINDOWP (f->tool_bar_window))
1760 clear_glyph_matrix (XWINDOW (f->tool_bar_window)->current_matrix);
1762 /* Recalculate toolbar height. */
1763 f->n_tool_bar_rows = 0;
1765 adjust_frame_size (f, -1, -1,
1766 ((NILP (fullscreen = get_frame_param (f, Qfullscreen))
1767 || EQ (fullscreen, Qfullwidth)) ? 1
1768 : (old_height == 0 || height == 0) ? 2
1769 : 4),
1770 false, Qtool_bar_lines);
1772 /* adjust_frame_size might not have done anything, garbage frame
1773 here. */
1774 adjust_frame_glyphs (f);
1775 SET_FRAME_GARBAGED (f);
1776 if (FRAME_X_WINDOW (f))
1777 x_clear_under_internal_border (f);
1780 static void
1781 w32_set_title_bar_text (struct frame *f, Lisp_Object name)
1783 if (FRAME_W32_WINDOW (f))
1785 block_input ();
1786 #ifdef __CYGWIN__
1787 GUI_FN (SetWindowText) (FRAME_W32_WINDOW (f),
1788 GUI_SDATA (GUI_ENCODE_SYSTEM (name)));
1789 #else
1790 /* The frame's title many times shows the name of the file
1791 visited in the selected window's buffer, so it makes sense to
1792 support non-ASCII characters outside of the current system
1793 codepage in the title. */
1794 if (w32_unicode_filenames)
1796 Lisp_Object encoded_title = ENCODE_UTF_8 (name);
1797 wchar_t *title_w;
1798 int tlen = pMultiByteToWideChar (CP_UTF8, 0, SSDATA (encoded_title),
1799 -1, NULL, 0);
1801 if (tlen > 0)
1803 /* Windows truncates the title text beyond what fits on
1804 a single line, so we can limit the length to some
1805 reasonably large value, and use alloca. */
1806 if (tlen > 10000)
1807 tlen = 10000;
1808 title_w = alloca ((tlen + 1) * sizeof (wchar_t));
1809 pMultiByteToWideChar (CP_UTF8, 0, SSDATA (encoded_title), -1,
1810 title_w, tlen);
1811 title_w[tlen] = L'\0';
1812 SetWindowTextW (FRAME_W32_WINDOW (f), title_w);
1814 else /* Conversion to UTF-16 failed, so we punt. */
1815 SetWindowTextA (FRAME_W32_WINDOW (f),
1816 SSDATA (ENCODE_SYSTEM (name)));
1818 else
1819 SetWindowTextA (FRAME_W32_WINDOW (f), SSDATA (ENCODE_SYSTEM (name)));
1820 #endif
1821 unblock_input ();
1825 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
1826 w32_id_name.
1828 If EXPLICIT is non-zero, that indicates that lisp code is setting the
1829 name; if NAME is a string, set F's name to NAME and set
1830 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
1832 If EXPLICIT is zero, that indicates that Emacs redisplay code is
1833 suggesting a new name, which lisp code should override; if
1834 F->explicit_name is set, ignore the new name; otherwise, set it. */
1836 void
1837 x_set_name (struct frame *f, Lisp_Object name, bool explicit)
1839 /* Make sure that requests from lisp code override requests from
1840 Emacs redisplay code. */
1841 if (explicit)
1843 /* If we're switching from explicit to implicit, we had better
1844 update the mode lines and thereby update the title. */
1845 if (f->explicit_name && NILP (name))
1846 update_mode_lines = 25;
1848 f->explicit_name = ! NILP (name);
1850 else if (f->explicit_name)
1851 return;
1853 /* If NAME is nil, set the name to the w32_id_name. */
1854 if (NILP (name))
1856 /* Check for no change needed in this very common case
1857 before we do any consing. */
1858 if (!strcmp (FRAME_DISPLAY_INFO (f)->w32_id_name,
1859 SDATA (f->name)))
1860 return;
1861 name = build_string (FRAME_DISPLAY_INFO (f)->w32_id_name);
1863 else
1864 CHECK_STRING (name);
1866 /* Don't change the name if it's already NAME. */
1867 if (! NILP (Fstring_equal (name, f->name)))
1868 return;
1870 fset_name (f, name);
1872 /* For setting the frame title, the title parameter should override
1873 the name parameter. */
1874 if (! NILP (f->title))
1875 name = f->title;
1877 w32_set_title_bar_text (f, name);
1880 /* This function should be called when the user's lisp code has
1881 specified a name for the frame; the name will override any set by the
1882 redisplay code. */
1883 void
1884 x_explicitly_set_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
1886 x_set_name (f, arg, true);
1889 /* This function should be called by Emacs redisplay code to set the
1890 name; names set this way will never override names set by the user's
1891 lisp code. */
1892 void
1893 x_implicitly_set_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
1895 x_set_name (f, arg, false);
1898 /* Change the title of frame F to NAME.
1899 If NAME is nil, use the frame name as the title. */
1901 void
1902 x_set_title (struct frame *f, Lisp_Object name, Lisp_Object old_name)
1904 /* Don't change the title if it's already NAME. */
1905 if (EQ (name, f->title))
1906 return;
1908 update_mode_lines = 26;
1910 fset_title (f, name);
1912 if (NILP (name))
1913 name = f->name;
1915 w32_set_title_bar_text (f, name);
1918 void
1919 x_set_scroll_bar_default_width (struct frame *f)
1921 int unit = FRAME_COLUMN_WIDTH (f);
1923 FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = GetSystemMetrics (SM_CXVSCROLL);
1924 FRAME_CONFIG_SCROLL_BAR_COLS (f)
1925 = (FRAME_CONFIG_SCROLL_BAR_WIDTH (f) + unit - 1) / unit;
1929 void
1930 x_set_scroll_bar_default_height (struct frame *f)
1932 int unit = FRAME_LINE_HEIGHT (f);
1934 FRAME_CONFIG_SCROLL_BAR_HEIGHT (f) = GetSystemMetrics (SM_CXHSCROLL);
1935 FRAME_CONFIG_SCROLL_BAR_LINES (f)
1936 = (FRAME_CONFIG_SCROLL_BAR_HEIGHT (f) + unit - 1) / unit;
1939 /* Subroutines for creating a frame. */
1941 Cursor
1942 w32_load_cursor (LPCTSTR name)
1944 /* Try first to load cursor from application resource. */
1945 Cursor cursor = LoadImage ((HINSTANCE) GetModuleHandle (NULL),
1946 name, IMAGE_CURSOR, 0, 0,
1947 LR_DEFAULTCOLOR | LR_DEFAULTSIZE | LR_SHARED);
1948 if (!cursor)
1950 /* Then try to load a shared predefined cursor. */
1951 cursor = LoadImage (NULL, name, IMAGE_CURSOR, 0, 0,
1952 LR_DEFAULTCOLOR | LR_DEFAULTSIZE | LR_SHARED);
1954 return cursor;
1957 static LRESULT CALLBACK w32_wnd_proc (HWND, UINT, WPARAM, LPARAM);
1959 #define INIT_WINDOW_CLASS(WC) \
1960 (WC).style = CS_HREDRAW | CS_VREDRAW; \
1961 (WC).lpfnWndProc = (WNDPROC) w32_wnd_proc; \
1962 (WC).cbClsExtra = 0; \
1963 (WC).cbWndExtra = WND_EXTRA_BYTES; \
1964 (WC).hInstance = hinst; \
1965 (WC).hIcon = LoadIcon (hinst, EMACS_CLASS); \
1966 (WC).hCursor = w32_load_cursor (IDC_ARROW); \
1967 (WC).hbrBackground = NULL; \
1968 (WC).lpszMenuName = NULL; \
1970 static BOOL
1971 w32_init_class (HINSTANCE hinst)
1973 if (w32_unicode_gui)
1975 WNDCLASSW uwc;
1976 INIT_WINDOW_CLASS(uwc);
1977 uwc.lpszClassName = L"Emacs";
1979 return RegisterClassW (&uwc);
1981 else
1983 WNDCLASS wc;
1984 INIT_WINDOW_CLASS(wc);
1985 wc.lpszClassName = EMACS_CLASS;
1987 return RegisterClassA (&wc);
1991 static HWND
1992 w32_createvscrollbar (struct frame *f, struct scroll_bar * bar)
1994 return CreateWindow ("SCROLLBAR", "", SBS_VERT | WS_CHILD | WS_VISIBLE,
1995 /* Position and size of scroll bar. */
1996 bar->left, bar->top, bar->width, bar->height,
1997 FRAME_W32_WINDOW (f), NULL, hinst, NULL);
2000 static HWND
2001 w32_createhscrollbar (struct frame *f, struct scroll_bar * bar)
2003 return CreateWindow ("SCROLLBAR", "", SBS_HORZ | WS_CHILD | WS_VISIBLE,
2004 /* Position and size of scroll bar. */
2005 bar->left, bar->top, bar->width, bar->height,
2006 FRAME_W32_WINDOW (f), NULL, hinst, NULL);
2009 static void
2010 w32_createwindow (struct frame *f, int *coords)
2012 HWND hwnd;
2013 RECT rect;
2014 int top;
2015 int left;
2017 rect.left = rect.top = 0;
2018 rect.right = FRAME_PIXEL_WIDTH (f);
2019 rect.bottom = FRAME_PIXEL_HEIGHT (f);
2021 AdjustWindowRect (&rect, f->output_data.w32->dwStyle,
2022 FRAME_EXTERNAL_MENU_BAR (f));
2024 /* Do first time app init */
2026 w32_init_class (hinst);
2028 if (f->size_hint_flags & USPosition || f->size_hint_flags & PPosition)
2030 left = f->left_pos;
2031 top = f->top_pos;
2033 else
2035 left = coords[0];
2036 top = coords[1];
2039 FRAME_W32_WINDOW (f) = hwnd
2040 = CreateWindow (EMACS_CLASS,
2041 f->namebuf,
2042 f->output_data.w32->dwStyle | WS_CLIPCHILDREN,
2043 left, top,
2044 rect.right - rect.left, rect.bottom - rect.top,
2045 NULL,
2046 NULL,
2047 hinst,
2048 NULL);
2050 if (hwnd)
2052 SetWindowLong (hwnd, WND_FONTWIDTH_INDEX, FRAME_COLUMN_WIDTH (f));
2053 SetWindowLong (hwnd, WND_LINEHEIGHT_INDEX, FRAME_LINE_HEIGHT (f));
2054 SetWindowLong (hwnd, WND_BORDER_INDEX, FRAME_INTERNAL_BORDER_WIDTH (f));
2055 SetWindowLong (hwnd, WND_VSCROLLBAR_INDEX, FRAME_SCROLL_BAR_AREA_WIDTH (f));
2056 SetWindowLong (hwnd, WND_HSCROLLBAR_INDEX, FRAME_SCROLL_BAR_AREA_HEIGHT (f));
2057 SetWindowLong (hwnd, WND_BACKGROUND_INDEX, FRAME_BACKGROUND_PIXEL (f));
2059 /* Enable drag-n-drop. */
2060 DragAcceptFiles (hwnd, TRUE);
2062 /* Do this to discard the default setting specified by our parent. */
2063 ShowWindow (hwnd, SW_HIDE);
2065 /* Update frame positions. */
2066 GetWindowRect (hwnd, &rect);
2067 f->left_pos = rect.left;
2068 f->top_pos = rect.top;
2072 static void
2073 my_post_msg (W32Msg * wmsg, HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam)
2075 wmsg->msg.hwnd = hwnd;
2076 wmsg->msg.message = msg;
2077 wmsg->msg.wParam = wParam;
2078 wmsg->msg.lParam = lParam;
2079 wmsg->msg.time = GetMessageTime ();
2081 post_msg (wmsg);
2084 /* GetKeyState and MapVirtualKey on Windows 95 do not actually distinguish
2085 between left and right keys as advertised. We test for this
2086 support dynamically, and set a flag when the support is absent. If
2087 absent, we keep track of the left and right control and alt keys
2088 ourselves. This is particularly necessary on keyboards that rely
2089 upon the AltGr key, which is represented as having the left control
2090 and right alt keys pressed. For these keyboards, we need to know
2091 when the left alt key has been pressed in addition to the AltGr key
2092 so that we can properly support M-AltGr-key sequences (such as M-@
2093 on Swedish keyboards). */
2095 #define EMACS_LCONTROL 0
2096 #define EMACS_RCONTROL 1
2097 #define EMACS_LMENU 2
2098 #define EMACS_RMENU 3
2100 static int modifiers[4];
2101 static int modifiers_recorded;
2102 static int modifier_key_support_tested;
2104 static void
2105 test_modifier_support (unsigned int wparam)
2107 unsigned int l, r;
2109 if (wparam != VK_CONTROL && wparam != VK_MENU)
2110 return;
2111 if (wparam == VK_CONTROL)
2113 l = VK_LCONTROL;
2114 r = VK_RCONTROL;
2116 else
2118 l = VK_LMENU;
2119 r = VK_RMENU;
2121 if (!(GetKeyState (l) & 0x8000) && !(GetKeyState (r) & 0x8000))
2122 modifiers_recorded = 1;
2123 else
2124 modifiers_recorded = 0;
2125 modifier_key_support_tested = 1;
2128 static void
2129 record_keydown (unsigned int wparam, unsigned int lparam)
2131 int i;
2133 if (!modifier_key_support_tested)
2134 test_modifier_support (wparam);
2136 if ((wparam != VK_CONTROL && wparam != VK_MENU) || !modifiers_recorded)
2137 return;
2139 if (wparam == VK_CONTROL)
2140 i = (lparam & 0x1000000) ? EMACS_RCONTROL : EMACS_LCONTROL;
2141 else
2142 i = (lparam & 0x1000000) ? EMACS_RMENU : EMACS_LMENU;
2144 modifiers[i] = 1;
2147 static void
2148 record_keyup (unsigned int wparam, unsigned int lparam)
2150 int i;
2152 if ((wparam != VK_CONTROL && wparam != VK_MENU) || !modifiers_recorded)
2153 return;
2155 if (wparam == VK_CONTROL)
2156 i = (lparam & 0x1000000) ? EMACS_RCONTROL : EMACS_LCONTROL;
2157 else
2158 i = (lparam & 0x1000000) ? EMACS_RMENU : EMACS_LMENU;
2160 modifiers[i] = 0;
2163 /* Emacs can lose focus while a modifier key has been pressed. When
2164 it regains focus, be conservative and clear all modifiers since
2165 we cannot reconstruct the left and right modifier state. */
2166 static void
2167 reset_modifiers (void)
2169 SHORT ctrl, alt;
2171 if (GetFocus () == NULL)
2172 /* Emacs doesn't have keyboard focus. Do nothing. */
2173 return;
2175 ctrl = GetAsyncKeyState (VK_CONTROL);
2176 alt = GetAsyncKeyState (VK_MENU);
2178 if (!(ctrl & 0x08000))
2179 /* Clear any recorded control modifier state. */
2180 modifiers[EMACS_RCONTROL] = modifiers[EMACS_LCONTROL] = 0;
2182 if (!(alt & 0x08000))
2183 /* Clear any recorded alt modifier state. */
2184 modifiers[EMACS_RMENU] = modifiers[EMACS_LMENU] = 0;
2186 /* Update the state of all modifier keys, because modifiers used in
2187 hot-key combinations can get stuck on if Emacs loses focus as a
2188 result of a hot-key being pressed. */
2190 BYTE keystate[256];
2192 #define CURRENT_STATE(key) ((GetAsyncKeyState (key) & 0x8000) >> 8)
2194 memset (keystate, 0, sizeof (keystate));
2195 GetKeyboardState (keystate);
2196 keystate[VK_SHIFT] = CURRENT_STATE (VK_SHIFT);
2197 keystate[VK_CONTROL] = CURRENT_STATE (VK_CONTROL);
2198 keystate[VK_LCONTROL] = CURRENT_STATE (VK_LCONTROL);
2199 keystate[VK_RCONTROL] = CURRENT_STATE (VK_RCONTROL);
2200 keystate[VK_MENU] = CURRENT_STATE (VK_MENU);
2201 keystate[VK_LMENU] = CURRENT_STATE (VK_LMENU);
2202 keystate[VK_RMENU] = CURRENT_STATE (VK_RMENU);
2203 keystate[VK_LWIN] = CURRENT_STATE (VK_LWIN);
2204 keystate[VK_RWIN] = CURRENT_STATE (VK_RWIN);
2205 keystate[VK_APPS] = CURRENT_STATE (VK_APPS);
2206 SetKeyboardState (keystate);
2210 /* Synchronize modifier state with what is reported with the current
2211 keystroke. Even if we cannot distinguish between left and right
2212 modifier keys, we know that, if no modifiers are set, then neither
2213 the left or right modifier should be set. */
2214 static void
2215 sync_modifiers (void)
2217 if (!modifiers_recorded)
2218 return;
2220 if (!(GetKeyState (VK_CONTROL) & 0x8000))
2221 modifiers[EMACS_RCONTROL] = modifiers[EMACS_LCONTROL] = 0;
2223 if (!(GetKeyState (VK_MENU) & 0x8000))
2224 modifiers[EMACS_RMENU] = modifiers[EMACS_LMENU] = 0;
2227 static int
2228 modifier_set (int vkey)
2230 /* Warning: The fact that VK_NUMLOCK is not treated as the other 2
2231 toggle keys is not an omission! If you want to add it, you will
2232 have to make changes in the default sub-case of the WM_KEYDOWN
2233 switch, because if the NUMLOCK modifier is set, the code there
2234 will directly convert any key that looks like an ASCII letter,
2235 and also downcase those that look like upper-case ASCII. */
2236 if (vkey == VK_CAPITAL)
2238 if (NILP (Vw32_enable_caps_lock))
2239 return 0;
2240 else
2241 return (GetKeyState (vkey) & 0x1);
2243 if (vkey == VK_SCROLL)
2245 if (NILP (Vw32_scroll_lock_modifier)
2246 /* w32-scroll-lock-modifier can be any non-nil value that is
2247 not one of the modifiers, in which case it shall be ignored. */
2248 || !( EQ (Vw32_scroll_lock_modifier, Qhyper)
2249 || EQ (Vw32_scroll_lock_modifier, Qsuper)
2250 || EQ (Vw32_scroll_lock_modifier, Qmeta)
2251 || EQ (Vw32_scroll_lock_modifier, Qalt)
2252 || EQ (Vw32_scroll_lock_modifier, Qcontrol)
2253 || EQ (Vw32_scroll_lock_modifier, Qshift)))
2254 return 0;
2255 else
2256 return (GetKeyState (vkey) & 0x1);
2259 if (!modifiers_recorded)
2260 return (GetKeyState (vkey) & 0x8000);
2262 switch (vkey)
2264 case VK_LCONTROL:
2265 return modifiers[EMACS_LCONTROL];
2266 case VK_RCONTROL:
2267 return modifiers[EMACS_RCONTROL];
2268 case VK_LMENU:
2269 return modifiers[EMACS_LMENU];
2270 case VK_RMENU:
2271 return modifiers[EMACS_RMENU];
2273 return (GetKeyState (vkey) & 0x8000);
2276 /* Convert between the modifier bits W32 uses and the modifier bits
2277 Emacs uses. */
2279 unsigned int
2280 w32_key_to_modifier (int key)
2282 Lisp_Object key_mapping;
2284 switch (key)
2286 case VK_LWIN:
2287 key_mapping = Vw32_lwindow_modifier;
2288 break;
2289 case VK_RWIN:
2290 key_mapping = Vw32_rwindow_modifier;
2291 break;
2292 case VK_APPS:
2293 key_mapping = Vw32_apps_modifier;
2294 break;
2295 case VK_SCROLL:
2296 key_mapping = Vw32_scroll_lock_modifier;
2297 break;
2298 default:
2299 key_mapping = Qnil;
2302 /* NB. This code runs in the input thread, asynchronously to the lisp
2303 thread, so we must be careful to ensure access to lisp data is
2304 thread-safe. The following code is safe because the modifier
2305 variable values are updated atomically from lisp and symbols are
2306 not relocated by GC. Also, we don't have to worry about seeing GC
2307 markbits here. */
2308 if (EQ (key_mapping, Qhyper))
2309 return hyper_modifier;
2310 if (EQ (key_mapping, Qsuper))
2311 return super_modifier;
2312 if (EQ (key_mapping, Qmeta))
2313 return meta_modifier;
2314 if (EQ (key_mapping, Qalt))
2315 return alt_modifier;
2316 if (EQ (key_mapping, Qctrl))
2317 return ctrl_modifier;
2318 if (EQ (key_mapping, Qcontrol)) /* synonym for ctrl */
2319 return ctrl_modifier;
2320 if (EQ (key_mapping, Qshift))
2321 return shift_modifier;
2323 /* Don't generate any modifier if not explicitly requested. */
2324 return 0;
2327 static unsigned int
2328 w32_get_modifiers (void)
2330 return ((modifier_set (VK_SHIFT) ? shift_modifier : 0) |
2331 (modifier_set (VK_CONTROL) ? ctrl_modifier : 0) |
2332 (modifier_set (VK_LWIN) ? w32_key_to_modifier (VK_LWIN) : 0) |
2333 (modifier_set (VK_RWIN) ? w32_key_to_modifier (VK_RWIN) : 0) |
2334 (modifier_set (VK_APPS) ? w32_key_to_modifier (VK_APPS) : 0) |
2335 (modifier_set (VK_SCROLL) ? w32_key_to_modifier (VK_SCROLL) : 0) |
2336 (modifier_set (VK_MENU) ?
2337 ((NILP (Vw32_alt_is_meta)) ? alt_modifier : meta_modifier) : 0));
2340 /* We map the VK_* modifiers into console modifier constants
2341 so that we can use the same routines to handle both console
2342 and window input. */
2344 static int
2345 construct_console_modifiers (void)
2347 int mods;
2349 mods = 0;
2350 mods |= (modifier_set (VK_SHIFT)) ? SHIFT_PRESSED : 0;
2351 mods |= (modifier_set (VK_CAPITAL)) ? CAPSLOCK_ON : 0;
2352 mods |= (modifier_set (VK_SCROLL)) ? SCROLLLOCK_ON : 0;
2353 mods |= (modifier_set (VK_NUMLOCK)) ? NUMLOCK_ON : 0;
2354 mods |= (modifier_set (VK_LCONTROL)) ? LEFT_CTRL_PRESSED : 0;
2355 mods |= (modifier_set (VK_RCONTROL)) ? RIGHT_CTRL_PRESSED : 0;
2356 mods |= (modifier_set (VK_LMENU)) ? LEFT_ALT_PRESSED : 0;
2357 mods |= (modifier_set (VK_RMENU)) ? RIGHT_ALT_PRESSED : 0;
2358 mods |= (modifier_set (VK_LWIN)) ? LEFT_WIN_PRESSED : 0;
2359 mods |= (modifier_set (VK_RWIN)) ? RIGHT_WIN_PRESSED : 0;
2360 mods |= (modifier_set (VK_APPS)) ? APPS_PRESSED : 0;
2362 return mods;
2365 static int
2366 w32_get_key_modifiers (unsigned int wparam, unsigned int lparam)
2368 int mods;
2370 /* Convert to emacs modifiers. */
2371 mods = w32_kbd_mods_to_emacs (construct_console_modifiers (), wparam);
2373 return mods;
2376 unsigned int
2377 map_keypad_keys (unsigned int virt_key, unsigned int extended)
2379 if (virt_key < VK_CLEAR || virt_key > VK_DELETE)
2380 return virt_key;
2382 if (virt_key == VK_RETURN)
2383 return (extended ? VK_NUMPAD_ENTER : VK_RETURN);
2385 if (virt_key >= VK_PRIOR && virt_key <= VK_DOWN)
2386 return (!extended ? (VK_NUMPAD_PRIOR + (virt_key - VK_PRIOR)) : virt_key);
2388 if (virt_key == VK_INSERT || virt_key == VK_DELETE)
2389 return (!extended ? (VK_NUMPAD_INSERT + (virt_key - VK_INSERT)) : virt_key);
2391 if (virt_key == VK_CLEAR)
2392 return (!extended ? VK_NUMPAD_CLEAR : virt_key);
2394 return virt_key;
2397 /* List of special key combinations which w32 would normally capture,
2398 but Emacs should grab instead. Not directly visible to lisp, to
2399 simplify synchronization. Each item is an integer encoding a virtual
2400 key code and modifier combination to capture. */
2401 static Lisp_Object w32_grabbed_keys;
2403 #define HOTKEY(vk, mods) make_number (((vk) & 255) | ((mods) << 8))
2404 #define HOTKEY_ID(k) (XFASTINT (k) & 0xbfff)
2405 #define HOTKEY_VK_CODE(k) (XFASTINT (k) & 255)
2406 #define HOTKEY_MODIFIERS(k) (XFASTINT (k) >> 8)
2408 #define RAW_HOTKEY_ID(k) ((k) & 0xbfff)
2409 #define RAW_HOTKEY_VK_CODE(k) ((k) & 255)
2410 #define RAW_HOTKEY_MODIFIERS(k) ((k) >> 8)
2412 /* Register hot-keys for reserved key combinations when Emacs has
2413 keyboard focus, since this is the only way Emacs can receive key
2414 combinations like Alt-Tab which are used by the system. */
2416 static void
2417 register_hot_keys (HWND hwnd)
2419 Lisp_Object keylist;
2421 /* Use CONSP, since we are called asynchronously. */
2422 for (keylist = w32_grabbed_keys; CONSP (keylist); keylist = XCDR (keylist))
2424 Lisp_Object key = XCAR (keylist);
2426 /* Deleted entries get set to nil. */
2427 if (!INTEGERP (key))
2428 continue;
2430 RegisterHotKey (hwnd, HOTKEY_ID (key),
2431 HOTKEY_MODIFIERS (key), HOTKEY_VK_CODE (key));
2435 static void
2436 unregister_hot_keys (HWND hwnd)
2438 Lisp_Object keylist;
2440 for (keylist = w32_grabbed_keys; CONSP (keylist); keylist = XCDR (keylist))
2442 Lisp_Object key = XCAR (keylist);
2444 if (!INTEGERP (key))
2445 continue;
2447 UnregisterHotKey (hwnd, HOTKEY_ID (key));
2451 #if EMACSDEBUG
2452 const char*
2453 w32_name_of_message (UINT msg)
2455 unsigned i;
2456 static char buf[64];
2457 static const struct {
2458 UINT msg;
2459 const char* name;
2460 } msgnames[] = {
2461 #define M(msg) { msg, # msg }
2462 M (WM_PAINT),
2463 M (WM_TIMER),
2464 M (WM_USER),
2465 M (WM_MOUSEMOVE),
2466 M (WM_LBUTTONUP),
2467 M (WM_KEYDOWN),
2468 M (WM_EMACS_KILL),
2469 M (WM_EMACS_CREATEWINDOW),
2470 M (WM_EMACS_DONE),
2471 M (WM_EMACS_CREATEVSCROLLBAR),
2472 M (WM_EMACS_CREATEHSCROLLBAR),
2473 M (WM_EMACS_SHOWWINDOW),
2474 M (WM_EMACS_SETWINDOWPOS),
2475 M (WM_EMACS_DESTROYWINDOW),
2476 M (WM_EMACS_TRACKPOPUPMENU),
2477 M (WM_EMACS_SETFOCUS),
2478 M (WM_EMACS_SETFOREGROUND),
2479 M (WM_EMACS_SETLOCALE),
2480 M (WM_EMACS_SETKEYBOARDLAYOUT),
2481 M (WM_EMACS_REGISTER_HOT_KEY),
2482 M (WM_EMACS_UNREGISTER_HOT_KEY),
2483 M (WM_EMACS_TOGGLE_LOCK_KEY),
2484 M (WM_EMACS_TRACK_CARET),
2485 M (WM_EMACS_DESTROY_CARET),
2486 M (WM_EMACS_SHOW_CARET),
2487 M (WM_EMACS_HIDE_CARET),
2488 M (WM_EMACS_SETCURSOR),
2489 M (WM_EMACS_SHOWCURSOR),
2490 M (WM_EMACS_PAINT),
2491 M (WM_CHAR),
2492 #undef M
2493 { 0, 0 }
2496 for (i = 0; msgnames[i].name; ++i)
2497 if (msgnames[i].msg == msg)
2498 return msgnames[i].name;
2500 sprintf (buf, "message 0x%04x", (unsigned)msg);
2501 return buf;
2503 #endif /* EMACSDEBUG */
2505 /* Here's an overview of how Emacs input works in GUI sessions on
2506 MS-Windows. (For description of non-GUI input, see the commentary
2507 before w32_console_read_socket in w32inevt.c.)
2509 System messages are read and processed by w32_msg_pump below. This
2510 function runs in a separate thread. It handles a small number of
2511 custom WM_EMACS_* messages (posted by the main thread, look for
2512 PostMessage calls), and dispatches the rest to w32_wnd_proc, which
2513 is the main window procedure for the entire Emacs application.
2515 w32_wnd_proc also runs in the same separate input thread. It
2516 handles some messages, mostly those that need GDI calls, by itself.
2517 For the others, it calls my_post_msg, which inserts the messages
2518 into the input queue serviced by w32_read_socket.
2520 w32_read_socket runs in the main (a.k.a. "Lisp") thread, and is
2521 called synchronously from keyboard.c when it is known or suspected
2522 that some input is available. w32_read_socket either handles
2523 messages immediately, or converts them into Emacs input events and
2524 stuffs them into kbd_buffer, where kbd_buffer_get_event can get at
2525 them and process them when read_char and its callers require
2526 input.
2528 Under Cygwin with the W32 toolkit, the use of /dev/windows with
2529 select(2) takes the place of w32_read_socket.
2533 /* Main message dispatch loop. */
2535 static void
2536 w32_msg_pump (deferred_msg * msg_buf)
2538 MSG msg;
2539 WPARAM result;
2540 HWND focus_window;
2542 msh_mousewheel = RegisterWindowMessage (MSH_MOUSEWHEEL);
2544 while ((w32_unicode_gui ? GetMessageW : GetMessageA) (&msg, NULL, 0, 0))
2547 /* DebPrint (("w32_msg_pump: %s time:%u\n", */
2548 /* w32_name_of_message (msg.message), msg.time)); */
2550 if (msg.hwnd == NULL)
2552 switch (msg.message)
2554 case WM_NULL:
2555 /* Produced by complete_deferred_msg; just ignore. */
2556 break;
2557 case WM_EMACS_CREATEWINDOW:
2558 /* Initialize COM for this window. Even though we don't use it,
2559 some third party shell extensions can cause it to be used in
2560 system dialogs, which causes a crash if it is not initialized.
2561 This is a known bug in Windows, which was fixed long ago, but
2562 the patch for XP is not publicly available until XP SP3,
2563 and older versions will never be patched. */
2564 CoInitialize (NULL);
2565 w32_createwindow ((struct frame *) msg.wParam,
2566 (int *) msg.lParam);
2567 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE, 0, 0))
2568 emacs_abort ();
2569 break;
2570 case WM_EMACS_SETLOCALE:
2571 SetThreadLocale (msg.wParam);
2572 /* Reply is not expected. */
2573 break;
2574 case WM_EMACS_SETKEYBOARDLAYOUT:
2575 result = (WPARAM) ActivateKeyboardLayout ((HKL) msg.wParam, 0);
2576 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE,
2577 result, 0))
2578 emacs_abort ();
2579 break;
2580 case WM_EMACS_REGISTER_HOT_KEY:
2581 focus_window = GetFocus ();
2582 if (focus_window != NULL)
2583 RegisterHotKey (focus_window,
2584 RAW_HOTKEY_ID (msg.wParam),
2585 RAW_HOTKEY_MODIFIERS (msg.wParam),
2586 RAW_HOTKEY_VK_CODE (msg.wParam));
2587 /* Reply is not expected. */
2588 break;
2589 case WM_EMACS_UNREGISTER_HOT_KEY:
2590 focus_window = GetFocus ();
2591 if (focus_window != NULL)
2592 UnregisterHotKey (focus_window, RAW_HOTKEY_ID (msg.wParam));
2593 /* Mark item as erased. NB: this code must be
2594 thread-safe. The next line is okay because the cons
2595 cell is never made into garbage and is not relocated by
2596 GC. */
2597 XSETCAR (make_lisp_ptr ((void *)msg.lParam, Lisp_Cons), Qnil);
2598 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE, 0, 0))
2599 emacs_abort ();
2600 break;
2601 case WM_EMACS_TOGGLE_LOCK_KEY:
2603 int vk_code = (int) msg.wParam;
2604 int cur_state = (GetKeyState (vk_code) & 1);
2605 int new_state = msg.lParam;
2607 if (new_state == -1
2608 || ((new_state & 1) != cur_state))
2610 one_w32_display_info.faked_key = vk_code;
2612 keybd_event ((BYTE) vk_code,
2613 (BYTE) MapVirtualKey (vk_code, 0),
2614 KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
2615 keybd_event ((BYTE) vk_code,
2616 (BYTE) MapVirtualKey (vk_code, 0),
2617 KEYEVENTF_EXTENDEDKEY | 0, 0);
2618 keybd_event ((BYTE) vk_code,
2619 (BYTE) MapVirtualKey (vk_code, 0),
2620 KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
2621 cur_state = !cur_state;
2623 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE,
2624 cur_state, 0))
2625 emacs_abort ();
2627 break;
2628 #ifdef MSG_DEBUG
2629 /* Broadcast messages make it here, so you need to be looking
2630 for something in particular for this to be useful. */
2631 default:
2632 DebPrint (("msg %x not expected by w32_msg_pump\n", msg.message));
2633 #endif
2636 else
2638 if (w32_unicode_gui)
2639 DispatchMessageW (&msg);
2640 else
2641 DispatchMessageA (&msg);
2644 /* Exit nested loop when our deferred message has completed. */
2645 if (msg_buf->completed)
2646 break;
2650 deferred_msg * deferred_msg_head;
2652 static deferred_msg *
2653 find_deferred_msg (HWND hwnd, UINT msg)
2655 deferred_msg * item;
2657 /* Don't actually need synchronization for read access, since
2658 modification of single pointer is always atomic. */
2659 /* enter_crit (); */
2661 for (item = deferred_msg_head; item != NULL; item = item->next)
2662 if (item->w32msg.msg.hwnd == hwnd
2663 && item->w32msg.msg.message == msg)
2664 break;
2666 /* leave_crit (); */
2668 return item;
2671 static LRESULT
2672 send_deferred_msg (deferred_msg * msg_buf,
2673 HWND hwnd,
2674 UINT msg,
2675 WPARAM wParam,
2676 LPARAM lParam)
2678 /* Only input thread can send deferred messages. */
2679 if (GetCurrentThreadId () != dwWindowsThreadId)
2680 emacs_abort ();
2682 /* It is an error to send a message that is already deferred. */
2683 if (find_deferred_msg (hwnd, msg) != NULL)
2684 emacs_abort ();
2686 /* Enforced synchronization is not needed because this is the only
2687 function that alters deferred_msg_head, and the following critical
2688 section is guaranteed to only be serially reentered (since only the
2689 input thread can call us). */
2691 /* enter_crit (); */
2693 msg_buf->completed = 0;
2694 msg_buf->next = deferred_msg_head;
2695 deferred_msg_head = msg_buf;
2696 my_post_msg (&msg_buf->w32msg, hwnd, msg, wParam, lParam);
2698 /* leave_crit (); */
2700 /* Start a new nested message loop to process other messages until
2701 this one is completed. */
2702 w32_msg_pump (msg_buf);
2704 deferred_msg_head = msg_buf->next;
2706 return msg_buf->result;
2709 void
2710 complete_deferred_msg (HWND hwnd, UINT msg, LRESULT result)
2712 deferred_msg * msg_buf = find_deferred_msg (hwnd, msg);
2714 if (msg_buf == NULL)
2715 /* Message may have been canceled, so don't abort. */
2716 return;
2718 msg_buf->result = result;
2719 msg_buf->completed = 1;
2721 /* Ensure input thread is woken so it notices the completion. */
2722 PostThreadMessage (dwWindowsThreadId, WM_NULL, 0, 0);
2725 static void
2726 cancel_all_deferred_msgs (void)
2728 deferred_msg * item;
2730 /* Don't actually need synchronization for read access, since
2731 modification of single pointer is always atomic. */
2732 /* enter_crit (); */
2734 for (item = deferred_msg_head; item != NULL; item = item->next)
2736 item->result = 0;
2737 item->completed = 1;
2740 /* leave_crit (); */
2742 /* Ensure input thread is woken so it notices the completion. */
2743 PostThreadMessage (dwWindowsThreadId, WM_NULL, 0, 0);
2746 DWORD WINAPI
2747 w32_msg_worker (void *arg)
2749 MSG msg;
2750 deferred_msg dummy_buf;
2752 /* Ensure our message queue is created */
2754 PeekMessage (&msg, NULL, 0, 0, PM_NOREMOVE);
2756 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE, 0, 0))
2757 emacs_abort ();
2759 memset (&dummy_buf, 0, sizeof (dummy_buf));
2760 dummy_buf.w32msg.msg.hwnd = NULL;
2761 dummy_buf.w32msg.msg.message = WM_NULL;
2763 /* This is the initial message loop which should only exit when the
2764 application quits. */
2765 w32_msg_pump (&dummy_buf);
2767 return 0;
2770 static void
2771 signal_user_input (void)
2773 /* Interrupt any lisp that wants to be interrupted by input. */
2774 if (!NILP (Vthrow_on_input))
2776 Vquit_flag = Vthrow_on_input;
2777 /* Doing a QUIT from this thread is a bad idea, since this
2778 unwinds the stack of the Lisp thread, and the Windows runtime
2779 rightfully barfs. Disabled. */
2780 #if 0
2781 /* If we're inside a function that wants immediate quits,
2782 do it now. */
2783 if (immediate_quit && NILP (Vinhibit_quit))
2785 immediate_quit = 0;
2786 QUIT;
2788 #endif
2793 static void
2794 post_character_message (HWND hwnd, UINT msg,
2795 WPARAM wParam, LPARAM lParam,
2796 DWORD modifiers)
2798 W32Msg wmsg;
2800 wmsg.dwModifiers = modifiers;
2802 /* Detect quit_char and set quit-flag directly. Note that we
2803 still need to post a message to ensure the main thread will be
2804 woken up if blocked in sys_select, but we do NOT want to post
2805 the quit_char message itself (because it will usually be as if
2806 the user had typed quit_char twice). Instead, we post a dummy
2807 message that has no particular effect. */
2809 int c = wParam;
2810 if (isalpha (c) && wmsg.dwModifiers == ctrl_modifier)
2811 c = make_ctrl_char (c) & 0377;
2812 if (c == quit_char
2813 || (wmsg.dwModifiers == 0
2814 && w32_quit_key && wParam == w32_quit_key))
2816 Vquit_flag = Qt;
2818 /* The choice of message is somewhat arbitrary, as long as
2819 the main thread handler just ignores it. */
2820 msg = WM_NULL;
2822 /* Interrupt any blocking system calls. */
2823 signal_quit ();
2825 /* As a safety precaution, forcibly complete any deferred
2826 messages. This is a kludge, but I don't see any particularly
2827 clean way to handle the situation where a deferred message is
2828 "dropped" in the lisp thread, and will thus never be
2829 completed, eg. by the user trying to activate the menubar
2830 when the lisp thread is busy, and then typing C-g when the
2831 menubar doesn't open promptly (with the result that the
2832 menubar never responds at all because the deferred
2833 WM_INITMENU message is never completed). Another problem
2834 situation is when the lisp thread calls SendMessage (to send
2835 a window manager command) when a message has been deferred;
2836 the lisp thread gets blocked indefinitely waiting for the
2837 deferred message to be completed, which itself is waiting for
2838 the lisp thread to respond.
2840 Note that we don't want to block the input thread waiting for
2841 a response from the lisp thread (although that would at least
2842 solve the deadlock problem above), because we want to be able
2843 to receive C-g to interrupt the lisp thread. */
2844 cancel_all_deferred_msgs ();
2846 else
2847 signal_user_input ();
2850 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
2853 static int
2854 get_wm_chars (HWND aWnd, int *buf, int buflen, int ignore_ctrl, int ctrl,
2855 int *ctrl_cnt, int *is_dead, int vk, int exp)
2857 MSG msg;
2858 /* If doubled is at the end, ignore it. */
2859 int i = buflen, doubled = 0, code_unit;
2861 if (ctrl_cnt)
2862 *ctrl_cnt = 0;
2863 if (is_dead)
2864 *is_dead = -1;
2865 eassert (w32_unicode_gui);
2866 while (buflen
2867 /* Should be called only when w32_unicode_gui: */
2868 && PeekMessageW (&msg, aWnd, WM_KEYFIRST, WM_KEYLAST,
2869 PM_NOREMOVE | PM_NOYIELD)
2870 && (msg.message == WM_CHAR || msg.message == WM_SYSCHAR
2871 || msg.message == WM_DEADCHAR || msg.message == WM_SYSDEADCHAR
2872 || msg.message == WM_UNICHAR))
2874 /* We extract character payload, but in this call we handle only the
2875 characters which come BEFORE the next keyup/keydown message. */
2876 int dead;
2878 GetMessageW (&msg, aWnd, msg.message, msg.message);
2879 dead = (msg.message == WM_DEADCHAR || msg.message == WM_SYSDEADCHAR);
2880 if (is_dead)
2881 *is_dead = (dead ? msg.wParam : -1);
2882 if (dead)
2883 continue;
2884 code_unit = msg.wParam;
2885 if (doubled)
2887 /* Had surrogate. */
2888 if (msg.message == WM_UNICHAR
2889 || code_unit < 0xDC00 || code_unit > 0xDFFF)
2890 { /* Mismatched first surrogate.
2891 Pass both code units as if they were two characters. */
2892 *buf++ = doubled;
2893 if (!--buflen)
2894 return i; /* Drop the 2nd char if at the end of the buffer. */
2896 else /* see https://en.wikipedia.org/wiki/UTF-16 */
2897 code_unit = (doubled << 10) + code_unit - 0x35FDC00;
2898 doubled = 0;
2900 else if (code_unit >= 0xD800 && code_unit <= 0xDBFF)
2902 /* Handle mismatched 2nd surrogate the same as a normal character. */
2903 doubled = code_unit;
2904 continue;
2907 /* The only "fake" characters delivered by ToUnicode() or
2908 TranslateMessage() are:
2909 0x01 .. 0x1a for Ctrl-letter, Enter, Tab, Ctrl-Break, Esc, Backspace
2910 0x00 and 0x1b .. 0x1f for Control- []\@^_
2911 0x7f for Control-BackSpace
2912 0x20 for Control-Space */
2913 if (ignore_ctrl
2914 && (code_unit < 0x20 || code_unit == 0x7f
2915 || (code_unit == 0x20 && ctrl)))
2917 /* Non-character payload in a WM_CHAR
2918 (Ctrl-something pressed, see above). Ignore, and report. */
2919 if (ctrl_cnt)
2920 *ctrl_cnt++;
2921 continue;
2923 /* Traditionally, Emacs would ignore the character payload of VK_NUMPAD*
2924 keys, and would treat them later via `function-key-map'. In addition
2925 to usual 102-key NUMPAD keys, this map also treats `kp-'-variants of
2926 space, tab, enter, separator, equal. TAB and EQUAL, apparently,
2927 cannot be generated on Win-GUI branch. ENTER is already handled
2928 by the code above. According to `lispy_function_keys', kp_space is
2929 generated by not-extended VK_CLEAR. (kp-tab != VK_OEM_NEC_EQUAL!).
2931 We do similarly for backward-compatibility, but ignore only the
2932 characters restorable later by `function-key-map'. */
2933 if (code_unit < 0x7f
2934 && ((vk >= VK_NUMPAD0 && vk <= VK_DIVIDE)
2935 || (exp && ((vk >= VK_PRIOR && vk <= VK_DOWN) ||
2936 vk == VK_INSERT || vk == VK_DELETE || vk == VK_CLEAR)))
2937 && strchr ("0123456789/*-+.,", code_unit))
2938 continue;
2939 *buf++ = code_unit;
2940 buflen--;
2942 return i - buflen;
2945 #ifdef DBG_WM_CHARS
2946 # define FPRINTF_WM_CHARS(ARG) fprintf ARG
2947 #else
2948 # define FPRINTF_WM_CHARS(ARG) 0
2949 #endif
2951 /* This is a heuristic only. This is supposed to track the state of the
2952 finite automaton in the language environment of Windows.
2954 However, separate windows (if with the same different language
2955 environments!) should have different values. Moreover, switching to a
2956 non-Emacs window with the same language environment, and using (dead)keys
2957 there would change the value stored in the kernel, but not this value. */
2958 /* A layout may emit deadkey=0. It looks like this would reset the state
2959 of the kernel's finite automaton (equivalent to emiting 0-length string,
2960 which is otherwise impossible in the dead-key map of a layout).
2961 Be ready to treat the case when this delivers WM_(SYS)DEADCHAR. */
2962 static int after_deadkey = -1;
2965 deliver_wm_chars (int do_translate, HWND hwnd, UINT msg, UINT wParam,
2966 UINT lParam, int legacy_alt_meta)
2968 /* An "old style" keyboard description may assign up to 125 UTF-16 code
2969 points to a keypress.
2970 (However, the "old style" TranslateMessage() would deliver at most 16 of
2971 them.) Be on a safe side, and prepare to treat many more. */
2972 int ctrl_cnt, buf[1024], count, is_dead, after_dead = (after_deadkey > 0);
2974 /* Since the keypress processing logic of Windows has a lot of state, it
2975 is important to call TranslateMessage() for every keyup/keydown, AND
2976 do it exactly once. (The actual change of state is done by
2977 ToUnicode[Ex](), which is called by TranslateMessage(). So one can
2978 call ToUnicode[Ex]() instead.)
2980 The "usual" message pump calls TranslateMessage() for EVERY event.
2981 Emacs calls TranslateMessage() very selectively (is it needed for doing
2982 some tricky stuff with Win95??? With newer Windows, selectiveness is,
2983 most probably, not needed -- and harms a lot).
2985 So, with the usual message pump, the following call to TranslateMessage()
2986 is not needed (and is going to be VERY harmful). With Emacs' message
2987 pump, the call is needed. */
2988 if (do_translate)
2990 MSG windows_msg = { hwnd, msg, wParam, lParam, 0, {0,0} };
2992 windows_msg.time = GetMessageTime ();
2993 TranslateMessage (&windows_msg);
2995 count = get_wm_chars (hwnd, buf, sizeof (buf)/sizeof (*buf), 1,
2996 /* The message may have been synthesized by
2997 who knows what; be conservative. */
2998 modifier_set (VK_LCONTROL)
2999 || modifier_set (VK_RCONTROL)
3000 || modifier_set (VK_CONTROL),
3001 &ctrl_cnt, &is_dead, wParam,
3002 (lParam & 0x1000000L) != 0);
3003 if (count)
3005 W32Msg wmsg;
3006 DWORD console_modifiers = construct_console_modifiers ();
3007 int *b = buf, strip_Alt = 1, strip_ExtraMods = 1, hairy = 0;
3008 char *type_CtrlAlt = NULL;
3010 /* XXXX In fact, there may be another case when we need to do the same:
3011 What happens if the string defined in the LIGATURES has length
3012 0? Probably, we will get count==0, but the state of the finite
3013 automaton would reset to 0??? */
3014 after_deadkey = -1;
3016 /* wParam is checked when converting CapsLock to Shift; this is a clone
3017 of w32_get_key_modifiers (). */
3018 wmsg.dwModifiers = w32_kbd_mods_to_emacs (console_modifiers, wParam);
3020 /* What follows is just heuristics; the correct treatement requires
3021 non-destructive ToUnicode():
3022 http://search.cpan.org/~ilyaz/UI-KeyboardLayout/lib/UI/KeyboardLayout.pm#Can_an_application_on_Windows_accept_keyboard_events?_Part_IV:_application-specific_modifiers
3024 What one needs to find is:
3025 * which of the present modifiers AFFECT the resulting char(s)
3026 (so should be stripped, since their EFFECT is "already
3027 taken into account" in the string in buf), and
3028 * which modifiers are not affecting buf, so should be reported to
3029 the application for further treatment.
3031 Example: assume that we know:
3032 (A) lCtrl+rCtrl+rAlt modifiers with VK_A key produce a Latin "f"
3033 ("may be logical" in JCUKEN-flavored Russian keyboard flavors);
3034 (B) removing any of lCtrl, rCtrl, rAlt changes the produced char;
3035 (C) Win-modifier is not affecting the produced character
3036 (this is the common case: happens with all "standard" layouts).
3038 Suppose the user presses Win+lCtrl+rCtrl+rAlt modifiers with VK_A.
3039 What is the intent of the user? We need to guess the intent to decide
3040 which event to deliver to the application.
3042 This looks like a reasonable logic: since Win- modifier doesn't affect
3043 the output string, the user was pressing Win for SOME OTHER purpose.
3044 So the user wanted to generate Win-SOMETHING event. Now, what is
3045 something? If one takes the mantra that "character payload is more
3046 important than the combination of keypresses which resulted in this
3047 payload", then one should ignore lCtrl+rCtrl+rAlt, ignore VK_A, and
3048 assume that the user wanted to generate Win-f.
3050 Unfortunately, without non-destructive ToUnicode(), checking (B),(C)
3051 is out of question. So we use heuristics (hopefully, covering
3052 99.9999% of cases). */
3054 /* Another thing to watch for is a possibility to use AltGr-* and
3055 Ctrl-Alt-* with different semantic.
3057 Background: the layout defining the KLLF_ALTGR bit are treated
3058 specially by the kernel: when VK_RMENU (=rightAlt, =AltGr) is pressed
3059 (released), a press (release) of VK_LCONTROL is emulated (unless Ctrl
3060 is already down). As a result, any press/release of AltGr is seen
3061 by applications as a press/release of lCtrl AND rAlt. This is
3062 applicable, in particular, to ToUnicode[Ex](). (Keyrepeat is covered
3063 the same way!)
3065 NOTE: it IS possible to see bare rAlt even with KLLF_ALTGR; but this
3066 requires a good finger coordination: doing (physically)
3067 Down-lCtrl Down-rAlt Up-lCtrl Down-a
3068 (doing quick enough, so that key repeat of rAlt [which would
3069 generate new "fake" Down-lCtrl events] does not happens before 'a'
3070 is down) results in no "fake" events, so the application will see
3071 only rAlt down when 'a' is pressed. (However, fake Up-lCtrl WILL
3072 be generated when rAlt goes UP.)
3074 In fact, note also that KLLF_ALTGR does not prohibit construction of
3075 rCtrl-rAlt (just press them in this order!).
3077 Moreover: "traditional" layouts do not define distinct modifier-masks
3078 for VK_LMENU and VK_RMENU (same for VK_L/RCONTROL). Instead, they
3079 rely on the KLLF_ALTGR bit to make the behavior of VK_LMENU and
3080 VK_RMENU distinct. As a corollary, for such layouts, the produced
3081 character is the same for AltGr-* (=rAlt-*) and Ctrl-Alt-* (in any
3082 combination of handedness). For description of masks, see
3084 http://search.cpan.org/~ilyaz/UI-KeyboardLayout/lib/UI/KeyboardLayout.pm#Keyboard_input_on_Windows,_Part_I:_what_is_the_kernel_doing?
3086 By default, Emacs was using these coincidences via the following
3087 heuristics: it was treating:
3088 (*) keypresses with lCtrl-rAlt modifiers as if they are carrying
3089 ONLY the character payload (no matter what the actual keyboard
3090 was defining: if lCtrl-lAlt-b was delivering U+05df=beta, then
3091 Emacs saw [beta]; if lCtrl-lAlt-b was undefined in the layout,
3092 the keypress was completely ignored), and
3093 (*) keypresses with the other combinations of handedness of Ctrl-Alt
3094 modifiers (e.g., lCtrl-lAlt) as if they NEVER carry a character
3095 payload (so they were reported "raw": if lCtrl-lAlt-b was
3096 delivering beta, then Emacs saw event [C-A-b], and not [beta]).
3097 This worked good for "traditional" layouts: users could type both
3098 AltGr-x and Ctrl-Alt-x, and one was a character, another a bindable
3099 event.
3101 However, for layouts which deliver different characters for AltGr-x
3102 and lCtrl-lAlt-x, this scheme makes the latter character unaccessible
3103 in Emacs. While it is easy to access functionality of [C-M-x] in
3104 Emacs by other means (for example, by the `controlify' prefix, or
3105 using lCtrl-rCtrl-x, or rCtrl-rAlt-x [in this order]), missing
3106 characters cannot be reconstructed without a tedious manual work. */
3108 /* These two cases are often going to be distinguishable, since at most
3109 one of these character is defined with KBDCTRL | KBDMENU modifier
3110 bitmap. (This heuristic breaks if both lCtrl-lAlt- AND lCtrl-rAlt-
3111 are translated to modifier bitmaps distinct from KBDCTRL | KBDMENU,
3112 or in the cases when lCtrl-lAlt-* and lCtrl-rAlt-* are generally
3113 different, but lCtrl-lAlt-x and lCtrl-rAlt-x happen to deliver the
3114 same character.)
3116 So we have 2 chunks of info:
3117 (A) is it lCtrl-rAlt-, or lCtrl-lAlt, or some other combination?
3118 (B) is the delivered character defined with KBDCTRL | KBDMENU bits?
3119 Basing on (A) and (B), we should decide whether to ignore the
3120 delivered character. (Before, Emacs was completely ignoring (B), and
3121 was treating the 3-state of (A) as a bit.) This means that we have 6
3122 bits of customization.
3124 Additionally, a presence of two Ctrl down may be AltGr-rCtrl-. */
3126 /* Strip all non-Shift modifiers if:
3127 - more than one UTF-16 code point delivered (can't call VkKeyScanW ())
3128 - or the character is a result of combining with a prefix key. */
3129 if (!after_dead && count == 1 && *b < 0x10000)
3131 if (console_modifiers & (RIGHT_ALT_PRESSED | LEFT_ALT_PRESSED)
3132 && console_modifiers & (RIGHT_CTRL_PRESSED | LEFT_CTRL_PRESSED))
3134 type_CtrlAlt = "bB"; /* generic bindable Ctrl-Alt- modifiers */
3135 if (console_modifiers & (LEFT_CTRL_PRESSED | RIGHT_CTRL_PRESSED)
3136 == (LEFT_CTRL_PRESSED | RIGHT_CTRL_PRESSED))
3137 /* double-Ctrl:
3138 e.g. AltGr-rCtrl on some layouts (in this order!) */
3139 type_CtrlAlt = "dD";
3140 else if (console_modifiers
3141 & (LEFT_CTRL_PRESSED | LEFT_ALT_PRESSED)
3142 == (LEFT_CTRL_PRESSED | LEFT_ALT_PRESSED))
3143 type_CtrlAlt = "lL"; /* Ctrl-Alt- modifiers on the left */
3144 else if (!NILP (Vw32_recognize_altgr)
3145 && (console_modifiers
3146 & (RIGHT_ALT_PRESSED | LEFT_CTRL_PRESSED))
3147 == (RIGHT_ALT_PRESSED | LEFT_CTRL_PRESSED))
3148 type_CtrlAlt = "gG"; /* modifiers as in AltGr */
3150 else if (wmsg.dwModifiers & (alt_modifier | meta_modifier)
3151 || (console_modifiers
3152 & (LEFT_WIN_PRESSED | RIGHT_WIN_PRESSED
3153 | APPS_PRESSED | SCROLLLOCK_ON)))
3155 /* Pure Alt (or combination of Alt, Win, APPS, scrolllock. */
3156 type_CtrlAlt = "aA";
3158 if (type_CtrlAlt)
3160 /* Out of bound bitmap: */
3161 SHORT r = VkKeyScanW (*b), bitmap = 0x1FF;
3163 FPRINTF_WM_CHARS((stderr, "VkKeyScanW %#06x %#04x\n", (int)r,
3164 wParam));
3165 if ((r & 0xFF) == wParam)
3166 bitmap = r>>8; /* *b is reachable via simple interface */
3167 if (*type_CtrlAlt == 'a') /* Simple Alt seen */
3169 if ((bitmap & ~1) == 0) /* 1: KBDSHIFT */
3171 /* In "traditional" layouts, Alt without Ctrl does not
3172 change the delivered character. This detects this
3173 situation; it is safe to report this as Alt-something
3174 -- as opposed to delivering the reported character
3175 without modifiers. */
3176 if (legacy_alt_meta
3177 && *b > 0x7f && ('A' <= wParam && wParam <= 'Z'))
3178 /* For backward-compatibility with older Emacsen, let
3179 this be processed by another branch below (which
3180 would convert it to Alt-Latin char via wParam). */
3181 return 0;
3183 else
3184 hairy = 1;
3186 /* Check whether the delivered character(s) is accessible via
3187 KBDCTRL | KBDALT ( | KBDSHIFT ) modifier mask (which is 7). */
3188 else if ((bitmap & ~1) != 6)
3190 /* The character is not accessible via plain Ctrl-Alt(-Shift)
3191 (which is, probably, same as AltGr) modifiers.
3192 Either it was after a prefix key, or is combined with
3193 modifier keys which we don't see, or there is an asymmetry
3194 between left-hand and right-hand modifiers, or other hairy
3195 stuff. */
3196 hairy = 1;
3198 /* The best solution is to delegate these tough (but rarely
3199 needed) choices to the user. Temporarily (???), it is
3200 implemented as C macros.
3202 Essentially, there are 3 things to do: return 0 (handle to the
3203 legacy processing code [ignoring the character payload]; keep
3204 some modifiers (so that they will be processed by the binding
3205 system [on top of the character payload]; strip modifiers [so
3206 that `self-insert' is going to be triggered with the character
3207 payload]).
3209 The default below should cover 99.9999% of cases:
3210 (a) strip Alt- in the hairy case only;
3211 (stripping = not ignoring)
3212 (l) for lAlt-lCtrl, ignore the char in simple cases only;
3213 (g) for what looks like AltGr, ignore the modifiers;
3214 (d) for what looks like lCtrl-rCtrl-Alt (probably
3215 AltGr-rCtrl), ignore the character in simple cases only;
3216 (b) for other cases of Ctrl-Alt, ignore the character in
3217 simple cases only.
3219 Essentially, in all hairy cases, and in looks-like-AltGr case,
3220 we keep the character, ignoring the modifiers. In all the
3221 other cases, we ignore the delivered character. */
3222 #define S_TYPES_TO_IGNORE_CHARACTER_PAYLOAD "aldb"
3223 #define S_TYPES_TO_REPORT_CHARACTER_PAYLOAD_WITH_MODIFIERS ""
3224 if (strchr (S_TYPES_TO_IGNORE_CHARACTER_PAYLOAD,
3225 type_CtrlAlt[hairy]))
3226 return 0;
3227 /* If in neither list, report all the modifiers we see COMBINED
3228 WITH the reported character. */
3229 if (strchr (S_TYPES_TO_REPORT_CHARACTER_PAYLOAD_WITH_MODIFIERS,
3230 type_CtrlAlt[hairy]))
3231 strip_ExtraMods = 0;
3234 if (strip_ExtraMods)
3235 wmsg.dwModifiers = wmsg.dwModifiers & shift_modifier;
3237 signal_user_input ();
3238 while (count--)
3240 FPRINTF_WM_CHARS((stderr, "unichar %#06x\n", *b));
3241 my_post_msg (&wmsg, hwnd, WM_UNICHAR, *b++, lParam);
3243 if (!ctrl_cnt) /* Process ALSO as ctrl */
3244 return 1;
3245 else
3246 FPRINTF_WM_CHARS((stderr, "extra ctrl char\n"));
3247 return -1;
3249 else if (is_dead >= 0)
3251 FPRINTF_WM_CHARS((stderr, "dead %#06x\n", is_dead));
3252 after_deadkey = is_dead;
3253 return 1;
3255 return 0;
3258 /* Main window procedure */
3260 static LRESULT CALLBACK
3261 w32_wnd_proc (HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam)
3263 struct frame *f;
3264 struct w32_display_info *dpyinfo = &one_w32_display_info;
3265 W32Msg wmsg;
3266 int windows_translate;
3267 int key;
3269 /* Note that it is okay to call x_window_to_frame, even though we are
3270 not running in the main lisp thread, because frame deletion
3271 requires the lisp thread to synchronize with this thread. Thus, if
3272 a frame struct is returned, it can be used without concern that the
3273 lisp thread might make it disappear while we are using it.
3275 NB. Walking the frame list in this thread is safe (as long as
3276 writes of Lisp_Object slots are atomic, which they are on Windows).
3277 Although delete-frame can destructively modify the frame list while
3278 we are walking it, a garbage collection cannot occur until after
3279 delete-frame has synchronized with this thread.
3281 It is also safe to use functions that make GDI calls, such as
3282 w32_clear_rect, because these functions must obtain a DC handle
3283 from the frame struct using get_frame_dc which is thread-aware. */
3285 switch (msg)
3287 case WM_ERASEBKGND:
3288 f = x_window_to_frame (dpyinfo, hwnd);
3289 if (f)
3291 HDC hdc = get_frame_dc (f);
3292 GetUpdateRect (hwnd, &wmsg.rect, FALSE);
3293 w32_clear_rect (f, hdc, &wmsg.rect);
3294 release_frame_dc (f, hdc);
3296 #if defined (W32_DEBUG_DISPLAY)
3297 DebPrint (("WM_ERASEBKGND (frame %p): erasing %d,%d-%d,%d\n",
3299 wmsg.rect.left, wmsg.rect.top,
3300 wmsg.rect.right, wmsg.rect.bottom));
3301 #endif /* W32_DEBUG_DISPLAY */
3303 return 1;
3304 case WM_PALETTECHANGED:
3305 /* ignore our own changes */
3306 if ((HWND)wParam != hwnd)
3308 f = x_window_to_frame (dpyinfo, hwnd);
3309 if (f)
3310 /* get_frame_dc will realize our palette and force all
3311 frames to be redrawn if needed. */
3312 release_frame_dc (f, get_frame_dc (f));
3314 return 0;
3315 case WM_PAINT:
3317 PAINTSTRUCT paintStruct;
3318 RECT update_rect;
3319 memset (&update_rect, 0, sizeof (update_rect));
3321 f = x_window_to_frame (dpyinfo, hwnd);
3322 if (f == 0)
3324 DebPrint (("WM_PAINT received for unknown window %p\n", hwnd));
3325 return 0;
3328 /* MSDN Docs say not to call BeginPaint if GetUpdateRect
3329 fails. Apparently this can happen under some
3330 circumstances. */
3331 if (GetUpdateRect (hwnd, &update_rect, FALSE) || !w32_strict_painting)
3333 enter_crit ();
3334 BeginPaint (hwnd, &paintStruct);
3336 /* The rectangles returned by GetUpdateRect and BeginPaint
3337 do not always match. Play it safe by assuming both areas
3338 are invalid. */
3339 UnionRect (&(wmsg.rect), &update_rect, &(paintStruct.rcPaint));
3341 #if defined (W32_DEBUG_DISPLAY)
3342 DebPrint (("WM_PAINT (frame %p): painting %d,%d-%d,%d\n",
3344 wmsg.rect.left, wmsg.rect.top,
3345 wmsg.rect.right, wmsg.rect.bottom));
3346 DebPrint ((" [update region is %d,%d-%d,%d]\n",
3347 update_rect.left, update_rect.top,
3348 update_rect.right, update_rect.bottom));
3349 #endif
3350 EndPaint (hwnd, &paintStruct);
3351 leave_crit ();
3353 /* Change the message type to prevent Windows from
3354 combining WM_PAINT messages in the Lisp thread's queue,
3355 since Windows assumes that each message queue is
3356 dedicated to one frame and does not bother checking
3357 that hwnd matches before combining them. */
3358 my_post_msg (&wmsg, hwnd, WM_EMACS_PAINT, wParam, lParam);
3360 return 0;
3363 /* If GetUpdateRect returns 0 (meaning there is no update
3364 region), assume the whole window needs to be repainted. */
3365 GetClientRect (hwnd, &wmsg.rect);
3366 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3367 return 0;
3370 case WM_INPUTLANGCHANGE:
3371 /* Inform lisp thread of keyboard layout changes. */
3372 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3374 /* The state of the finite automaton is separate per every input
3375 language environment (so it does not change when one switches
3376 to a different window with the same environment). Moreover,
3377 the experiments show that the state is not remembered when
3378 one switches back to the pre-previous environment. */
3379 after_deadkey = -1;
3381 /* XXXX??? What follows is a COMPLETE misunderstanding of Windows! */
3383 /* Clear dead keys in the keyboard state; for simplicity only
3384 preserve modifier key states. */
3386 int i;
3387 BYTE keystate[256];
3389 GetKeyboardState (keystate);
3390 for (i = 0; i < 256; i++)
3391 if (1
3392 && i != VK_SHIFT
3393 && i != VK_LSHIFT
3394 && i != VK_RSHIFT
3395 && i != VK_CAPITAL
3396 && i != VK_NUMLOCK
3397 && i != VK_SCROLL
3398 && i != VK_CONTROL
3399 && i != VK_LCONTROL
3400 && i != VK_RCONTROL
3401 && i != VK_MENU
3402 && i != VK_LMENU
3403 && i != VK_RMENU
3404 && i != VK_LWIN
3405 && i != VK_RWIN)
3406 keystate[i] = 0;
3407 SetKeyboardState (keystate);
3409 goto dflt;
3411 case WM_HOTKEY:
3412 /* Synchronize hot keys with normal input. */
3413 PostMessage (hwnd, WM_KEYDOWN, HIWORD (lParam), 0);
3414 return (0);
3416 case WM_KEYUP:
3417 case WM_SYSKEYUP:
3418 record_keyup (wParam, lParam);
3419 goto dflt;
3421 case WM_KEYDOWN:
3422 case WM_SYSKEYDOWN:
3423 /* Ignore keystrokes we fake ourself; see below. */
3424 if (dpyinfo->faked_key == wParam)
3426 dpyinfo->faked_key = 0;
3427 /* Make sure TranslateMessage sees them though (as long as
3428 they don't produce WM_CHAR messages). This ensures that
3429 indicator lights are toggled promptly on Windows 9x, for
3430 example. */
3431 if (wParam < 256 && lispy_function_keys[wParam])
3433 windows_translate = 1;
3434 goto translate;
3436 return 0;
3439 /* Synchronize modifiers with current keystroke. */
3440 sync_modifiers ();
3441 record_keydown (wParam, lParam);
3442 if (w32_use_fallback_wm_chars_method)
3443 wParam = map_keypad_keys (wParam, (lParam & 0x1000000L) != 0);
3445 windows_translate = 0;
3447 switch (wParam)
3449 case VK_LWIN:
3450 if (NILP (Vw32_pass_lwindow_to_system))
3452 /* Prevent system from acting on keyup (which opens the
3453 Start menu if no other key was pressed) by simulating a
3454 press of Space which we will ignore. */
3455 if (GetAsyncKeyState (wParam) & 1)
3457 if (NUMBERP (Vw32_phantom_key_code))
3458 key = XUINT (Vw32_phantom_key_code) & 255;
3459 else
3460 key = VK_SPACE;
3461 dpyinfo->faked_key = key;
3462 keybd_event (key, (BYTE) MapVirtualKey (key, 0), 0, 0);
3465 if (!NILP (Vw32_lwindow_modifier))
3466 return 0;
3467 break;
3468 case VK_RWIN:
3469 if (NILP (Vw32_pass_rwindow_to_system))
3471 if (GetAsyncKeyState (wParam) & 1)
3473 if (NUMBERP (Vw32_phantom_key_code))
3474 key = XUINT (Vw32_phantom_key_code) & 255;
3475 else
3476 key = VK_SPACE;
3477 dpyinfo->faked_key = key;
3478 keybd_event (key, (BYTE) MapVirtualKey (key, 0), 0, 0);
3481 if (!NILP (Vw32_rwindow_modifier))
3482 return 0;
3483 break;
3484 case VK_APPS:
3485 if (!NILP (Vw32_apps_modifier))
3486 return 0;
3487 break;
3488 case VK_MENU:
3489 if (NILP (Vw32_pass_alt_to_system))
3490 /* Prevent DefWindowProc from activating the menu bar if an
3491 Alt key is pressed and released by itself. */
3492 return 0;
3493 windows_translate = 1;
3494 break;
3495 case VK_CAPITAL:
3496 /* Decide whether to treat as modifier or function key. */
3497 if (NILP (Vw32_enable_caps_lock))
3498 goto disable_lock_key;
3499 windows_translate = 1;
3500 break;
3501 case VK_NUMLOCK:
3502 /* Decide whether to treat as modifier or function key. */
3503 if (NILP (Vw32_enable_num_lock))
3504 goto disable_lock_key;
3505 windows_translate = 1;
3506 break;
3507 case VK_SCROLL:
3508 /* Decide whether to treat as modifier or function key. */
3509 if (NILP (Vw32_scroll_lock_modifier))
3510 goto disable_lock_key;
3511 windows_translate = 1;
3512 break;
3513 disable_lock_key:
3514 /* Ensure the appropriate lock key state (and indicator light)
3515 remains in the same state. We do this by faking another
3516 press of the relevant key. Apparently, this really is the
3517 only way to toggle the state of the indicator lights. */
3518 dpyinfo->faked_key = wParam;
3519 keybd_event ((BYTE) wParam, (BYTE) MapVirtualKey (wParam, 0),
3520 KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
3521 keybd_event ((BYTE) wParam, (BYTE) MapVirtualKey (wParam, 0),
3522 KEYEVENTF_EXTENDEDKEY | 0, 0);
3523 keybd_event ((BYTE) wParam, (BYTE) MapVirtualKey (wParam, 0),
3524 KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
3525 /* Ensure indicator lights are updated promptly on Windows 9x
3526 (TranslateMessage apparently does this), after forwarding
3527 input event. */
3528 post_character_message (hwnd, msg, wParam, lParam,
3529 w32_get_key_modifiers (wParam, lParam));
3530 windows_translate = 1;
3531 break;
3532 case VK_CONTROL:
3533 case VK_SHIFT:
3534 case VK_PROCESSKEY: /* Generated by IME. */
3535 windows_translate = 1;
3536 break;
3537 case VK_CANCEL:
3538 /* Windows maps Ctrl-Pause (aka Ctrl-Break) into VK_CANCEL,
3539 which is confusing for purposes of key binding; convert
3540 VK_CANCEL events into VK_PAUSE events. */
3541 wParam = VK_PAUSE;
3542 break;
3543 case VK_PAUSE:
3544 /* Windows maps Ctrl-NumLock into VK_PAUSE, which is confusing
3545 for purposes of key binding; convert these back into
3546 VK_NUMLOCK events, at least when we want to see NumLock key
3547 presses. (Note that there is never any possibility that
3548 VK_PAUSE with Ctrl really is C-Pause as per above.) */
3549 if (NILP (Vw32_enable_num_lock) && modifier_set (VK_CONTROL))
3550 wParam = VK_NUMLOCK;
3551 break;
3552 default:
3553 if (w32_unicode_gui && !w32_use_fallback_wm_chars_method)
3555 /* If this event generates characters or deadkeys, do
3556 not interpret it as a "raw combination of modifiers
3557 and keysym". Hide deadkeys, and use the generated
3558 character(s) instead of the keysym. (Backward
3559 compatibility: exceptions for numpad keys generating
3560 0-9 . , / * - +, and for extra-Alt combined with a
3561 non-Latin char.)
3563 Try to not report modifiers which have effect on
3564 which character or deadkey is generated.
3566 Example (contrived): if rightAlt-? generates f (on a
3567 Cyrillic keyboard layout), and Ctrl, leftAlt do not
3568 affect the generated character, one wants to report
3569 Ctrl-leftAlt-f if the user presses
3570 Ctrl-leftAlt-rightAlt-?. */
3571 int res;
3572 #if 0
3573 /* Some of WM_CHAR may be fed to us directly, some are
3574 results of TranslateMessage(). Using 0 as the first
3575 argument (in a separate call) might help us
3576 distinguish these two cases.
3578 However, the keypress feeders would most probably
3579 expect the "standard" message pump, when
3580 TranslateMessage() is called on EVERY KeyDown/KeyUp
3581 event. So they may feed us Down-Ctrl Down-FAKE
3582 Char-o and expect us to recognize it as Ctrl-o.
3583 Using 0 as the first argument would interfere with
3584 this. */
3585 deliver_wm_chars (0, hwnd, msg, wParam, lParam, 1);
3586 #endif
3587 /* Processing the generated WM_CHAR messages *WHILE* we
3588 handle KEYDOWN/UP event is the best choice, since
3589 without any fuss, we know all 3 of: scancode, virtual
3590 keycode, and expansion. (Additionally, one knows
3591 boundaries of expansion of different keypresses.) */
3592 res = deliver_wm_chars (1, hwnd, msg, wParam, lParam, 1);
3593 windows_translate = -(res != 0);
3594 if (res > 0) /* Bound to character(s) or a deadkey */
3595 break;
3596 /* deliver_wm_chars may make some branches after this vestigal. */
3598 wParam = map_keypad_keys (wParam, (lParam & 0x1000000L) != 0);
3599 /* If not defined as a function key, change it to a WM_CHAR message. */
3600 if (wParam > 255 || !lispy_function_keys[wParam])
3602 DWORD modifiers = construct_console_modifiers ();
3604 if (!NILP (Vw32_recognize_altgr)
3605 && modifier_set (VK_LCONTROL) && modifier_set (VK_RMENU))
3607 /* Always let TranslateMessage handle AltGr key chords;
3608 for some reason, ToAscii doesn't always process AltGr
3609 chords correctly. */
3610 windows_translate = 1;
3612 else if ((modifiers & (~SHIFT_PRESSED & ~CAPSLOCK_ON)) != 0)
3614 /* Handle key chords including any modifiers other
3615 than shift directly, in order to preserve as much
3616 modifier information as possible. */
3617 if ('A' <= wParam && wParam <= 'Z')
3619 /* Don't translate modified alphabetic keystrokes,
3620 so the user doesn't need to constantly switch
3621 layout to type control or meta keystrokes when
3622 the normal layout translates alphabetic
3623 characters to non-ascii characters. */
3624 if (!modifier_set (VK_SHIFT))
3625 wParam += ('a' - 'A');
3626 msg = WM_CHAR;
3628 else
3630 /* Try to handle other keystrokes by determining the
3631 base character (ie. translating the base key plus
3632 shift modifier). */
3633 int add;
3634 KEY_EVENT_RECORD key;
3636 key.bKeyDown = TRUE;
3637 key.wRepeatCount = 1;
3638 key.wVirtualKeyCode = wParam;
3639 key.wVirtualScanCode = (lParam & 0xFF0000) >> 16;
3640 key.uChar.AsciiChar = 0;
3641 key.dwControlKeyState = modifiers;
3643 add = w32_kbd_patch_key (&key, w32_keyboard_codepage);
3644 /* 0 means an unrecognized keycode, negative means
3645 dead key. Ignore both. */
3646 while (--add >= 0)
3648 /* Forward asciified character sequence. */
3649 post_character_message
3650 (hwnd, WM_CHAR,
3651 (unsigned char) key.uChar.AsciiChar, lParam,
3652 w32_get_key_modifiers (wParam, lParam));
3653 w32_kbd_patch_key (&key, w32_keyboard_codepage);
3655 return 0;
3658 else
3660 /* Let TranslateMessage handle everything else. */
3661 windows_translate = 1;
3666 if (windows_translate == -1)
3667 break;
3668 translate:
3669 if (windows_translate)
3671 MSG windows_msg = { hwnd, msg, wParam, lParam, 0, {0,0} };
3672 windows_msg.time = GetMessageTime ();
3673 TranslateMessage (&windows_msg);
3674 goto dflt;
3677 /* Fall through */
3679 case WM_SYSCHAR:
3680 case WM_CHAR:
3681 if (wParam > 255 )
3683 W32Msg wmsg;
3685 wmsg.dwModifiers = w32_get_key_modifiers (wParam, lParam);
3686 signal_user_input ();
3687 my_post_msg (&wmsg, hwnd, WM_UNICHAR, wParam, lParam);
3690 else
3691 post_character_message (hwnd, msg, wParam, lParam,
3692 w32_get_key_modifiers (wParam, lParam));
3693 break;
3695 case WM_UNICHAR:
3696 /* WM_UNICHAR looks promising from the docs, but the exact
3697 circumstances in which TranslateMessage sends it is one of those
3698 Microsoft secret API things that EU and US courts are supposed
3699 to have put a stop to already. Spy++ shows it being sent to Notepad
3700 and other MS apps, but never to Emacs.
3702 Some third party IMEs send it in accordance with the official
3703 documentation though, so handle it here.
3705 UNICODE_NOCHAR is used to test for support for this message.
3706 TRUE indicates that the message is supported. */
3707 if (wParam == UNICODE_NOCHAR)
3708 return TRUE;
3711 W32Msg wmsg;
3712 wmsg.dwModifiers = w32_get_key_modifiers (wParam, lParam);
3713 signal_user_input ();
3714 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3716 break;
3718 case WM_IME_CHAR:
3719 /* If we can't get the IME result as Unicode, use default processing,
3720 which will at least allow characters decodable in the system locale
3721 get through. */
3722 if (!get_composition_string_fn)
3723 goto dflt;
3725 else if (!ignore_ime_char)
3727 wchar_t * buffer;
3728 int size, i;
3729 W32Msg wmsg;
3730 HIMC context = get_ime_context_fn (hwnd);
3731 wmsg.dwModifiers = w32_get_key_modifiers (wParam, lParam);
3732 /* Get buffer size. */
3733 size = get_composition_string_fn (context, GCS_RESULTSTR, NULL, 0);
3734 buffer = alloca (size);
3735 size = get_composition_string_fn (context, GCS_RESULTSTR,
3736 buffer, size);
3737 release_ime_context_fn (hwnd, context);
3739 signal_user_input ();
3740 for (i = 0; i < size / sizeof (wchar_t); i++)
3742 my_post_msg (&wmsg, hwnd, WM_UNICHAR, (WPARAM) buffer[i],
3743 lParam);
3745 /* Ignore the messages for the rest of the
3746 characters in the string that was output above. */
3747 ignore_ime_char = (size / sizeof (wchar_t)) - 1;
3749 else
3750 ignore_ime_char--;
3752 break;
3754 case WM_IME_STARTCOMPOSITION:
3755 if (!set_ime_composition_window_fn)
3756 goto dflt;
3757 else
3759 COMPOSITIONFORM form;
3760 HIMC context;
3761 struct window *w;
3763 /* Implementation note: The code below does something that
3764 one shouldn't do: it accesses the window object from a
3765 separate thread, while the main (a.k.a. "Lisp") thread
3766 runs and can legitimately delete and even GC it. That is
3767 why we are extra careful not to futz with a window that
3768 is different from the one recorded when the system caret
3769 coordinates were last modified. That is also why we are
3770 careful not to move the IME window if the window
3771 described by W was deleted, as indicated by its buffer
3772 field being reset to nil. */
3773 f = x_window_to_frame (dpyinfo, hwnd);
3774 if (!(f && FRAME_LIVE_P (f)))
3775 goto dflt;
3776 w = XWINDOW (FRAME_SELECTED_WINDOW (f));
3777 /* Punt if someone changed the frame's selected window
3778 behind our back. */
3779 if (w != w32_system_caret_window)
3780 goto dflt;
3782 form.dwStyle = CFS_RECT;
3783 form.ptCurrentPos.x = w32_system_caret_x;
3784 form.ptCurrentPos.y = w32_system_caret_y;
3786 form.rcArea.left = WINDOW_TEXT_TO_FRAME_PIXEL_X (w, 0);
3787 form.rcArea.top = (WINDOW_TOP_EDGE_Y (w)
3788 + w32_system_caret_hdr_height);
3789 form.rcArea.right = (WINDOW_BOX_RIGHT_EDGE_X (w)
3790 - WINDOW_RIGHT_MARGIN_WIDTH (w)
3791 - WINDOW_RIGHT_FRINGE_WIDTH (w));
3792 form.rcArea.bottom = (WINDOW_BOTTOM_EDGE_Y (w)
3793 - WINDOW_BOTTOM_DIVIDER_WIDTH (w)
3794 - w32_system_caret_mode_height);
3796 /* Punt if the window was deleted behind our back. */
3797 if (!BUFFERP (w->contents))
3798 goto dflt;
3800 context = get_ime_context_fn (hwnd);
3802 if (!context)
3803 goto dflt;
3805 set_ime_composition_window_fn (context, &form);
3806 release_ime_context_fn (hwnd, context);
3808 /* We should "goto dflt" here to pass WM_IME_STARTCOMPOSITION to
3809 DefWindowProc, so that the composition window will actually
3810 be displayed. But doing so causes trouble with displaying
3811 dialog boxes, such as the file selection dialog or font
3812 selection dialog. So something else is needed to fix the
3813 former without breaking the latter. See bug#11732. */
3814 break;
3816 case WM_IME_ENDCOMPOSITION:
3817 ignore_ime_char = 0;
3818 goto dflt;
3820 /* Simulate middle mouse button events when left and right buttons
3821 are used together, but only if user has two button mouse. */
3822 case WM_LBUTTONDOWN:
3823 case WM_RBUTTONDOWN:
3824 if (w32_num_mouse_buttons > 2)
3825 goto handle_plain_button;
3828 int this = (msg == WM_LBUTTONDOWN) ? LMOUSE : RMOUSE;
3829 int other = (msg == WM_LBUTTONDOWN) ? RMOUSE : LMOUSE;
3831 if (button_state & this)
3832 return 0;
3834 if (button_state == 0)
3835 SetCapture (hwnd);
3837 button_state |= this;
3839 if (button_state & other)
3841 if (mouse_button_timer)
3843 KillTimer (hwnd, mouse_button_timer);
3844 mouse_button_timer = 0;
3846 /* Generate middle mouse event instead. */
3847 msg = WM_MBUTTONDOWN;
3848 button_state |= MMOUSE;
3850 else if (button_state & MMOUSE)
3852 /* Ignore button event if we've already generated a
3853 middle mouse down event. This happens if the
3854 user releases and press one of the two buttons
3855 after we've faked a middle mouse event. */
3856 return 0;
3858 else
3860 /* Flush out saved message. */
3861 post_msg (&saved_mouse_button_msg);
3863 wmsg.dwModifiers = w32_get_modifiers ();
3864 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3865 signal_user_input ();
3867 /* Clear message buffer. */
3868 saved_mouse_button_msg.msg.hwnd = 0;
3870 else
3872 /* Hold onto message for now. */
3873 mouse_button_timer =
3874 SetTimer (hwnd, MOUSE_BUTTON_ID,
3875 w32_mouse_button_tolerance, NULL);
3876 saved_mouse_button_msg.msg.hwnd = hwnd;
3877 saved_mouse_button_msg.msg.message = msg;
3878 saved_mouse_button_msg.msg.wParam = wParam;
3879 saved_mouse_button_msg.msg.lParam = lParam;
3880 saved_mouse_button_msg.msg.time = GetMessageTime ();
3881 saved_mouse_button_msg.dwModifiers = w32_get_modifiers ();
3884 return 0;
3886 case WM_LBUTTONUP:
3887 case WM_RBUTTONUP:
3888 if (w32_num_mouse_buttons > 2)
3889 goto handle_plain_button;
3892 int this = (msg == WM_LBUTTONUP) ? LMOUSE : RMOUSE;
3893 int other = (msg == WM_LBUTTONUP) ? RMOUSE : LMOUSE;
3895 if ((button_state & this) == 0)
3896 return 0;
3898 button_state &= ~this;
3900 if (button_state & MMOUSE)
3902 /* Only generate event when second button is released. */
3903 if ((button_state & other) == 0)
3905 msg = WM_MBUTTONUP;
3906 button_state &= ~MMOUSE;
3908 if (button_state) emacs_abort ();
3910 else
3911 return 0;
3913 else
3915 /* Flush out saved message if necessary. */
3916 if (saved_mouse_button_msg.msg.hwnd)
3918 post_msg (&saved_mouse_button_msg);
3921 wmsg.dwModifiers = w32_get_modifiers ();
3922 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3923 signal_user_input ();
3925 /* Always clear message buffer and cancel timer. */
3926 saved_mouse_button_msg.msg.hwnd = 0;
3927 KillTimer (hwnd, mouse_button_timer);
3928 mouse_button_timer = 0;
3930 if (button_state == 0)
3931 ReleaseCapture ();
3933 return 0;
3935 case WM_XBUTTONDOWN:
3936 case WM_XBUTTONUP:
3937 if (w32_pass_extra_mouse_buttons_to_system)
3938 goto dflt;
3939 /* else fall through and process them. */
3940 case WM_MBUTTONDOWN:
3941 case WM_MBUTTONUP:
3942 handle_plain_button:
3944 BOOL up;
3945 int button;
3947 /* Ignore middle and extra buttons as long as the menu is active. */
3948 f = x_window_to_frame (dpyinfo, hwnd);
3949 if (f && f->output_data.w32->menubar_active)
3950 return 0;
3952 if (parse_button (msg, HIWORD (wParam), &button, &up))
3954 if (up) ReleaseCapture ();
3955 else SetCapture (hwnd);
3956 button = (button == 0) ? LMOUSE :
3957 ((button == 1) ? MMOUSE : RMOUSE);
3958 if (up)
3959 button_state &= ~button;
3960 else
3961 button_state |= button;
3965 wmsg.dwModifiers = w32_get_modifiers ();
3966 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3967 signal_user_input ();
3969 /* Need to return true for XBUTTON messages, false for others,
3970 to indicate that we processed the message. */
3971 return (msg == WM_XBUTTONDOWN || msg == WM_XBUTTONUP);
3973 case WM_MOUSEMOVE:
3974 f = x_window_to_frame (dpyinfo, hwnd);
3975 if (f)
3977 /* Ignore mouse movements as long as the menu is active.
3978 These movements are processed by the window manager
3979 anyway, and it's wrong to handle them as if they happened
3980 on the underlying frame. */
3981 if (f->output_data.w32->menubar_active)
3982 return 0;
3984 /* If the mouse moved, and the mouse pointer is invisible,
3985 make it visible again. We do this here so as to be able
3986 to show the mouse pointer even when the main
3987 (a.k.a. "Lisp") thread is busy doing something. */
3988 static int last_x, last_y;
3989 int x = GET_X_LPARAM (lParam);
3990 int y = GET_Y_LPARAM (lParam);
3992 if (f->pointer_invisible
3993 && (x != last_x || y != last_y))
3994 f->pointer_invisible = false;
3996 last_x = x;
3997 last_y = y;
4000 /* If the mouse has just moved into the frame, start tracking
4001 it, so we will be notified when it leaves the frame. Mouse
4002 tracking only works under W98 and NT4 and later. On earlier
4003 versions, there is no way of telling when the mouse leaves the
4004 frame, so we just have to put up with help-echo and mouse
4005 highlighting remaining while the frame is not active. */
4006 if (track_mouse_event_fn && !track_mouse_window
4007 /* If the menu bar is active, turning on tracking of mouse
4008 movement events might send these events to the tooltip
4009 frame, if the user happens to move the mouse pointer over
4010 the tooltip. But since we don't process events for
4011 tooltip frames, this causes Windows to present a
4012 hourglass cursor, which is ugly and unexpected. So don't
4013 enable tracking mouse events in this case; they will be
4014 restarted when the menu pops down. (Confusingly, the
4015 menubar_active member of f->output_data.w32, tested
4016 above, is only set when a menu was popped up _not_ from
4017 the frame's menu bar, but via x-popup-menu.) */
4018 && !menubar_in_use)
4020 TRACKMOUSEEVENT tme;
4021 tme.cbSize = sizeof (tme);
4022 tme.dwFlags = TME_LEAVE;
4023 tme.hwndTrack = hwnd;
4024 tme.dwHoverTime = HOVER_DEFAULT;
4026 track_mouse_event_fn (&tme);
4027 track_mouse_window = hwnd;
4029 case WM_HSCROLL:
4030 case WM_VSCROLL:
4031 if (w32_mouse_move_interval <= 0
4032 || (msg == WM_MOUSEMOVE && button_state == 0))
4034 wmsg.dwModifiers = w32_get_modifiers ();
4035 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4036 return 0;
4039 /* Hang onto mouse move and scroll messages for a bit, to avoid
4040 sending such events to Emacs faster than it can process them.
4041 If we get more events before the timer from the first message
4042 expires, we just replace the first message. */
4044 if (saved_mouse_move_msg.msg.hwnd == 0)
4045 mouse_move_timer =
4046 SetTimer (hwnd, MOUSE_MOVE_ID,
4047 w32_mouse_move_interval, NULL);
4049 /* Hold onto message for now. */
4050 saved_mouse_move_msg.msg.hwnd = hwnd;
4051 saved_mouse_move_msg.msg.message = msg;
4052 saved_mouse_move_msg.msg.wParam = wParam;
4053 saved_mouse_move_msg.msg.lParam = lParam;
4054 saved_mouse_move_msg.msg.time = GetMessageTime ();
4055 saved_mouse_move_msg.dwModifiers = w32_get_modifiers ();
4057 return 0;
4059 case WM_MOUSEWHEEL:
4060 case WM_DROPFILES:
4061 wmsg.dwModifiers = w32_get_modifiers ();
4062 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4063 signal_user_input ();
4064 return 0;
4066 case WM_APPCOMMAND:
4067 if (w32_pass_multimedia_buttons_to_system)
4068 goto dflt;
4069 /* Otherwise, pass to lisp, the same way we do with mousehwheel. */
4070 case WM_MOUSEHWHEEL:
4071 wmsg.dwModifiers = w32_get_modifiers ();
4072 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4073 signal_user_input ();
4074 /* Non-zero must be returned when WM_MOUSEHWHEEL messages are
4075 handled, to prevent the system trying to handle it by faking
4076 scroll bar events. */
4077 return 1;
4079 case WM_TIMER:
4080 /* Flush out saved messages if necessary. */
4081 if (wParam == mouse_button_timer)
4083 if (saved_mouse_button_msg.msg.hwnd)
4085 post_msg (&saved_mouse_button_msg);
4086 signal_user_input ();
4087 saved_mouse_button_msg.msg.hwnd = 0;
4089 KillTimer (hwnd, mouse_button_timer);
4090 mouse_button_timer = 0;
4092 else if (wParam == mouse_move_timer)
4094 if (saved_mouse_move_msg.msg.hwnd)
4096 post_msg (&saved_mouse_move_msg);
4097 saved_mouse_move_msg.msg.hwnd = 0;
4099 KillTimer (hwnd, mouse_move_timer);
4100 mouse_move_timer = 0;
4102 else if (wParam == menu_free_timer)
4104 KillTimer (hwnd, menu_free_timer);
4105 menu_free_timer = 0;
4106 f = x_window_to_frame (dpyinfo, hwnd);
4107 /* If a popup menu is active, don't wipe its strings. */
4108 if (menubar_in_use
4109 && current_popup_menu == NULL)
4111 /* Free memory used by owner-drawn and help-echo strings. */
4112 w32_free_menu_strings (hwnd);
4113 if (f)
4114 f->output_data.w32->menubar_active = 0;
4115 menubar_in_use = 0;
4118 return 0;
4120 case WM_NCACTIVATE:
4121 /* Windows doesn't send us focus messages when putting up and
4122 taking down a system popup dialog as for Ctrl-Alt-Del on Windows 95.
4123 The only indication we get that something happened is receiving
4124 this message afterwards. So this is a good time to reset our
4125 keyboard modifiers' state. */
4126 reset_modifiers ();
4127 goto dflt;
4129 case WM_INITMENU:
4130 button_state = 0;
4131 ReleaseCapture ();
4132 /* We must ensure menu bar is fully constructed and up to date
4133 before allowing user interaction with it. To achieve this
4134 we send this message to the lisp thread and wait for a
4135 reply (whose value is not actually needed) to indicate that
4136 the menu bar is now ready for use, so we can now return.
4138 To remain responsive in the meantime, we enter a nested message
4139 loop that can process all other messages.
4141 However, we skip all this if the message results from calling
4142 TrackPopupMenu - in fact, we must NOT attempt to send the lisp
4143 thread a message because it is blocked on us at this point. We
4144 set menubar_active before calling TrackPopupMenu to indicate
4145 this (there is no possibility of confusion with real menubar
4146 being active). */
4148 f = x_window_to_frame (dpyinfo, hwnd);
4149 if (f
4150 && (f->output_data.w32->menubar_active
4151 /* We can receive this message even in the absence of a
4152 menubar (ie. when the system menu is activated) - in this
4153 case we do NOT want to forward the message, otherwise it
4154 will cause the menubar to suddenly appear when the user
4155 had requested it to be turned off! */
4156 || f->output_data.w32->menubar_widget == NULL))
4157 return 0;
4160 deferred_msg msg_buf;
4162 /* Detect if message has already been deferred; in this case
4163 we cannot return any sensible value to ignore this. */
4164 if (find_deferred_msg (hwnd, msg) != NULL)
4165 emacs_abort ();
4167 menubar_in_use = 1;
4169 return send_deferred_msg (&msg_buf, hwnd, msg, wParam, lParam);
4172 case WM_EXITMENULOOP:
4173 f = x_window_to_frame (dpyinfo, hwnd);
4175 /* If a menu is still active, check again after a short delay,
4176 since Windows often (always?) sends the WM_EXITMENULOOP
4177 before the corresponding WM_COMMAND message.
4178 Don't do this if a popup menu is active, since it is only
4179 menubar menus that require cleaning up in this way.
4181 if (f && menubar_in_use && current_popup_menu == NULL)
4182 menu_free_timer = SetTimer (hwnd, MENU_FREE_ID, MENU_FREE_DELAY, NULL);
4184 /* If hourglass cursor should be displayed, display it now. */
4185 if (f && f->output_data.w32->hourglass_p)
4186 SetCursor (f->output_data.w32->hourglass_cursor);
4188 goto dflt;
4190 case WM_MENUSELECT:
4191 /* Direct handling of help_echo in menus. Should be safe now
4192 that we generate the help_echo by placing a help event in the
4193 keyboard buffer. */
4195 HMENU menu = (HMENU) lParam;
4196 UINT menu_item = (UINT) LOWORD (wParam);
4197 UINT flags = (UINT) HIWORD (wParam);
4199 w32_menu_display_help (hwnd, menu, menu_item, flags);
4201 return 0;
4203 case WM_MEASUREITEM:
4204 f = x_window_to_frame (dpyinfo, hwnd);
4205 if (f)
4207 MEASUREITEMSTRUCT * pMis = (MEASUREITEMSTRUCT *) lParam;
4209 if (pMis->CtlType == ODT_MENU)
4211 /* Work out dimensions for popup menu titles. */
4212 char * title = (char *) pMis->itemData;
4213 HDC hdc = GetDC (hwnd);
4214 HFONT menu_font = GetCurrentObject (hdc, OBJ_FONT);
4215 LOGFONT menu_logfont;
4216 HFONT old_font;
4217 SIZE size;
4219 GetObject (menu_font, sizeof (menu_logfont), &menu_logfont);
4220 menu_logfont.lfWeight = FW_BOLD;
4221 menu_font = CreateFontIndirect (&menu_logfont);
4222 old_font = SelectObject (hdc, menu_font);
4224 pMis->itemHeight = GetSystemMetrics (SM_CYMENUSIZE);
4225 if (title)
4227 if (unicode_append_menu)
4228 GetTextExtentPoint32W (hdc, (WCHAR *) title,
4229 wcslen ((WCHAR *) title),
4230 &size);
4231 else
4232 GetTextExtentPoint32 (hdc, title, strlen (title), &size);
4234 pMis->itemWidth = size.cx;
4235 if (pMis->itemHeight < size.cy)
4236 pMis->itemHeight = size.cy;
4238 else
4239 pMis->itemWidth = 0;
4241 SelectObject (hdc, old_font);
4242 DeleteObject (menu_font);
4243 ReleaseDC (hwnd, hdc);
4244 return TRUE;
4247 return 0;
4249 case WM_DRAWITEM:
4250 f = x_window_to_frame (dpyinfo, hwnd);
4251 if (f)
4253 DRAWITEMSTRUCT * pDis = (DRAWITEMSTRUCT *) lParam;
4255 if (pDis->CtlType == ODT_MENU)
4257 /* Draw popup menu title. */
4258 char * title = (char *) pDis->itemData;
4259 if (title)
4261 HDC hdc = pDis->hDC;
4262 HFONT menu_font = GetCurrentObject (hdc, OBJ_FONT);
4263 LOGFONT menu_logfont;
4264 HFONT old_font;
4266 GetObject (menu_font, sizeof (menu_logfont), &menu_logfont);
4267 menu_logfont.lfWeight = FW_BOLD;
4268 menu_font = CreateFontIndirect (&menu_logfont);
4269 old_font = SelectObject (hdc, menu_font);
4271 /* Always draw title as if not selected. */
4272 if (unicode_append_menu)
4273 ExtTextOutW (hdc,
4274 pDis->rcItem.left
4275 + GetSystemMetrics (SM_CXMENUCHECK),
4276 pDis->rcItem.top,
4277 ETO_OPAQUE, &pDis->rcItem,
4278 (WCHAR *) title,
4279 wcslen ((WCHAR *) title), NULL);
4280 else
4281 ExtTextOut (hdc,
4282 pDis->rcItem.left
4283 + GetSystemMetrics (SM_CXMENUCHECK),
4284 pDis->rcItem.top,
4285 ETO_OPAQUE, &pDis->rcItem,
4286 title, strlen (title), NULL);
4288 SelectObject (hdc, old_font);
4289 DeleteObject (menu_font);
4291 return TRUE;
4294 return 0;
4296 #if 0
4297 /* Still not right - can't distinguish between clicks in the
4298 client area of the frame from clicks forwarded from the scroll
4299 bars - may have to hook WM_NCHITTEST to remember the mouse
4300 position and then check if it is in the client area ourselves. */
4301 case WM_MOUSEACTIVATE:
4302 /* Discard the mouse click that activates a frame, allowing the
4303 user to click anywhere without changing point (or worse!).
4304 Don't eat mouse clicks on scrollbars though!! */
4305 if (LOWORD (lParam) == HTCLIENT )
4306 return MA_ACTIVATEANDEAT;
4307 goto dflt;
4308 #endif
4310 case WM_MOUSELEAVE:
4311 /* No longer tracking mouse. */
4312 track_mouse_window = NULL;
4314 case WM_ACTIVATEAPP:
4315 case WM_ACTIVATE:
4316 case WM_WINDOWPOSCHANGED:
4317 case WM_SHOWWINDOW:
4318 /* Inform lisp thread that a frame might have just been obscured
4319 or exposed, so should recheck visibility of all frames. */
4320 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4321 goto dflt;
4323 case WM_SETFOCUS:
4324 dpyinfo->faked_key = 0;
4325 reset_modifiers ();
4326 register_hot_keys (hwnd);
4327 goto command;
4328 case WM_KILLFOCUS:
4329 unregister_hot_keys (hwnd);
4330 button_state = 0;
4331 ReleaseCapture ();
4332 /* Relinquish the system caret. */
4333 if (w32_system_caret_hwnd)
4335 w32_visible_system_caret_hwnd = NULL;
4336 w32_system_caret_hwnd = NULL;
4337 DestroyCaret ();
4339 goto command;
4340 case WM_COMMAND:
4341 menubar_in_use = 0;
4342 f = x_window_to_frame (dpyinfo, hwnd);
4343 if (f && HIWORD (wParam) == 0)
4345 if (menu_free_timer)
4347 KillTimer (hwnd, menu_free_timer);
4348 menu_free_timer = 0;
4351 case WM_MOVE:
4352 case WM_SIZE:
4353 command:
4354 wmsg.dwModifiers = w32_get_modifiers ();
4355 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4356 goto dflt;
4358 case WM_DESTROY:
4359 CoUninitialize ();
4360 return 0;
4362 case WM_CLOSE:
4363 wmsg.dwModifiers = w32_get_modifiers ();
4364 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4365 return 0;
4367 case WM_WINDOWPOSCHANGING:
4368 /* Don't restrict the sizing of any kind of frames. If the window
4369 manager doesn't, there's no reason to do it ourselves. */
4370 #if 0
4371 if (frame_resize_pixelwise || hwnd == tip_window)
4372 #endif
4373 return 0;
4375 #if 0
4376 /* Don't restrict the sizing of fullscreened frames, allowing them to be
4377 flush with the sides of the screen. */
4378 f = x_window_to_frame (dpyinfo, hwnd);
4379 if (f && FRAME_PREV_FSMODE (f) != FULLSCREEN_NONE)
4380 return 0;
4383 WINDOWPLACEMENT wp;
4384 LPWINDOWPOS lppos = (WINDOWPOS *) lParam;
4386 wp.length = sizeof (WINDOWPLACEMENT);
4387 GetWindowPlacement (hwnd, &wp);
4389 if (wp.showCmd != SW_SHOWMAXIMIZED && wp.showCmd != SW_SHOWMINIMIZED
4390 && (lppos->flags & SWP_NOSIZE) == 0)
4392 RECT rect;
4393 int wdiff;
4394 int hdiff;
4395 DWORD font_width;
4396 DWORD line_height;
4397 DWORD internal_border;
4398 DWORD vscrollbar_extra;
4399 DWORD hscrollbar_extra;
4400 RECT wr;
4402 wp.length = sizeof (wp);
4403 GetWindowRect (hwnd, &wr);
4405 enter_crit ();
4407 font_width = GetWindowLong (hwnd, WND_FONTWIDTH_INDEX);
4408 line_height = GetWindowLong (hwnd, WND_LINEHEIGHT_INDEX);
4409 internal_border = GetWindowLong (hwnd, WND_BORDER_INDEX);
4410 vscrollbar_extra = GetWindowLong (hwnd, WND_VSCROLLBAR_INDEX);
4411 hscrollbar_extra = GetWindowLong (hwnd, WND_HSCROLLBAR_INDEX);
4413 leave_crit ();
4415 memset (&rect, 0, sizeof (rect));
4416 AdjustWindowRect (&rect, GetWindowLong (hwnd, GWL_STYLE),
4417 GetMenu (hwnd) != NULL);
4419 /* Force width and height of client area to be exact
4420 multiples of the character cell dimensions. */
4421 wdiff = (lppos->cx - (rect.right - rect.left)
4422 - 2 * internal_border - vscrollbar_extra)
4423 % font_width;
4424 hdiff = (lppos->cy - (rect.bottom - rect.top)
4425 - 2 * internal_border - hscrollbar_extra)
4426 % line_height;
4428 if (wdiff || hdiff)
4430 /* For right/bottom sizing we can just fix the sizes.
4431 However for top/left sizing we will need to fix the X
4432 and Y positions as well. */
4434 int cx_mintrack = GetSystemMetrics (SM_CXMINTRACK);
4435 int cy_mintrack = GetSystemMetrics (SM_CYMINTRACK);
4437 lppos->cx = max (lppos->cx - wdiff, cx_mintrack);
4438 lppos->cy = max (lppos->cy - hdiff, cy_mintrack);
4440 if (wp.showCmd != SW_SHOWMAXIMIZED
4441 && (lppos->flags & SWP_NOMOVE) == 0)
4443 if (lppos->x != wr.left || lppos->y != wr.top)
4445 lppos->x += wdiff;
4446 lppos->y += hdiff;
4448 else
4450 lppos->flags |= SWP_NOMOVE;
4454 return 0;
4459 goto dflt;
4460 #endif
4462 case WM_GETMINMAXINFO:
4463 /* Hack to allow resizing the Emacs frame above the screen size.
4464 Note that Windows 9x limits coordinates to 16-bits. */
4465 ((LPMINMAXINFO) lParam)->ptMaxTrackSize.x = 32767;
4466 ((LPMINMAXINFO) lParam)->ptMaxTrackSize.y = 32767;
4467 return 0;
4469 case WM_SETCURSOR:
4470 if (LOWORD (lParam) == HTCLIENT)
4472 f = x_window_to_frame (dpyinfo, hwnd);
4473 if (f)
4475 if (f->output_data.w32->hourglass_p
4476 && !menubar_in_use && !current_popup_menu)
4477 SetCursor (f->output_data.w32->hourglass_cursor);
4478 else if (f->pointer_invisible)
4479 SetCursor (NULL);
4480 else
4481 SetCursor (f->output_data.w32->current_cursor);
4484 return 0;
4486 goto dflt;
4488 case WM_EMACS_SETCURSOR:
4490 Cursor cursor = (Cursor) wParam;
4491 f = x_window_to_frame (dpyinfo, hwnd);
4492 if (f && cursor)
4494 f->output_data.w32->current_cursor = cursor;
4495 /* Don't change the cursor while menu-bar menu is in use. */
4496 if (!f->output_data.w32->menubar_active
4497 && !f->output_data.w32->hourglass_p)
4499 if (f->pointer_invisible)
4500 SetCursor (NULL);
4501 else
4502 SetCursor (cursor);
4505 return 0;
4508 case WM_EMACS_SHOWCURSOR:
4510 ShowCursor ((BOOL) wParam);
4512 return 0;
4515 case WM_EMACS_CREATEVSCROLLBAR:
4516 return (LRESULT) w32_createvscrollbar ((struct frame *) wParam,
4517 (struct scroll_bar *) lParam);
4519 case WM_EMACS_CREATEHSCROLLBAR:
4520 return (LRESULT) w32_createhscrollbar ((struct frame *) wParam,
4521 (struct scroll_bar *) lParam);
4523 case WM_EMACS_SHOWWINDOW:
4524 return ShowWindow ((HWND) wParam, (WPARAM) lParam);
4526 case WM_EMACS_BRINGTOTOP:
4527 case WM_EMACS_SETFOREGROUND:
4529 HWND foreground_window;
4530 DWORD foreground_thread, retval;
4532 /* On NT 5.0, and apparently Windows 98, it is necessary to
4533 attach to the thread that currently has focus in order to
4534 pull the focus away from it. */
4535 foreground_window = GetForegroundWindow ();
4536 foreground_thread = GetWindowThreadProcessId (foreground_window, NULL);
4537 if (!foreground_window
4538 || foreground_thread == GetCurrentThreadId ()
4539 || !AttachThreadInput (GetCurrentThreadId (),
4540 foreground_thread, TRUE))
4541 foreground_thread = 0;
4543 retval = SetForegroundWindow ((HWND) wParam);
4544 if (msg == WM_EMACS_BRINGTOTOP)
4545 retval = BringWindowToTop ((HWND) wParam);
4547 /* Detach from the previous foreground thread. */
4548 if (foreground_thread)
4549 AttachThreadInput (GetCurrentThreadId (),
4550 foreground_thread, FALSE);
4552 return retval;
4555 case WM_EMACS_SETWINDOWPOS:
4557 WINDOWPOS * pos = (WINDOWPOS *) wParam;
4558 return SetWindowPos (hwnd, pos->hwndInsertAfter,
4559 pos->x, pos->y, pos->cx, pos->cy, pos->flags);
4562 case WM_EMACS_DESTROYWINDOW:
4563 DragAcceptFiles ((HWND) wParam, FALSE);
4564 return DestroyWindow ((HWND) wParam);
4566 case WM_EMACS_HIDE_CARET:
4567 return HideCaret (hwnd);
4569 case WM_EMACS_SHOW_CARET:
4570 return ShowCaret (hwnd);
4572 case WM_EMACS_DESTROY_CARET:
4573 w32_system_caret_hwnd = NULL;
4574 w32_visible_system_caret_hwnd = NULL;
4575 return DestroyCaret ();
4577 case WM_EMACS_TRACK_CARET:
4578 /* If there is currently no system caret, create one. */
4579 if (w32_system_caret_hwnd == NULL)
4581 /* Use the default caret width, and avoid changing it
4582 unnecessarily, as it confuses screen reader software. */
4583 w32_system_caret_hwnd = hwnd;
4584 CreateCaret (hwnd, NULL, 0,
4585 w32_system_caret_height);
4588 if (!SetCaretPos (w32_system_caret_x, w32_system_caret_y))
4589 return 0;
4590 /* Ensure visible caret gets turned on when requested. */
4591 else if (w32_use_visible_system_caret
4592 && w32_visible_system_caret_hwnd != hwnd)
4594 w32_visible_system_caret_hwnd = hwnd;
4595 return ShowCaret (hwnd);
4597 /* Ensure visible caret gets turned off when requested. */
4598 else if (!w32_use_visible_system_caret
4599 && w32_visible_system_caret_hwnd)
4601 w32_visible_system_caret_hwnd = NULL;
4602 return HideCaret (hwnd);
4604 else
4605 return 1;
4607 case WM_EMACS_TRACKPOPUPMENU:
4609 UINT flags;
4610 POINT *pos;
4611 int retval;
4612 pos = (POINT *)lParam;
4613 flags = TPM_CENTERALIGN;
4614 if (button_state & LMOUSE)
4615 flags |= TPM_LEFTBUTTON;
4616 else if (button_state & RMOUSE)
4617 flags |= TPM_RIGHTBUTTON;
4619 /* Remember we did a SetCapture on the initial mouse down event,
4620 so for safety, we make sure the capture is canceled now. */
4621 ReleaseCapture ();
4622 button_state = 0;
4624 /* Use menubar_active to indicate that WM_INITMENU is from
4625 TrackPopupMenu below, and should be ignored. */
4626 f = x_window_to_frame (dpyinfo, hwnd);
4627 if (f)
4628 f->output_data.w32->menubar_active = 1;
4630 if (TrackPopupMenu ((HMENU)wParam, flags, pos->x, pos->y,
4631 0, hwnd, NULL))
4633 MSG amsg;
4634 /* Eat any mouse messages during popupmenu */
4635 while (PeekMessage (&amsg, hwnd, WM_MOUSEFIRST, WM_MOUSELAST,
4636 PM_REMOVE));
4637 /* Get the menu selection, if any */
4638 if (PeekMessage (&amsg, hwnd, WM_COMMAND, WM_COMMAND, PM_REMOVE))
4640 retval = LOWORD (amsg.wParam);
4642 else
4644 retval = 0;
4647 else
4649 retval = -1;
4652 return retval;
4654 case WM_EMACS_FILENOTIFY:
4655 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4656 return 1;
4658 default:
4659 /* Check for messages registered at runtime. */
4660 if (msg == msh_mousewheel)
4662 wmsg.dwModifiers = w32_get_modifiers ();
4663 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4664 signal_user_input ();
4665 return 0;
4668 dflt:
4669 return (w32_unicode_gui ? DefWindowProcW : DefWindowProcA) (hwnd, msg, wParam, lParam);
4672 /* The most common default return code for handled messages is 0. */
4673 return 0;
4676 static void
4677 my_create_window (struct frame * f)
4679 MSG msg;
4680 static int coords[2];
4681 Lisp_Object left, top;
4682 struct w32_display_info *dpyinfo = &one_w32_display_info;
4684 /* When called with RES_TYPE_NUMBER, x_get_arg will return zero for
4685 anything that is not a number and is not Qunbound. */
4686 left = x_get_arg (dpyinfo, Qnil, Qleft, "left", "Left", RES_TYPE_NUMBER);
4687 top = x_get_arg (dpyinfo, Qnil, Qtop, "top", "Top", RES_TYPE_NUMBER);
4688 if (EQ (left, Qunbound))
4689 coords[0] = CW_USEDEFAULT;
4690 else
4691 coords[0] = XINT (left);
4692 if (EQ (top, Qunbound))
4693 coords[1] = CW_USEDEFAULT;
4694 else
4695 coords[1] = XINT (top);
4697 if (!PostThreadMessage (dwWindowsThreadId, WM_EMACS_CREATEWINDOW,
4698 (WPARAM)f, (LPARAM)coords))
4699 emacs_abort ();
4700 GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE);
4704 /* Create a tooltip window. Unlike my_create_window, we do not do this
4705 indirectly via the Window thread, as we do not need to process Window
4706 messages for the tooltip. Creating tooltips indirectly also creates
4707 deadlocks when tooltips are created for menu items. */
4708 static void
4709 my_create_tip_window (struct frame *f)
4711 RECT rect;
4713 rect.left = rect.top = 0;
4714 rect.right = FRAME_PIXEL_WIDTH (f);
4715 rect.bottom = FRAME_PIXEL_HEIGHT (f);
4717 AdjustWindowRect (&rect, f->output_data.w32->dwStyle,
4718 FRAME_EXTERNAL_MENU_BAR (f));
4720 tip_window = FRAME_W32_WINDOW (f)
4721 = CreateWindow (EMACS_CLASS,
4722 f->namebuf,
4723 f->output_data.w32->dwStyle,
4724 f->left_pos,
4725 f->top_pos,
4726 rect.right - rect.left,
4727 rect.bottom - rect.top,
4728 FRAME_W32_WINDOW (SELECTED_FRAME ()), /* owner */
4729 NULL,
4730 hinst,
4731 NULL);
4733 if (tip_window)
4735 SetWindowLong (tip_window, WND_FONTWIDTH_INDEX, FRAME_COLUMN_WIDTH (f));
4736 SetWindowLong (tip_window, WND_LINEHEIGHT_INDEX, FRAME_LINE_HEIGHT (f));
4737 SetWindowLong (tip_window, WND_BORDER_INDEX, FRAME_INTERNAL_BORDER_WIDTH (f));
4738 SetWindowLong (tip_window, WND_BACKGROUND_INDEX, FRAME_BACKGROUND_PIXEL (f));
4740 /* Tip frames have no scrollbars. */
4741 SetWindowLong (tip_window, WND_VSCROLLBAR_INDEX, 0);
4742 SetWindowLong (tip_window, WND_HSCROLLBAR_INDEX, 0);
4744 /* Do this to discard the default setting specified by our parent. */
4745 ShowWindow (tip_window, SW_HIDE);
4750 /* Create and set up the w32 window for frame F. */
4752 static void
4753 w32_window (struct frame *f, long window_prompting, bool minibuffer_only)
4755 block_input ();
4757 /* Use the resource name as the top-level window name
4758 for looking up resources. Make a non-Lisp copy
4759 for the window manager, so GC relocation won't bother it.
4761 Elsewhere we specify the window name for the window manager. */
4762 f->namebuf = xlispstrdup (Vx_resource_name);
4764 my_create_window (f);
4766 validate_x_resource_name ();
4768 /* x_set_name normally ignores requests to set the name if the
4769 requested name is the same as the current name. This is the one
4770 place where that assumption isn't correct; f->name is set, but
4771 the server hasn't been told. */
4773 Lisp_Object name;
4774 int explicit = f->explicit_name;
4776 f->explicit_name = 0;
4777 name = f->name;
4778 fset_name (f, Qnil);
4779 x_set_name (f, name, explicit);
4782 unblock_input ();
4784 if (!minibuffer_only && FRAME_EXTERNAL_MENU_BAR (f))
4785 initialize_frame_menubar (f);
4787 if (FRAME_W32_WINDOW (f) == 0)
4788 error ("Unable to create window");
4791 /* Handle the icon stuff for this window. Perhaps later we might
4792 want an x_set_icon_position which can be called interactively as
4793 well. */
4795 static void
4796 x_icon (struct frame *f, Lisp_Object parms)
4798 Lisp_Object icon_x, icon_y;
4799 struct w32_display_info *dpyinfo = &one_w32_display_info;
4801 /* Set the position of the icon. Note that Windows 95 groups all
4802 icons in the tray. */
4803 icon_x = x_get_arg (dpyinfo, parms, Qicon_left, 0, 0, RES_TYPE_NUMBER);
4804 icon_y = x_get_arg (dpyinfo, parms, Qicon_top, 0, 0, RES_TYPE_NUMBER);
4805 if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
4807 CHECK_NUMBER (icon_x);
4808 CHECK_NUMBER (icon_y);
4810 else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
4811 error ("Both left and top icon corners of icon must be specified");
4813 block_input ();
4815 #if 0 /* TODO */
4816 /* Start up iconic or window? */
4817 x_wm_set_window_state
4818 (f, (EQ (x_get_arg (dpyinfo, parms, Qvisibility, 0, 0, RES_TYPE_SYMBOL), Qicon)
4819 ? IconicState
4820 : NormalState));
4822 x_text_icon (f, SSDATA ((!NILP (f->icon_name)
4823 ? f->icon_name
4824 : f->name)));
4825 #endif
4827 unblock_input ();
4831 static void
4832 x_make_gc (struct frame *f)
4834 XGCValues gc_values;
4836 block_input ();
4838 /* Create the GC's of this frame.
4839 Note that many default values are used. */
4841 /* Normal video */
4842 gc_values.font = FRAME_FONT (f);
4844 /* Cursor has cursor-color background, background-color foreground. */
4845 gc_values.foreground = FRAME_BACKGROUND_PIXEL (f);
4846 gc_values.background = f->output_data.w32->cursor_pixel;
4847 f->output_data.w32->cursor_gc
4848 = XCreateGC (NULL, FRAME_W32_WINDOW (f),
4849 (GCFont | GCForeground | GCBackground),
4850 &gc_values);
4852 /* Reliefs. */
4853 f->output_data.w32->white_relief.gc = 0;
4854 f->output_data.w32->black_relief.gc = 0;
4856 unblock_input ();
4860 /* Handler for signals raised during x_create_frame and
4861 x_create_tip_frame. FRAME is the frame which is partially
4862 constructed. */
4864 static Lisp_Object
4865 unwind_create_frame (Lisp_Object frame)
4867 struct frame *f = XFRAME (frame);
4869 /* If frame is ``official'', nothing to do. */
4870 if (NILP (Fmemq (frame, Vframe_list)))
4872 #ifdef GLYPH_DEBUG
4873 struct w32_display_info *dpyinfo = FRAME_DISPLAY_INFO (f);
4875 /* If the frame's image cache refcount is still the same as our
4876 private shadow variable, it means we are unwinding a frame
4877 for which we didn't yet call init_frame_faces, where the
4878 refcount is incremented. Therefore, we increment it here, so
4879 that free_frame_faces, called in x_free_frame_resources
4880 below, will not mistakenly decrement the counter that was not
4881 incremented yet to account for this new frame. */
4882 if (FRAME_IMAGE_CACHE (f) != NULL
4883 && FRAME_IMAGE_CACHE (f)->refcount == image_cache_refcount)
4884 FRAME_IMAGE_CACHE (f)->refcount++;
4885 #endif
4887 x_free_frame_resources (f);
4888 free_glyphs (f);
4890 #ifdef GLYPH_DEBUG
4891 /* Check that reference counts are indeed correct. */
4892 eassert (dpyinfo->reference_count == dpyinfo_refcount);
4893 eassert ((dpyinfo->terminal->image_cache == NULL
4894 && image_cache_refcount == 0)
4895 || (dpyinfo->terminal->image_cache != NULL
4896 && dpyinfo->terminal->image_cache->refcount == image_cache_refcount));
4897 #endif
4898 return Qt;
4901 return Qnil;
4904 static void
4905 do_unwind_create_frame (Lisp_Object frame)
4907 unwind_create_frame (frame);
4910 static void
4911 unwind_create_frame_1 (Lisp_Object val)
4913 inhibit_lisp_code = val;
4916 static void
4917 x_default_font_parameter (struct frame *f, Lisp_Object parms)
4919 struct w32_display_info *dpyinfo = FRAME_DISPLAY_INFO (f);
4920 Lisp_Object font_param = x_get_arg (dpyinfo, parms, Qfont, NULL, NULL,
4921 RES_TYPE_STRING);
4922 Lisp_Object font;
4923 if (EQ (font_param, Qunbound))
4924 font_param = Qnil;
4925 font = !NILP (font_param) ? font_param
4926 : x_get_arg (dpyinfo, parms, Qfont, "font", "Font", RES_TYPE_STRING);
4928 if (!STRINGP (font))
4930 int i;
4931 static char *names[]
4932 = { "Courier New-10",
4933 "-*-Courier-normal-r-*-*-13-*-*-*-c-*-iso8859-1",
4934 "-*-Fixedsys-normal-r-*-*-12-*-*-*-c-*-iso8859-1",
4935 "Fixedsys",
4936 NULL };
4938 for (i = 0; names[i]; i++)
4940 font = font_open_by_name (f, build_unibyte_string (names[i]));
4941 if (! NILP (font))
4942 break;
4944 if (NILP (font))
4945 error ("No suitable font was found");
4947 else if (!NILP (font_param))
4949 /* Remember the explicit font parameter, so we can re-apply it after
4950 we've applied the `default' face settings. */
4951 x_set_frame_parameters (f, Fcons (Fcons (Qfont_param, font_param), Qnil));
4953 x_default_parameter (f, parms, Qfont, font, "font", "Font", RES_TYPE_STRING);
4956 DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
4957 1, 1, 0,
4958 doc: /* Make a new window, which is called a \"frame\" in Emacs terms.
4959 Return an Emacs frame object.
4960 PARAMETERS is an alist of frame parameters.
4961 If the parameters specify that the frame should not have a minibuffer,
4962 and do not specify a specific minibuffer window to use,
4963 then `default-minibuffer-frame' must be a frame whose minibuffer can
4964 be shared by the new frame.
4966 This function is an internal primitive--use `make-frame' instead. */)
4967 (Lisp_Object parameters)
4969 struct frame *f;
4970 Lisp_Object frame, tem;
4971 Lisp_Object name;
4972 bool minibuffer_only = false;
4973 long window_prompting = 0;
4974 ptrdiff_t count = SPECPDL_INDEX ();
4975 Lisp_Object display;
4976 struct w32_display_info *dpyinfo = NULL;
4977 Lisp_Object parent;
4978 struct kboard *kb;
4980 if (!FRAME_W32_P (SELECTED_FRAME ())
4981 && !FRAME_INITIAL_P (SELECTED_FRAME ()))
4982 error ("Cannot create a GUI frame in a -nw session");
4984 /* Make copy of frame parameters because the original is in pure
4985 storage now. */
4986 parameters = Fcopy_alist (parameters);
4988 /* Use this general default value to start with
4989 until we know if this frame has a specified name. */
4990 Vx_resource_name = Vinvocation_name;
4992 display = x_get_arg (dpyinfo, parameters, Qterminal, 0, 0, RES_TYPE_NUMBER);
4993 if (EQ (display, Qunbound))
4994 display = x_get_arg (dpyinfo, parameters, Qdisplay, 0, 0, RES_TYPE_STRING);
4995 if (EQ (display, Qunbound))
4996 display = Qnil;
4997 dpyinfo = check_x_display_info (display);
4998 kb = dpyinfo->terminal->kboard;
5000 if (!dpyinfo->terminal->name)
5001 error ("Terminal is not live, can't create new frames on it");
5003 name = x_get_arg (dpyinfo, parameters, Qname, "name", "Name", RES_TYPE_STRING);
5004 if (!STRINGP (name)
5005 && ! EQ (name, Qunbound)
5006 && ! NILP (name))
5007 error ("Invalid frame name--not a string or nil");
5009 if (STRINGP (name))
5010 Vx_resource_name = name;
5012 /* See if parent window is specified. */
5013 parent = x_get_arg (dpyinfo, parameters, Qparent_id, NULL, NULL, RES_TYPE_NUMBER);
5014 if (EQ (parent, Qunbound))
5015 parent = Qnil;
5016 if (! NILP (parent))
5017 CHECK_NUMBER (parent);
5019 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
5020 /* No need to protect DISPLAY because that's not used after passing
5021 it to make_frame_without_minibuffer. */
5022 frame = Qnil;
5023 tem = x_get_arg (dpyinfo, parameters, Qminibuffer, "minibuffer", "Minibuffer",
5024 RES_TYPE_SYMBOL);
5025 if (EQ (tem, Qnone) || NILP (tem))
5026 f = make_frame_without_minibuffer (Qnil, kb, display);
5027 else if (EQ (tem, Qonly))
5029 f = make_minibuffer_frame ();
5030 minibuffer_only = true;
5032 else if (WINDOWP (tem))
5033 f = make_frame_without_minibuffer (tem, kb, display);
5034 else
5035 f = make_frame (true);
5037 XSETFRAME (frame, f);
5039 /* By default, make scrollbars the system standard width and height. */
5040 FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = GetSystemMetrics (SM_CXVSCROLL);
5041 FRAME_CONFIG_SCROLL_BAR_HEIGHT (f) = GetSystemMetrics (SM_CXHSCROLL);
5043 f->terminal = dpyinfo->terminal;
5045 f->output_method = output_w32;
5046 f->output_data.w32 = xzalloc (sizeof (struct w32_output));
5047 FRAME_FONTSET (f) = -1;
5049 fset_icon_name
5050 (f, x_get_arg (dpyinfo, parameters, Qicon_name, "iconName", "Title",
5051 RES_TYPE_STRING));
5052 if (! STRINGP (f->icon_name))
5053 fset_icon_name (f, Qnil);
5055 /* FRAME_DISPLAY_INFO (f) = dpyinfo; */
5057 /* With FRAME_DISPLAY_INFO set up, this unwind-protect is safe. */
5058 record_unwind_protect (do_unwind_create_frame, frame);
5060 #ifdef GLYPH_DEBUG
5061 image_cache_refcount =
5062 FRAME_IMAGE_CACHE (f) ? FRAME_IMAGE_CACHE (f)->refcount : 0;
5063 dpyinfo_refcount = dpyinfo->reference_count;
5064 #endif /* GLYPH_DEBUG */
5066 /* Specify the parent under which to make this window. */
5067 if (!NILP (parent))
5069 /* Cast to UINT_PTR shuts up compiler warnings about cast to
5070 pointer from integer of different size. */
5071 f->output_data.w32->parent_desc = (Window) (UINT_PTR) XFASTINT (parent);
5072 f->output_data.w32->explicit_parent = true;
5074 else
5076 f->output_data.w32->parent_desc = FRAME_DISPLAY_INFO (f)->root_window;
5077 f->output_data.w32->explicit_parent = false;
5080 /* Set the name; the functions to which we pass f expect the name to
5081 be set. */
5082 if (EQ (name, Qunbound) || NILP (name))
5084 fset_name (f, build_string (dpyinfo->w32_id_name));
5085 f->explicit_name = false;
5087 else
5089 fset_name (f, name);
5090 f->explicit_name = true;
5091 /* Use the frame's title when getting resources for this frame. */
5092 specbind (Qx_resource_name, name);
5095 if (uniscribe_available)
5096 register_font_driver (&uniscribe_font_driver, f);
5097 register_font_driver (&w32font_driver, f);
5099 x_default_parameter (f, parameters, Qfont_backend, Qnil,
5100 "fontBackend", "FontBackend", RES_TYPE_STRING);
5102 /* Extract the window parameters from the supplied values
5103 that are needed to determine window geometry. */
5104 x_default_font_parameter (f, parameters);
5106 x_default_parameter (f, parameters, Qborder_width, make_number (2),
5107 "borderWidth", "BorderWidth", RES_TYPE_NUMBER);
5109 /* We recognize either internalBorderWidth or internalBorder
5110 (which is what xterm calls it). */
5111 if (NILP (Fassq (Qinternal_border_width, parameters)))
5113 Lisp_Object value;
5115 value = x_get_arg (dpyinfo, parameters, Qinternal_border_width,
5116 "internalBorder", "InternalBorder", RES_TYPE_NUMBER);
5117 if (! EQ (value, Qunbound))
5118 parameters = Fcons (Fcons (Qinternal_border_width, value),
5119 parameters);
5121 /* Default internalBorderWidth to 0 on Windows to match other programs. */
5122 x_default_parameter (f, parameters, Qinternal_border_width, make_number (0),
5123 "internalBorderWidth", "InternalBorder", RES_TYPE_NUMBER);
5124 x_default_parameter (f, parameters, Qright_divider_width, make_number (0),
5125 NULL, NULL, RES_TYPE_NUMBER);
5126 x_default_parameter (f, parameters, Qbottom_divider_width, make_number (0),
5127 NULL, NULL, RES_TYPE_NUMBER);
5128 x_default_parameter (f, parameters, Qvertical_scroll_bars, Qright,
5129 "verticalScrollBars", "ScrollBars", RES_TYPE_SYMBOL);
5130 x_default_parameter (f, parameters, Qhorizontal_scroll_bars, Qnil,
5131 "horizontalScrollBars", "ScrollBars", RES_TYPE_SYMBOL);
5133 /* Also do the stuff which must be set before the window exists. */
5134 x_default_parameter (f, parameters, Qforeground_color, build_string ("black"),
5135 "foreground", "Foreground", RES_TYPE_STRING);
5136 x_default_parameter (f, parameters, Qbackground_color, build_string ("white"),
5137 "background", "Background", RES_TYPE_STRING);
5138 x_default_parameter (f, parameters, Qmouse_color, build_string ("black"),
5139 "pointerColor", "Foreground", RES_TYPE_STRING);
5140 x_default_parameter (f, parameters, Qborder_color, build_string ("black"),
5141 "borderColor", "BorderColor", RES_TYPE_STRING);
5142 x_default_parameter (f, parameters, Qscreen_gamma, Qnil,
5143 "screenGamma", "ScreenGamma", RES_TYPE_FLOAT);
5144 x_default_parameter (f, parameters, Qline_spacing, Qnil,
5145 "lineSpacing", "LineSpacing", RES_TYPE_NUMBER);
5146 x_default_parameter (f, parameters, Qleft_fringe, Qnil,
5147 "leftFringe", "LeftFringe", RES_TYPE_NUMBER);
5148 x_default_parameter (f, parameters, Qright_fringe, Qnil,
5149 "rightFringe", "RightFringe", RES_TYPE_NUMBER);
5150 /* Process alpha here (Bug#16619). */
5151 x_default_parameter (f, parameters, Qalpha, Qnil,
5152 "alpha", "Alpha", RES_TYPE_NUMBER);
5154 /* Init faces first since we need the frame's column width/line
5155 height in various occasions. */
5156 init_frame_faces (f);
5158 /* The following call of change_frame_size is needed since otherwise
5159 x_set_tool_bar_lines will already work with the character sizes
5160 installed by init_frame_faces while the frame's pixel size is
5161 still calculated from a character size of 1 and we subsequently
5162 hit the (height >= 0) assertion in window_box_height.
5164 The non-pixelwise code apparently worked around this because it
5165 had one frame line vs one toolbar line which left us with a zero
5166 root window height which was obviously wrong as well ... */
5167 adjust_frame_size (f, FRAME_COLS (f) * FRAME_COLUMN_WIDTH (f),
5168 FRAME_LINES (f) * FRAME_LINE_HEIGHT (f), 5, true,
5169 Qx_create_frame_1);
5171 /* The X resources controlling the menu-bar and tool-bar are
5172 processed specially at startup, and reflected in the mode
5173 variables; ignore them here. */
5174 x_default_parameter (f, parameters, Qmenu_bar_lines,
5175 NILP (Vmenu_bar_mode)
5176 ? make_number (0) : make_number (1),
5177 NULL, NULL, RES_TYPE_NUMBER);
5178 x_default_parameter (f, parameters, Qtool_bar_lines,
5179 NILP (Vtool_bar_mode)
5180 ? make_number (0) : make_number (1),
5181 NULL, NULL, RES_TYPE_NUMBER);
5183 x_default_parameter (f, parameters, Qbuffer_predicate, Qnil,
5184 "bufferPredicate", "BufferPredicate", RES_TYPE_SYMBOL);
5185 x_default_parameter (f, parameters, Qtitle, Qnil,
5186 "title", "Title", RES_TYPE_STRING);
5188 f->output_data.w32->dwStyle = WS_OVERLAPPEDWINDOW;
5189 f->output_data.w32->parent_desc = FRAME_DISPLAY_INFO (f)->root_window;
5191 f->output_data.w32->text_cursor = w32_load_cursor (IDC_IBEAM);
5192 f->output_data.w32->nontext_cursor = w32_load_cursor (IDC_ARROW);
5193 f->output_data.w32->modeline_cursor = w32_load_cursor (IDC_ARROW);
5194 f->output_data.w32->hand_cursor = w32_load_cursor (IDC_HAND);
5195 f->output_data.w32->hourglass_cursor = w32_load_cursor (IDC_WAIT);
5196 f->output_data.w32->horizontal_drag_cursor = w32_load_cursor (IDC_SIZEWE);
5197 f->output_data.w32->vertical_drag_cursor = w32_load_cursor (IDC_SIZENS);
5199 f->output_data.w32->current_cursor = f->output_data.w32->nontext_cursor;
5201 window_prompting = x_figure_window_size (f, parameters, true);
5203 tem = x_get_arg (dpyinfo, parameters, Qunsplittable, 0, 0, RES_TYPE_BOOLEAN);
5204 f->no_split = minibuffer_only || EQ (tem, Qt);
5206 w32_window (f, window_prompting, minibuffer_only);
5207 x_icon (f, parameters);
5209 x_make_gc (f);
5211 /* Now consider the frame official. */
5212 f->terminal->reference_count++;
5213 FRAME_DISPLAY_INFO (f)->reference_count++;
5214 Vframe_list = Fcons (frame, Vframe_list);
5216 /* We need to do this after creating the window, so that the
5217 icon-creation functions can say whose icon they're describing. */
5218 x_default_parameter (f, parameters, Qicon_type, Qnil,
5219 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL);
5221 x_default_parameter (f, parameters, Qauto_raise, Qnil,
5222 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN);
5223 x_default_parameter (f, parameters, Qauto_lower, Qnil,
5224 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN);
5225 x_default_parameter (f, parameters, Qcursor_type, Qbox,
5226 "cursorType", "CursorType", RES_TYPE_SYMBOL);
5227 x_default_parameter (f, parameters, Qscroll_bar_width, Qnil,
5228 "scrollBarWidth", "ScrollBarWidth", RES_TYPE_NUMBER);
5229 x_default_parameter (f, parameters, Qscroll_bar_height, Qnil,
5230 "scrollBarHeight", "ScrollBarHeight", RES_TYPE_NUMBER);
5232 /* Allow x_set_window_size, now. */
5233 f->can_x_set_window_size = true;
5235 adjust_frame_size (f, FRAME_TEXT_WIDTH (f), FRAME_TEXT_HEIGHT (f), 0, true,
5236 Qx_create_frame_2);
5238 /* Tell the server what size and position, etc, we want, and how
5239 badly we want them. This should be done after we have the menu
5240 bar so that its size can be taken into account. */
5241 block_input ();
5242 x_wm_set_size_hint (f, window_prompting, false);
5243 unblock_input ();
5245 /* Process fullscreen parameter here in the hope that normalizing a
5246 fullheight/fullwidth frame will produce the size set by the last
5247 adjust_frame_size call. */
5248 x_default_parameter (f, parameters, Qfullscreen, Qnil,
5249 "fullscreen", "Fullscreen", RES_TYPE_SYMBOL);
5251 /* Make the window appear on the frame and enable display, unless
5252 the caller says not to. However, with explicit parent, Emacs
5253 cannot control visibility, so don't try. */
5254 if (! f->output_data.w32->explicit_parent)
5256 Lisp_Object visibility;
5258 visibility = x_get_arg (dpyinfo, parameters, Qvisibility, 0, 0, RES_TYPE_SYMBOL);
5259 if (EQ (visibility, Qunbound))
5260 visibility = Qt;
5262 if (EQ (visibility, Qicon))
5263 x_iconify_frame (f);
5264 else if (! NILP (visibility))
5265 x_make_frame_visible (f);
5266 else
5267 /* Must have been Qnil. */
5271 /* Initialize `default-minibuffer-frame' in case this is the first
5272 frame on this terminal. */
5273 if (FRAME_HAS_MINIBUF_P (f)
5274 && (!FRAMEP (KVAR (kb, Vdefault_minibuffer_frame))
5275 || !FRAME_LIVE_P (XFRAME (KVAR (kb, Vdefault_minibuffer_frame)))))
5276 kset_default_minibuffer_frame (kb, frame);
5278 /* All remaining specified parameters, which have not been "used"
5279 by x_get_arg and friends, now go in the misc. alist of the frame. */
5280 for (tem = parameters; CONSP (tem); tem = XCDR (tem))
5281 if (CONSP (XCAR (tem)) && !NILP (XCAR (XCAR (tem))))
5282 fset_param_alist (f, Fcons (XCAR (tem), f->param_alist));
5284 /* Make sure windows on this frame appear in calls to next-window
5285 and similar functions. */
5286 Vwindow_list = Qnil;
5288 return unbind_to (count, frame);
5291 /* FRAME is used only to get a handle on the X display. We don't pass the
5292 display info directly because we're called from frame.c, which doesn't
5293 know about that structure. */
5294 Lisp_Object
5295 x_get_focus_frame (struct frame *frame)
5297 struct w32_display_info *dpyinfo = FRAME_DISPLAY_INFO (frame);
5298 Lisp_Object xfocus;
5299 if (! dpyinfo->w32_focus_frame)
5300 return Qnil;
5302 XSETFRAME (xfocus, dpyinfo->w32_focus_frame);
5303 return xfocus;
5306 DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1, 2, 0,
5307 doc: /* Internal function called by `color-defined-p', which see.
5308 (Note that the Nextstep version of this function ignores FRAME.) */)
5309 (Lisp_Object color, Lisp_Object frame)
5311 XColor foo;
5312 struct frame *f = decode_window_system_frame (frame);
5314 CHECK_STRING (color);
5316 if (w32_defined_color (f, SDATA (color), &foo, false))
5317 return Qt;
5318 else
5319 return Qnil;
5322 DEFUN ("xw-color-values", Fxw_color_values, Sxw_color_values, 1, 2, 0,
5323 doc: /* Internal function called by `color-values', which see. */)
5324 (Lisp_Object color, Lisp_Object frame)
5326 XColor foo;
5327 struct frame *f = decode_window_system_frame (frame);
5329 CHECK_STRING (color);
5331 if (w32_defined_color (f, SDATA (color), &foo, false))
5332 return list3i ((GetRValue (foo.pixel) << 8) | GetRValue (foo.pixel),
5333 (GetGValue (foo.pixel) << 8) | GetGValue (foo.pixel),
5334 (GetBValue (foo.pixel) << 8) | GetBValue (foo.pixel));
5335 else
5336 return Qnil;
5339 DEFUN ("xw-display-color-p", Fxw_display_color_p, Sxw_display_color_p, 0, 1, 0,
5340 doc: /* Internal function called by `display-color-p', which see. */)
5341 (Lisp_Object display)
5343 struct w32_display_info *dpyinfo = check_x_display_info (display);
5345 if ((dpyinfo->n_planes * dpyinfo->n_cbits) <= 2)
5346 return Qnil;
5348 return Qt;
5351 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p,
5352 Sx_display_grayscale_p, 0, 1, 0,
5353 doc: /* Return t if DISPLAY supports shades of gray.
5354 Note that color displays do support shades of gray.
5355 The optional argument DISPLAY specifies which display to ask about.
5356 DISPLAY should be either a frame or a display name (a string).
5357 If omitted or nil, that stands for the selected frame's display. */)
5358 (Lisp_Object display)
5360 struct w32_display_info *dpyinfo = check_x_display_info (display);
5362 if ((dpyinfo->n_planes * dpyinfo->n_cbits) <= 1)
5363 return Qnil;
5365 return Qt;
5368 DEFUN ("x-display-pixel-width", Fx_display_pixel_width,
5369 Sx_display_pixel_width, 0, 1, 0,
5370 doc: /* Return the width in pixels of DISPLAY.
5371 The optional argument DISPLAY specifies which display to ask about.
5372 DISPLAY should be either a frame or a display name (a string).
5373 If omitted or nil, that stands for the selected frame's display.
5375 On \"multi-monitor\" setups this refers to the pixel width for all
5376 physical monitors associated with DISPLAY. To get information for
5377 each physical monitor, use `display-monitor-attributes-list'. */)
5378 (Lisp_Object display)
5380 struct w32_display_info *dpyinfo = check_x_display_info (display);
5382 return make_number (x_display_pixel_width (dpyinfo));
5385 DEFUN ("x-display-pixel-height", Fx_display_pixel_height,
5386 Sx_display_pixel_height, 0, 1, 0,
5387 doc: /* Return the height in pixels of DISPLAY.
5388 The optional argument DISPLAY specifies which display to ask about.
5389 DISPLAY should be either a frame or a display name (a string).
5390 If omitted or nil, that stands for the selected frame's display.
5392 On \"multi-monitor\" setups this refers to the pixel height for all
5393 physical monitors associated with DISPLAY. To get information for
5394 each physical monitor, use `display-monitor-attributes-list'. */)
5395 (Lisp_Object display)
5397 struct w32_display_info *dpyinfo = check_x_display_info (display);
5399 return make_number (x_display_pixel_height (dpyinfo));
5402 DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes,
5403 0, 1, 0,
5404 doc: /* Return the number of bitplanes of DISPLAY.
5405 The optional argument DISPLAY specifies which display to ask about.
5406 DISPLAY should be either a frame or a display name (a string).
5407 If omitted or nil, that stands for the selected frame's display. */)
5408 (Lisp_Object display)
5410 struct w32_display_info *dpyinfo = check_x_display_info (display);
5412 return make_number (dpyinfo->n_planes * dpyinfo->n_cbits);
5415 DEFUN ("x-display-color-cells", Fx_display_color_cells, Sx_display_color_cells,
5416 0, 1, 0,
5417 doc: /* Return the number of color cells of DISPLAY.
5418 The optional argument DISPLAY specifies which display to ask about.
5419 DISPLAY should be either a frame or a display name (a string).
5420 If omitted or nil, that stands for the selected frame's display. */)
5421 (Lisp_Object display)
5423 struct w32_display_info *dpyinfo = check_x_display_info (display);
5424 int cap;
5426 /* Don't use NCOLORS: it returns incorrect results under remote
5427 * desktop. We force 24+ bit depths to 24-bit, both to prevent an
5428 * overflow and because probably is more meaningful on Windows
5429 * anyway. */
5431 cap = 1 << min (dpyinfo->n_planes * dpyinfo->n_cbits, 24);
5432 return make_number (cap);
5435 DEFUN ("x-server-max-request-size", Fx_server_max_request_size,
5436 Sx_server_max_request_size,
5437 0, 1, 0,
5438 doc: /* Return the maximum request size of the server of DISPLAY.
5439 The optional argument DISPLAY specifies which display to ask about.
5440 DISPLAY should be either a frame or a display name (a string).
5441 If omitted or nil, that stands for the selected frame's display. */)
5442 (Lisp_Object display)
5444 return make_number (1);
5447 DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0,
5448 doc: /* Return the "vendor ID" string of the GUI software on TERMINAL.
5450 (Labeling every distributor as a "vendor" embodies the false assumption
5451 that operating systems cannot be developed and distributed noncommercially.)
5453 For GNU and Unix systems, this queries the X server software; for
5454 MS-Windows, this queries the OS.
5456 The optional argument TERMINAL specifies which display to ask about.
5457 TERMINAL should be a terminal object, a frame or a display name (a string).
5458 If omitted or nil, that stands for the selected frame's display. */)
5459 (Lisp_Object terminal)
5461 return build_string ("Microsoft Corp.");
5464 DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0,
5465 doc: /* Return the version numbers of the GUI software on TERMINAL.
5466 The value is a list of three integers specifying the version of the GUI
5467 software in use.
5469 For GNU and Unix system, the first 2 numbers are the version of the X
5470 Protocol used on TERMINAL and the 3rd number is the distributor-specific
5471 release number. For MS-Windows, the 3 numbers report the version and
5472 the build number of the OS.
5474 See also the function `x-server-vendor'.
5476 The optional argument TERMINAL specifies which display to ask about.
5477 TERMINAL should be a terminal object, a frame or a display name (a string).
5478 If omitted or nil, that stands for the selected frame's display. */)
5479 (Lisp_Object terminal)
5481 return list3i (w32_major_version, w32_minor_version, w32_build_number);
5484 DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0,
5485 doc: /* Return the number of screens on the server of DISPLAY.
5486 The optional argument DISPLAY specifies which display to ask about.
5487 DISPLAY should be either a frame or a display name (a string).
5488 If omitted or nil, that stands for the selected frame's display. */)
5489 (Lisp_Object display)
5491 return make_number (1);
5494 DEFUN ("x-display-mm-height", Fx_display_mm_height,
5495 Sx_display_mm_height, 0, 1, 0,
5496 doc: /* Return the height in millimeters of DISPLAY.
5497 The optional argument DISPLAY specifies which display to ask about.
5498 DISPLAY should be either a frame or a display name (a string).
5499 If omitted or nil, that stands for the selected frame's display.
5501 On \"multi-monitor\" setups this refers to the height in millimeters for
5502 all physical monitors associated with DISPLAY. To get information
5503 for each physical monitor, use `display-monitor-attributes-list'. */)
5504 (Lisp_Object display)
5506 struct w32_display_info *dpyinfo = check_x_display_info (display);
5507 HDC hdc;
5508 double mm_per_pixel;
5510 hdc = GetDC (NULL);
5511 mm_per_pixel = ((double) GetDeviceCaps (hdc, VERTSIZE)
5512 / GetDeviceCaps (hdc, VERTRES));
5513 ReleaseDC (NULL, hdc);
5515 return make_number (x_display_pixel_height (dpyinfo) * mm_per_pixel + 0.5);
5518 DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0,
5519 doc: /* Return the width in millimeters of DISPLAY.
5520 The optional argument DISPLAY specifies which display to ask about.
5521 DISPLAY should be either a frame or a display name (a string).
5522 If omitted or nil, that stands for the selected frame's display.
5524 On \"multi-monitor\" setups this refers to the width in millimeters for
5525 all physical monitors associated with TERMINAL. To get information
5526 for each physical monitor, use `display-monitor-attributes-list'. */)
5527 (Lisp_Object display)
5529 struct w32_display_info *dpyinfo = check_x_display_info (display);
5530 HDC hdc;
5531 double mm_per_pixel;
5533 hdc = GetDC (NULL);
5534 mm_per_pixel = ((double) GetDeviceCaps (hdc, HORZSIZE)
5535 / GetDeviceCaps (hdc, HORZRES));
5536 ReleaseDC (NULL, hdc);
5538 return make_number (x_display_pixel_width (dpyinfo) * mm_per_pixel + 0.5);
5541 DEFUN ("x-display-backing-store", Fx_display_backing_store,
5542 Sx_display_backing_store, 0, 1, 0,
5543 doc: /* Return an indication of whether DISPLAY does backing store.
5544 The value may be `always', `when-mapped', or `not-useful'.
5545 The optional argument DISPLAY specifies which display to ask about.
5546 DISPLAY should be either a frame or a display name (a string).
5547 If omitted or nil, that stands for the selected frame's display. */)
5548 (Lisp_Object display)
5550 return intern ("not-useful");
5553 DEFUN ("x-display-visual-class", Fx_display_visual_class,
5554 Sx_display_visual_class, 0, 1, 0,
5555 doc: /* Return the visual class of DISPLAY.
5556 The value is one of the symbols `static-gray', `gray-scale',
5557 `static-color', `pseudo-color', `true-color', or `direct-color'.
5559 The optional argument DISPLAY specifies which display to ask about.
5560 DISPLAY should be either a frame or a display name (a string).
5561 If omitted or nil, that stands for the selected frame's display. */)
5562 (Lisp_Object display)
5564 struct w32_display_info *dpyinfo = check_x_display_info (display);
5565 Lisp_Object result = Qnil;
5567 if (dpyinfo->has_palette)
5568 result = intern ("pseudo-color");
5569 else if (dpyinfo->n_planes * dpyinfo->n_cbits == 1)
5570 result = intern ("static-grey");
5571 else if (dpyinfo->n_planes * dpyinfo->n_cbits == 4)
5572 result = intern ("static-color");
5573 else if (dpyinfo->n_planes * dpyinfo->n_cbits > 8)
5574 result = intern ("true-color");
5576 return result;
5579 DEFUN ("x-display-save-under", Fx_display_save_under,
5580 Sx_display_save_under, 0, 1, 0,
5581 doc: /* Return t if DISPLAY supports the save-under feature.
5582 The optional argument DISPLAY specifies which display to ask about.
5583 DISPLAY should be either a frame or a display name (a string).
5584 If omitted or nil, that stands for the selected frame's display. */)
5585 (Lisp_Object display)
5587 return Qnil;
5590 static BOOL CALLBACK ALIGN_STACK
5591 w32_monitor_enum (HMONITOR monitor, HDC hdc, RECT *rcMonitor, LPARAM dwData)
5593 Lisp_Object *monitor_list = (Lisp_Object *) dwData;
5595 *monitor_list = Fcons (make_save_ptr (monitor), *monitor_list);
5597 return TRUE;
5600 static Lisp_Object
5601 w32_display_monitor_attributes_list (void)
5603 Lisp_Object attributes_list = Qnil, primary_monitor_attributes = Qnil;
5604 Lisp_Object monitor_list = Qnil, monitor_frames, rest, frame;
5605 int i, n_monitors;
5606 HMONITOR *monitors;
5608 if (!(enum_display_monitors_fn && get_monitor_info_fn
5609 && monitor_from_window_fn))
5610 return Qnil;
5612 if (!enum_display_monitors_fn (NULL, NULL, w32_monitor_enum,
5613 (LPARAM) &monitor_list)
5614 || NILP (monitor_list))
5615 return Qnil;
5617 n_monitors = 0;
5618 for (rest = monitor_list; CONSP (rest); rest = XCDR (rest))
5619 n_monitors++;
5621 monitors = xmalloc (n_monitors * sizeof (*monitors));
5622 for (i = 0; i < n_monitors; i++)
5624 monitors[i] = XSAVE_POINTER (XCAR (monitor_list), 0);
5625 monitor_list = XCDR (monitor_list);
5628 monitor_frames = Fmake_vector (make_number (n_monitors), Qnil);
5629 FOR_EACH_FRAME (rest, frame)
5631 struct frame *f = XFRAME (frame);
5633 if (FRAME_W32_P (f) && !EQ (frame, tip_frame))
5635 HMONITOR monitor =
5636 monitor_from_window_fn (FRAME_W32_WINDOW (f),
5637 MONITOR_DEFAULT_TO_NEAREST);
5639 for (i = 0; i < n_monitors; i++)
5640 if (monitors[i] == monitor)
5641 break;
5643 if (i < n_monitors)
5644 ASET (monitor_frames, i, Fcons (frame, AREF (monitor_frames, i)));
5648 for (i = 0; i < n_monitors; i++)
5650 Lisp_Object geometry, workarea, name, attributes = Qnil;
5651 HDC hdc;
5652 int width_mm, height_mm;
5653 struct MONITOR_INFO_EX mi;
5655 mi.cbSize = sizeof (mi);
5656 if (!get_monitor_info_fn (monitors[i], (struct MONITOR_INFO *) &mi))
5657 continue;
5659 hdc = CreateDCA ("DISPLAY", mi.szDevice, NULL, NULL);
5660 if (hdc == NULL)
5661 continue;
5662 width_mm = GetDeviceCaps (hdc, HORZSIZE);
5663 height_mm = GetDeviceCaps (hdc, VERTSIZE);
5664 DeleteDC (hdc);
5666 attributes = Fcons (Fcons (Qframes, AREF (monitor_frames, i)),
5667 attributes);
5669 name = DECODE_SYSTEM (build_unibyte_string (mi.szDevice));
5671 attributes = Fcons (Fcons (Qname, name), attributes);
5673 attributes = Fcons (Fcons (Qmm_size, list2i (width_mm, height_mm)),
5674 attributes);
5676 workarea = list4i (mi.rcWork.left, mi.rcWork.top,
5677 mi.rcWork.right - mi.rcWork.left,
5678 mi.rcWork.bottom - mi.rcWork.top);
5679 attributes = Fcons (Fcons (Qworkarea, workarea), attributes);
5681 geometry = list4i (mi.rcMonitor.left, mi.rcMonitor.top,
5682 mi.rcMonitor.right - mi.rcMonitor.left,
5683 mi.rcMonitor.bottom - mi.rcMonitor.top);
5684 attributes = Fcons (Fcons (Qgeometry, geometry), attributes);
5686 if (mi.dwFlags & MONITORINFOF_PRIMARY)
5687 primary_monitor_attributes = attributes;
5688 else
5689 attributes_list = Fcons (attributes, attributes_list);
5692 if (!NILP (primary_monitor_attributes))
5693 attributes_list = Fcons (primary_monitor_attributes, attributes_list);
5695 xfree (monitors);
5697 return attributes_list;
5700 static Lisp_Object
5701 w32_display_monitor_attributes_list_fallback (struct w32_display_info *dpyinfo)
5703 Lisp_Object geometry, workarea, frames, rest, frame, attributes = Qnil;
5704 HDC hdc;
5705 double mm_per_pixel;
5706 int pixel_width, pixel_height, width_mm, height_mm;
5707 RECT workarea_rect;
5709 /* Fallback: treat (possibly) multiple physical monitors as if they
5710 formed a single monitor as a whole. This should provide a
5711 consistent result at least on single monitor environments. */
5712 attributes = Fcons (Fcons (Qname, build_string ("combined screen")),
5713 attributes);
5715 frames = Qnil;
5716 FOR_EACH_FRAME (rest, frame)
5718 struct frame *f = XFRAME (frame);
5720 if (FRAME_W32_P (f) && !EQ (frame, tip_frame))
5721 frames = Fcons (frame, frames);
5723 attributes = Fcons (Fcons (Qframes, frames), attributes);
5725 pixel_width = x_display_pixel_width (dpyinfo);
5726 pixel_height = x_display_pixel_height (dpyinfo);
5728 hdc = GetDC (NULL);
5729 mm_per_pixel = ((double) GetDeviceCaps (hdc, HORZSIZE)
5730 / GetDeviceCaps (hdc, HORZRES));
5731 width_mm = pixel_width * mm_per_pixel + 0.5;
5732 mm_per_pixel = ((double) GetDeviceCaps (hdc, VERTSIZE)
5733 / GetDeviceCaps (hdc, VERTRES));
5734 height_mm = pixel_height * mm_per_pixel + 0.5;
5735 ReleaseDC (NULL, hdc);
5736 attributes = Fcons (Fcons (Qmm_size, list2i (width_mm, height_mm)),
5737 attributes);
5739 /* GetSystemMetrics below may return 0 for Windows 95 or NT 4.0, but
5740 we don't care. */
5741 geometry = list4i (GetSystemMetrics (SM_XVIRTUALSCREEN),
5742 GetSystemMetrics (SM_YVIRTUALSCREEN),
5743 pixel_width, pixel_height);
5744 if (SystemParametersInfo (SPI_GETWORKAREA, 0, &workarea_rect, 0))
5745 workarea = list4i (workarea_rect.left, workarea_rect.top,
5746 workarea_rect.right - workarea_rect.left,
5747 workarea_rect.bottom - workarea_rect.top);
5748 else
5749 workarea = geometry;
5750 attributes = Fcons (Fcons (Qworkarea, workarea), attributes);
5752 attributes = Fcons (Fcons (Qgeometry, geometry), attributes);
5754 return list1 (attributes);
5757 DEFUN ("w32-display-monitor-attributes-list", Fw32_display_monitor_attributes_list,
5758 Sw32_display_monitor_attributes_list,
5759 0, 1, 0,
5760 doc: /* Return a list of physical monitor attributes on the W32 display DISPLAY.
5762 The optional argument DISPLAY specifies which display to ask about.
5763 DISPLAY should be either a frame or a display name (a string).
5764 If omitted or nil, that stands for the selected frame's display.
5766 Internal use only, use `display-monitor-attributes-list' instead. */)
5767 (Lisp_Object display)
5769 struct w32_display_info *dpyinfo = check_x_display_info (display);
5770 Lisp_Object attributes_list;
5772 block_input ();
5773 attributes_list = w32_display_monitor_attributes_list ();
5774 if (NILP (attributes_list))
5775 attributes_list = w32_display_monitor_attributes_list_fallback (dpyinfo);
5776 unblock_input ();
5778 return attributes_list;
5781 DEFUN ("set-message-beep", Fset_message_beep, Sset_message_beep, 1, 1, 0,
5782 doc: /* Set the sound generated when the bell is rung.
5783 SOUND is `asterisk', `exclamation', `hand', `question', `ok', or `silent'
5784 to use the corresponding system sound for the bell. The `silent' sound
5785 prevents Emacs from making any sound at all.
5786 SOUND is nil to use the normal beep. */)
5787 (Lisp_Object sound)
5789 CHECK_SYMBOL (sound);
5791 if (NILP (sound))
5792 sound_type = 0xFFFFFFFF;
5793 else if (EQ (sound, intern ("asterisk")))
5794 sound_type = MB_ICONASTERISK;
5795 else if (EQ (sound, intern ("exclamation")))
5796 sound_type = MB_ICONEXCLAMATION;
5797 else if (EQ (sound, intern ("hand")))
5798 sound_type = MB_ICONHAND;
5799 else if (EQ (sound, intern ("question")))
5800 sound_type = MB_ICONQUESTION;
5801 else if (EQ (sound, intern ("ok")))
5802 sound_type = MB_OK;
5803 else if (EQ (sound, intern ("silent")))
5804 sound_type = MB_EMACS_SILENT;
5805 else
5806 sound_type = 0xFFFFFFFF;
5808 return sound;
5812 x_screen_planes (register struct frame *f)
5814 return FRAME_DISPLAY_INFO (f)->n_planes;
5817 /* Return the display structure for the display named NAME.
5818 Open a new connection if necessary. */
5820 struct w32_display_info *
5821 x_display_info_for_name (Lisp_Object name)
5823 struct w32_display_info *dpyinfo;
5825 CHECK_STRING (name);
5827 for (dpyinfo = &one_w32_display_info; dpyinfo; dpyinfo = dpyinfo->next)
5828 if (!NILP (Fstring_equal (XCAR (dpyinfo->name_list_element), name)))
5829 return dpyinfo;
5831 /* Use this general default value to start with. */
5832 Vx_resource_name = Vinvocation_name;
5834 validate_x_resource_name ();
5836 dpyinfo = w32_term_init (name, (unsigned char *)0,
5837 SSDATA (Vx_resource_name));
5839 if (dpyinfo == 0)
5840 error ("Cannot connect to server %s", SDATA (name));
5842 XSETFASTINT (Vwindow_system_version, w32_major_version);
5844 return dpyinfo;
5847 DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
5848 1, 3, 0, doc: /* Open a connection to a display server.
5849 DISPLAY is the name of the display to connect to.
5850 Optional second arg XRM-STRING is a string of resources in xrdb format.
5851 If the optional third arg MUST-SUCCEED is non-nil,
5852 terminate Emacs if we can't open the connection.
5853 (In the Nextstep version, the last two arguments are currently ignored.) */)
5854 (Lisp_Object display, Lisp_Object xrm_string, Lisp_Object must_succeed)
5856 unsigned char *xrm_option;
5857 struct w32_display_info *dpyinfo;
5859 CHECK_STRING (display);
5861 /* Signal an error in order to encourage correct use from callers.
5862 * If we ever support multiple window systems in the same Emacs,
5863 * we'll need callers to be precise about what window system they
5864 * want. */
5866 if (strcmp (SSDATA (display), "w32") != 0)
5867 error ("The name of the display in this Emacs must be \"w32\"");
5869 /* If initialization has already been done, return now to avoid
5870 overwriting critical parts of one_w32_display_info. */
5871 if (window_system_available (NULL))
5872 return Qnil;
5874 if (! NILP (xrm_string))
5875 CHECK_STRING (xrm_string);
5877 /* Allow color mapping to be defined externally; first look in user's
5878 HOME directory, then in Emacs etc dir for a file called rgb.txt. */
5880 Lisp_Object color_file;
5882 color_file = build_string ("~/rgb.txt");
5884 if (NILP (Ffile_readable_p (color_file)))
5885 color_file =
5886 Fexpand_file_name (build_string ("rgb.txt"),
5887 Fsymbol_value (intern ("data-directory")));
5889 Vw32_color_map = Fx_load_color_file (color_file);
5891 if (NILP (Vw32_color_map))
5892 Vw32_color_map = w32_default_color_map ();
5894 /* Merge in system logical colors. */
5895 add_system_logical_colors_to_map (&Vw32_color_map);
5897 if (! NILP (xrm_string))
5898 xrm_option = SDATA (xrm_string);
5899 else
5900 xrm_option = (unsigned char *) 0;
5902 /* Use this general default value to start with. */
5903 /* First remove .exe suffix from invocation-name - it looks ugly. */
5905 char basename[ MAX_PATH ], *str;
5907 lispstpcpy (basename, Vinvocation_name);
5908 str = strrchr (basename, '.');
5909 if (str) *str = 0;
5910 Vinvocation_name = build_string (basename);
5912 Vx_resource_name = Vinvocation_name;
5914 validate_x_resource_name ();
5916 /* This is what opens the connection and sets x_current_display.
5917 This also initializes many symbols, such as those used for input. */
5918 dpyinfo = w32_term_init (display, xrm_option,
5919 SSDATA (Vx_resource_name));
5921 if (dpyinfo == 0)
5923 if (!NILP (must_succeed))
5924 fatal ("Cannot connect to server %s.\n",
5925 SDATA (display));
5926 else
5927 error ("Cannot connect to server %s", SDATA (display));
5930 XSETFASTINT (Vwindow_system_version, w32_major_version);
5931 return Qnil;
5934 DEFUN ("x-close-connection", Fx_close_connection,
5935 Sx_close_connection, 1, 1, 0,
5936 doc: /* Close the connection to DISPLAY's server.
5937 For DISPLAY, specify either a frame or a display name (a string).
5938 If DISPLAY is nil, that stands for the selected frame's display. */)
5939 (Lisp_Object display)
5941 struct w32_display_info *dpyinfo = check_x_display_info (display);
5943 if (dpyinfo->reference_count > 0)
5944 error ("Display still has frames on it");
5946 block_input ();
5947 x_destroy_all_bitmaps (dpyinfo);
5949 x_delete_display (dpyinfo);
5950 unblock_input ();
5952 return Qnil;
5955 DEFUN ("x-display-list", Fx_display_list, Sx_display_list, 0, 0, 0,
5956 doc: /* Return the list of display names that Emacs has connections to. */)
5957 (void)
5959 Lisp_Object result = Qnil;
5960 struct w32_display_info *wdi;
5962 for (wdi = x_display_list; wdi; wdi = wdi->next)
5963 result = Fcons (XCAR (wdi->name_list_element), result);
5965 return result;
5968 DEFUN ("x-synchronize", Fx_synchronize, Sx_synchronize, 1, 2, 0,
5969 doc: /* If ON is non-nil, report X errors as soon as the erring request is made.
5970 This function only has an effect on X Windows. With MS Windows, it is
5971 defined but does nothing.
5973 If ON is nil, allow buffering of requests.
5974 Turning on synchronization prohibits the Xlib routines from buffering
5975 requests and seriously degrades performance, but makes debugging much
5976 easier.
5977 The optional second argument TERMINAL specifies which display to act on.
5978 TERMINAL should be a terminal object, a frame or a display name (a string).
5979 If TERMINAL is omitted or nil, that stands for the selected frame's display. */)
5980 (Lisp_Object on, Lisp_Object display)
5982 return Qnil;
5987 /***********************************************************************
5988 Window properties
5989 ***********************************************************************/
5991 #if 0 /* TODO : port window properties to W32 */
5993 DEFUN ("x-change-window-property", Fx_change_window_property,
5994 Sx_change_window_property, 2, 6, 0,
5995 doc: /* Change window property PROP to VALUE on the X window of FRAME.
5996 PROP must be a string. VALUE may be a string or a list of conses,
5997 numbers and/or strings. If an element in the list is a string, it is
5998 converted to an atom and the value of the Atom is used. If an element
5999 is a cons, it is converted to a 32 bit number where the car is the 16
6000 top bits and the cdr is the lower 16 bits.
6002 FRAME nil or omitted means use the selected frame.
6003 If TYPE is given and non-nil, it is the name of the type of VALUE.
6004 If TYPE is not given or nil, the type is STRING.
6005 FORMAT gives the size in bits of each element if VALUE is a list.
6006 It must be one of 8, 16 or 32.
6007 If VALUE is a string or FORMAT is nil or not given, FORMAT defaults to 8.
6008 If OUTER-P is non-nil, the property is changed for the outer X window of
6009 FRAME. Default is to change on the edit X window. */)
6010 (Lisp_Object prop, Lisp_Object value, Lisp_Object frame,
6011 Lisp_Object type, Lisp_Object format, Lisp_Object outer_p)
6013 struct frame *f = decode_window_system_frame (frame);
6014 Atom prop_atom;
6016 CHECK_STRING (prop);
6017 CHECK_STRING (value);
6019 block_input ();
6020 prop_atom = XInternAtom (FRAME_W32_DISPLAY (f), SDATA (prop), False);
6021 XChangeProperty (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f),
6022 prop_atom, XA_STRING, 8, PropModeReplace,
6023 SDATA (value), SCHARS (value));
6025 /* Make sure the property is set when we return. */
6026 XFlush (FRAME_W32_DISPLAY (f));
6027 unblock_input ();
6029 return value;
6033 DEFUN ("x-delete-window-property", Fx_delete_window_property,
6034 Sx_delete_window_property, 1, 2, 0,
6035 doc: /* Remove window property PROP from X window of FRAME.
6036 FRAME nil or omitted means use the selected frame. Value is PROP. */)
6037 (Lisp_Object prop, Lisp_Object frame)
6039 struct frame *f = decode_window_system_frame (frame);
6040 Atom prop_atom;
6042 CHECK_STRING (prop);
6043 block_input ();
6044 prop_atom = XInternAtom (FRAME_W32_DISPLAY (f), SDATA (prop), False);
6045 XDeleteProperty (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f), prop_atom);
6047 /* Make sure the property is removed when we return. */
6048 XFlush (FRAME_W32_DISPLAY (f));
6049 unblock_input ();
6051 return prop;
6055 DEFUN ("x-window-property", Fx_window_property, Sx_window_property,
6056 1, 6, 0,
6057 doc: /* Value is the value of window property PROP on FRAME.
6058 If FRAME is nil or omitted, use the selected frame.
6060 On X Windows, the following optional arguments are also accepted:
6061 If TYPE is nil or omitted, get the property as a string.
6062 Otherwise TYPE is the name of the atom that denotes the type expected.
6063 If SOURCE is non-nil, get the property on that window instead of from
6064 FRAME. The number 0 denotes the root window.
6065 If DELETE-P is non-nil, delete the property after retrieving it.
6066 If VECTOR-RET-P is non-nil, don't return a string but a vector of values.
6068 On MS Windows, this function accepts but ignores those optional arguments.
6070 Value is nil if FRAME hasn't a property with name PROP or if PROP has
6071 no value of TYPE (always string in the MS Windows case). */)
6072 (Lisp_Object prop, Lisp_Object frame, Lisp_Object type,
6073 Lisp_Object source, Lisp_Object delete_p, Lisp_Object vector_ret_p)
6075 struct frame *f = decode_window_system_frame (frame);
6076 Atom prop_atom;
6077 int rc;
6078 Lisp_Object prop_value = Qnil;
6079 char *tmp_data = NULL;
6080 Atom actual_type;
6081 int actual_format;
6082 unsigned long actual_size, bytes_remaining;
6084 CHECK_STRING (prop);
6085 block_input ();
6086 prop_atom = XInternAtom (FRAME_W32_DISPLAY (f), SDATA (prop), False);
6087 rc = XGetWindowProperty (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f),
6088 prop_atom, 0, 0, False, XA_STRING,
6089 &actual_type, &actual_format, &actual_size,
6090 &bytes_remaining, (unsigned char **) &tmp_data);
6091 if (rc == Success)
6093 int size = bytes_remaining;
6095 XFree (tmp_data);
6096 tmp_data = NULL;
6098 rc = XGetWindowProperty (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f),
6099 prop_atom, 0, bytes_remaining,
6100 False, XA_STRING,
6101 &actual_type, &actual_format,
6102 &actual_size, &bytes_remaining,
6103 (unsigned char **) &tmp_data);
6104 if (rc == Success)
6105 prop_value = make_string (tmp_data, size);
6107 XFree (tmp_data);
6110 unblock_input ();
6112 return prop_value;
6114 return Qnil;
6117 #endif /* TODO */
6119 /***********************************************************************
6120 Tool tips
6121 ***********************************************************************/
6123 static Lisp_Object x_create_tip_frame (struct w32_display_info *,
6124 Lisp_Object, Lisp_Object);
6125 static void compute_tip_xy (struct frame *, Lisp_Object, Lisp_Object,
6126 Lisp_Object, int, int, int *, int *);
6128 /* The frame of a currently visible tooltip. */
6130 Lisp_Object tip_frame;
6132 /* If non-nil, a timer started that hides the last tooltip when it
6133 fires. */
6135 Lisp_Object tip_timer;
6136 Window tip_window;
6138 /* If non-nil, a vector of 3 elements containing the last args
6139 with which x-show-tip was called. See there. */
6141 Lisp_Object last_show_tip_args;
6144 static void
6145 unwind_create_tip_frame (Lisp_Object frame)
6147 Lisp_Object deleted;
6149 deleted = unwind_create_frame (frame);
6150 if (EQ (deleted, Qt))
6152 tip_window = NULL;
6153 tip_frame = Qnil;
6158 /* Create a frame for a tooltip on the display described by DPYINFO.
6159 PARMS is a list of frame parameters. TEXT is the string to
6160 display in the tip frame. Value is the frame.
6162 Note that functions called here, esp. x_default_parameter can
6163 signal errors, for instance when a specified color name is
6164 undefined. We have to make sure that we're in a consistent state
6165 when this happens. */
6167 static Lisp_Object
6168 x_create_tip_frame (struct w32_display_info *dpyinfo,
6169 Lisp_Object parms, Lisp_Object text)
6171 struct frame *f;
6172 Lisp_Object frame;
6173 Lisp_Object name;
6174 long window_prompting = 0;
6175 int width, height;
6176 ptrdiff_t count = SPECPDL_INDEX ();
6177 struct kboard *kb;
6178 bool face_change_before = face_change;
6179 Lisp_Object buffer;
6180 struct buffer *old_buffer;
6182 /* Use this general default value to start with until we know if
6183 this frame has a specified name. */
6184 Vx_resource_name = Vinvocation_name;
6186 kb = dpyinfo->terminal->kboard;
6188 /* The calls to x_get_arg remove elements from PARMS, so copy it to
6189 avoid destructive changes behind our caller's back. */
6190 parms = Fcopy_alist (parms);
6192 /* Get the name of the frame to use for resource lookup. */
6193 name = x_get_arg (dpyinfo, parms, Qname, "name", "Name", RES_TYPE_STRING);
6194 if (!STRINGP (name)
6195 && !EQ (name, Qunbound)
6196 && !NILP (name))
6197 error ("Invalid frame name--not a string or nil");
6198 Vx_resource_name = name;
6200 frame = Qnil;
6201 /* Make a frame without minibuffer nor mode-line. */
6202 f = make_frame (false);
6203 f->wants_modeline = 0;
6204 XSETFRAME (frame, f);
6206 AUTO_STRING (tip, " *tip*");
6207 buffer = Fget_buffer_create (tip);
6208 /* Use set_window_buffer instead of Fset_window_buffer (see
6209 discussion of bug#11984, bug#12025, bug#12026). */
6210 set_window_buffer (FRAME_ROOT_WINDOW (f), buffer, false, false);
6211 old_buffer = current_buffer;
6212 set_buffer_internal_1 (XBUFFER (buffer));
6213 bset_truncate_lines (current_buffer, Qnil);
6214 specbind (Qinhibit_read_only, Qt);
6215 specbind (Qinhibit_modification_hooks, Qt);
6216 Ferase_buffer ();
6217 Finsert (1, &text);
6218 set_buffer_internal_1 (old_buffer);
6220 record_unwind_protect (unwind_create_tip_frame, frame);
6222 /* By setting the output method, we're essentially saying that
6223 the frame is live, as per FRAME_LIVE_P. If we get a signal
6224 from this point on, x_destroy_window might screw up reference
6225 counts etc. */
6226 f->terminal = dpyinfo->terminal;
6227 f->output_method = output_w32;
6228 f->output_data.w32 = xzalloc (sizeof (struct w32_output));
6230 FRAME_FONTSET (f) = -1;
6231 fset_icon_name (f, Qnil);
6233 #ifdef GLYPH_DEBUG
6234 image_cache_refcount =
6235 FRAME_IMAGE_CACHE (f) ? FRAME_IMAGE_CACHE (f)->refcount : 0;
6236 dpyinfo_refcount = dpyinfo->reference_count;
6237 #endif /* GLYPH_DEBUG */
6238 FRAME_KBOARD (f) = kb;
6239 f->output_data.w32->parent_desc = FRAME_DISPLAY_INFO (f)->root_window;
6240 f->output_data.w32->explicit_parent = false;
6242 /* Set the name; the functions to which we pass f expect the name to
6243 be set. */
6244 if (EQ (name, Qunbound) || NILP (name))
6246 fset_name (f, build_string (dpyinfo->w32_id_name));
6247 f->explicit_name = false;
6249 else
6251 fset_name (f, name);
6252 f->explicit_name = true;
6253 /* use the frame's title when getting resources for this frame. */
6254 specbind (Qx_resource_name, name);
6257 if (uniscribe_available)
6258 register_font_driver (&uniscribe_font_driver, f);
6259 register_font_driver (&w32font_driver, f);
6261 x_default_parameter (f, parms, Qfont_backend, Qnil,
6262 "fontBackend", "FontBackend", RES_TYPE_STRING);
6264 /* Extract the window parameters from the supplied values
6265 that are needed to determine window geometry. */
6266 x_default_font_parameter (f, parms);
6268 x_default_parameter (f, parms, Qborder_width, make_number (2),
6269 "borderWidth", "BorderWidth", RES_TYPE_NUMBER);
6270 /* This defaults to 2 in order to match xterm. We recognize either
6271 internalBorderWidth or internalBorder (which is what xterm calls
6272 it). */
6273 if (NILP (Fassq (Qinternal_border_width, parms)))
6275 Lisp_Object value;
6277 value = x_get_arg (dpyinfo, parms, Qinternal_border_width,
6278 "internalBorder", "internalBorder", RES_TYPE_NUMBER);
6279 if (! EQ (value, Qunbound))
6280 parms = Fcons (Fcons (Qinternal_border_width, value),
6281 parms);
6283 x_default_parameter (f, parms, Qinternal_border_width, make_number (1),
6284 "internalBorderWidth", "internalBorderWidth",
6285 RES_TYPE_NUMBER);
6286 x_default_parameter (f, parms, Qright_divider_width, make_number (0),
6287 NULL, NULL, RES_TYPE_NUMBER);
6288 x_default_parameter (f, parms, Qbottom_divider_width, make_number (0),
6289 NULL, NULL, RES_TYPE_NUMBER);
6291 /* Also do the stuff which must be set before the window exists. */
6292 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
6293 "foreground", "Foreground", RES_TYPE_STRING);
6294 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
6295 "background", "Background", RES_TYPE_STRING);
6296 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
6297 "pointerColor", "Foreground", RES_TYPE_STRING);
6298 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
6299 "cursorColor", "Foreground", RES_TYPE_STRING);
6300 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
6301 "borderColor", "BorderColor", RES_TYPE_STRING);
6303 /* Init faces before x_default_parameter is called for the
6304 scroll-bar-width parameter because otherwise we end up in
6305 init_iterator with a null face cache, which should not happen. */
6306 init_frame_faces (f);
6308 f->output_data.w32->dwStyle = WS_BORDER | WS_POPUP | WS_DISABLED;
6309 f->output_data.w32->parent_desc = FRAME_DISPLAY_INFO (f)->root_window;
6311 window_prompting = x_figure_window_size (f, parms, false);
6313 /* No fringes on tip frame. */
6314 f->fringe_cols = 0;
6315 f->left_fringe_width = 0;
6316 f->right_fringe_width = 0;
6318 block_input ();
6319 my_create_tip_window (f);
6320 unblock_input ();
6322 x_make_gc (f);
6324 x_default_parameter (f, parms, Qauto_raise, Qnil,
6325 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN);
6326 x_default_parameter (f, parms, Qauto_lower, Qnil,
6327 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN);
6328 x_default_parameter (f, parms, Qcursor_type, Qbox,
6329 "cursorType", "CursorType", RES_TYPE_SYMBOL);
6330 /* Process alpha here (Bug#17344). */
6331 x_default_parameter (f, parms, Qalpha, Qnil,
6332 "alpha", "Alpha", RES_TYPE_NUMBER);
6334 /* Dimensions, especially FRAME_LINES (f), must be done via
6335 change_frame_size. Change will not be effected unless different
6336 from the current FRAME_LINES (f). */
6337 width = FRAME_COLS (f);
6338 height = FRAME_LINES (f);
6339 SET_FRAME_COLS (f, 0);
6340 SET_FRAME_LINES (f, 0);
6341 adjust_frame_size (f, width * FRAME_COLUMN_WIDTH (f),
6342 height * FRAME_LINE_HEIGHT (f), 0, true, Qtip_frame);
6344 /* Add `tooltip' frame parameter's default value. */
6345 if (NILP (Fframe_parameter (frame, Qtooltip)))
6346 Fmodify_frame_parameters (frame, Fcons (Fcons (Qtooltip, Qt), Qnil));
6348 /* Set up faces after all frame parameters are known. This call
6349 also merges in face attributes specified for new frames.
6351 Frame parameters may be changed if .Xdefaults contains
6352 specifications for the default font. For example, if there is an
6353 `Emacs.default.attributeBackground: pink', the `background-color'
6354 attribute of the frame get's set, which let's the internal border
6355 of the tooltip frame appear in pink. Prevent this. */
6357 Lisp_Object bg = Fframe_parameter (frame, Qbackground_color);
6358 Lisp_Object fg = Fframe_parameter (frame, Qforeground_color);
6359 Lisp_Object colors = Qnil;
6361 /* Set tip_frame here, so that */
6362 tip_frame = frame;
6363 call2 (Qface_set_after_frame_default, frame, Qnil);
6365 if (!EQ (bg, Fframe_parameter (frame, Qbackground_color)))
6366 colors = Fcons (Fcons (Qbackground_color, bg), colors);
6367 if (!EQ (fg, Fframe_parameter (frame, Qforeground_color)))
6368 colors = Fcons (Fcons (Qforeground_color, fg), colors);
6370 if (!NILP (colors))
6371 Fmodify_frame_parameters (frame, colors);
6374 f->no_split = true;
6376 /* Now that the frame is official, it counts as a reference to
6377 its display. */
6378 FRAME_DISPLAY_INFO (f)->reference_count++;
6379 f->terminal->reference_count++;
6381 /* It is now ok to make the frame official even if we get an error
6382 below. And the frame needs to be on Vframe_list or making it
6383 visible won't work. */
6384 Vframe_list = Fcons (frame, Vframe_list);
6385 f->can_x_set_window_size = true;
6387 /* Setting attributes of faces of the tooltip frame from resources
6388 and similar will set face_change, which leads to the
6389 clearing of all current matrices. Since this isn't necessary
6390 here, avoid it by resetting face_change to the value it
6391 had before we created the tip frame. */
6392 face_change = face_change_before;
6394 /* Discard the unwind_protect. */
6395 return unbind_to (count, frame);
6399 /* Compute where to display tip frame F. PARMS is the list of frame
6400 parameters for F. DX and DY are specified offsets from the current
6401 location of the mouse. WIDTH and HEIGHT are the width and height
6402 of the tooltip. Return coordinates relative to the root window of
6403 the display in *ROOT_X and *ROOT_Y. */
6405 static void
6406 compute_tip_xy (struct frame *f,
6407 Lisp_Object parms, Lisp_Object dx, Lisp_Object dy,
6408 int width, int height, int *root_x, int *root_y)
6410 Lisp_Object left, top, right, bottom;
6411 int min_x, min_y, max_x, max_y;
6413 /* User-specified position? */
6414 left = Fcdr (Fassq (Qleft, parms));
6415 top = Fcdr (Fassq (Qtop, parms));
6416 right = Fcdr (Fassq (Qright, parms));
6417 bottom = Fcdr (Fassq (Qbottom, parms));
6419 /* Move the tooltip window where the mouse pointer is. Resize and
6420 show it. */
6421 if ((!INTEGERP (left) && !INTEGERP (right))
6422 || (!INTEGERP (top) && !INTEGERP (bottom)))
6424 POINT pt;
6426 /* Default min and max values. */
6427 min_x = 0;
6428 min_y = 0;
6429 max_x = x_display_pixel_width (FRAME_DISPLAY_INFO (f));
6430 max_y = x_display_pixel_height (FRAME_DISPLAY_INFO (f));
6432 block_input ();
6433 GetCursorPos (&pt);
6434 *root_x = pt.x;
6435 *root_y = pt.y;
6436 unblock_input ();
6438 /* If multiple monitor support is available, constrain the tip onto
6439 the current monitor. This improves the above by allowing negative
6440 co-ordinates if monitor positions are such that they are valid, and
6441 snaps a tooltip onto a single monitor if we are close to the edge
6442 where it would otherwise flow onto the other monitor (or into
6443 nothingness if there is a gap in the overlap). */
6444 if (monitor_from_point_fn && get_monitor_info_fn)
6446 struct MONITOR_INFO info;
6447 HMONITOR monitor
6448 = monitor_from_point_fn (pt, MONITOR_DEFAULT_TO_NEAREST);
6449 info.cbSize = sizeof (info);
6451 if (get_monitor_info_fn (monitor, &info))
6453 min_x = info.rcWork.left;
6454 min_y = info.rcWork.top;
6455 max_x = info.rcWork.right;
6456 max_y = info.rcWork.bottom;
6461 if (INTEGERP (top))
6462 *root_y = XINT (top);
6463 else if (INTEGERP (bottom))
6464 *root_y = XINT (bottom) - height;
6465 else if (*root_y + XINT (dy) <= min_y)
6466 *root_y = min_y; /* Can happen for negative dy */
6467 else if (*root_y + XINT (dy) + height <= max_y)
6468 /* It fits below the pointer */
6469 *root_y += XINT (dy);
6470 else if (height + XINT (dy) + min_y <= *root_y)
6471 /* It fits above the pointer. */
6472 *root_y -= height + XINT (dy);
6473 else
6474 /* Put it on the top. */
6475 *root_y = min_y;
6477 if (INTEGERP (left))
6478 *root_x = XINT (left);
6479 else if (INTEGERP (right))
6480 *root_y = XINT (right) - width;
6481 else if (*root_x + XINT (dx) <= min_x)
6482 *root_x = 0; /* Can happen for negative dx */
6483 else if (*root_x + XINT (dx) + width <= max_x)
6484 /* It fits to the right of the pointer. */
6485 *root_x += XINT (dx);
6486 else if (width + XINT (dx) + min_x <= *root_x)
6487 /* It fits to the left of the pointer. */
6488 *root_x -= width + XINT (dx);
6489 else
6490 /* Put it left justified on the screen -- it ought to fit that way. */
6491 *root_x = min_x;
6495 DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0,
6496 doc: /* Show STRING in a \"tooltip\" window on frame FRAME.
6497 A tooltip window is a small window displaying a string.
6499 This is an internal function; Lisp code should call `tooltip-show'.
6501 FRAME nil or omitted means use the selected frame.
6503 PARMS is an optional list of frame parameters which can be
6504 used to change the tooltip's appearance.
6506 Automatically hide the tooltip after TIMEOUT seconds. TIMEOUT nil
6507 means use the default timeout of 5 seconds.
6509 If the list of frame parameters PARMS contains a `left' parameter,
6510 display the tooltip at that x-position. If the list of frame parameters
6511 PARMS contains no `left' but a `right' parameter, display the tooltip
6512 right-adjusted at that x-position. Otherwise display it at the
6513 x-position of the mouse, with offset DX added (default is 5 if DX isn't
6514 specified).
6516 Likewise for the y-position: If a `top' frame parameter is specified, it
6517 determines the position of the upper edge of the tooltip window. If a
6518 `bottom' parameter but no `top' frame parameter is specified, it
6519 determines the position of the lower edge of the tooltip window.
6520 Otherwise display the tooltip window at the y-position of the mouse,
6521 with offset DY added (default is -10).
6523 A tooltip's maximum size is specified by `x-max-tooltip-size'.
6524 Text larger than the specified size is clipped. */)
6525 (Lisp_Object string, Lisp_Object frame, Lisp_Object parms, Lisp_Object timeout, Lisp_Object dx, Lisp_Object dy)
6527 struct frame *f;
6528 struct window *w;
6529 int root_x, root_y;
6530 struct buffer *old_buffer;
6531 struct text_pos pos;
6532 int i, width, height;
6533 bool seen_reversed_p;
6534 int old_windows_or_buffers_changed = windows_or_buffers_changed;
6535 ptrdiff_t count = SPECPDL_INDEX ();
6537 specbind (Qinhibit_redisplay, Qt);
6539 CHECK_STRING (string);
6540 f = decode_window_system_frame (frame);
6541 if (NILP (timeout))
6542 timeout = make_number (5);
6543 else
6544 CHECK_NATNUM (timeout);
6546 if (NILP (dx))
6547 dx = make_number (5);
6548 else
6549 CHECK_NUMBER (dx);
6551 if (NILP (dy))
6552 dy = make_number (-10);
6553 else
6554 CHECK_NUMBER (dy);
6556 if (NILP (last_show_tip_args))
6557 last_show_tip_args = Fmake_vector (make_number (3), Qnil);
6559 if (!NILP (tip_frame))
6561 Lisp_Object last_string = AREF (last_show_tip_args, 0);
6562 Lisp_Object last_frame = AREF (last_show_tip_args, 1);
6563 Lisp_Object last_parms = AREF (last_show_tip_args, 2);
6565 if (EQ (frame, last_frame)
6566 && !NILP (Fequal (last_string, string))
6567 && !NILP (Fequal (last_parms, parms)))
6569 struct frame *f = XFRAME (tip_frame);
6571 /* Only DX and DY have changed. */
6572 if (!NILP (tip_timer))
6574 Lisp_Object timer = tip_timer;
6575 tip_timer = Qnil;
6576 call1 (Qcancel_timer, timer);
6579 block_input ();
6580 compute_tip_xy (f, parms, dx, dy, FRAME_PIXEL_WIDTH (f),
6581 FRAME_PIXEL_HEIGHT (f), &root_x, &root_y);
6583 /* Put tooltip in topmost group and in position. */
6584 SetWindowPos (FRAME_W32_WINDOW (f), HWND_TOPMOST,
6585 root_x, root_y, 0, 0,
6586 SWP_NOSIZE | SWP_NOACTIVATE | SWP_NOOWNERZORDER);
6588 /* Ensure tooltip is on top of other topmost windows (eg menus). */
6589 SetWindowPos (FRAME_W32_WINDOW (f), HWND_TOP,
6590 0, 0, 0, 0,
6591 SWP_NOMOVE | SWP_NOSIZE
6592 | SWP_NOACTIVATE | SWP_NOOWNERZORDER);
6594 unblock_input ();
6595 goto start_timer;
6599 /* Hide a previous tip, if any. */
6600 Fx_hide_tip ();
6602 ASET (last_show_tip_args, 0, string);
6603 ASET (last_show_tip_args, 1, frame);
6604 ASET (last_show_tip_args, 2, parms);
6606 /* Add default values to frame parameters. */
6607 if (NILP (Fassq (Qname, parms)))
6608 parms = Fcons (Fcons (Qname, build_string ("tooltip")), parms);
6609 if (NILP (Fassq (Qinternal_border_width, parms)))
6610 parms = Fcons (Fcons (Qinternal_border_width, make_number (3)), parms);
6611 if (NILP (Fassq (Qright_divider_width, parms)))
6612 parms = Fcons (Fcons (Qright_divider_width, make_number (0)), parms);
6613 if (NILP (Fassq (Qbottom_divider_width, parms)))
6614 parms = Fcons (Fcons (Qbottom_divider_width, make_number (0)), parms);
6615 if (NILP (Fassq (Qborder_width, parms)))
6616 parms = Fcons (Fcons (Qborder_width, make_number (1)), parms);
6617 if (NILP (Fassq (Qborder_color, parms)))
6618 parms = Fcons (Fcons (Qborder_color, build_string ("lightyellow")), parms);
6619 if (NILP (Fassq (Qbackground_color, parms)))
6620 parms = Fcons (Fcons (Qbackground_color, build_string ("lightyellow")),
6621 parms);
6623 /* Block input until the tip has been fully drawn, to avoid crashes
6624 when drawing tips in menus. */
6625 block_input ();
6627 /* Create a frame for the tooltip, and record it in the global
6628 variable tip_frame. */
6629 frame = x_create_tip_frame (FRAME_DISPLAY_INFO (f), parms, string);
6630 f = XFRAME (frame);
6632 /* Set up the frame's root window. */
6633 w = XWINDOW (FRAME_ROOT_WINDOW (f));
6634 w->left_col = 0;
6635 w->top_line = 0;
6636 w->pixel_left = 0;
6637 w->pixel_top = 0;
6639 if (CONSP (Vx_max_tooltip_size)
6640 && INTEGERP (XCAR (Vx_max_tooltip_size))
6641 && XINT (XCAR (Vx_max_tooltip_size)) > 0
6642 && INTEGERP (XCDR (Vx_max_tooltip_size))
6643 && XINT (XCDR (Vx_max_tooltip_size)) > 0)
6645 w->total_cols = XFASTINT (XCAR (Vx_max_tooltip_size));
6646 w->total_lines = XFASTINT (XCDR (Vx_max_tooltip_size));
6648 else
6650 w->total_cols = 80;
6651 w->total_lines = 40;
6654 w->pixel_width = w->total_cols * FRAME_COLUMN_WIDTH (f);
6655 w->pixel_height = w->total_lines * FRAME_LINE_HEIGHT (f);
6657 FRAME_TOTAL_COLS (f) = WINDOW_TOTAL_COLS (w);
6658 adjust_frame_glyphs (f);
6659 w->pseudo_window_p = true;
6661 /* Display the tooltip text in a temporary buffer. */
6662 old_buffer = current_buffer;
6663 set_buffer_internal_1 (XBUFFER (XWINDOW (FRAME_ROOT_WINDOW (f))->contents));
6664 bset_truncate_lines (current_buffer, Qnil);
6665 clear_glyph_matrix (w->desired_matrix);
6666 clear_glyph_matrix (w->current_matrix);
6667 SET_TEXT_POS (pos, BEGV, BEGV_BYTE);
6668 try_window (FRAME_ROOT_WINDOW (f), pos, TRY_WINDOW_IGNORE_FONTS_CHANGE);
6670 /* Compute width and height of the tooltip. */
6671 width = height = 0;
6672 seen_reversed_p = false;
6673 for (i = 0; i < w->desired_matrix->nrows; ++i)
6675 struct glyph_row *row = &w->desired_matrix->rows[i];
6676 struct glyph *last;
6677 int row_width;
6679 /* Stop at the first empty row at the end. */
6680 if (!row->enabled_p || !MATRIX_ROW_DISPLAYS_TEXT_P (row))
6681 break;
6683 /* Let the row go over the full width of the frame. */
6684 row->full_width_p = true;
6686 row_width = row->pixel_width;
6687 if (row->used[TEXT_AREA])
6689 if (!row->reversed_p)
6691 /* There's a glyph at the end of rows that is used to
6692 place the cursor there. Don't include the width of
6693 this glyph. */
6694 last = &row->glyphs[TEXT_AREA][row->used[TEXT_AREA] - 1];
6695 if (NILP (last->object))
6696 row_width -= last->pixel_width;
6698 else
6700 /* There could be a stretch glyph at the beginning of R2L
6701 rows that is produced by extend_face_to_end_of_line.
6702 Don't count that glyph. */
6703 struct glyph *g = row->glyphs[TEXT_AREA];
6705 if (g->type == STRETCH_GLYPH && NILP (g->object))
6707 row_width -= g->pixel_width;
6708 seen_reversed_p = true;
6713 height += row->height;
6714 width = max (width, row_width);
6717 /* If we've seen partial-length R2L rows, we need to re-adjust the
6718 tool-tip frame width and redisplay it again, to avoid over-wide
6719 tips due to the stretch glyph that extends R2L lines to full
6720 width of the frame. */
6721 if (seen_reversed_p)
6723 /* PXW: Why do we do the pixel-to-cols conversion only if
6724 seen_reversed_p holds? Don't we have to set other fields of
6725 the window/frame structure?
6727 w->total_cols and FRAME_TOTAL_COLS want the width in columns,
6728 not in pixels. */
6729 w->pixel_width = width;
6730 width /= WINDOW_FRAME_COLUMN_WIDTH (w);
6731 w->total_cols = width;
6732 FRAME_TOTAL_COLS (f) = width;
6733 SET_FRAME_WIDTH (f, width);
6734 adjust_frame_glyphs (f);
6735 w->pseudo_window_p = 1;
6736 clear_glyph_matrix (w->desired_matrix);
6737 clear_glyph_matrix (w->current_matrix);
6738 try_window (FRAME_ROOT_WINDOW (f), pos, TRY_WINDOW_IGNORE_FONTS_CHANGE);
6739 width = height = 0;
6740 /* Recompute width and height of the tooltip. */
6741 for (i = 0; i < w->desired_matrix->nrows; ++i)
6743 struct glyph_row *row = &w->desired_matrix->rows[i];
6744 struct glyph *last;
6745 int row_width;
6747 if (!row->enabled_p || !MATRIX_ROW_DISPLAYS_TEXT_P (row))
6748 break;
6749 row->full_width_p = true;
6750 row_width = row->pixel_width;
6751 if (row->used[TEXT_AREA] && !row->reversed_p)
6753 last = &row->glyphs[TEXT_AREA][row->used[TEXT_AREA] - 1];
6754 if (NILP (last->object))
6755 row_width -= last->pixel_width;
6758 height += row->height;
6759 width = max (width, row_width);
6763 /* Add the frame's internal border to the width and height the w32
6764 window should have. */
6765 height += 2 * FRAME_INTERNAL_BORDER_WIDTH (f);
6766 width += 2 * FRAME_INTERNAL_BORDER_WIDTH (f);
6768 /* Move the tooltip window where the mouse pointer is. Resize and
6769 show it.
6771 PXW: This should use the frame's pixel coordinates. */
6772 compute_tip_xy (f, parms, dx, dy, width, height, &root_x, &root_y);
6775 /* Adjust Window size to take border into account. */
6776 RECT rect;
6777 rect.left = rect.top = 0;
6778 rect.right = width;
6779 rect.bottom = height;
6780 AdjustWindowRect (&rect, f->output_data.w32->dwStyle,
6781 FRAME_EXTERNAL_MENU_BAR (f));
6783 /* Position and size tooltip, and put it in the topmost group.
6784 The add-on of FRAME_COLUMN_WIDTH to the 5th argument is a
6785 peculiarity of w32 display: without it, some fonts cause the
6786 last character of the tip to be truncated or wrapped around to
6787 the next line. */
6788 SetWindowPos (FRAME_W32_WINDOW (f), HWND_TOPMOST,
6789 root_x, root_y,
6790 rect.right - rect.left + FRAME_COLUMN_WIDTH (f),
6791 rect.bottom - rect.top, SWP_NOACTIVATE | SWP_NOOWNERZORDER);
6793 /* Ensure tooltip is on top of other topmost windows (eg menus). */
6794 SetWindowPos (FRAME_W32_WINDOW (f), HWND_TOP,
6795 0, 0, 0, 0,
6796 SWP_NOMOVE | SWP_NOSIZE
6797 | SWP_NOACTIVATE | SWP_NOOWNERZORDER);
6799 /* Let redisplay know that we have made the frame visible already. */
6800 SET_FRAME_VISIBLE (f, 1);
6802 ShowWindow (FRAME_W32_WINDOW (f), SW_SHOWNOACTIVATE);
6805 /* Draw into the window. */
6806 w->must_be_updated_p = true;
6807 update_single_window (w);
6809 unblock_input ();
6811 /* Restore original current buffer. */
6812 set_buffer_internal_1 (old_buffer);
6813 windows_or_buffers_changed = old_windows_or_buffers_changed;
6815 start_timer:
6816 /* Let the tip disappear after timeout seconds. */
6817 tip_timer = call3 (intern ("run-at-time"), timeout, Qnil,
6818 intern ("x-hide-tip"));
6820 return unbind_to (count, Qnil);
6824 DEFUN ("x-hide-tip", Fx_hide_tip, Sx_hide_tip, 0, 0, 0,
6825 doc: /* Hide the current tooltip window, if there is any.
6826 Value is t if tooltip was open, nil otherwise. */)
6827 (void)
6829 ptrdiff_t count;
6830 Lisp_Object deleted, frame, timer;
6832 /* Return quickly if nothing to do. */
6833 if (NILP (tip_timer) && NILP (tip_frame))
6834 return Qnil;
6836 frame = tip_frame;
6837 timer = tip_timer;
6838 tip_frame = tip_timer = deleted = Qnil;
6840 count = SPECPDL_INDEX ();
6841 specbind (Qinhibit_redisplay, Qt);
6842 specbind (Qinhibit_quit, Qt);
6844 if (!NILP (timer))
6845 call1 (Qcancel_timer, timer);
6847 if (FRAMEP (frame))
6849 delete_frame (frame, Qnil);
6850 deleted = Qt;
6853 return unbind_to (count, deleted);
6856 /***********************************************************************
6857 File selection dialog
6858 ***********************************************************************/
6860 #define FILE_NAME_TEXT_FIELD edt1
6861 #define FILE_NAME_COMBO_BOX cmb13
6862 #define FILE_NAME_LIST lst1
6864 /* Callback for altering the behavior of the Open File dialog.
6865 Makes the Filename text field contain "Current Directory" and be
6866 read-only when "Directories" is selected in the filter. This
6867 allows us to work around the fact that the standard Open File
6868 dialog does not support directories. */
6869 static UINT_PTR CALLBACK
6870 file_dialog_callback (HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam)
6872 if (msg == WM_NOTIFY)
6874 OFNOTIFYW * notify_w = (OFNOTIFYW *)lParam;
6875 OFNOTIFYA * notify_a = (OFNOTIFYA *)lParam;
6876 int dropdown_changed;
6877 int dir_index;
6878 #ifdef NTGUI_UNICODE
6879 const int use_unicode = 1;
6880 #else /* !NTGUI_UNICODE */
6881 int use_unicode = w32_unicode_filenames;
6882 #endif /* NTGUI_UNICODE */
6884 /* Detect when the Filter dropdown is changed. */
6885 if (use_unicode)
6886 dropdown_changed =
6887 notify_w->hdr.code == CDN_TYPECHANGE
6888 || notify_w->hdr.code == CDN_INITDONE;
6889 else
6890 dropdown_changed =
6891 notify_a->hdr.code == CDN_TYPECHANGE
6892 || notify_a->hdr.code == CDN_INITDONE;
6893 if (dropdown_changed)
6895 HWND dialog = GetParent (hwnd);
6896 HWND edit_control = GetDlgItem (dialog, FILE_NAME_TEXT_FIELD);
6897 HWND list = GetDlgItem (dialog, FILE_NAME_LIST);
6898 int hdr_code;
6900 /* At least on Windows 7, the above attempt to get the window handle
6901 to the File Name Text Field fails. The following code does the
6902 job though. Note that this code is based on my examination of the
6903 window hierarchy using Microsoft Spy++. bk */
6904 if (edit_control == NULL)
6906 HWND tmp = GetDlgItem (dialog, FILE_NAME_COMBO_BOX);
6907 if (tmp)
6909 tmp = GetWindow (tmp, GW_CHILD);
6910 if (tmp)
6911 edit_control = GetWindow (tmp, GW_CHILD);
6915 /* Directories is in index 2. */
6916 if (use_unicode)
6918 dir_index = notify_w->lpOFN->nFilterIndex;
6919 hdr_code = notify_w->hdr.code;
6921 else
6923 dir_index = notify_a->lpOFN->nFilterIndex;
6924 hdr_code = notify_a->hdr.code;
6926 if (dir_index == 2)
6928 if (use_unicode)
6929 SendMessageW (dialog, CDM_SETCONTROLTEXT, FILE_NAME_TEXT_FIELD,
6930 (LPARAM)L"Current Directory");
6931 else
6932 SendMessageA (dialog, CDM_SETCONTROLTEXT, FILE_NAME_TEXT_FIELD,
6933 (LPARAM)"Current Directory");
6934 EnableWindow (edit_control, FALSE);
6935 /* Note that at least on Windows 7, the above call to EnableWindow
6936 disables the window that would ordinarily have focus. If we
6937 do not set focus to some other window here, focus will land in
6938 no man's land and the user will be unable to tab through the
6939 dialog box (pressing tab will only result in a beep).
6940 Avoid that problem by setting focus to the list here. */
6941 if (hdr_code == CDN_INITDONE)
6942 SetFocus (list);
6944 else
6946 /* Don't override default filename on init done. */
6947 if (hdr_code == CDN_TYPECHANGE)
6949 if (use_unicode)
6950 SendMessageW (dialog, CDM_SETCONTROLTEXT,
6951 FILE_NAME_TEXT_FIELD, (LPARAM)L"");
6952 else
6953 SendMessageA (dialog, CDM_SETCONTROLTEXT,
6954 FILE_NAME_TEXT_FIELD, (LPARAM)"");
6956 EnableWindow (edit_control, TRUE);
6960 return 0;
6963 DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 5, 0,
6964 doc: /* Read file name, prompting with PROMPT in directory DIR.
6965 Use a file selection dialog. Select DEFAULT-FILENAME in the dialog's file
6966 selection box, if specified. If MUSTMATCH is non-nil, the returned file
6967 or directory must exist.
6969 This function is only defined on NS, MS Windows, and X Windows with the
6970 Motif or Gtk toolkits. With the Motif toolkit, ONLY-DIR-P is ignored.
6971 Otherwise, if ONLY-DIR-P is non-nil, the user can only select directories.
6972 On Windows 7 and later, the file selection dialog "remembers" the last
6973 directory where the user selected a file, and will open that directory
6974 instead of DIR on subsequent invocations of this function with the same
6975 value of DIR as in previous invocations; this is standard Windows behavior. */)
6976 (Lisp_Object prompt, Lisp_Object dir, Lisp_Object default_filename, Lisp_Object mustmatch, Lisp_Object only_dir_p)
6978 /* Filter index: 1: All Files, 2: Directories only */
6979 static const wchar_t filter_w[] = L"All Files (*.*)\0*.*\0Directories\0*|*\0";
6980 static const char filter_a[] = "All Files (*.*)\0*.*\0Directories\0*|*\0";
6982 Lisp_Object filename = default_filename;
6983 struct frame *f = SELECTED_FRAME ();
6984 BOOL file_opened = FALSE;
6985 Lisp_Object orig_dir = dir;
6986 Lisp_Object orig_prompt = prompt;
6988 /* If we compile with _WIN32_WINNT set to 0x0400 (for NT4
6989 compatibility) we end up with the old file dialogs. Define a big
6990 enough struct for the new dialog to trick GetOpenFileName into
6991 giving us the new dialogs on newer versions of Windows. */
6992 struct {
6993 OPENFILENAMEW details;
6994 #if _WIN32_WINNT < 0x500 /* < win2k */
6995 PVOID pvReserved;
6996 DWORD dwReserved;
6997 DWORD FlagsEx;
6998 #endif /* < win2k */
6999 } new_file_details_w;
7001 #ifdef NTGUI_UNICODE
7002 wchar_t filename_buf_w[32*1024 + 1]; // NT kernel maximum
7003 OPENFILENAMEW * file_details_w = &new_file_details_w.details;
7004 const int use_unicode = 1;
7005 #else /* not NTGUI_UNICODE */
7006 struct {
7007 OPENFILENAMEA details;
7008 #if _WIN32_WINNT < 0x500 /* < win2k */
7009 PVOID pvReserved;
7010 DWORD dwReserved;
7011 DWORD FlagsEx;
7012 #endif /* < win2k */
7013 } new_file_details_a;
7014 wchar_t filename_buf_w[MAX_PATH + 1], dir_w[MAX_PATH];
7015 char filename_buf_a[MAX_PATH + 1], dir_a[MAX_PATH];
7016 OPENFILENAMEW * file_details_w = &new_file_details_w.details;
7017 OPENFILENAMEA * file_details_a = &new_file_details_a.details;
7018 int use_unicode = w32_unicode_filenames;
7019 wchar_t *prompt_w;
7020 char *prompt_a;
7021 int len;
7022 char fname_ret[MAX_UTF8_PATH];
7023 #endif /* NTGUI_UNICODE */
7026 /* Note: under NTGUI_UNICODE, we do _NOT_ use ENCODE_FILE: the
7027 system file encoding expected by the platform APIs (e.g. Cygwin's
7028 POSIX implementation) may not be the same as the encoding expected
7029 by the Windows "ANSI" APIs! */
7031 CHECK_STRING (prompt);
7032 CHECK_STRING (dir);
7034 dir = Fexpand_file_name (dir, Qnil);
7036 if (STRINGP (filename))
7037 filename = Ffile_name_nondirectory (filename);
7038 else
7039 filename = empty_unibyte_string;
7041 #ifdef CYGWIN
7042 dir = Fcygwin_convert_file_name_to_windows (dir, Qt);
7043 if (SCHARS (filename) > 0)
7044 filename = Fcygwin_convert_file_name_to_windows (filename, Qnil);
7045 #endif
7047 CHECK_STRING (dir);
7048 CHECK_STRING (filename);
7050 /* The code in file_dialog_callback that attempts to set the text
7051 of the file name edit window when handling the CDN_INITDONE
7052 WM_NOTIFY message does not work. Setting filename to "Current
7053 Directory" in the only_dir_p case here does work however. */
7054 if (SCHARS (filename) == 0 && ! NILP (only_dir_p))
7055 filename = build_string ("Current Directory");
7057 /* Convert the values we've computed so far to system form. */
7058 #ifdef NTGUI_UNICODE
7059 to_unicode (prompt, &prompt);
7060 to_unicode (dir, &dir);
7061 to_unicode (filename, &filename);
7062 if (SBYTES (filename) + 1 > sizeof (filename_buf_w))
7063 report_file_error ("filename too long", default_filename);
7065 memcpy (filename_buf_w, SDATA (filename), SBYTES (filename) + 1);
7066 #else /* !NTGUI_UNICODE */
7067 prompt = ENCODE_FILE (prompt);
7068 dir = ENCODE_FILE (dir);
7069 filename = ENCODE_FILE (filename);
7071 /* We modify these in-place, so make copies for safety. */
7072 dir = Fcopy_sequence (dir);
7073 unixtodos_filename (SDATA (dir));
7074 filename = Fcopy_sequence (filename);
7075 unixtodos_filename (SDATA (filename));
7076 if (SBYTES (filename) >= MAX_UTF8_PATH)
7077 report_file_error ("filename too long", default_filename);
7078 if (w32_unicode_filenames)
7080 filename_to_utf16 (SSDATA (dir), dir_w);
7081 if (filename_to_utf16 (SSDATA (filename), filename_buf_w) != 0)
7083 /* filename_to_utf16 sets errno to ENOENT when the file
7084 name is too long or cannot be converted to UTF-16. */
7085 if (errno == ENOENT && filename_buf_w[MAX_PATH - 1] != 0)
7086 report_file_error ("filename too long", default_filename);
7088 len = pMultiByteToWideChar (CP_UTF8, MB_ERR_INVALID_CHARS,
7089 SSDATA (prompt), -1, NULL, 0);
7090 if (len > 32768)
7091 len = 32768;
7092 prompt_w = alloca (len * sizeof (wchar_t));
7093 pMultiByteToWideChar (CP_UTF8, MB_ERR_INVALID_CHARS,
7094 SSDATA (prompt), -1, prompt_w, len);
7096 else
7098 filename_to_ansi (SSDATA (dir), dir_a);
7099 if (filename_to_ansi (SSDATA (filename), filename_buf_a) != '\0')
7101 /* filename_to_ansi sets errno to ENOENT when the file
7102 name is too long or cannot be converted to UTF-16. */
7103 if (errno == ENOENT && filename_buf_a[MAX_PATH - 1] != 0)
7104 report_file_error ("filename too long", default_filename);
7106 len = pMultiByteToWideChar (CP_UTF8, MB_ERR_INVALID_CHARS,
7107 SSDATA (prompt), -1, NULL, 0);
7108 if (len > 32768)
7109 len = 32768;
7110 prompt_w = alloca (len * sizeof (wchar_t));
7111 pMultiByteToWideChar (CP_UTF8, MB_ERR_INVALID_CHARS,
7112 SSDATA (prompt), -1, prompt_w, len);
7113 len = pWideCharToMultiByte (CP_ACP, 0, prompt_w, -1, NULL, 0, NULL, NULL);
7114 if (len > 32768)
7115 len = 32768;
7116 prompt_a = alloca (len);
7117 pWideCharToMultiByte (CP_ACP, 0, prompt_w, -1, prompt_a, len, NULL, NULL);
7119 #endif /* NTGUI_UNICODE */
7121 /* Fill in the structure for the call to GetOpenFileName below.
7122 For NTGUI_UNICODE builds (which run only on NT), we just use
7123 the actual size of the structure. For non-NTGUI_UNICODE
7124 builds, we tell the OS we're using an old version of the
7125 structure if the OS isn't new enough to support the newer
7126 version. */
7127 if (use_unicode)
7129 memset (&new_file_details_w, 0, sizeof (new_file_details_w));
7130 if (w32_major_version > 4 && w32_major_version < 95)
7131 file_details_w->lStructSize = sizeof (new_file_details_w);
7132 else
7133 file_details_w->lStructSize = sizeof (*file_details_w);
7134 /* Set up the inout parameter for the selected file name. */
7135 file_details_w->lpstrFile = filename_buf_w;
7136 file_details_w->nMaxFile =
7137 sizeof (filename_buf_w) / sizeof (*filename_buf_w);
7138 file_details_w->hwndOwner = FRAME_W32_WINDOW (f);
7139 /* Undocumented Bug in Common File Dialog:
7140 If a filter is not specified, shell links are not resolved. */
7141 file_details_w->lpstrFilter = filter_w;
7142 #ifdef NTGUI_UNICODE
7143 file_details_w->lpstrInitialDir = (wchar_t*) SDATA (dir);
7144 file_details_w->lpstrTitle = (guichar_t*) SDATA (prompt);
7145 #else
7146 file_details_w->lpstrInitialDir = dir_w;
7147 file_details_w->lpstrTitle = prompt_w;
7148 #endif
7149 file_details_w->nFilterIndex = NILP (only_dir_p) ? 1 : 2;
7150 file_details_w->Flags = (OFN_HIDEREADONLY | OFN_NOCHANGEDIR
7151 | OFN_EXPLORER | OFN_ENABLEHOOK);
7152 if (!NILP (mustmatch))
7154 /* Require that the path to the parent directory exists. */
7155 file_details_w->Flags |= OFN_PATHMUSTEXIST;
7156 /* If we are looking for a file, require that it exists. */
7157 if (NILP (only_dir_p))
7158 file_details_w->Flags |= OFN_FILEMUSTEXIST;
7161 #ifndef NTGUI_UNICODE
7162 else
7164 memset (&new_file_details_a, 0, sizeof (new_file_details_a));
7165 if (w32_major_version > 4 && w32_major_version < 95)
7166 file_details_a->lStructSize = sizeof (new_file_details_a);
7167 else
7168 file_details_a->lStructSize = sizeof (*file_details_a);
7169 file_details_a->lpstrFile = filename_buf_a;
7170 file_details_a->nMaxFile =
7171 sizeof (filename_buf_a) / sizeof (*filename_buf_a);
7172 file_details_a->hwndOwner = FRAME_W32_WINDOW (f);
7173 file_details_a->lpstrFilter = filter_a;
7174 file_details_a->lpstrInitialDir = dir_a;
7175 file_details_a->lpstrTitle = prompt_a;
7176 file_details_a->nFilterIndex = NILP (only_dir_p) ? 1 : 2;
7177 file_details_a->Flags = (OFN_HIDEREADONLY | OFN_NOCHANGEDIR
7178 | OFN_EXPLORER | OFN_ENABLEHOOK);
7179 if (!NILP (mustmatch))
7181 /* Require that the path to the parent directory exists. */
7182 file_details_a->Flags |= OFN_PATHMUSTEXIST;
7183 /* If we are looking for a file, require that it exists. */
7184 if (NILP (only_dir_p))
7185 file_details_a->Flags |= OFN_FILEMUSTEXIST;
7188 #endif /* !NTGUI_UNICODE */
7191 int count = SPECPDL_INDEX ();
7192 /* Prevent redisplay. */
7193 specbind (Qinhibit_redisplay, Qt);
7194 block_input ();
7195 if (use_unicode)
7197 file_details_w->lpfnHook = file_dialog_callback;
7199 file_opened = GetOpenFileNameW (file_details_w);
7201 #ifndef NTGUI_UNICODE
7202 else
7204 file_details_a->lpfnHook = file_dialog_callback;
7206 file_opened = GetOpenFileNameA (file_details_a);
7208 #endif /* !NTGUI_UNICODE */
7209 unblock_input ();
7210 unbind_to (count, Qnil);
7213 if (file_opened)
7215 /* Get an Emacs string from the value Windows gave us. */
7216 #ifdef NTGUI_UNICODE
7217 filename = from_unicode_buffer (filename_buf_w);
7218 #else /* !NTGUI_UNICODE */
7219 if (use_unicode)
7220 filename_from_utf16 (filename_buf_w, fname_ret);
7221 else
7222 filename_from_ansi (filename_buf_a, fname_ret);
7223 dostounix_filename (fname_ret);
7224 filename = DECODE_FILE (build_unibyte_string (fname_ret));
7225 #endif /* NTGUI_UNICODE */
7227 #ifdef CYGWIN
7228 filename = Fcygwin_convert_file_name_from_windows (filename, Qt);
7229 #endif /* CYGWIN */
7231 /* Strip the dummy filename off the end of the string if we
7232 added it to select a directory. */
7233 if ((use_unicode && file_details_w->nFilterIndex == 2)
7234 #ifndef NTGUI_UNICODE
7235 || (!use_unicode && file_details_a->nFilterIndex == 2)
7236 #endif
7238 filename = Ffile_name_directory (filename);
7240 /* User canceled the dialog without making a selection. */
7241 else if (!CommDlgExtendedError ())
7242 filename = Qnil;
7243 /* An error occurred, fallback on reading from the mini-buffer. */
7244 else
7245 filename = Fcompleting_read (
7246 orig_prompt,
7247 intern ("read-file-name-internal"),
7248 orig_dir,
7249 mustmatch,
7250 orig_dir,
7251 Qfile_name_history,
7252 default_filename,
7253 Qnil);
7256 /* Make "Cancel" equivalent to C-g. */
7257 if (NILP (filename))
7258 Fsignal (Qquit, Qnil);
7260 return filename;
7264 #ifdef WINDOWSNT
7265 /* Moving files to the system recycle bin.
7266 Used by `move-file-to-trash' instead of the default moving to ~/.Trash */
7267 DEFUN ("system-move-file-to-trash", Fsystem_move_file_to_trash,
7268 Ssystem_move_file_to_trash, 1, 1, 0,
7269 doc: /* Move file or directory named FILENAME to the recycle bin. */)
7270 (Lisp_Object filename)
7272 Lisp_Object handler;
7273 Lisp_Object encoded_file;
7274 Lisp_Object operation;
7276 operation = Qdelete_file;
7277 if (!NILP (Ffile_directory_p (filename))
7278 && NILP (Ffile_symlink_p (filename)))
7280 operation = intern ("delete-directory");
7281 filename = Fdirectory_file_name (filename);
7284 /* Must have fully qualified file names for moving files to Recycle
7285 Bin. */
7286 filename = Fexpand_file_name (filename, Qnil);
7288 handler = Ffind_file_name_handler (filename, operation);
7289 if (!NILP (handler))
7290 return call2 (handler, operation, filename);
7291 else
7293 const char * path;
7294 int result;
7296 encoded_file = ENCODE_FILE (filename);
7298 path = map_w32_filename (SDATA (encoded_file), NULL);
7300 /* The Unicode version of SHFileOperation is not supported on
7301 Windows 9X. */
7302 if (w32_unicode_filenames && os_subtype != OS_9X)
7304 SHFILEOPSTRUCTW file_op_w;
7305 /* We need one more element beyond MAX_PATH because this is
7306 a list of file names, with the last element double-null
7307 terminated. */
7308 wchar_t tmp_path_w[MAX_PATH + 1];
7310 memset (tmp_path_w, 0, sizeof (tmp_path_w));
7311 filename_to_utf16 (path, tmp_path_w);
7313 /* On Windows, write permission is required to delete/move files. */
7314 _wchmod (tmp_path_w, 0666);
7316 memset (&file_op_w, 0, sizeof (file_op_w));
7317 file_op_w.hwnd = HWND_DESKTOP;
7318 file_op_w.wFunc = FO_DELETE;
7319 file_op_w.pFrom = tmp_path_w;
7320 file_op_w.fFlags = FOF_SILENT | FOF_NOCONFIRMATION | FOF_ALLOWUNDO
7321 | FOF_NOERRORUI | FOF_NO_CONNECTED_ELEMENTS;
7322 file_op_w.fAnyOperationsAborted = FALSE;
7324 result = SHFileOperationW (&file_op_w);
7326 else
7328 SHFILEOPSTRUCTA file_op_a;
7329 char tmp_path_a[MAX_PATH + 1];
7331 memset (tmp_path_a, 0, sizeof (tmp_path_a));
7332 filename_to_ansi (path, tmp_path_a);
7334 /* If a file cannot be represented in ANSI codepage, don't
7335 let them inadvertently delete other files because some
7336 characters are interpreted as a wildcards. */
7337 if (_mbspbrk (tmp_path_a, "?*"))
7338 result = ERROR_FILE_NOT_FOUND;
7339 else
7341 _chmod (tmp_path_a, 0666);
7343 memset (&file_op_a, 0, sizeof (file_op_a));
7344 file_op_a.hwnd = HWND_DESKTOP;
7345 file_op_a.wFunc = FO_DELETE;
7346 file_op_a.pFrom = tmp_path_a;
7347 file_op_a.fFlags = FOF_SILENT | FOF_NOCONFIRMATION | FOF_ALLOWUNDO
7348 | FOF_NOERRORUI | FOF_NO_CONNECTED_ELEMENTS;
7349 file_op_a.fAnyOperationsAborted = FALSE;
7351 result = SHFileOperationA (&file_op_a);
7354 if (result != 0)
7355 report_file_error ("Removing old name", list1 (filename));
7357 return Qnil;
7360 #endif /* WINDOWSNT */
7363 /***********************************************************************
7364 w32 specialized functions
7365 ***********************************************************************/
7367 DEFUN ("w32-send-sys-command", Fw32_send_sys_command,
7368 Sw32_send_sys_command, 1, 2, 0,
7369 doc: /* Send frame a Windows WM_SYSCOMMAND message of type COMMAND.
7370 Some useful values for COMMAND are #xf030 to maximize frame (#xf020
7371 to minimize), #xf120 to restore frame to original size, and #xf100
7372 to activate the menubar for keyboard access. #xf140 activates the
7373 screen saver if defined.
7375 If optional parameter FRAME is not specified, use selected frame. */)
7376 (Lisp_Object command, Lisp_Object frame)
7378 struct frame *f = decode_window_system_frame (frame);
7380 CHECK_NUMBER (command);
7382 if (FRAME_W32_P (f))
7383 PostMessage (FRAME_W32_WINDOW (f), WM_SYSCOMMAND, XINT (command), 0);
7385 return Qnil;
7388 DEFUN ("w32-shell-execute", Fw32_shell_execute, Sw32_shell_execute, 2, 4, 0,
7389 doc: /* Get Windows to perform OPERATION on DOCUMENT.
7390 This is a wrapper around the ShellExecute system function, which
7391 invokes the application registered to handle OPERATION for DOCUMENT.
7393 OPERATION is either nil or a string that names a supported operation.
7394 What operations can be used depends on the particular DOCUMENT and its
7395 handler application, but typically it is one of the following common
7396 operations:
7398 \"open\" - open DOCUMENT, which could be a file, a directory, or an
7399 executable program (application). If it is an application,
7400 that application is launched in the current buffer's default
7401 directory. Otherwise, the application associated with
7402 DOCUMENT is launched in the buffer's default directory.
7403 \"opennew\" - like \"open\", but instruct the application to open
7404 DOCUMENT in a new window.
7405 \"openas\" - open the \"Open With\" dialog for DOCUMENT.
7406 \"print\" - print DOCUMENT, which must be a file.
7407 \"printto\" - print DOCUMENT, which must be a file, to a specified printer.
7408 The printer should be provided in PARAMETERS, see below.
7409 \"explore\" - start the Windows Explorer on DOCUMENT.
7410 \"edit\" - launch an editor and open DOCUMENT for editing; which
7411 editor is launched depends on the association for the
7412 specified DOCUMENT.
7413 \"find\" - initiate search starting from DOCUMENT, which must specify
7414 a directory.
7415 \"delete\" - move DOCUMENT, a file or a directory, to Recycle Bin.
7416 \"copy\" - copy DOCUMENT, which must be a file or a directory, into
7417 the clipboard.
7418 \"cut\" - move DOCUMENT, a file or a directory, into the clipboard.
7419 \"paste\" - paste the file whose name is in the clipboard into DOCUMENT,
7420 which must be a directory.
7421 \"pastelink\"
7422 - create a shortcut in DOCUMENT (which must be a directory)
7423 the file or directory whose name is in the clipboard.
7424 \"runas\" - run DOCUMENT, which must be an excutable file, with
7425 elevated privileges (a.k.a. \"as Administrator\").
7426 \"properties\"
7427 - open the property sheet dialog for DOCUMENT.
7428 nil - invoke the default OPERATION, or \"open\" if default is
7429 not defined or unavailable.
7431 DOCUMENT is typically the name of a document file or a URL, but can
7432 also be an executable program to run, or a directory to open in the
7433 Windows Explorer. If it is a file or a directory, it must be a local
7434 one; this function does not support remote file names.
7436 If DOCUMENT is an executable program, the optional third arg PARAMETERS
7437 can be a string containing command line parameters, separated by blanks,
7438 that will be passed to the program. Some values of OPERATION also require
7439 parameters (e.g., \"printto\" requires the printer address). Otherwise,
7440 PARAMETERS should be nil or unspecified. Note that double quote characters
7441 in PARAMETERS must each be enclosed in 2 additional quotes, as in \"\"\".
7443 Optional fourth argument SHOW-FLAG can be used to control how the
7444 application will be displayed when it is invoked. If SHOW-FLAG is nil
7445 or unspecified, the application is displayed as if SHOW-FLAG of 10 was
7446 specified, otherwise it is an integer between 0 and 11 representing
7447 a ShowWindow flag:
7449 0 - start hidden
7450 1 - start as normal-size window
7451 3 - start in a maximized window
7452 6 - start in a minimized window
7453 10 - start as the application itself specifies; this is the default. */)
7454 (Lisp_Object operation, Lisp_Object document, Lisp_Object parameters, Lisp_Object show_flag)
7456 char *errstr;
7457 Lisp_Object current_dir = BVAR (current_buffer, directory);;
7458 wchar_t *doc_w = NULL, *params_w = NULL, *ops_w = NULL;
7459 #ifdef CYGWIN
7460 intptr_t result;
7461 #else
7462 int use_unicode = w32_unicode_filenames;
7463 char *doc_a = NULL, *params_a = NULL, *ops_a = NULL;
7464 Lisp_Object absdoc, handler;
7465 BOOL success;
7466 #endif
7468 CHECK_STRING (document);
7470 #ifdef CYGWIN
7471 current_dir = Fcygwin_convert_file_name_to_windows (current_dir, Qt);
7472 document = Fcygwin_convert_file_name_to_windows (document, Qt);
7474 /* Encode filename, current directory and parameters. */
7475 current_dir = GUI_ENCODE_FILE (current_dir);
7476 document = GUI_ENCODE_FILE (document);
7477 doc_w = GUI_SDATA (document);
7478 if (STRINGP (parameters))
7480 parameters = GUI_ENCODE_SYSTEM (parameters);
7481 params_w = GUI_SDATA (parameters);
7483 if (STRINGP (operation))
7485 operation = GUI_ENCODE_SYSTEM (operation);
7486 ops_w = GUI_SDATA (operation);
7488 result = (intptr_t) ShellExecuteW (NULL, ops_w, doc_w, params_w,
7489 GUI_SDATA (current_dir),
7490 (INTEGERP (show_flag)
7491 ? XINT (show_flag) : SW_SHOWDEFAULT));
7493 if (result > 32)
7494 return Qt;
7496 switch (result)
7498 case SE_ERR_ACCESSDENIED:
7499 errstr = w32_strerror (ERROR_ACCESS_DENIED);
7500 break;
7501 case SE_ERR_ASSOCINCOMPLETE:
7502 case SE_ERR_NOASSOC:
7503 errstr = w32_strerror (ERROR_NO_ASSOCIATION);
7504 break;
7505 case SE_ERR_DDEBUSY:
7506 case SE_ERR_DDEFAIL:
7507 errstr = w32_strerror (ERROR_DDE_FAIL);
7508 break;
7509 case SE_ERR_DDETIMEOUT:
7510 errstr = w32_strerror (ERROR_TIMEOUT);
7511 break;
7512 case SE_ERR_DLLNOTFOUND:
7513 errstr = w32_strerror (ERROR_DLL_NOT_FOUND);
7514 break;
7515 case SE_ERR_FNF:
7516 errstr = w32_strerror (ERROR_FILE_NOT_FOUND);
7517 break;
7518 case SE_ERR_OOM:
7519 errstr = w32_strerror (ERROR_NOT_ENOUGH_MEMORY);
7520 break;
7521 case SE_ERR_PNF:
7522 errstr = w32_strerror (ERROR_PATH_NOT_FOUND);
7523 break;
7524 case SE_ERR_SHARE:
7525 errstr = w32_strerror (ERROR_SHARING_VIOLATION);
7526 break;
7527 default:
7528 errstr = w32_strerror (0);
7529 break;
7532 #else /* !CYGWIN */
7534 const char file_url_str[] = "file:///";
7535 const int file_url_len = sizeof (file_url_str) - 1;
7536 int doclen;
7538 if (strncmp (SSDATA (document), file_url_str, file_url_len) == 0)
7540 /* Passing "file:///" URLs to ShellExecute causes shlwapi.dll to
7541 start a thread in some rare system configurations, for
7542 unknown reasons. That thread is started in the context of
7543 the Emacs process, but out of control of our code, and seems
7544 to never exit afterwards. Each such thread reserves 8MB of
7545 stack space (because that's the value recorded in the Emacs
7546 executable at link time: Emacs needs a large stack). So a
7547 large enough number of invocations of w32-shell-execute can
7548 potentially cause the Emacs process to run out of available
7549 address space, which is nasty. To work around this, we
7550 convert such URLs to local file names, which seems to prevent
7551 those threads from starting. See bug #20220. */
7552 char *p = SSDATA (document) + file_url_len;
7554 if (c_isalpha (*p) && p[1] == ':' && IS_DIRECTORY_SEP (p[2]))
7555 document = Fsubstring_no_properties (document,
7556 make_number (file_url_len), Qnil);
7558 /* We have a situation here. If DOCUMENT is a relative file name,
7559 but its name includes leading directories, i.e. it lives not in
7560 CURRENT_DIR, but in its subdirectory, then ShellExecute below
7561 will fail to find it. So we need to make the file name is
7562 absolute. But DOCUMENT does not have to be a file, it can be a
7563 URL, for example. So we make it absolute only if it is an
7564 existing file; if it is a file that does not exist, tough. */
7565 absdoc = Fexpand_file_name (document, Qnil);
7566 /* Don't call file handlers for file-exists-p, since they might
7567 attempt to access the file, which could fail or produce undesired
7568 consequences, see bug#16558 for an example. */
7569 handler = Ffind_file_name_handler (absdoc, Qfile_exists_p);
7570 if (NILP (handler))
7572 Lisp_Object absdoc_encoded = ENCODE_FILE (absdoc);
7574 if (faccessat (AT_FDCWD, SSDATA (absdoc_encoded), F_OK, AT_EACCESS) == 0)
7576 /* ShellExecute fails if DOCUMENT is a UNC with forward
7577 slashes (expand-file-name above converts all backslashes
7578 to forward slashes). Now that we know DOCUMENT is a
7579 file, we can mirror all forward slashes into backslashes. */
7580 unixtodos_filename (SSDATA (absdoc_encoded));
7581 document = absdoc_encoded;
7583 else
7584 document = ENCODE_FILE (document);
7586 else
7587 document = ENCODE_FILE (document);
7589 current_dir = ENCODE_FILE (current_dir);
7590 /* Cannot use filename_to_utf16/ansi with DOCUMENT, since it could
7591 be a URL that is not limited to MAX_PATH chararcters. */
7592 doclen = pMultiByteToWideChar (CP_UTF8, MB_ERR_INVALID_CHARS,
7593 SSDATA (document), -1, NULL, 0);
7594 doc_w = xmalloc (doclen * sizeof (wchar_t));
7595 pMultiByteToWideChar (CP_UTF8, MB_ERR_INVALID_CHARS,
7596 SSDATA (document), -1, doc_w, doclen);
7597 if (use_unicode)
7599 wchar_t current_dir_w[MAX_PATH];
7600 SHELLEXECUTEINFOW shexinfo_w;
7602 /* Encode the current directory and parameters, and convert
7603 operation to UTF-16. */
7604 filename_to_utf16 (SSDATA (current_dir), current_dir_w);
7605 if (STRINGP (parameters))
7607 int len;
7609 parameters = ENCODE_SYSTEM (parameters);
7610 len = pMultiByteToWideChar (CP_ACP, MB_ERR_INVALID_CHARS,
7611 SSDATA (parameters), -1, NULL, 0);
7612 if (len > 32768)
7613 len = 32768;
7614 params_w = alloca (len * sizeof (wchar_t));
7615 pMultiByteToWideChar (CP_ACP, MB_ERR_INVALID_CHARS,
7616 SSDATA (parameters), -1, params_w, len);
7617 params_w[len - 1] = 0;
7619 if (STRINGP (operation))
7621 /* Assume OPERATION is pure ASCII. */
7622 const char *s = SSDATA (operation);
7623 wchar_t *d;
7624 int len = SBYTES (operation) + 1;
7626 if (len > 32768)
7627 len = 32768;
7628 d = ops_w = alloca (len * sizeof (wchar_t));
7629 while (d < ops_w + len - 1)
7630 *d++ = *s++;
7631 *d = 0;
7634 /* Using ShellExecuteEx and setting the SEE_MASK_INVOKEIDLIST
7635 flag succeeds with more OPERATIONs (a.k.a. "verbs"), as it is
7636 able to invoke verbs from shortcut menu extensions, not just
7637 static verbs listed in the Registry. */
7638 memset (&shexinfo_w, 0, sizeof (shexinfo_w));
7639 shexinfo_w.cbSize = sizeof (shexinfo_w);
7640 shexinfo_w.fMask =
7641 SEE_MASK_INVOKEIDLIST | SEE_MASK_FLAG_DDEWAIT | SEE_MASK_FLAG_NO_UI;
7642 shexinfo_w.hwnd = NULL;
7643 shexinfo_w.lpVerb = ops_w;
7644 shexinfo_w.lpFile = doc_w;
7645 shexinfo_w.lpParameters = params_w;
7646 shexinfo_w.lpDirectory = current_dir_w;
7647 shexinfo_w.nShow =
7648 (INTEGERP (show_flag) ? XINT (show_flag) : SW_SHOWDEFAULT);
7649 success = ShellExecuteExW (&shexinfo_w);
7650 xfree (doc_w);
7652 else
7654 char document_a[MAX_PATH], current_dir_a[MAX_PATH];
7655 SHELLEXECUTEINFOA shexinfo_a;
7656 int codepage = codepage_for_filenames (NULL);
7657 int ldoc_a = pWideCharToMultiByte (codepage, 0, doc_w, -1, NULL, 0,
7658 NULL, NULL);
7660 doc_a = xmalloc (ldoc_a);
7661 pWideCharToMultiByte (codepage, 0, doc_w, -1, doc_a, ldoc_a, NULL, NULL);
7662 filename_to_ansi (SSDATA (current_dir), current_dir_a);
7663 if (STRINGP (parameters))
7665 parameters = ENCODE_SYSTEM (parameters);
7666 params_a = SSDATA (parameters);
7668 if (STRINGP (operation))
7670 /* Assume OPERATION is pure ASCII. */
7671 ops_a = SSDATA (operation);
7673 memset (&shexinfo_a, 0, sizeof (shexinfo_a));
7674 shexinfo_a.cbSize = sizeof (shexinfo_a);
7675 shexinfo_a.fMask =
7676 SEE_MASK_INVOKEIDLIST | SEE_MASK_FLAG_DDEWAIT | SEE_MASK_FLAG_NO_UI;
7677 shexinfo_a.hwnd = NULL;
7678 shexinfo_a.lpVerb = ops_a;
7679 shexinfo_a.lpFile = doc_a;
7680 shexinfo_a.lpParameters = params_a;
7681 shexinfo_a.lpDirectory = current_dir_a;
7682 shexinfo_a.nShow =
7683 (INTEGERP (show_flag) ? XINT (show_flag) : SW_SHOWDEFAULT);
7684 success = ShellExecuteExA (&shexinfo_a);
7685 xfree (doc_w);
7686 xfree (doc_a);
7689 if (success)
7690 return Qt;
7692 errstr = w32_strerror (0);
7694 #endif /* !CYGWIN */
7696 /* The error string might be encoded in the locale's encoding. */
7697 if (!NILP (Vlocale_coding_system))
7699 Lisp_Object decoded =
7700 code_convert_string_norecord (build_unibyte_string (errstr),
7701 Vlocale_coding_system, 0);
7702 errstr = SSDATA (decoded);
7704 error ("ShellExecute failed: %s", errstr);
7707 /* Lookup virtual keycode from string representing the name of a
7708 non-ascii keystroke into the corresponding virtual key, using
7709 lispy_function_keys. */
7710 static int
7711 lookup_vk_code (char *key)
7713 int i;
7715 for (i = 0; i < 256; i++)
7716 if (lispy_function_keys[i]
7717 && strcmp (lispy_function_keys[i], key) == 0)
7718 return i;
7720 return -1;
7723 /* Convert a one-element vector style key sequence to a hot key
7724 definition. */
7725 static Lisp_Object
7726 w32_parse_hot_key (Lisp_Object key)
7728 /* Copied from Fdefine_key and store_in_keymap. */
7729 register Lisp_Object c;
7730 int vk_code;
7731 int lisp_modifiers;
7732 int w32_modifiers;
7734 CHECK_VECTOR (key);
7736 if (ASIZE (key) != 1)
7737 return Qnil;
7739 c = AREF (key, 0);
7741 if (CONSP (c) && lucid_event_type_list_p (c))
7742 c = Fevent_convert_list (c);
7744 if (! INTEGERP (c) && ! SYMBOLP (c))
7745 error ("Key definition is invalid");
7747 /* Work out the base key and the modifiers. */
7748 if (SYMBOLP (c))
7750 c = parse_modifiers (c);
7751 lisp_modifiers = XINT (Fcar (Fcdr (c)));
7752 c = Fcar (c);
7753 if (!SYMBOLP (c))
7754 emacs_abort ();
7755 vk_code = lookup_vk_code (SDATA (SYMBOL_NAME (c)));
7757 else if (INTEGERP (c))
7759 lisp_modifiers = XINT (c) & ~CHARACTERBITS;
7760 /* Many ascii characters are their own virtual key code. */
7761 vk_code = XINT (c) & CHARACTERBITS;
7764 if (vk_code < 0 || vk_code > 255)
7765 return Qnil;
7767 if ((lisp_modifiers & meta_modifier) != 0
7768 && !NILP (Vw32_alt_is_meta))
7769 lisp_modifiers |= alt_modifier;
7771 /* Supply defs missing from mingw32. */
7772 #ifndef MOD_ALT
7773 #define MOD_ALT 0x0001
7774 #define MOD_CONTROL 0x0002
7775 #define MOD_SHIFT 0x0004
7776 #define MOD_WIN 0x0008
7777 #endif
7779 /* Convert lisp modifiers to Windows hot-key form. */
7780 w32_modifiers = (lisp_modifiers & hyper_modifier) ? MOD_WIN : 0;
7781 w32_modifiers |= (lisp_modifiers & alt_modifier) ? MOD_ALT : 0;
7782 w32_modifiers |= (lisp_modifiers & ctrl_modifier) ? MOD_CONTROL : 0;
7783 w32_modifiers |= (lisp_modifiers & shift_modifier) ? MOD_SHIFT : 0;
7785 return HOTKEY (vk_code, w32_modifiers);
7788 DEFUN ("w32-register-hot-key", Fw32_register_hot_key,
7789 Sw32_register_hot_key, 1, 1, 0,
7790 doc: /* Register KEY as a hot-key combination.
7791 Certain key combinations like Alt-Tab are reserved for system use on
7792 Windows, and therefore are normally intercepted by the system. However,
7793 most of these key combinations can be received by registering them as
7794 hot-keys, overriding their special meaning.
7796 KEY must be a one element key definition in vector form that would be
7797 acceptable to `define-key' (e.g. [A-tab] for Alt-Tab). The meta
7798 modifier is interpreted as Alt if `w32-alt-is-meta' is t, and hyper
7799 is always interpreted as the Windows modifier keys.
7801 The return value is the hotkey-id if registered, otherwise nil. */)
7802 (Lisp_Object key)
7804 key = w32_parse_hot_key (key);
7806 if (!NILP (key) && NILP (Fmemq (key, w32_grabbed_keys)))
7808 /* Reuse an empty slot if possible. */
7809 Lisp_Object item = Fmemq (Qnil, w32_grabbed_keys);
7811 /* Safe to add new key to list, even if we have focus. */
7812 if (NILP (item))
7813 w32_grabbed_keys = Fcons (key, w32_grabbed_keys);
7814 else
7815 XSETCAR (item, key);
7817 /* Notify input thread about new hot-key definition, so that it
7818 takes effect without needing to switch focus. */
7819 PostThreadMessage (dwWindowsThreadId, WM_EMACS_REGISTER_HOT_KEY,
7820 (WPARAM) XINT (key), 0);
7823 return key;
7826 DEFUN ("w32-unregister-hot-key", Fw32_unregister_hot_key,
7827 Sw32_unregister_hot_key, 1, 1, 0,
7828 doc: /* Unregister KEY as a hot-key combination. */)
7829 (Lisp_Object key)
7831 Lisp_Object item;
7833 if (!INTEGERP (key))
7834 key = w32_parse_hot_key (key);
7836 item = Fmemq (key, w32_grabbed_keys);
7838 if (!NILP (item))
7840 LPARAM lparam;
7842 eassert (CONSP (item));
7843 /* Pass the tail of the list as a pointer to a Lisp_Cons cell,
7844 so that it works in a --with-wide-int build as well. */
7845 lparam = (LPARAM) XUNTAG (item, Lisp_Cons);
7847 /* Notify input thread about hot-key definition being removed, so
7848 that it takes effect without needing focus switch. */
7849 if (PostThreadMessage (dwWindowsThreadId, WM_EMACS_UNREGISTER_HOT_KEY,
7850 (WPARAM) XINT (XCAR (item)), lparam))
7852 MSG msg;
7853 GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE);
7855 return Qt;
7857 return Qnil;
7860 DEFUN ("w32-registered-hot-keys", Fw32_registered_hot_keys,
7861 Sw32_registered_hot_keys, 0, 0, 0,
7862 doc: /* Return list of registered hot-key IDs. */)
7863 (void)
7865 return Fdelq (Qnil, Fcopy_sequence (w32_grabbed_keys));
7868 DEFUN ("w32-reconstruct-hot-key", Fw32_reconstruct_hot_key,
7869 Sw32_reconstruct_hot_key, 1, 1, 0,
7870 doc: /* Convert hot-key ID to a lisp key combination.
7871 usage: (w32-reconstruct-hot-key ID) */)
7872 (Lisp_Object hotkeyid)
7874 int vk_code, w32_modifiers;
7875 Lisp_Object key;
7877 CHECK_NUMBER (hotkeyid);
7879 vk_code = HOTKEY_VK_CODE (hotkeyid);
7880 w32_modifiers = HOTKEY_MODIFIERS (hotkeyid);
7882 if (vk_code < 256 && lispy_function_keys[vk_code])
7883 key = intern (lispy_function_keys[vk_code]);
7884 else
7885 key = make_number (vk_code);
7887 key = Fcons (key, Qnil);
7888 if (w32_modifiers & MOD_SHIFT)
7889 key = Fcons (Qshift, key);
7890 if (w32_modifiers & MOD_CONTROL)
7891 key = Fcons (Qctrl, key);
7892 if (w32_modifiers & MOD_ALT)
7893 key = Fcons (NILP (Vw32_alt_is_meta) ? Qalt : Qmeta, key);
7894 if (w32_modifiers & MOD_WIN)
7895 key = Fcons (Qhyper, key);
7897 return key;
7900 DEFUN ("w32-toggle-lock-key", Fw32_toggle_lock_key,
7901 Sw32_toggle_lock_key, 1, 2, 0,
7902 doc: /* Toggle the state of the lock key KEY.
7903 KEY can be `capslock', `kp-numlock', or `scroll'.
7904 If the optional parameter NEW-STATE is a number, then the state of KEY
7905 is set to off if the low bit of NEW-STATE is zero, otherwise on.
7906 If NEW-STATE is omitted or nil, the function toggles the state,
7908 Value is the new state of the key, or nil if the function failed
7909 to change the state. */)
7910 (Lisp_Object key, Lisp_Object new_state)
7912 int vk_code;
7913 LPARAM lparam;
7915 if (EQ (key, intern ("capslock")))
7916 vk_code = VK_CAPITAL;
7917 else if (EQ (key, intern ("kp-numlock")))
7918 vk_code = VK_NUMLOCK;
7919 else if (EQ (key, intern ("scroll")))
7920 vk_code = VK_SCROLL;
7921 else
7922 return Qnil;
7924 if (!dwWindowsThreadId)
7925 return make_number (w32_console_toggle_lock_key (vk_code, new_state));
7927 if (NILP (new_state))
7928 lparam = -1;
7929 else
7930 lparam = (XUINT (new_state)) & 1;
7931 if (PostThreadMessage (dwWindowsThreadId, WM_EMACS_TOGGLE_LOCK_KEY,
7932 (WPARAM) vk_code, lparam))
7934 MSG msg;
7935 GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE);
7936 return make_number (msg.wParam);
7938 return Qnil;
7941 DEFUN ("w32-window-exists-p", Fw32_window_exists_p, Sw32_window_exists_p,
7942 2, 2, 0,
7943 doc: /* Return non-nil if a window exists with the specified CLASS and NAME.
7945 This is a direct interface to the Windows API FindWindow function. */)
7946 (Lisp_Object class, Lisp_Object name)
7948 HWND hnd;
7950 if (!NILP (class))
7951 CHECK_STRING (class);
7952 if (!NILP (name))
7953 CHECK_STRING (name);
7955 hnd = FindWindow (STRINGP (class) ? ((LPCTSTR) SDATA (class)) : NULL,
7956 STRINGP (name) ? ((LPCTSTR) SDATA (name)) : NULL);
7957 if (!hnd)
7958 return Qnil;
7959 return Qt;
7962 DEFUN ("w32-frame-geometry", Fw32_frame_geometry, Sw32_frame_geometry, 0, 1, 0,
7963 doc: /* Return geometric attributes of FRAME.
7964 FRAME must be a live frame and defaults to the selected one. The return
7965 value is an association list of the attributes listed below. All height
7966 and width values are in pixels.
7968 `outer-position' is a cons of the outer left and top edges of FRAME
7969 relative to the origin - the position (0, 0) - of FRAME's display.
7971 `outer-size' is a cons of the outer width and height of FRAME. The
7972 outer size includes the title bar and the external borders as well as
7973 any menu and/or tool bar of frame.
7975 `external-border-size' is a cons of the horizontal and vertical width of
7976 FRAME's external borders as supplied by the window manager.
7978 `title-bar-size' is a cons of the width and height of the title bar of
7979 FRAME as supplied by the window manager. If both of them are zero,
7980 FRAME has no title bar. If only the width is zero, Emacs was not
7981 able to retrieve the width information.
7983 `menu-bar-external', if non-nil, means the menu bar is external (never
7984 included in the inner edges of FRAME).
7986 `menu-bar-size' is a cons of the width and height of the menu bar of
7987 FRAME.
7989 `tool-bar-external', if non-nil, means the tool bar is external (never
7990 included in the inner edges of FRAME).
7992 `tool-bar-position' tells on which side the tool bar on FRAME is and can
7993 be one of `left', `top', `right' or `bottom'. If this is nil, FRAME
7994 has no tool bar.
7996 `tool-bar-size' is a cons of the width and height of the tool bar of
7997 FRAME.
7999 `internal-border-width' is the width of the internal border of
8000 FRAME. */)
8001 (Lisp_Object frame)
8003 struct frame *f = decode_live_frame (frame);
8005 MENUBARINFO menu_bar;
8006 WINDOWINFO window;
8007 int left, top, right, bottom;
8008 unsigned int external_border_width, external_border_height;
8009 int title_bar_width = 0, title_bar_height = 0;
8010 int single_menu_bar_height, wrapped_menu_bar_height, menu_bar_height;
8011 int tool_bar_height = FRAME_TOOL_BAR_HEIGHT (f);
8012 int internal_border_width = FRAME_INTERNAL_BORDER_WIDTH (f);
8013 bool fullboth = EQ (get_frame_param (f, Qfullscreen), Qfullboth);
8015 if (FRAME_INITIAL_P (f) || !FRAME_W32_P (f))
8016 return Qnil;
8018 block_input ();
8019 /* Outer rectangle and borders. */
8020 window.cbSize = sizeof (window);
8021 GetWindowInfo (FRAME_W32_WINDOW (f), &window);
8022 external_border_width = window.cxWindowBorders;
8023 external_border_height = window.cyWindowBorders;
8024 /* Title bar. */
8025 if (get_title_bar_info_fn)
8027 TITLEBAR_INFO title_bar;
8029 title_bar.cbSize = sizeof (title_bar);
8030 title_bar.rcTitleBar.left = title_bar.rcTitleBar.right = 0;
8031 title_bar.rcTitleBar.top = title_bar.rcTitleBar.bottom = 0;
8032 for (int i = 0; i < 6; i++)
8033 title_bar.rgstate[i] = 0;
8034 if (get_title_bar_info_fn (FRAME_W32_WINDOW (f), &title_bar)
8035 && !(title_bar.rgstate[0] & 0x00008001))
8037 title_bar_width
8038 = title_bar.rcTitleBar.right - title_bar.rcTitleBar.left;
8039 title_bar_height
8040 = title_bar.rcTitleBar.bottom - title_bar.rcTitleBar.top;
8043 else if ((window.dwStyle & WS_CAPTION) == WS_CAPTION)
8044 title_bar_height = GetSystemMetrics (SM_CYCAPTION);
8045 /* Menu bar. */
8046 menu_bar.cbSize = sizeof (menu_bar);
8047 menu_bar.rcBar.right = menu_bar.rcBar.left = 0;
8048 menu_bar.rcBar.top = menu_bar.rcBar.bottom = 0;
8049 GetMenuBarInfo (FRAME_W32_WINDOW (f), 0xFFFFFFFD, 0, &menu_bar);
8050 single_menu_bar_height = GetSystemMetrics (SM_CYMENU);
8051 wrapped_menu_bar_height = GetSystemMetrics (SM_CYMENUSIZE);
8052 unblock_input ();
8054 left = window.rcWindow.left;
8055 top = window.rcWindow.top;
8056 right = window.rcWindow.right;
8057 bottom = window.rcWindow.bottom;
8059 /* Menu bar. */
8060 menu_bar_height = menu_bar.rcBar.bottom - menu_bar.rcBar.top;
8061 /* Fix menu bar height reported by GetMenuBarInfo. */
8062 if (menu_bar_height > single_menu_bar_height)
8063 /* A wrapped menu bar. */
8064 menu_bar_height += single_menu_bar_height - wrapped_menu_bar_height;
8065 else if (menu_bar_height > 0)
8066 /* A single line menu bar. */
8067 menu_bar_height = single_menu_bar_height;
8069 return listn (CONSTYPE_HEAP, 10,
8070 Fcons (Qouter_position,
8071 Fcons (make_number (left), make_number (top))),
8072 Fcons (Qouter_size,
8073 Fcons (make_number (right - left),
8074 make_number (bottom - top))),
8075 Fcons (Qexternal_border_size,
8076 Fcons (make_number (external_border_width),
8077 make_number (external_border_height))),
8078 Fcons (Qtitle_bar_size,
8079 Fcons (make_number (title_bar_width),
8080 make_number (title_bar_height))),
8081 Fcons (Qmenu_bar_external, Qt),
8082 Fcons (Qmenu_bar_size,
8083 Fcons (make_number
8084 (menu_bar.rcBar.right - menu_bar.rcBar.left),
8085 make_number (menu_bar_height))),
8086 Fcons (Qtool_bar_external, Qnil),
8087 Fcons (Qtool_bar_position, tool_bar_height ? Qtop : Qnil),
8088 Fcons (Qtool_bar_size,
8089 Fcons (make_number
8090 (tool_bar_height
8091 ? right - left - 2 * internal_border_width
8092 : 0),
8093 make_number (tool_bar_height))),
8094 Fcons (Qinternal_border_width,
8095 make_number (internal_border_width)));
8098 DEFUN ("w32-frame-edges", Fw32_frame_edges, Sw32_frame_edges, 0, 2, 0,
8099 doc: /* Return edge coordinates of FRAME.
8100 FRAME must be a live frame and defaults to the selected one. The return
8101 value is a list of the form (LEFT, TOP, RIGHT, BOTTOM). All values are
8102 in pixels relative to the origin - the position (0, 0) - of FRAME's
8103 display.
8105 If optional argument TYPE is the symbol `outer-edges', return the outer
8106 edges of FRAME. The outer edges comprise the decorations of the window
8107 manager (like the title bar or external borders) as well as any external
8108 menu or tool bar of FRAME. If optional argument TYPE is the symbol
8109 `native-edges' or nil, return the native edges of FRAME. The native
8110 edges exclude the decorations of the window manager and any external
8111 menu or tool bar of FRAME. If TYPE is the symbol `inner-edges', return
8112 the inner edges of FRAME. These edges exclude title bar, any borders,
8113 menu bar or tool bar of FRAME. */)
8114 (Lisp_Object frame, Lisp_Object type)
8116 struct frame *f = decode_live_frame (frame);
8118 if (FRAME_INITIAL_P (f) || !FRAME_W32_P (f))
8119 return Qnil;
8121 if (EQ (type, Qouter_edges))
8123 RECT rectangle;
8125 block_input ();
8126 /* Outer frame rectangle, including outer borders and title bar. */
8127 GetWindowRect (FRAME_W32_WINDOW (f), &rectangle);
8128 unblock_input ();
8130 return list4 (make_number (rectangle.left),
8131 make_number (rectangle.top),
8132 make_number (rectangle.right),
8133 make_number (rectangle.bottom));
8135 else
8137 RECT rectangle;
8138 POINT pt;
8139 int left, top, right, bottom;
8141 block_input ();
8142 /* Inner frame rectangle, excluding borders and title bar. */
8143 GetClientRect (FRAME_W32_WINDOW (f), &rectangle);
8144 /* Get top-left corner of native rectangle in screen
8145 coordinates. */
8146 pt.x = 0;
8147 pt.y = 0;
8148 ClientToScreen (FRAME_W32_WINDOW (f), &pt);
8149 unblock_input ();
8151 left = pt.x;
8152 top = pt.y;
8153 right = left + rectangle.right;
8154 bottom = top + rectangle.bottom;
8156 if (EQ (type, Qinner_edges))
8158 int internal_border_width = FRAME_INTERNAL_BORDER_WIDTH (f);
8160 return list4 (make_number (left + internal_border_width),
8161 make_number (top
8162 + FRAME_TOOL_BAR_HEIGHT (f)
8163 + internal_border_width),
8164 make_number (right - internal_border_width),
8165 make_number (bottom - internal_border_width));
8167 else
8168 return list4 (make_number (left), make_number (top),
8169 make_number (right), make_number (bottom));
8173 DEFUN ("w32-mouse-absolute-pixel-position", Fw32_mouse_absolute_pixel_position,
8174 Sw32_mouse_absolute_pixel_position, 0, 0, 0,
8175 doc: /* Return absolute position of mouse cursor in pixels.
8176 The position is returned as a cons cell (X . Y) of the coordinates of
8177 the mouse cursor position in pixels relative to a position (0, 0) of the
8178 selected frame's display. */)
8179 (void)
8181 POINT pt;
8183 block_input ();
8184 GetCursorPos (&pt);
8185 unblock_input ();
8187 return Fcons (make_number (pt.x), make_number (pt.y));
8190 DEFUN ("w32-set-mouse-absolute-pixel-position", Fw32_set_mouse_absolute_pixel_position,
8191 Sw32_set_mouse_absolute_pixel_position, 2, 2, 0,
8192 doc: /* Move mouse pointer to absolute pixel position (X, Y).
8193 The coordinates X and Y are interpreted in pixels relative to a position
8194 (0, 0) of the selected frame's display. */)
8195 (Lisp_Object x, Lisp_Object y)
8197 CHECK_TYPE_RANGED_INTEGER (int, x);
8198 CHECK_TYPE_RANGED_INTEGER (int, y);
8200 block_input ();
8201 SetCursorPos (XINT (x), XINT (y));
8202 unblock_input ();
8204 return Qnil;
8207 DEFUN ("w32-battery-status", Fw32_battery_status, Sw32_battery_status, 0, 0, 0,
8208 doc: /* Get power status information from Windows system.
8210 The following %-sequences are provided:
8211 %L AC line status (verbose)
8212 %B Battery status (verbose)
8213 %b Battery status, empty means high, `-' means low,
8214 `!' means critical, and `+' means charging
8215 %p Battery load percentage
8216 %s Remaining time (to charge or discharge) in seconds
8217 %m Remaining time (to charge or discharge) in minutes
8218 %h Remaining time (to charge or discharge) in hours
8219 %t Remaining time (to charge or discharge) in the form `h:min' */)
8220 (void)
8222 Lisp_Object status = Qnil;
8224 SYSTEM_POWER_STATUS system_status;
8225 if (GetSystemPowerStatus (&system_status))
8227 Lisp_Object line_status, battery_status, battery_status_symbol;
8228 Lisp_Object load_percentage, seconds, minutes, hours, remain;
8230 long seconds_left = (long) system_status.BatteryLifeTime;
8232 if (system_status.ACLineStatus == 0)
8233 line_status = build_string ("off-line");
8234 else if (system_status.ACLineStatus == 1)
8235 line_status = build_string ("on-line");
8236 else
8237 line_status = build_string ("N/A");
8239 if (system_status.BatteryFlag & 128)
8241 battery_status = build_string ("N/A");
8242 battery_status_symbol = empty_unibyte_string;
8244 else if (system_status.BatteryFlag & 8)
8246 battery_status = build_string ("charging");
8247 battery_status_symbol = build_string ("+");
8248 if (system_status.BatteryFullLifeTime != -1L)
8249 seconds_left = system_status.BatteryFullLifeTime - seconds_left;
8251 else if (system_status.BatteryFlag & 4)
8253 battery_status = build_string ("critical");
8254 battery_status_symbol = build_string ("!");
8256 else if (system_status.BatteryFlag & 2)
8258 battery_status = build_string ("low");
8259 battery_status_symbol = build_string ("-");
8261 else if (system_status.BatteryFlag & 1)
8263 battery_status = build_string ("high");
8264 battery_status_symbol = empty_unibyte_string;
8266 else
8268 battery_status = build_string ("medium");
8269 battery_status_symbol = empty_unibyte_string;
8272 if (system_status.BatteryLifePercent > 100)
8273 load_percentage = build_string ("N/A");
8274 else
8276 char buffer[16];
8277 snprintf (buffer, 16, "%d", system_status.BatteryLifePercent);
8278 load_percentage = build_string (buffer);
8281 if (seconds_left < 0)
8282 seconds = minutes = hours = remain = build_string ("N/A");
8283 else
8285 long m;
8286 float h;
8287 char buffer[16];
8288 snprintf (buffer, 16, "%ld", seconds_left);
8289 seconds = build_string (buffer);
8291 m = seconds_left / 60;
8292 snprintf (buffer, 16, "%ld", m);
8293 minutes = build_string (buffer);
8295 h = seconds_left / 3600.0;
8296 snprintf (buffer, 16, "%3.1f", h);
8297 hours = build_string (buffer);
8299 snprintf (buffer, 16, "%ld:%02ld", m / 60, m % 60);
8300 remain = build_string (buffer);
8303 status = listn (CONSTYPE_HEAP, 8,
8304 Fcons (make_number ('L'), line_status),
8305 Fcons (make_number ('B'), battery_status),
8306 Fcons (make_number ('b'), battery_status_symbol),
8307 Fcons (make_number ('p'), load_percentage),
8308 Fcons (make_number ('s'), seconds),
8309 Fcons (make_number ('m'), minutes),
8310 Fcons (make_number ('h'), hours),
8311 Fcons (make_number ('t'), remain));
8313 return status;
8317 #ifdef WINDOWSNT
8318 typedef BOOL (WINAPI *GetDiskFreeSpaceExW_Proc)
8319 (LPCWSTR, PULARGE_INTEGER, PULARGE_INTEGER, PULARGE_INTEGER);
8320 typedef BOOL (WINAPI *GetDiskFreeSpaceExA_Proc)
8321 (LPCSTR, PULARGE_INTEGER, PULARGE_INTEGER, PULARGE_INTEGER);
8323 DEFUN ("file-system-info", Ffile_system_info, Sfile_system_info, 1, 1, 0,
8324 doc: /* Return storage information about the file system FILENAME is on.
8325 Value is a list of floats (TOTAL FREE AVAIL), where TOTAL is the total
8326 storage of the file system, FREE is the free storage, and AVAIL is the
8327 storage available to a non-superuser. All 3 numbers are in bytes.
8328 If the underlying system call fails, value is nil. */)
8329 (Lisp_Object filename)
8331 Lisp_Object encoded, value;
8333 CHECK_STRING (filename);
8334 filename = Fexpand_file_name (filename, Qnil);
8335 encoded = ENCODE_FILE (filename);
8337 value = Qnil;
8339 /* Determining the required information on Windows turns out, sadly,
8340 to be more involved than one would hope. The original Windows API
8341 call for this will return bogus information on some systems, but we
8342 must dynamically probe for the replacement api, since that was
8343 added rather late on. */
8345 HMODULE hKernel = GetModuleHandle ("kernel32");
8346 GetDiskFreeSpaceExW_Proc pfn_GetDiskFreeSpaceExW =
8347 (GetDiskFreeSpaceExW_Proc) GetProcAddress (hKernel, "GetDiskFreeSpaceExW");
8348 GetDiskFreeSpaceExA_Proc pfn_GetDiskFreeSpaceExA =
8349 (GetDiskFreeSpaceExA_Proc) GetProcAddress (hKernel, "GetDiskFreeSpaceExA");
8350 bool have_pfn_GetDiskFreeSpaceEx =
8351 ((w32_unicode_filenames && pfn_GetDiskFreeSpaceExW)
8352 || (!w32_unicode_filenames && pfn_GetDiskFreeSpaceExA));
8354 /* On Windows, we may need to specify the root directory of the
8355 volume holding FILENAME. */
8356 char rootname[MAX_UTF8_PATH];
8357 wchar_t rootname_w[MAX_PATH];
8358 char rootname_a[MAX_PATH];
8359 char *name = SDATA (encoded);
8360 BOOL result;
8362 /* find the root name of the volume if given */
8363 if (isalpha (name[0]) && name[1] == ':')
8365 rootname[0] = name[0];
8366 rootname[1] = name[1];
8367 rootname[2] = '\\';
8368 rootname[3] = 0;
8370 else if (IS_DIRECTORY_SEP (name[0]) && IS_DIRECTORY_SEP (name[1]))
8372 char *str = rootname;
8373 int slashes = 4;
8376 if (IS_DIRECTORY_SEP (*name) && --slashes == 0)
8377 break;
8378 *str++ = *name++;
8380 while ( *name );
8382 *str++ = '\\';
8383 *str = 0;
8386 if (w32_unicode_filenames)
8387 filename_to_utf16 (rootname, rootname_w);
8388 else
8389 filename_to_ansi (rootname, rootname_a);
8391 if (have_pfn_GetDiskFreeSpaceEx)
8393 /* Unsigned large integers cannot be cast to double, so
8394 use signed ones instead. */
8395 LARGE_INTEGER availbytes;
8396 LARGE_INTEGER freebytes;
8397 LARGE_INTEGER totalbytes;
8399 if (w32_unicode_filenames)
8400 result = pfn_GetDiskFreeSpaceExW (rootname_w,
8401 (ULARGE_INTEGER *)&availbytes,
8402 (ULARGE_INTEGER *)&totalbytes,
8403 (ULARGE_INTEGER *)&freebytes);
8404 else
8405 result = pfn_GetDiskFreeSpaceExA (rootname_a,
8406 (ULARGE_INTEGER *)&availbytes,
8407 (ULARGE_INTEGER *)&totalbytes,
8408 (ULARGE_INTEGER *)&freebytes);
8409 if (result)
8410 value = list3 (make_float ((double) totalbytes.QuadPart),
8411 make_float ((double) freebytes.QuadPart),
8412 make_float ((double) availbytes.QuadPart));
8414 else
8416 DWORD sectors_per_cluster;
8417 DWORD bytes_per_sector;
8418 DWORD free_clusters;
8419 DWORD total_clusters;
8421 if (w32_unicode_filenames)
8422 result = GetDiskFreeSpaceW (rootname_w,
8423 &sectors_per_cluster,
8424 &bytes_per_sector,
8425 &free_clusters,
8426 &total_clusters);
8427 else
8428 result = GetDiskFreeSpaceA (rootname_a,
8429 &sectors_per_cluster,
8430 &bytes_per_sector,
8431 &free_clusters,
8432 &total_clusters);
8433 if (result)
8434 value = list3 (make_float ((double) total_clusters
8435 * sectors_per_cluster * bytes_per_sector),
8436 make_float ((double) free_clusters
8437 * sectors_per_cluster * bytes_per_sector),
8438 make_float ((double) free_clusters
8439 * sectors_per_cluster * bytes_per_sector));
8443 return value;
8445 #endif /* WINDOWSNT */
8448 #ifdef WINDOWSNT
8449 DEFUN ("default-printer-name", Fdefault_printer_name, Sdefault_printer_name,
8450 0, 0, 0, doc: /* Return the name of Windows default printer device. */)
8451 (void)
8453 static char pname_buf[256];
8454 int err;
8455 HANDLE hPrn;
8456 PRINTER_INFO_2W *ppi2w = NULL;
8457 PRINTER_INFO_2A *ppi2a = NULL;
8458 DWORD dwNeeded = 0, dwReturned = 0;
8459 char server_name[MAX_UTF8_PATH], share_name[MAX_UTF8_PATH];
8460 char port_name[MAX_UTF8_PATH];
8462 /* Retrieve the default string from Win.ini (the registry).
8463 * String will be in form "printername,drivername,portname".
8464 * This is the most portable way to get the default printer. */
8465 if (GetProfileString ("windows", "device", ",,", pname_buf, sizeof (pname_buf)) <= 0)
8466 return Qnil;
8467 /* printername precedes first "," character */
8468 strtok (pname_buf, ",");
8469 /* We want to know more than the printer name */
8470 if (!OpenPrinter (pname_buf, &hPrn, NULL))
8471 return Qnil;
8472 /* GetPrinterW is not supported by unicows.dll. */
8473 if (w32_unicode_filenames && os_subtype != OS_9X)
8474 GetPrinterW (hPrn, 2, NULL, 0, &dwNeeded);
8475 else
8476 GetPrinterA (hPrn, 2, NULL, 0, &dwNeeded);
8477 if (dwNeeded == 0)
8479 ClosePrinter (hPrn);
8480 return Qnil;
8482 /* Call GetPrinter again with big enough memory block. */
8483 if (w32_unicode_filenames && os_subtype != OS_9X)
8485 /* Allocate memory for the PRINTER_INFO_2 struct. */
8486 ppi2w = xmalloc (dwNeeded);
8487 err = GetPrinterW (hPrn, 2, (LPBYTE)ppi2w, dwNeeded, &dwReturned);
8488 ClosePrinter (hPrn);
8489 if (!err)
8491 xfree (ppi2w);
8492 return Qnil;
8495 if ((ppi2w->Attributes & PRINTER_ATTRIBUTE_SHARED)
8496 && ppi2w->pServerName)
8498 filename_from_utf16 (ppi2w->pServerName, server_name);
8499 filename_from_utf16 (ppi2w->pShareName, share_name);
8501 else
8503 server_name[0] = '\0';
8504 filename_from_utf16 (ppi2w->pPortName, port_name);
8507 else
8509 ppi2a = xmalloc (dwNeeded);
8510 err = GetPrinterA (hPrn, 2, (LPBYTE)ppi2a, dwNeeded, &dwReturned);
8511 ClosePrinter (hPrn);
8512 if (!err)
8514 xfree (ppi2a);
8515 return Qnil;
8518 if ((ppi2a->Attributes & PRINTER_ATTRIBUTE_SHARED)
8519 && ppi2a->pServerName)
8521 filename_from_ansi (ppi2a->pServerName, server_name);
8522 filename_from_ansi (ppi2a->pShareName, share_name);
8524 else
8526 server_name[0] = '\0';
8527 filename_from_ansi (ppi2a->pPortName, port_name);
8531 if (server_name[0])
8533 /* a remote printer */
8534 if (server_name[0] == '\\')
8535 snprintf (pname_buf, sizeof (pname_buf), "%s\\%s", server_name,
8536 share_name);
8537 else
8538 snprintf (pname_buf, sizeof (pname_buf), "\\\\%s\\%s", server_name,
8539 share_name);
8540 pname_buf[sizeof (pname_buf) - 1] = '\0';
8542 else
8544 /* a local printer */
8545 strncpy (pname_buf, port_name, sizeof (pname_buf));
8546 pname_buf[sizeof (pname_buf) - 1] = '\0';
8547 /* `pPortName' can include several ports, delimited by ','.
8548 * we only use the first one. */
8549 strtok (pname_buf, ",");
8552 return DECODE_FILE (build_unibyte_string (pname_buf));
8554 #endif /* WINDOWSNT */
8557 /* Equivalent of strerror for W32 error codes. */
8558 char *
8559 w32_strerror (int error_no)
8561 static char buf[500];
8562 DWORD ret;
8564 if (error_no == 0)
8565 error_no = GetLastError ();
8567 ret = FormatMessage (FORMAT_MESSAGE_FROM_SYSTEM |
8568 FORMAT_MESSAGE_IGNORE_INSERTS,
8569 NULL,
8570 error_no,
8571 0, /* choose most suitable language */
8572 buf, sizeof (buf), NULL);
8574 while (ret > 0 && (buf[ret - 1] == '\n' ||
8575 buf[ret - 1] == '\r' ))
8576 --ret;
8577 buf[ret] = '\0';
8578 if (!ret)
8579 sprintf (buf, "w32 error %u", error_no);
8581 return buf;
8584 /* For convenience when debugging. (You cannot call GetLastError
8585 directly from GDB: it will crash, because it uses the __stdcall
8586 calling convention, not the _cdecl convention assumed by GDB.) */
8587 DWORD
8588 w32_last_error (void)
8590 return GetLastError ();
8593 /* Cache information describing the NT system for later use. */
8594 void
8595 cache_system_info (void)
8597 union
8599 struct info
8601 char major;
8602 char minor;
8603 short platform;
8604 } info;
8605 DWORD data;
8606 } version;
8608 /* Cache the module handle of Emacs itself. */
8609 hinst = GetModuleHandle (NULL);
8611 /* Cache the version of the operating system. */
8612 version.data = GetVersion ();
8613 w32_major_version = version.info.major;
8614 w32_minor_version = version.info.minor;
8616 if (version.info.platform & 0x8000)
8617 os_subtype = OS_9X;
8618 else
8619 os_subtype = OS_NT;
8621 /* Cache page size, allocation unit, processor type, etc. */
8622 GetSystemInfo (&sysinfo_cache);
8623 syspage_mask = (DWORD_PTR)sysinfo_cache.dwPageSize - 1;
8625 /* Cache os info. */
8626 osinfo_cache.dwOSVersionInfoSize = sizeof (OSVERSIONINFO);
8627 GetVersionEx (&osinfo_cache);
8629 w32_build_number = osinfo_cache.dwBuildNumber;
8630 if (os_subtype == OS_9X)
8631 w32_build_number &= 0xffff;
8633 w32_num_mouse_buttons = GetSystemMetrics (SM_CMOUSEBUTTONS);
8636 #ifdef EMACSDEBUG
8637 void
8638 _DebPrint (const char *fmt, ...)
8640 char buf[1024];
8641 va_list args;
8643 va_start (args, fmt);
8644 vsprintf (buf, fmt, args);
8645 va_end (args);
8646 #if CYGWIN
8647 fprintf (stderr, "%s", buf);
8648 #endif
8649 OutputDebugString (buf);
8651 #endif
8654 w32_console_toggle_lock_key (int vk_code, Lisp_Object new_state)
8656 int cur_state = (GetKeyState (vk_code) & 1);
8658 if (NILP (new_state)
8659 || (NUMBERP (new_state)
8660 && ((XUINT (new_state)) & 1) != cur_state))
8662 #ifdef WINDOWSNT
8663 faked_key = vk_code;
8664 #endif /* WINDOWSNT */
8666 keybd_event ((BYTE) vk_code,
8667 (BYTE) MapVirtualKey (vk_code, 0),
8668 KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
8669 keybd_event ((BYTE) vk_code,
8670 (BYTE) MapVirtualKey (vk_code, 0),
8671 KEYEVENTF_EXTENDEDKEY | 0, 0);
8672 keybd_event ((BYTE) vk_code,
8673 (BYTE) MapVirtualKey (vk_code, 0),
8674 KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
8675 cur_state = !cur_state;
8678 return cur_state;
8681 /* Translate console modifiers to emacs modifiers.
8682 German keyboard support (Kai Morgan Zeise 2/18/95). */
8684 w32_kbd_mods_to_emacs (DWORD mods, WORD key)
8686 int retval = 0;
8688 /* If we recognize right-alt and left-ctrl as AltGr, and it has been
8689 pressed, first remove those modifiers. */
8690 if (!NILP (Vw32_recognize_altgr)
8691 && (mods & (RIGHT_ALT_PRESSED | LEFT_CTRL_PRESSED))
8692 == (RIGHT_ALT_PRESSED | LEFT_CTRL_PRESSED))
8693 mods &= ~ (RIGHT_ALT_PRESSED | LEFT_CTRL_PRESSED);
8695 if (mods & (RIGHT_ALT_PRESSED | LEFT_ALT_PRESSED))
8696 retval = ((NILP (Vw32_alt_is_meta)) ? alt_modifier : meta_modifier);
8698 if (mods & (RIGHT_CTRL_PRESSED | LEFT_CTRL_PRESSED))
8700 retval |= ctrl_modifier;
8701 if ((mods & (RIGHT_CTRL_PRESSED | LEFT_CTRL_PRESSED))
8702 == (RIGHT_CTRL_PRESSED | LEFT_CTRL_PRESSED))
8703 retval |= meta_modifier;
8706 if (mods & LEFT_WIN_PRESSED)
8707 retval |= w32_key_to_modifier (VK_LWIN);
8708 if (mods & RIGHT_WIN_PRESSED)
8709 retval |= w32_key_to_modifier (VK_RWIN);
8710 if (mods & APPS_PRESSED)
8711 retval |= w32_key_to_modifier (VK_APPS);
8712 if (mods & SCROLLLOCK_ON)
8713 retval |= w32_key_to_modifier (VK_SCROLL);
8715 /* Just in case someone wanted the original behavior, make it
8716 optional by setting w32-capslock-is-shiftlock to t. */
8717 if (NILP (Vw32_capslock_is_shiftlock)
8718 /* Keys that should _not_ be affected by CapsLock. */
8719 && ( (key == VK_BACK)
8720 || (key == VK_TAB)
8721 || (key == VK_CLEAR)
8722 || (key == VK_RETURN)
8723 || (key == VK_ESCAPE)
8724 || ((key >= VK_SPACE) && (key <= VK_HELP))
8725 || ((key >= VK_NUMPAD0) && (key <= VK_F24))
8726 || ((key >= VK_NUMPAD_CLEAR) && (key <= VK_NUMPAD_DELETE))
8729 /* Only consider shift state. */
8730 if ((mods & SHIFT_PRESSED) != 0)
8731 retval |= shift_modifier;
8733 else
8735 /* Ignore CapsLock state if not enabled. */
8736 if (NILP (Vw32_enable_caps_lock))
8737 mods &= ~CAPSLOCK_ON;
8738 if ((mods & (SHIFT_PRESSED | CAPSLOCK_ON)) != 0)
8739 retval |= shift_modifier;
8742 return retval;
8745 /* The return code indicates key code size. cpID is the codepage to
8746 use for translation to Unicode; -1 means use the current console
8747 input codepage. */
8749 w32_kbd_patch_key (KEY_EVENT_RECORD *event, int cpId)
8751 unsigned int key_code = event->wVirtualKeyCode;
8752 unsigned int mods = event->dwControlKeyState;
8753 BYTE keystate[256];
8754 static BYTE ansi_code[4];
8755 static int isdead = 0;
8757 if (isdead == 2)
8759 event->uChar.AsciiChar = ansi_code[2];
8760 isdead = 0;
8761 return 1;
8763 if (event->uChar.AsciiChar != 0)
8764 return 1;
8766 memset (keystate, 0, sizeof (keystate));
8767 keystate[key_code] = 0x80;
8768 if (mods & SHIFT_PRESSED)
8769 keystate[VK_SHIFT] = 0x80;
8770 if (mods & CAPSLOCK_ON)
8771 keystate[VK_CAPITAL] = 1;
8772 /* If we recognize right-alt and left-ctrl as AltGr, set the key
8773 states accordingly before invoking ToAscii. */
8774 if (!NILP (Vw32_recognize_altgr)
8775 && (mods & LEFT_CTRL_PRESSED) && (mods & RIGHT_ALT_PRESSED))
8777 keystate[VK_CONTROL] = 0x80;
8778 keystate[VK_LCONTROL] = 0x80;
8779 keystate[VK_MENU] = 0x80;
8780 keystate[VK_RMENU] = 0x80;
8783 #if 0
8784 /* Because of an OS bug, ToAscii corrupts the stack when called to
8785 convert a dead key in console mode on NT4. Unfortunately, trying
8786 to check for dead keys using MapVirtualKey doesn't work either -
8787 these functions apparently use internal information about keyboard
8788 layout which doesn't get properly updated in console programs when
8789 changing layout (though apparently it gets partly updated,
8790 otherwise ToAscii wouldn't crash). */
8791 if (is_dead_key (event->wVirtualKeyCode))
8792 return 0;
8793 #endif
8795 /* On NT, call ToUnicode instead and then convert to the current
8796 console input codepage. */
8797 if (os_subtype == OS_NT)
8799 WCHAR buf[128];
8801 isdead = ToUnicode (event->wVirtualKeyCode, event->wVirtualScanCode,
8802 keystate, buf, 128, 0);
8803 if (isdead > 0)
8805 /* When we are called from the GUI message processing code,
8806 we are passed the current keyboard codepage, a positive
8807 number, to use below. */
8808 if (cpId == -1)
8809 cpId = GetConsoleCP ();
8811 event->uChar.UnicodeChar = buf[isdead - 1];
8812 isdead = WideCharToMultiByte (cpId, 0, buf, isdead,
8813 ansi_code, 4, NULL, NULL);
8815 else
8816 isdead = 0;
8818 else
8820 isdead = ToAscii (event->wVirtualKeyCode, event->wVirtualScanCode,
8821 keystate, (LPWORD) ansi_code, 0);
8824 if (isdead == 0)
8825 return 0;
8826 event->uChar.AsciiChar = ansi_code[0];
8827 return isdead;
8831 void
8832 w32_sys_ring_bell (struct frame *f)
8834 if (sound_type == 0xFFFFFFFF)
8836 Beep (666, 100);
8838 else if (sound_type == MB_EMACS_SILENT)
8840 /* Do nothing. */
8842 else
8843 MessageBeep (sound_type);
8846 DEFUN ("w32--menu-bar-in-use", Fw32__menu_bar_in_use, Sw32__menu_bar_in_use,
8847 0, 0, 0,
8848 doc: /* Return non-nil when a menu-bar menu is being used.
8849 Internal use only. */)
8850 (void)
8852 return menubar_in_use ? Qt : Qnil;
8856 /***********************************************************************
8857 Initialization
8858 ***********************************************************************/
8860 /* Keep this list in the same order as frame_parms in frame.c.
8861 Use 0 for unsupported frame parameters. */
8863 frame_parm_handler w32_frame_parm_handlers[] =
8865 x_set_autoraise,
8866 x_set_autolower,
8867 x_set_background_color,
8868 x_set_border_color,
8869 x_set_border_width,
8870 x_set_cursor_color,
8871 x_set_cursor_type,
8872 x_set_font,
8873 x_set_foreground_color,
8874 x_set_icon_name,
8875 x_set_icon_type,
8876 x_set_internal_border_width,
8877 x_set_right_divider_width,
8878 x_set_bottom_divider_width,
8879 x_set_menu_bar_lines,
8880 x_set_mouse_color,
8881 x_explicitly_set_name,
8882 x_set_scroll_bar_width,
8883 x_set_scroll_bar_height,
8884 x_set_title,
8885 x_set_unsplittable,
8886 x_set_vertical_scroll_bars,
8887 x_set_horizontal_scroll_bars,
8888 x_set_visibility,
8889 x_set_tool_bar_lines,
8890 0, /* x_set_scroll_bar_foreground, */
8891 0, /* x_set_scroll_bar_background, */
8892 x_set_screen_gamma,
8893 x_set_line_spacing,
8894 x_set_left_fringe,
8895 x_set_right_fringe,
8896 0, /* x_set_wait_for_wm, */
8897 x_set_fullscreen,
8898 x_set_font_backend,
8899 x_set_alpha,
8900 0, /* x_set_sticky */
8901 0, /* x_set_tool_bar_position */
8904 void
8905 syms_of_w32fns (void)
8907 globals_of_w32fns ();
8908 track_mouse_window = NULL;
8910 w32_visible_system_caret_hwnd = NULL;
8912 DEFSYM (Qundefined_color, "undefined-color");
8913 DEFSYM (Qcancel_timer, "cancel-timer");
8914 DEFSYM (Qhyper, "hyper");
8915 DEFSYM (Qsuper, "super");
8916 DEFSYM (Qmeta, "meta");
8917 DEFSYM (Qalt, "alt");
8918 DEFSYM (Qctrl, "ctrl");
8919 DEFSYM (Qcontrol, "control");
8920 DEFSYM (Qshift, "shift");
8921 DEFSYM (Qfont_param, "font-parameter");
8922 DEFSYM (Qgeometry, "geometry");
8923 DEFSYM (Qworkarea, "workarea");
8924 DEFSYM (Qmm_size, "mm-size");
8925 DEFSYM (Qframes, "frames");
8926 DEFSYM (Qtip_frame, "tip-frame");
8927 DEFSYM (Qunicode_sip, "unicode-sip");
8929 /* Symbols used elsewhere, but only in MS-Windows-specific code. */
8930 DEFSYM (Qgnutls_dll, "gnutls");
8931 DEFSYM (Qlibxml2_dll, "libxml2");
8932 DEFSYM (Qserif, "serif");
8933 DEFSYM (Qzlib_dll, "zlib");
8935 Fput (Qundefined_color, Qerror_conditions,
8936 listn (CONSTYPE_PURE, 2, Qundefined_color, Qerror));
8937 Fput (Qundefined_color, Qerror_message,
8938 build_pure_c_string ("Undefined color"));
8940 staticpro (&w32_grabbed_keys);
8941 w32_grabbed_keys = Qnil;
8943 DEFVAR_LISP ("w32-color-map", Vw32_color_map,
8944 doc: /* An array of color name mappings for Windows. */);
8945 Vw32_color_map = Qnil;
8947 DEFVAR_LISP ("w32-pass-alt-to-system", Vw32_pass_alt_to_system,
8948 doc: /* Non-nil if Alt key presses are passed on to Windows.
8949 When non-nil, for example, Alt pressed and released and then space will
8950 open the System menu. When nil, Emacs processes the Alt key events, and
8951 then silently swallows them. */);
8952 Vw32_pass_alt_to_system = Qnil;
8954 DEFVAR_LISP ("w32-alt-is-meta", Vw32_alt_is_meta,
8955 doc: /* Non-nil if the Alt key is to be considered the same as the META key.
8956 When nil, Emacs will translate the Alt key to the ALT modifier, not to META. */);
8957 Vw32_alt_is_meta = Qt;
8959 DEFVAR_INT ("w32-quit-key", w32_quit_key,
8960 doc: /* If non-zero, the virtual key code for an alternative quit key. */);
8961 w32_quit_key = 0;
8963 DEFVAR_LISP ("w32-pass-lwindow-to-system",
8964 Vw32_pass_lwindow_to_system,
8965 doc: /* If non-nil, the left \"Windows\" key is passed on to Windows.
8967 When non-nil, the Start menu is opened by tapping the key.
8968 If you set this to nil, the left \"Windows\" key is processed by Emacs
8969 according to the value of `w32-lwindow-modifier', which see.
8971 Note that some combinations of the left \"Windows\" key with other keys are
8972 caught by Windows at low level, and so binding them in Emacs will have no
8973 effect. For example, <lwindow>-r always pops up the Windows Run dialog,
8974 <lwindow>-<Pause> pops up the "System Properties" dialog, etc. However, see
8975 the doc string of `w32-phantom-key-code'. */);
8976 Vw32_pass_lwindow_to_system = Qt;
8978 DEFVAR_LISP ("w32-pass-rwindow-to-system",
8979 Vw32_pass_rwindow_to_system,
8980 doc: /* If non-nil, the right \"Windows\" key is passed on to Windows.
8982 When non-nil, the Start menu is opened by tapping the key.
8983 If you set this to nil, the right \"Windows\" key is processed by Emacs
8984 according to the value of `w32-rwindow-modifier', which see.
8986 Note that some combinations of the right \"Windows\" key with other keys are
8987 caught by Windows at low level, and so binding them in Emacs will have no
8988 effect. For example, <rwindow>-r always pops up the Windows Run dialog,
8989 <rwindow>-<Pause> pops up the "System Properties" dialog, etc. However, see
8990 the doc string of `w32-phantom-key-code'. */);
8991 Vw32_pass_rwindow_to_system = Qt;
8993 DEFVAR_LISP ("w32-phantom-key-code",
8994 Vw32_phantom_key_code,
8995 doc: /* Virtual key code used to generate \"phantom\" key presses.
8996 Value is a number between 0 and 255.
8998 Phantom key presses are generated in order to stop the system from
8999 acting on \"Windows\" key events when `w32-pass-lwindow-to-system' or
9000 `w32-pass-rwindow-to-system' is nil. */);
9001 /* Although 255 is technically not a valid key code, it works and
9002 means that this hack won't interfere with any real key code. */
9003 XSETINT (Vw32_phantom_key_code, 255);
9005 DEFVAR_LISP ("w32-enable-num-lock",
9006 Vw32_enable_num_lock,
9007 doc: /* If non-nil, the Num Lock key acts normally.
9008 Set to nil to handle Num Lock as the `kp-numlock' key. */);
9009 Vw32_enable_num_lock = Qt;
9011 DEFVAR_LISP ("w32-enable-caps-lock",
9012 Vw32_enable_caps_lock,
9013 doc: /* If non-nil, the Caps Lock key acts normally.
9014 Set to nil to handle Caps Lock as the `capslock' key. */);
9015 Vw32_enable_caps_lock = Qt;
9017 DEFVAR_LISP ("w32-scroll-lock-modifier",
9018 Vw32_scroll_lock_modifier,
9019 doc: /* Modifier to use for the Scroll Lock ON state.
9020 The value can be hyper, super, meta, alt, control or shift for the
9021 respective modifier, or nil to handle Scroll Lock as the `scroll' key.
9022 Any other value will cause the Scroll Lock key to be ignored. */);
9023 Vw32_scroll_lock_modifier = Qnil;
9025 DEFVAR_LISP ("w32-lwindow-modifier",
9026 Vw32_lwindow_modifier,
9027 doc: /* Modifier to use for the left \"Windows\" key.
9028 The value can be hyper, super, meta, alt, control or shift for the
9029 respective modifier, or nil to appear as the `lwindow' key.
9030 Any other value will cause the key to be ignored. */);
9031 Vw32_lwindow_modifier = Qnil;
9033 DEFVAR_LISP ("w32-rwindow-modifier",
9034 Vw32_rwindow_modifier,
9035 doc: /* Modifier to use for the right \"Windows\" key.
9036 The value can be hyper, super, meta, alt, control or shift for the
9037 respective modifier, or nil to appear as the `rwindow' key.
9038 Any other value will cause the key to be ignored. */);
9039 Vw32_rwindow_modifier = Qnil;
9041 DEFVAR_LISP ("w32-apps-modifier",
9042 Vw32_apps_modifier,
9043 doc: /* Modifier to use for the \"Apps\" key.
9044 The value can be hyper, super, meta, alt, control or shift for the
9045 respective modifier, or nil to appear as the `apps' key.
9046 Any other value will cause the key to be ignored. */);
9047 Vw32_apps_modifier = Qnil;
9049 DEFVAR_BOOL ("w32-enable-synthesized-fonts", w32_enable_synthesized_fonts,
9050 doc: /* Non-nil enables selection of artificially italicized and bold fonts. */);
9051 w32_enable_synthesized_fonts = 0;
9053 DEFVAR_LISP ("w32-enable-palette", Vw32_enable_palette,
9054 doc: /* Non-nil enables Windows palette management to map colors exactly. */);
9055 Vw32_enable_palette = Qt;
9057 DEFVAR_INT ("w32-mouse-button-tolerance",
9058 w32_mouse_button_tolerance,
9059 doc: /* Analogue of double click interval for faking middle mouse events.
9060 The value is the minimum time in milliseconds that must elapse between
9061 left and right button down events before they are considered distinct events.
9062 If both mouse buttons are depressed within this interval, a middle mouse
9063 button down event is generated instead. */);
9064 w32_mouse_button_tolerance = GetDoubleClickTime () / 2;
9066 DEFVAR_INT ("w32-mouse-move-interval",
9067 w32_mouse_move_interval,
9068 doc: /* Minimum interval between mouse move events.
9069 The value is the minimum time in milliseconds that must elapse between
9070 successive mouse move (or scroll bar drag) events before they are
9071 reported as lisp events. */);
9072 w32_mouse_move_interval = 0;
9074 DEFVAR_BOOL ("w32-pass-extra-mouse-buttons-to-system",
9075 w32_pass_extra_mouse_buttons_to_system,
9076 doc: /* If non-nil, the fourth and fifth mouse buttons are passed to Windows.
9077 Recent versions of Windows support mice with up to five buttons.
9078 Since most applications don't support these extra buttons, most mouse
9079 drivers will allow you to map them to functions at the system level.
9080 If this variable is non-nil, Emacs will pass them on, allowing the
9081 system to handle them. */);
9082 w32_pass_extra_mouse_buttons_to_system = 0;
9084 DEFVAR_BOOL ("w32-pass-multimedia-buttons-to-system",
9085 w32_pass_multimedia_buttons_to_system,
9086 doc: /* If non-nil, media buttons are passed to Windows.
9087 Some modern keyboards contain buttons for controlling media players, web
9088 browsers and other applications. Generally these buttons are handled on a
9089 system wide basis, but by setting this to nil they are made available
9090 to Emacs for binding. Depending on your keyboard, additional keys that
9091 may be available are:
9093 browser-back, browser-forward, browser-refresh, browser-stop,
9094 browser-search, browser-favorites, browser-home,
9095 mail, mail-reply, mail-forward, mail-send,
9096 app-1, app-2,
9097 help, find, new, open, close, save, print, undo, redo, copy, cut, paste,
9098 spell-check, correction-list, toggle-dictate-command,
9099 media-next, media-previous, media-stop, media-play-pause, media-select,
9100 media-play, media-pause, media-record, media-fast-forward, media-rewind,
9101 media-channel-up, media-channel-down,
9102 volume-mute, volume-up, volume-down,
9103 mic-volume-mute, mic-volume-down, mic-volume-up, mic-toggle,
9104 bass-down, bass-boost, bass-up, treble-down, treble-up */);
9105 w32_pass_multimedia_buttons_to_system = 1;
9107 #if 0 /* TODO: Mouse cursor customization. */
9108 DEFVAR_LISP ("x-pointer-shape", Vx_pointer_shape,
9109 doc: /* The shape of the pointer when over text.
9110 Changing the value does not affect existing frames
9111 unless you set the mouse color. */);
9112 Vx_pointer_shape = Qnil;
9114 Vx_nontext_pointer_shape = Qnil;
9116 Vx_mode_pointer_shape = Qnil;
9118 DEFVAR_LISP ("x-hourglass-pointer-shape", Vx_hourglass_pointer_shape,
9119 doc: /* The shape of the pointer when Emacs is busy.
9120 This variable takes effect when you create a new frame
9121 or when you set the mouse color. */);
9122 Vx_hourglass_pointer_shape = Qnil;
9124 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
9125 Vx_sensitive_text_pointer_shape,
9126 doc: /* The shape of the pointer when over mouse-sensitive text.
9127 This variable takes effect when you create a new frame
9128 or when you set the mouse color. */);
9129 Vx_sensitive_text_pointer_shape = Qnil;
9131 DEFVAR_LISP ("x-window-horizontal-drag-cursor",
9132 Vx_window_horizontal_drag_shape,
9133 doc: /* Pointer shape to use for indicating a window can be dragged horizontally.
9134 This variable takes effect when you create a new frame
9135 or when you set the mouse color. */);
9136 Vx_window_horizontal_drag_shape = Qnil;
9138 DEFVAR_LISP ("x-window-vertical-drag-cursor",
9139 Vx_window_vertical_drag_shape,
9140 doc: /* Pointer shape to use for indicating a window can be dragged vertically.
9141 This variable takes effect when you create a new frame
9142 or when you set the mouse color. */);
9143 Vx_window_vertical_drag_shape = Qnil;
9144 #endif
9146 DEFVAR_LISP ("x-cursor-fore-pixel", Vx_cursor_fore_pixel,
9147 doc: /* A string indicating the foreground color of the cursor box. */);
9148 Vx_cursor_fore_pixel = Qnil;
9150 DEFVAR_LISP ("x-max-tooltip-size", Vx_max_tooltip_size,
9151 doc: /* Maximum size for tooltips.
9152 Value is a pair (COLUMNS . ROWS). Text larger than this is clipped. */);
9153 Vx_max_tooltip_size = Fcons (make_number (80), make_number (40));
9155 DEFVAR_LISP ("x-no-window-manager", Vx_no_window_manager,
9156 doc: /* Non-nil if no window manager is in use.
9157 Emacs doesn't try to figure this out; this is always nil
9158 unless you set it to something else. */);
9159 /* We don't have any way to find this out, so set it to nil
9160 and maybe the user would like to set it to t. */
9161 Vx_no_window_manager = Qnil;
9163 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
9164 Vx_pixel_size_width_font_regexp,
9165 doc: /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'.
9167 Since Emacs gets width of a font matching with this regexp from
9168 PIXEL_SIZE field of the name, font finding mechanism gets faster for
9169 such a font. This is especially effective for such large fonts as
9170 Chinese, Japanese, and Korean. */);
9171 Vx_pixel_size_width_font_regexp = Qnil;
9173 DEFVAR_LISP ("w32-bdf-filename-alist",
9174 Vw32_bdf_filename_alist,
9175 doc: /* List of bdf fonts and their corresponding filenames. */);
9176 Vw32_bdf_filename_alist = Qnil;
9178 DEFVAR_BOOL ("w32-strict-fontnames",
9179 w32_strict_fontnames,
9180 doc: /* Non-nil means only use fonts that are exact matches for those requested.
9181 Default is nil, which allows old fontnames that are not XLFD compliant,
9182 and allows third-party CJK display to work by specifying false charset
9183 fields to trick Emacs into translating to Big5, SJIS etc.
9184 Setting this to t will prevent wrong fonts being selected when
9185 fontsets are automatically created. */);
9186 w32_strict_fontnames = 0;
9188 DEFVAR_BOOL ("w32-strict-painting",
9189 w32_strict_painting,
9190 doc: /* Non-nil means use strict rules for repainting frames.
9191 Set this to nil to get the old behavior for repainting; this should
9192 only be necessary if the default setting causes problems. */);
9193 w32_strict_painting = 1;
9195 DEFVAR_BOOL ("w32-use-fallback-wm-chars-method",
9196 w32_use_fallback_wm_chars_method,
9197 doc: /* Non-nil means use old method of processing character keys.
9198 This is intended only for debugging of the new processing method.
9199 Default is nil.
9201 This variable has effect only on NT family of systems, not on Windows 9X. */);
9202 w32_use_fallback_wm_chars_method = 0;
9204 DEFVAR_BOOL ("w32-disable-new-uniscribe-apis",
9205 w32_disable_new_uniscribe_apis,
9206 doc: /* Non-nil means don't use new Uniscribe APIs.
9207 The new APIs are used to access OTF features supported by fonts.
9208 This is intended only for debugging of the new Uniscribe-related code.
9209 Default is nil.
9211 This variable has effect only on Windows Vista and later. */);
9212 w32_disable_new_uniscribe_apis = 0;
9214 #if 0 /* TODO: Port to W32 */
9215 defsubr (&Sx_change_window_property);
9216 defsubr (&Sx_delete_window_property);
9217 defsubr (&Sx_window_property);
9218 #endif
9219 defsubr (&Sxw_display_color_p);
9220 defsubr (&Sx_display_grayscale_p);
9221 defsubr (&Sxw_color_defined_p);
9222 defsubr (&Sxw_color_values);
9223 defsubr (&Sx_server_max_request_size);
9224 defsubr (&Sx_server_vendor);
9225 defsubr (&Sx_server_version);
9226 defsubr (&Sx_display_pixel_width);
9227 defsubr (&Sx_display_pixel_height);
9228 defsubr (&Sx_display_mm_width);
9229 defsubr (&Sx_display_mm_height);
9230 defsubr (&Sx_display_screens);
9231 defsubr (&Sx_display_planes);
9232 defsubr (&Sx_display_color_cells);
9233 defsubr (&Sx_display_visual_class);
9234 defsubr (&Sx_display_backing_store);
9235 defsubr (&Sx_display_save_under);
9236 defsubr (&Sx_create_frame);
9237 defsubr (&Sx_open_connection);
9238 defsubr (&Sx_close_connection);
9239 defsubr (&Sx_display_list);
9240 defsubr (&Sw32_frame_geometry);
9241 defsubr (&Sw32_frame_edges);
9242 defsubr (&Sw32_mouse_absolute_pixel_position);
9243 defsubr (&Sw32_set_mouse_absolute_pixel_position);
9244 defsubr (&Sx_synchronize);
9246 /* W32 specific functions */
9248 defsubr (&Sw32_define_rgb_color);
9249 defsubr (&Sw32_default_color_map);
9250 defsubr (&Sw32_display_monitor_attributes_list);
9251 defsubr (&Sw32_send_sys_command);
9252 defsubr (&Sw32_shell_execute);
9253 defsubr (&Sw32_register_hot_key);
9254 defsubr (&Sw32_unregister_hot_key);
9255 defsubr (&Sw32_registered_hot_keys);
9256 defsubr (&Sw32_reconstruct_hot_key);
9257 defsubr (&Sw32_toggle_lock_key);
9258 defsubr (&Sw32_window_exists_p);
9259 defsubr (&Sw32_battery_status);
9260 defsubr (&Sw32__menu_bar_in_use);
9262 #ifdef WINDOWSNT
9263 defsubr (&Sfile_system_info);
9264 defsubr (&Sdefault_printer_name);
9265 #endif
9267 defsubr (&Sset_message_beep);
9268 defsubr (&Sx_show_tip);
9269 defsubr (&Sx_hide_tip);
9270 tip_timer = Qnil;
9271 staticpro (&tip_timer);
9272 tip_frame = Qnil;
9273 staticpro (&tip_frame);
9275 last_show_tip_args = Qnil;
9276 staticpro (&last_show_tip_args);
9278 defsubr (&Sx_file_dialog);
9279 #ifdef WINDOWSNT
9280 defsubr (&Ssystem_move_file_to_trash);
9281 #endif
9286 /* Crashing and reporting backtrace. */
9288 #ifndef CYGWIN
9289 static LONG CALLBACK my_exception_handler (EXCEPTION_POINTERS *);
9290 static LPTOP_LEVEL_EXCEPTION_FILTER prev_exception_handler;
9291 #endif
9292 static DWORD except_code;
9293 static PVOID except_addr;
9295 #ifndef CYGWIN
9297 /* Stack overflow recovery. */
9299 /* Re-establish the guard page at stack limit. This is needed because
9300 when a stack overflow is detected, Windows removes the guard bit
9301 from the guard page, so if we don't re-establish that protection,
9302 the next stack overflow will cause a crash. */
9303 void
9304 w32_reset_stack_overflow_guard (void)
9306 /* MinGW headers don't declare this (should be in malloc.h). */
9307 _CRTIMP int __cdecl _resetstkoflw (void);
9309 /* We ignore the return value. If _resetstkoflw fails, the next
9310 stack overflow will crash the program. */
9311 (void)_resetstkoflw ();
9314 static void
9315 stack_overflow_handler (void)
9317 /* Hard GC error may lead to stack overflow caused by
9318 too nested calls to mark_object. No way to survive. */
9319 if (gc_in_progress)
9320 terminate_due_to_signal (SIGSEGV, 40);
9321 #ifdef _WIN64
9322 /* See ms-w32.h: MinGW64's longjmp crashes if invoked in this context. */
9323 __builtin_longjmp (return_to_command_loop, 1);
9324 #else
9325 sys_longjmp (return_to_command_loop, 1);
9326 #endif
9329 /* This handler records the exception code and the address where it
9330 was triggered so that this info could be included in the backtrace.
9331 Without that, the backtrace in some cases has no information
9332 whatsoever about the offending code, and looks as if the top-level
9333 exception handler in the MinGW startup code was the one that
9334 crashed. We also recover from stack overflow, by calling our stack
9335 overflow handler that jumps back to top level. */
9336 static LONG CALLBACK
9337 my_exception_handler (EXCEPTION_POINTERS * exception_data)
9339 except_code = exception_data->ExceptionRecord->ExceptionCode;
9340 except_addr = exception_data->ExceptionRecord->ExceptionAddress;
9342 /* If this is a stack overflow exception, attempt to recover. */
9343 if (exception_data->ExceptionRecord->ExceptionCode == EXCEPTION_STACK_OVERFLOW
9344 && exception_data->ExceptionRecord->NumberParameters == 2
9345 /* We can only longjmp to top level from the main thread. */
9346 && GetCurrentThreadId () == dwMainThreadId)
9348 /* Call stack_overflow_handler (). */
9349 #ifdef _WIN64
9350 exception_data->ContextRecord->Rip = (DWORD_PTR) &stack_overflow_handler;
9351 #else
9352 exception_data->ContextRecord->Eip = (DWORD_PTR) &stack_overflow_handler;
9353 #endif
9354 /* Zero this out, so the stale address of the stack overflow
9355 exception we handled is not displayed in some future
9356 unrelated crash. */
9357 except_addr = 0;
9358 return EXCEPTION_CONTINUE_EXECUTION;
9361 if (prev_exception_handler)
9362 return prev_exception_handler (exception_data);
9363 return EXCEPTION_EXECUTE_HANDLER;
9365 #endif
9367 typedef USHORT (WINAPI * CaptureStackBackTrace_proc) (ULONG, ULONG, PVOID *,
9368 PULONG);
9370 #define BACKTRACE_LIMIT_MAX 62
9373 w32_backtrace (void **buffer, int limit)
9375 static CaptureStackBackTrace_proc s_pfn_CaptureStackBackTrace = NULL;
9376 HMODULE hm_kernel32 = NULL;
9378 if (!s_pfn_CaptureStackBackTrace)
9380 hm_kernel32 = LoadLibrary ("Kernel32.dll");
9381 s_pfn_CaptureStackBackTrace =
9382 (CaptureStackBackTrace_proc) GetProcAddress (hm_kernel32,
9383 "RtlCaptureStackBackTrace");
9385 if (s_pfn_CaptureStackBackTrace)
9386 return s_pfn_CaptureStackBackTrace (0, min (BACKTRACE_LIMIT_MAX, limit),
9387 buffer, NULL);
9388 return 0;
9391 void
9392 emacs_abort (void)
9394 int button;
9395 button = MessageBox (NULL,
9396 "A fatal error has occurred!\n\n"
9397 "Would you like to attach a debugger?\n\n"
9398 "Select:\n"
9399 "YES -- to debug Emacs, or\n"
9400 "NO -- to abort Emacs and produce a backtrace\n"
9401 " (emacs_backtrace.txt in current directory)."
9402 #if __GNUC__
9403 "\n\n(type \"gdb -p <emacs-PID>\" and\n"
9404 "\"continue\" inside GDB before clicking YES.)"
9405 #endif
9406 , "Emacs Abort Dialog",
9407 MB_ICONEXCLAMATION | MB_TASKMODAL
9408 | MB_SETFOREGROUND | MB_YESNO);
9409 switch (button)
9411 case IDYES:
9412 DebugBreak ();
9413 exit (2); /* tell the compiler we will never return */
9414 case IDNO:
9415 default:
9417 void *stack[BACKTRACE_LIMIT_MAX + 1];
9418 int i = w32_backtrace (stack, BACKTRACE_LIMIT_MAX + 1);
9420 if (i)
9422 int errfile_fd = -1;
9423 int j;
9424 char buf[sizeof ("\r\nException at this address:\r\n\r\n")
9425 /* The type below should really be 'void *', but
9426 INT_BUFSIZE_BOUND cannot handle that without
9427 triggering compiler warnings (under certain
9428 pedantic warning switches), it wants an
9429 integer type. */
9430 + 2 * INT_BUFSIZE_BOUND (intptr_t)];
9431 #ifdef CYGWIN
9432 int stderr_fd = 2;
9433 #else
9434 HANDLE errout = GetStdHandle (STD_ERROR_HANDLE);
9435 int stderr_fd = -1;
9437 if (errout && errout != INVALID_HANDLE_VALUE)
9438 stderr_fd = _open_osfhandle ((intptr_t)errout, O_APPEND | O_BINARY);
9439 #endif
9441 /* We use %p, not 0x%p, as %p produces a leading "0x" on XP,
9442 but not on Windows 7. addr2line doesn't mind a missing
9443 "0x", but will be confused by an extra one. */
9444 if (except_addr)
9445 sprintf (buf, "\r\nException 0x%lx at this address:\r\n%p\r\n",
9446 except_code, except_addr);
9447 if (stderr_fd >= 0)
9449 if (except_addr)
9450 write (stderr_fd, buf, strlen (buf));
9451 write (stderr_fd, "\r\nBacktrace:\r\n", 14);
9453 #ifdef CYGWIN
9454 #define _open open
9455 #endif
9456 errfile_fd = _open ("emacs_backtrace.txt", O_RDWR | O_CREAT | O_BINARY, S_IREAD | S_IWRITE);
9457 if (errfile_fd >= 0)
9459 lseek (errfile_fd, 0L, SEEK_END);
9460 if (except_addr)
9461 write (errfile_fd, buf, strlen (buf));
9462 write (errfile_fd, "\r\nBacktrace:\r\n", 14);
9465 for (j = 0; j < i; j++)
9467 /* stack[] gives the return addresses, whereas we want
9468 the address of the call, so decrease each address
9469 by approximate size of 1 CALL instruction. */
9470 sprintf (buf, "%p\r\n", (char *)stack[j] - sizeof(void *));
9471 if (stderr_fd >= 0)
9472 write (stderr_fd, buf, strlen (buf));
9473 if (errfile_fd >= 0)
9474 write (errfile_fd, buf, strlen (buf));
9476 if (i == BACKTRACE_LIMIT_MAX)
9478 if (stderr_fd >= 0)
9479 write (stderr_fd, "...\r\n", 5);
9480 if (errfile_fd >= 0)
9481 write (errfile_fd, "...\r\n", 5);
9483 if (errfile_fd >= 0)
9484 close (errfile_fd);
9486 abort ();
9487 break;
9494 /* Initialization. */
9497 globals_of_w32fns is used to initialize those global variables that
9498 must always be initialized on startup even when the global variable
9499 initialized is non zero (see the function main in emacs.c).
9500 globals_of_w32fns is called from syms_of_w32fns when the global
9501 variable initialized is 0 and directly from main when initialized
9502 is non zero.
9504 void
9505 globals_of_w32fns (void)
9507 HMODULE user32_lib = GetModuleHandle ("user32.dll");
9509 TrackMouseEvent not available in all versions of Windows, so must load
9510 it dynamically. Do it once, here, instead of every time it is used.
9512 track_mouse_event_fn = (TrackMouseEvent_Proc)
9513 GetProcAddress (user32_lib, "TrackMouseEvent");
9515 monitor_from_point_fn = (MonitorFromPoint_Proc)
9516 GetProcAddress (user32_lib, "MonitorFromPoint");
9517 get_monitor_info_fn = (GetMonitorInfo_Proc)
9518 GetProcAddress (user32_lib, "GetMonitorInfoA");
9519 monitor_from_window_fn = (MonitorFromWindow_Proc)
9520 GetProcAddress (user32_lib, "MonitorFromWindow");
9521 enum_display_monitors_fn = (EnumDisplayMonitors_Proc)
9522 GetProcAddress (user32_lib, "EnumDisplayMonitors");
9523 get_title_bar_info_fn = (GetTitleBarInfo_Proc)
9524 GetProcAddress (user32_lib, "GetTitleBarInfo");
9527 HMODULE imm32_lib = GetModuleHandle ("imm32.dll");
9528 get_composition_string_fn = (ImmGetCompositionString_Proc)
9529 GetProcAddress (imm32_lib, "ImmGetCompositionStringW");
9530 get_ime_context_fn = (ImmGetContext_Proc)
9531 GetProcAddress (imm32_lib, "ImmGetContext");
9532 release_ime_context_fn = (ImmReleaseContext_Proc)
9533 GetProcAddress (imm32_lib, "ImmReleaseContext");
9534 set_ime_composition_window_fn = (ImmSetCompositionWindow_Proc)
9535 GetProcAddress (imm32_lib, "ImmSetCompositionWindow");
9538 except_code = 0;
9539 except_addr = 0;
9540 #ifndef CYGWIN
9541 prev_exception_handler = SetUnhandledExceptionFilter (my_exception_handler);
9542 #endif
9544 DEFVAR_INT ("w32-ansi-code-page",
9545 w32_ansi_code_page,
9546 doc: /* The ANSI code page used by the system. */);
9547 w32_ansi_code_page = GetACP ();
9549 if (os_subtype == OS_NT)
9550 w32_unicode_gui = 1;
9551 else
9552 w32_unicode_gui = 0;
9554 after_deadkey = -1;
9556 /* MessageBox does not work without this when linked to comctl32.dll 6.0. */
9557 InitCommonControls ();
9559 syms_of_w32uniscribe ();
9561 /* Needed for recovery from C stack overflows in batch mode. */
9562 if (noninteractive)
9563 dwMainThreadId = GetCurrentThreadId ();
9566 #ifdef NTGUI_UNICODE
9568 Lisp_Object
9569 ntgui_encode_system (Lisp_Object str)
9571 Lisp_Object encoded;
9572 to_unicode (str, &encoded);
9573 return encoded;
9576 #endif /* NTGUI_UNICODE */