* lisp/autorevert.el (auto-revert-handler): Use vc-refresh-state.
[emacs.git] / src / w32fns.c
blobd92352a98026396bfe97b8011c23e2658499dfc9
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 "buffer.h"
39 #include "keyboard.h"
40 #include "blockinput.h"
41 #include "coding.h"
43 #include "w32common.h"
45 #ifdef WINDOWSNT
46 #include <mbstring.h>
47 #endif /* WINDOWSNT */
49 #if CYGWIN
50 #include "cygw32.h"
51 #else
52 #include "w32.h"
53 #endif
55 #include <commctrl.h>
56 #include <commdlg.h>
57 #include <shellapi.h>
58 #include <ctype.h>
59 #include <winspool.h>
60 #include <objbase.h>
62 #include <dlgs.h>
63 #include <imm.h>
64 #include <windowsx.h>
66 #ifndef FOF_NO_CONNECTED_ELEMENTS
67 #define FOF_NO_CONNECTED_ELEMENTS 0x2000
68 #endif
70 void syms_of_w32fns (void);
71 void globals_of_w32fns (void);
73 extern void free_frame_menubar (struct frame *);
74 extern int w32_console_toggle_lock_key (int, Lisp_Object);
75 extern void w32_menu_display_help (HWND, HMENU, UINT, UINT);
76 extern void w32_free_menu_strings (HWND);
77 extern const char *map_w32_filename (const char *, const char **);
78 extern char * w32_strerror (int error_no);
80 #ifndef IDC_HAND
81 #define IDC_HAND MAKEINTRESOURCE(32649)
82 #endif
84 /* Prefix for system colors. */
85 #define SYSTEM_COLOR_PREFIX "System"
86 #define SYSTEM_COLOR_PREFIX_LEN (sizeof (SYSTEM_COLOR_PREFIX) - 1)
88 /* State variables for emulating a three button mouse. */
89 #define LMOUSE 1
90 #define MMOUSE 2
91 #define RMOUSE 4
93 static int button_state = 0;
94 static W32Msg saved_mouse_button_msg;
95 static unsigned mouse_button_timer = 0; /* non-zero when timer is active */
96 static W32Msg saved_mouse_move_msg;
97 static unsigned mouse_move_timer = 0;
99 /* Window that is tracking the mouse. */
100 static HWND track_mouse_window;
102 /* Multi-monitor API definitions that are not pulled from the headers
103 since we are compiling for NT 4. */
104 #ifndef MONITOR_DEFAULT_TO_NEAREST
105 #define MONITOR_DEFAULT_TO_NEAREST 2
106 #endif
107 #ifndef MONITORINFOF_PRIMARY
108 #define MONITORINFOF_PRIMARY 1
109 #endif
110 #ifndef SM_XVIRTUALSCREEN
111 #define SM_XVIRTUALSCREEN 76
112 #endif
113 #ifndef SM_YVIRTUALSCREEN
114 #define SM_YVIRTUALSCREEN 77
115 #endif
116 /* MinGW headers define MONITORINFO unconditionally, but MSVC ones don't.
117 To avoid a compile error on one or the other, redefine with a new name. */
118 struct MONITOR_INFO
120 DWORD cbSize;
121 RECT rcMonitor;
122 RECT rcWork;
123 DWORD dwFlags;
126 #if _WIN32_WINDOWS >= 0x0410
127 #define C_CHILDREN_TITLEBAR CCHILDREN_TITLEBAR
128 typedef TITLEBARINFO TITLEBAR_INFO;
129 #else
130 #define C_CHILDREN_TITLEBAR 5
131 typedef struct
133 DWORD cbSize;
134 RECT rcTitleBar;
135 DWORD rgstate[C_CHILDREN_TITLEBAR+1];
136 } TITLEBAR_INFO, *PTITLEBAR_INFO;
137 #endif
139 #ifndef CCHDEVICENAME
140 #define CCHDEVICENAME 32
141 #endif
142 struct MONITOR_INFO_EX
144 DWORD cbSize;
145 RECT rcMonitor;
146 RECT rcWork;
147 DWORD dwFlags;
148 char szDevice[CCHDEVICENAME];
151 /* Reportedly, MSVC does not have this in its headers. */
152 #if defined (_MSC_VER) && _WIN32_WINNT < 0x0500
153 DECLARE_HANDLE(HMONITOR);
154 #endif
156 typedef BOOL (WINAPI * TrackMouseEvent_Proc)
157 (IN OUT LPTRACKMOUSEEVENT lpEventTrack);
158 typedef LONG (WINAPI * ImmGetCompositionString_Proc)
159 (IN HIMC context, IN DWORD index, OUT LPVOID buffer, IN DWORD bufLen);
160 typedef HIMC (WINAPI * ImmGetContext_Proc) (IN HWND window);
161 typedef BOOL (WINAPI * ImmReleaseContext_Proc) (IN HWND wnd, IN HIMC context);
162 typedef BOOL (WINAPI * ImmSetCompositionWindow_Proc) (IN HIMC context,
163 IN COMPOSITIONFORM *form);
164 typedef HMONITOR (WINAPI * MonitorFromPoint_Proc) (IN POINT pt, IN DWORD flags);
165 typedef BOOL (WINAPI * GetMonitorInfo_Proc)
166 (IN HMONITOR monitor, OUT struct MONITOR_INFO* info);
167 typedef HMONITOR (WINAPI * MonitorFromWindow_Proc)
168 (IN HWND hwnd, IN DWORD dwFlags);
169 typedef BOOL CALLBACK (* MonitorEnum_Proc)
170 (IN HMONITOR monitor, IN HDC hdc, IN RECT *rcMonitor, IN LPARAM dwData);
171 typedef BOOL (WINAPI * EnumDisplayMonitors_Proc)
172 (IN HDC hdc, IN RECT *rcClip, IN MonitorEnum_Proc fnEnum, IN LPARAM dwData);
173 typedef BOOL (WINAPI * GetTitleBarInfo_Proc)
174 (IN HWND hwnd, OUT TITLEBAR_INFO* info);
176 TrackMouseEvent_Proc track_mouse_event_fn = NULL;
177 ImmGetCompositionString_Proc get_composition_string_fn = NULL;
178 ImmGetContext_Proc get_ime_context_fn = NULL;
179 ImmReleaseContext_Proc release_ime_context_fn = NULL;
180 ImmSetCompositionWindow_Proc set_ime_composition_window_fn = NULL;
181 MonitorFromPoint_Proc monitor_from_point_fn = NULL;
182 GetMonitorInfo_Proc get_monitor_info_fn = NULL;
183 MonitorFromWindow_Proc monitor_from_window_fn = NULL;
184 EnumDisplayMonitors_Proc enum_display_monitors_fn = NULL;
185 GetTitleBarInfo_Proc get_title_bar_info_fn = NULL;
187 #ifdef NTGUI_UNICODE
188 #define unicode_append_menu AppendMenuW
189 #else /* !NTGUI_UNICODE */
190 extern AppendMenuW_Proc unicode_append_menu;
191 #endif /* NTGUI_UNICODE */
193 /* Flag to selectively ignore WM_IME_CHAR messages. */
194 static int ignore_ime_char = 0;
196 /* W95 mousewheel handler */
197 unsigned int msh_mousewheel = 0;
199 /* Timers */
200 #define MOUSE_BUTTON_ID 1
201 #define MOUSE_MOVE_ID 2
202 #define MENU_FREE_ID 3
203 /* The delay (milliseconds) before a menu is freed after WM_EXITMENULOOP
204 is received. */
205 #define MENU_FREE_DELAY 1000
206 static unsigned menu_free_timer = 0;
208 #ifdef GLYPH_DEBUG
209 static ptrdiff_t image_cache_refcount;
210 static int dpyinfo_refcount;
211 #endif
213 static HWND w32_visible_system_caret_hwnd;
215 static int w32_unicode_gui;
217 /* From w32menu.c */
218 extern HMENU current_popup_menu;
219 int menubar_in_use = 0;
221 /* From w32uniscribe.c */
222 extern void syms_of_w32uniscribe (void);
223 extern int uniscribe_available;
225 #ifdef WINDOWSNT
226 /* From w32inevt.c */
227 extern int faked_key;
228 #endif /* WINDOWSNT */
230 /* This gives us the page size and the size of the allocation unit on NT. */
231 SYSTEM_INFO sysinfo_cache;
233 /* This gives us version, build, and platform identification. */
234 OSVERSIONINFO osinfo_cache;
236 DWORD_PTR syspage_mask = 0;
238 /* The major and minor versions of NT. */
239 int w32_major_version;
240 int w32_minor_version;
241 int w32_build_number;
243 /* Distinguish between Windows NT and Windows 95. */
244 int os_subtype;
246 #ifdef HAVE_NTGUI
247 HINSTANCE hinst = NULL;
248 #endif
250 static unsigned int sound_type = 0xFFFFFFFF;
251 #define MB_EMACS_SILENT (0xFFFFFFFF - 1)
253 /* Let the user specify a display with a frame.
254 nil stands for the selected frame--or, if that is not a w32 frame,
255 the first display on the list. */
257 struct w32_display_info *
258 check_x_display_info (Lisp_Object object)
260 if (NILP (object))
262 struct frame *sf = XFRAME (selected_frame);
264 if (FRAME_W32_P (sf) && FRAME_LIVE_P (sf))
265 return FRAME_DISPLAY_INFO (sf);
266 else
267 return &one_w32_display_info;
269 else if (TERMINALP (object))
271 struct terminal *t = decode_live_terminal (object);
273 if (t->type != output_w32)
274 error ("Terminal %d is not a W32 display", t->id);
276 return t->display_info.w32;
278 else if (STRINGP (object))
279 return x_display_info_for_name (object);
280 else
282 struct frame *f;
284 CHECK_LIVE_FRAME (object);
285 f = XFRAME (object);
286 if (! FRAME_W32_P (f))
287 error ("Non-W32 frame used");
288 return FRAME_DISPLAY_INFO (f);
292 /* Return the Emacs frame-object corresponding to an w32 window.
293 It could be the frame's main window or an icon window. */
295 struct frame *
296 x_window_to_frame (struct w32_display_info *dpyinfo, HWND wdesc)
298 Lisp_Object tail, frame;
299 struct frame *f;
301 FOR_EACH_FRAME (tail, frame)
303 f = XFRAME (frame);
304 if (!FRAME_W32_P (f) || FRAME_DISPLAY_INFO (f) != dpyinfo)
305 continue;
307 if (FRAME_W32_WINDOW (f) == wdesc)
308 return f;
310 return 0;
314 static Lisp_Object unwind_create_frame (Lisp_Object);
315 static void unwind_create_tip_frame (Lisp_Object);
316 static void my_create_window (struct frame *);
317 static void my_create_tip_window (struct frame *);
319 /* TODO: Native Input Method support; see x_create_im. */
320 void x_set_foreground_color (struct frame *, Lisp_Object, Lisp_Object);
321 void x_set_background_color (struct frame *, Lisp_Object, Lisp_Object);
322 void x_set_mouse_color (struct frame *, Lisp_Object, Lisp_Object);
323 void x_set_cursor_color (struct frame *, Lisp_Object, Lisp_Object);
324 void x_set_border_color (struct frame *, Lisp_Object, Lisp_Object);
325 void x_set_cursor_type (struct frame *, Lisp_Object, Lisp_Object);
326 void x_set_icon_type (struct frame *, Lisp_Object, Lisp_Object);
327 void x_set_icon_name (struct frame *, Lisp_Object, Lisp_Object);
328 void x_explicitly_set_name (struct frame *, Lisp_Object, Lisp_Object);
329 void x_set_menu_bar_lines (struct frame *, Lisp_Object, Lisp_Object);
330 void x_set_title (struct frame *, Lisp_Object, Lisp_Object);
331 void x_set_tool_bar_lines (struct frame *, Lisp_Object, Lisp_Object);
332 void x_set_internal_border_width (struct frame *f, Lisp_Object, Lisp_Object);
335 /* Store the screen positions of frame F into XPTR and YPTR.
336 These are the positions of the containing window manager window,
337 not Emacs's own window. */
339 void
340 x_real_positions (struct frame *f, int *xptr, int *yptr)
342 POINT pt;
343 RECT rect;
345 /* Get the bounds of the WM window. */
346 GetWindowRect (FRAME_W32_WINDOW (f), &rect);
348 pt.x = 0;
349 pt.y = 0;
351 /* Convert (0, 0) in the client area to screen co-ordinates. */
352 ClientToScreen (FRAME_W32_WINDOW (f), &pt);
354 *xptr = rect.left;
355 *yptr = rect.top;
358 /* Returns the window rectangle appropriate for the given fullscreen mode.
359 The normal rect parameter was the window's rectangle prior to entering
360 fullscreen mode. If multiple monitor support is available, the nearest
361 monitor to the window is chosen. */
363 void
364 w32_fullscreen_rect (HWND hwnd, int fsmode, RECT normal, RECT *rect)
366 struct MONITOR_INFO mi = { sizeof(mi) };
367 if (monitor_from_window_fn && get_monitor_info_fn)
369 HMONITOR monitor =
370 monitor_from_window_fn (hwnd, MONITOR_DEFAULT_TO_NEAREST);
371 get_monitor_info_fn (monitor, &mi);
373 else
375 mi.rcMonitor.left = 0;
376 mi.rcMonitor.top = 0;
377 mi.rcMonitor.right = GetSystemMetrics (SM_CXSCREEN);
378 mi.rcMonitor.bottom = GetSystemMetrics (SM_CYSCREEN);
379 mi.rcWork.left = 0;
380 mi.rcWork.top = 0;
381 mi.rcWork.right = GetSystemMetrics (SM_CXMAXIMIZED);
382 mi.rcWork.bottom = GetSystemMetrics (SM_CYMAXIMIZED);
385 switch (fsmode)
387 case FULLSCREEN_BOTH:
388 rect->left = mi.rcMonitor.left;
389 rect->top = mi.rcMonitor.top;
390 rect->right = mi.rcMonitor.right;
391 rect->bottom = mi.rcMonitor.bottom;
392 break;
393 case FULLSCREEN_WIDTH:
394 rect->left = mi.rcWork.left;
395 rect->top = normal.top;
396 rect->right = mi.rcWork.right;
397 rect->bottom = normal.bottom;
398 break;
399 case FULLSCREEN_HEIGHT:
400 rect->left = normal.left;
401 rect->top = mi.rcWork.top;
402 rect->right = normal.right;
403 rect->bottom = mi.rcWork.bottom;
404 break;
405 default:
406 *rect = normal;
407 break;
413 DEFUN ("w32-define-rgb-color", Fw32_define_rgb_color,
414 Sw32_define_rgb_color, 4, 4, 0,
415 doc: /* Convert RGB numbers to a Windows color reference and associate with NAME.
416 This adds or updates a named color to `w32-color-map', making it
417 available for use. The original entry's RGB ref is returned, or nil
418 if the entry is new. */)
419 (Lisp_Object red, Lisp_Object green, Lisp_Object blue, Lisp_Object name)
421 Lisp_Object rgb;
422 Lisp_Object oldrgb = Qnil;
423 Lisp_Object entry;
425 CHECK_NUMBER (red);
426 CHECK_NUMBER (green);
427 CHECK_NUMBER (blue);
428 CHECK_STRING (name);
430 XSETINT (rgb, RGB (XUINT (red), XUINT (green), XUINT (blue)));
432 block_input ();
434 /* replace existing entry in w32-color-map or add new entry. */
435 entry = Fassoc (name, Vw32_color_map);
436 if (NILP (entry))
438 entry = Fcons (name, rgb);
439 Vw32_color_map = Fcons (entry, Vw32_color_map);
441 else
443 oldrgb = Fcdr (entry);
444 Fsetcdr (entry, rgb);
447 unblock_input ();
449 return (oldrgb);
452 /* The default colors for the w32 color map */
453 typedef struct colormap_t
455 char *name;
456 COLORREF colorref;
457 } colormap_t;
459 colormap_t w32_color_map[] =
461 {"snow" , PALETTERGB (255,250,250)},
462 {"ghost white" , PALETTERGB (248,248,255)},
463 {"GhostWhite" , PALETTERGB (248,248,255)},
464 {"white smoke" , PALETTERGB (245,245,245)},
465 {"WhiteSmoke" , PALETTERGB (245,245,245)},
466 {"gainsboro" , PALETTERGB (220,220,220)},
467 {"floral white" , PALETTERGB (255,250,240)},
468 {"FloralWhite" , PALETTERGB (255,250,240)},
469 {"old lace" , PALETTERGB (253,245,230)},
470 {"OldLace" , PALETTERGB (253,245,230)},
471 {"linen" , PALETTERGB (250,240,230)},
472 {"antique white" , PALETTERGB (250,235,215)},
473 {"AntiqueWhite" , PALETTERGB (250,235,215)},
474 {"papaya whip" , PALETTERGB (255,239,213)},
475 {"PapayaWhip" , PALETTERGB (255,239,213)},
476 {"blanched almond" , PALETTERGB (255,235,205)},
477 {"BlanchedAlmond" , PALETTERGB (255,235,205)},
478 {"bisque" , PALETTERGB (255,228,196)},
479 {"peach puff" , PALETTERGB (255,218,185)},
480 {"PeachPuff" , PALETTERGB (255,218,185)},
481 {"navajo white" , PALETTERGB (255,222,173)},
482 {"NavajoWhite" , PALETTERGB (255,222,173)},
483 {"moccasin" , PALETTERGB (255,228,181)},
484 {"cornsilk" , PALETTERGB (255,248,220)},
485 {"ivory" , PALETTERGB (255,255,240)},
486 {"lemon chiffon" , PALETTERGB (255,250,205)},
487 {"LemonChiffon" , PALETTERGB (255,250,205)},
488 {"seashell" , PALETTERGB (255,245,238)},
489 {"honeydew" , PALETTERGB (240,255,240)},
490 {"mint cream" , PALETTERGB (245,255,250)},
491 {"MintCream" , PALETTERGB (245,255,250)},
492 {"azure" , PALETTERGB (240,255,255)},
493 {"alice blue" , PALETTERGB (240,248,255)},
494 {"AliceBlue" , PALETTERGB (240,248,255)},
495 {"lavender" , PALETTERGB (230,230,250)},
496 {"lavender blush" , PALETTERGB (255,240,245)},
497 {"LavenderBlush" , PALETTERGB (255,240,245)},
498 {"misty rose" , PALETTERGB (255,228,225)},
499 {"MistyRose" , PALETTERGB (255,228,225)},
500 {"white" , PALETTERGB (255,255,255)},
501 {"black" , PALETTERGB ( 0, 0, 0)},
502 {"dark slate gray" , PALETTERGB ( 47, 79, 79)},
503 {"DarkSlateGray" , PALETTERGB ( 47, 79, 79)},
504 {"dark slate grey" , PALETTERGB ( 47, 79, 79)},
505 {"DarkSlateGrey" , PALETTERGB ( 47, 79, 79)},
506 {"dim gray" , PALETTERGB (105,105,105)},
507 {"DimGray" , PALETTERGB (105,105,105)},
508 {"dim grey" , PALETTERGB (105,105,105)},
509 {"DimGrey" , PALETTERGB (105,105,105)},
510 {"slate gray" , PALETTERGB (112,128,144)},
511 {"SlateGray" , PALETTERGB (112,128,144)},
512 {"slate grey" , PALETTERGB (112,128,144)},
513 {"SlateGrey" , PALETTERGB (112,128,144)},
514 {"light slate gray" , PALETTERGB (119,136,153)},
515 {"LightSlateGray" , PALETTERGB (119,136,153)},
516 {"light slate grey" , PALETTERGB (119,136,153)},
517 {"LightSlateGrey" , PALETTERGB (119,136,153)},
518 {"gray" , PALETTERGB (190,190,190)},
519 {"grey" , PALETTERGB (190,190,190)},
520 {"light grey" , PALETTERGB (211,211,211)},
521 {"LightGrey" , PALETTERGB (211,211,211)},
522 {"light gray" , PALETTERGB (211,211,211)},
523 {"LightGray" , PALETTERGB (211,211,211)},
524 {"midnight blue" , PALETTERGB ( 25, 25,112)},
525 {"MidnightBlue" , PALETTERGB ( 25, 25,112)},
526 {"navy" , PALETTERGB ( 0, 0,128)},
527 {"navy blue" , PALETTERGB ( 0, 0,128)},
528 {"NavyBlue" , PALETTERGB ( 0, 0,128)},
529 {"cornflower blue" , PALETTERGB (100,149,237)},
530 {"CornflowerBlue" , PALETTERGB (100,149,237)},
531 {"dark slate blue" , PALETTERGB ( 72, 61,139)},
532 {"DarkSlateBlue" , PALETTERGB ( 72, 61,139)},
533 {"slate blue" , PALETTERGB (106, 90,205)},
534 {"SlateBlue" , PALETTERGB (106, 90,205)},
535 {"medium slate blue" , PALETTERGB (123,104,238)},
536 {"MediumSlateBlue" , PALETTERGB (123,104,238)},
537 {"light slate blue" , PALETTERGB (132,112,255)},
538 {"LightSlateBlue" , PALETTERGB (132,112,255)},
539 {"medium blue" , PALETTERGB ( 0, 0,205)},
540 {"MediumBlue" , PALETTERGB ( 0, 0,205)},
541 {"royal blue" , PALETTERGB ( 65,105,225)},
542 {"RoyalBlue" , PALETTERGB ( 65,105,225)},
543 {"blue" , PALETTERGB ( 0, 0,255)},
544 {"dodger blue" , PALETTERGB ( 30,144,255)},
545 {"DodgerBlue" , PALETTERGB ( 30,144,255)},
546 {"deep sky blue" , PALETTERGB ( 0,191,255)},
547 {"DeepSkyBlue" , PALETTERGB ( 0,191,255)},
548 {"sky blue" , PALETTERGB (135,206,235)},
549 {"SkyBlue" , PALETTERGB (135,206,235)},
550 {"light sky blue" , PALETTERGB (135,206,250)},
551 {"LightSkyBlue" , PALETTERGB (135,206,250)},
552 {"steel blue" , PALETTERGB ( 70,130,180)},
553 {"SteelBlue" , PALETTERGB ( 70,130,180)},
554 {"light steel blue" , PALETTERGB (176,196,222)},
555 {"LightSteelBlue" , PALETTERGB (176,196,222)},
556 {"light blue" , PALETTERGB (173,216,230)},
557 {"LightBlue" , PALETTERGB (173,216,230)},
558 {"powder blue" , PALETTERGB (176,224,230)},
559 {"PowderBlue" , PALETTERGB (176,224,230)},
560 {"pale turquoise" , PALETTERGB (175,238,238)},
561 {"PaleTurquoise" , PALETTERGB (175,238,238)},
562 {"dark turquoise" , PALETTERGB ( 0,206,209)},
563 {"DarkTurquoise" , PALETTERGB ( 0,206,209)},
564 {"medium turquoise" , PALETTERGB ( 72,209,204)},
565 {"MediumTurquoise" , PALETTERGB ( 72,209,204)},
566 {"turquoise" , PALETTERGB ( 64,224,208)},
567 {"cyan" , PALETTERGB ( 0,255,255)},
568 {"light cyan" , PALETTERGB (224,255,255)},
569 {"LightCyan" , PALETTERGB (224,255,255)},
570 {"cadet blue" , PALETTERGB ( 95,158,160)},
571 {"CadetBlue" , PALETTERGB ( 95,158,160)},
572 {"medium aquamarine" , PALETTERGB (102,205,170)},
573 {"MediumAquamarine" , PALETTERGB (102,205,170)},
574 {"aquamarine" , PALETTERGB (127,255,212)},
575 {"dark green" , PALETTERGB ( 0,100, 0)},
576 {"DarkGreen" , PALETTERGB ( 0,100, 0)},
577 {"dark olive green" , PALETTERGB ( 85,107, 47)},
578 {"DarkOliveGreen" , PALETTERGB ( 85,107, 47)},
579 {"dark sea green" , PALETTERGB (143,188,143)},
580 {"DarkSeaGreen" , PALETTERGB (143,188,143)},
581 {"sea green" , PALETTERGB ( 46,139, 87)},
582 {"SeaGreen" , PALETTERGB ( 46,139, 87)},
583 {"medium sea green" , PALETTERGB ( 60,179,113)},
584 {"MediumSeaGreen" , PALETTERGB ( 60,179,113)},
585 {"light sea green" , PALETTERGB ( 32,178,170)},
586 {"LightSeaGreen" , PALETTERGB ( 32,178,170)},
587 {"pale green" , PALETTERGB (152,251,152)},
588 {"PaleGreen" , PALETTERGB (152,251,152)},
589 {"spring green" , PALETTERGB ( 0,255,127)},
590 {"SpringGreen" , PALETTERGB ( 0,255,127)},
591 {"lawn green" , PALETTERGB (124,252, 0)},
592 {"LawnGreen" , PALETTERGB (124,252, 0)},
593 {"green" , PALETTERGB ( 0,255, 0)},
594 {"chartreuse" , PALETTERGB (127,255, 0)},
595 {"medium spring green" , PALETTERGB ( 0,250,154)},
596 {"MediumSpringGreen" , PALETTERGB ( 0,250,154)},
597 {"green yellow" , PALETTERGB (173,255, 47)},
598 {"GreenYellow" , PALETTERGB (173,255, 47)},
599 {"lime green" , PALETTERGB ( 50,205, 50)},
600 {"LimeGreen" , PALETTERGB ( 50,205, 50)},
601 {"yellow green" , PALETTERGB (154,205, 50)},
602 {"YellowGreen" , PALETTERGB (154,205, 50)},
603 {"forest green" , PALETTERGB ( 34,139, 34)},
604 {"ForestGreen" , PALETTERGB ( 34,139, 34)},
605 {"olive drab" , PALETTERGB (107,142, 35)},
606 {"OliveDrab" , PALETTERGB (107,142, 35)},
607 {"dark khaki" , PALETTERGB (189,183,107)},
608 {"DarkKhaki" , PALETTERGB (189,183,107)},
609 {"khaki" , PALETTERGB (240,230,140)},
610 {"pale goldenrod" , PALETTERGB (238,232,170)},
611 {"PaleGoldenrod" , PALETTERGB (238,232,170)},
612 {"light goldenrod yellow" , PALETTERGB (250,250,210)},
613 {"LightGoldenrodYellow" , PALETTERGB (250,250,210)},
614 {"light yellow" , PALETTERGB (255,255,224)},
615 {"LightYellow" , PALETTERGB (255,255,224)},
616 {"yellow" , PALETTERGB (255,255, 0)},
617 {"gold" , PALETTERGB (255,215, 0)},
618 {"light goldenrod" , PALETTERGB (238,221,130)},
619 {"LightGoldenrod" , PALETTERGB (238,221,130)},
620 {"goldenrod" , PALETTERGB (218,165, 32)},
621 {"dark goldenrod" , PALETTERGB (184,134, 11)},
622 {"DarkGoldenrod" , PALETTERGB (184,134, 11)},
623 {"rosy brown" , PALETTERGB (188,143,143)},
624 {"RosyBrown" , PALETTERGB (188,143,143)},
625 {"indian red" , PALETTERGB (205, 92, 92)},
626 {"IndianRed" , PALETTERGB (205, 92, 92)},
627 {"saddle brown" , PALETTERGB (139, 69, 19)},
628 {"SaddleBrown" , PALETTERGB (139, 69, 19)},
629 {"sienna" , PALETTERGB (160, 82, 45)},
630 {"peru" , PALETTERGB (205,133, 63)},
631 {"burlywood" , PALETTERGB (222,184,135)},
632 {"beige" , PALETTERGB (245,245,220)},
633 {"wheat" , PALETTERGB (245,222,179)},
634 {"sandy brown" , PALETTERGB (244,164, 96)},
635 {"SandyBrown" , PALETTERGB (244,164, 96)},
636 {"tan" , PALETTERGB (210,180,140)},
637 {"chocolate" , PALETTERGB (210,105, 30)},
638 {"firebrick" , PALETTERGB (178,34, 34)},
639 {"brown" , PALETTERGB (165,42, 42)},
640 {"dark salmon" , PALETTERGB (233,150,122)},
641 {"DarkSalmon" , PALETTERGB (233,150,122)},
642 {"salmon" , PALETTERGB (250,128,114)},
643 {"light salmon" , PALETTERGB (255,160,122)},
644 {"LightSalmon" , PALETTERGB (255,160,122)},
645 {"orange" , PALETTERGB (255,165, 0)},
646 {"dark orange" , PALETTERGB (255,140, 0)},
647 {"DarkOrange" , PALETTERGB (255,140, 0)},
648 {"coral" , PALETTERGB (255,127, 80)},
649 {"light coral" , PALETTERGB (240,128,128)},
650 {"LightCoral" , PALETTERGB (240,128,128)},
651 {"tomato" , PALETTERGB (255, 99, 71)},
652 {"orange red" , PALETTERGB (255, 69, 0)},
653 {"OrangeRed" , PALETTERGB (255, 69, 0)},
654 {"red" , PALETTERGB (255, 0, 0)},
655 {"hot pink" , PALETTERGB (255,105,180)},
656 {"HotPink" , PALETTERGB (255,105,180)},
657 {"deep pink" , PALETTERGB (255, 20,147)},
658 {"DeepPink" , PALETTERGB (255, 20,147)},
659 {"pink" , PALETTERGB (255,192,203)},
660 {"light pink" , PALETTERGB (255,182,193)},
661 {"LightPink" , PALETTERGB (255,182,193)},
662 {"pale violet red" , PALETTERGB (219,112,147)},
663 {"PaleVioletRed" , PALETTERGB (219,112,147)},
664 {"maroon" , PALETTERGB (176, 48, 96)},
665 {"medium violet red" , PALETTERGB (199, 21,133)},
666 {"MediumVioletRed" , PALETTERGB (199, 21,133)},
667 {"violet red" , PALETTERGB (208, 32,144)},
668 {"VioletRed" , PALETTERGB (208, 32,144)},
669 {"magenta" , PALETTERGB (255, 0,255)},
670 {"violet" , PALETTERGB (238,130,238)},
671 {"plum" , PALETTERGB (221,160,221)},
672 {"orchid" , PALETTERGB (218,112,214)},
673 {"medium orchid" , PALETTERGB (186, 85,211)},
674 {"MediumOrchid" , PALETTERGB (186, 85,211)},
675 {"dark orchid" , PALETTERGB (153, 50,204)},
676 {"DarkOrchid" , PALETTERGB (153, 50,204)},
677 {"dark violet" , PALETTERGB (148, 0,211)},
678 {"DarkViolet" , PALETTERGB (148, 0,211)},
679 {"blue violet" , PALETTERGB (138, 43,226)},
680 {"BlueViolet" , PALETTERGB (138, 43,226)},
681 {"purple" , PALETTERGB (160, 32,240)},
682 {"medium purple" , PALETTERGB (147,112,219)},
683 {"MediumPurple" , PALETTERGB (147,112,219)},
684 {"thistle" , PALETTERGB (216,191,216)},
685 {"gray0" , PALETTERGB ( 0, 0, 0)},
686 {"grey0" , PALETTERGB ( 0, 0, 0)},
687 {"dark grey" , PALETTERGB (169,169,169)},
688 {"DarkGrey" , PALETTERGB (169,169,169)},
689 {"dark gray" , PALETTERGB (169,169,169)},
690 {"DarkGray" , PALETTERGB (169,169,169)},
691 {"dark blue" , PALETTERGB ( 0, 0,139)},
692 {"DarkBlue" , PALETTERGB ( 0, 0,139)},
693 {"dark cyan" , PALETTERGB ( 0,139,139)},
694 {"DarkCyan" , PALETTERGB ( 0,139,139)},
695 {"dark magenta" , PALETTERGB (139, 0,139)},
696 {"DarkMagenta" , PALETTERGB (139, 0,139)},
697 {"dark red" , PALETTERGB (139, 0, 0)},
698 {"DarkRed" , PALETTERGB (139, 0, 0)},
699 {"light green" , PALETTERGB (144,238,144)},
700 {"LightGreen" , PALETTERGB (144,238,144)},
703 static Lisp_Object
704 w32_default_color_map (void)
706 int i;
707 colormap_t *pc = w32_color_map;
708 Lisp_Object cmap;
710 block_input ();
712 cmap = Qnil;
714 for (i = 0; i < ARRAYELTS (w32_color_map); pc++, i++)
715 cmap = Fcons (Fcons (build_string (pc->name),
716 make_number (pc->colorref)),
717 cmap);
719 unblock_input ();
721 return (cmap);
724 DEFUN ("w32-default-color-map", Fw32_default_color_map, Sw32_default_color_map,
725 0, 0, 0, doc: /* Return the default color map. */)
726 (void)
728 return w32_default_color_map ();
731 static Lisp_Object
732 w32_color_map_lookup (const char *colorname)
734 Lisp_Object tail, ret = Qnil;
736 block_input ();
738 for (tail = Vw32_color_map; CONSP (tail); tail = XCDR (tail))
740 register Lisp_Object elt, tem;
742 elt = XCAR (tail);
743 if (!CONSP (elt)) continue;
745 tem = XCAR (elt);
747 if (lstrcmpi (SSDATA (tem), colorname) == 0)
749 ret = Fcdr (elt);
750 break;
753 QUIT;
756 unblock_input ();
758 return ret;
762 static void
763 add_system_logical_colors_to_map (Lisp_Object *system_colors)
765 HKEY colors_key;
767 /* Other registry operations are done with input blocked. */
768 block_input ();
770 /* Look for "Control Panel/Colors" under User and Machine registry
771 settings. */
772 if (RegOpenKeyEx (HKEY_CURRENT_USER, "Control Panel\\Colors", 0,
773 KEY_READ, &colors_key) == ERROR_SUCCESS
774 || RegOpenKeyEx (HKEY_LOCAL_MACHINE, "Control Panel\\Colors", 0,
775 KEY_READ, &colors_key) == ERROR_SUCCESS)
777 /* List all keys. */
778 char color_buffer[64];
779 char full_name_buffer[MAX_PATH + SYSTEM_COLOR_PREFIX_LEN];
780 int index = 0;
781 DWORD name_size, color_size;
782 char *name_buffer = full_name_buffer + SYSTEM_COLOR_PREFIX_LEN;
784 name_size = sizeof (full_name_buffer) - SYSTEM_COLOR_PREFIX_LEN;
785 color_size = sizeof (color_buffer);
787 strcpy (full_name_buffer, SYSTEM_COLOR_PREFIX);
789 while (RegEnumValueA (colors_key, index, name_buffer, &name_size,
790 NULL, NULL, (LPBYTE)color_buffer, &color_size)
791 == ERROR_SUCCESS)
793 int r, g, b;
794 if (sscanf (color_buffer, " %u %u %u", &r, &g, &b) == 3)
795 *system_colors = Fcons (Fcons (build_string (full_name_buffer),
796 make_number (RGB (r, g, b))),
797 *system_colors);
799 name_size = sizeof (full_name_buffer) - SYSTEM_COLOR_PREFIX_LEN;
800 color_size = sizeof (color_buffer);
801 index++;
803 RegCloseKey (colors_key);
806 unblock_input ();
810 static Lisp_Object
811 x_to_w32_color (const char * colorname)
813 register Lisp_Object ret = Qnil;
815 block_input ();
817 if (colorname[0] == '#')
819 /* Could be an old-style RGB Device specification. */
820 int size = strlen (colorname + 1);
821 char *color = alloca (size + 1);
823 strcpy (color, colorname + 1);
824 if (size == 3 || size == 6 || size == 9 || size == 12)
826 UINT colorval;
827 int i, pos;
828 pos = 0;
829 size /= 3;
830 colorval = 0;
832 for (i = 0; i < 3; i++)
834 char *end;
835 char t;
836 unsigned long value;
838 /* The check for 'x' in the following conditional takes into
839 account the fact that strtol allows a "0x" in front of
840 our numbers, and we don't. */
841 if (!isxdigit (color[0]) || color[1] == 'x')
842 break;
843 t = color[size];
844 color[size] = '\0';
845 value = strtoul (color, &end, 16);
846 color[size] = t;
847 if (errno == ERANGE || end - color != size)
848 break;
849 switch (size)
851 case 1:
852 value = value * 0x10;
853 break;
854 case 2:
855 break;
856 case 3:
857 value /= 0x10;
858 break;
859 case 4:
860 value /= 0x100;
861 break;
863 colorval |= (value << pos);
864 pos += 0x8;
865 if (i == 2)
867 unblock_input ();
868 XSETINT (ret, colorval);
869 return ret;
871 color = end;
875 else if (strnicmp (colorname, "rgb:", 4) == 0)
877 const char *color;
878 UINT colorval;
879 int i, pos;
880 pos = 0;
882 colorval = 0;
883 color = colorname + 4;
884 for (i = 0; i < 3; i++)
886 char *end;
887 unsigned long value;
889 /* The check for 'x' in the following conditional takes into
890 account the fact that strtol allows a "0x" in front of
891 our numbers, and we don't. */
892 if (!isxdigit (color[0]) || color[1] == 'x')
893 break;
894 value = strtoul (color, &end, 16);
895 if (errno == ERANGE)
896 break;
897 switch (end - color)
899 case 1:
900 value = value * 0x10 + value;
901 break;
902 case 2:
903 break;
904 case 3:
905 value /= 0x10;
906 break;
907 case 4:
908 value /= 0x100;
909 break;
910 default:
911 value = ULONG_MAX;
913 if (value == ULONG_MAX)
914 break;
915 colorval |= (value << pos);
916 pos += 0x8;
917 if (i == 2)
919 if (*end != '\0')
920 break;
921 unblock_input ();
922 XSETINT (ret, colorval);
923 return ret;
925 if (*end != '/')
926 break;
927 color = end + 1;
930 else if (strnicmp (colorname, "rgbi:", 5) == 0)
932 /* This is an RGB Intensity specification. */
933 const char *color;
934 UINT colorval;
935 int i, pos;
936 pos = 0;
938 colorval = 0;
939 color = colorname + 5;
940 for (i = 0; i < 3; i++)
942 char *end;
943 double value;
944 UINT val;
946 value = strtod (color, &end);
947 if (errno == ERANGE)
948 break;
949 if (value < 0.0 || value > 1.0)
950 break;
951 val = (UINT)(0x100 * value);
952 /* We used 0x100 instead of 0xFF to give a continuous
953 range between 0.0 and 1.0 inclusive. The next statement
954 fixes the 1.0 case. */
955 if (val == 0x100)
956 val = 0xFF;
957 colorval |= (val << pos);
958 pos += 0x8;
959 if (i == 2)
961 if (*end != '\0')
962 break;
963 unblock_input ();
964 XSETINT (ret, colorval);
965 return ret;
967 if (*end != '/')
968 break;
969 color = end + 1;
972 /* I am not going to attempt to handle any of the CIE color schemes
973 or TekHVC, since I don't know the algorithms for conversion to
974 RGB. */
976 /* If we fail to lookup the color name in w32_color_map, then check the
977 colorname to see if it can be crudely approximated: If the X color
978 ends in a number (e.g., "darkseagreen2"), strip the number and
979 return the result of looking up the base color name. */
980 ret = w32_color_map_lookup (colorname);
981 if (NILP (ret))
983 int len = strlen (colorname);
985 if (isdigit (colorname[len - 1]))
987 char *ptr, *approx = alloca (len + 1);
989 strcpy (approx, colorname);
990 ptr = &approx[len - 1];
991 while (ptr > approx && isdigit (*ptr))
992 *ptr-- = '\0';
994 ret = w32_color_map_lookup (approx);
998 unblock_input ();
999 return ret;
1002 void
1003 w32_regenerate_palette (struct frame *f)
1005 struct w32_palette_entry * list;
1006 LOGPALETTE * log_palette;
1007 HPALETTE new_palette;
1008 int i;
1010 /* don't bother trying to create palette if not supported */
1011 if (! FRAME_DISPLAY_INFO (f)->has_palette)
1012 return;
1014 log_palette = (LOGPALETTE *)
1015 alloca (sizeof (LOGPALETTE) +
1016 FRAME_DISPLAY_INFO (f)->num_colors * sizeof (PALETTEENTRY));
1017 log_palette->palVersion = 0x300;
1018 log_palette->palNumEntries = FRAME_DISPLAY_INFO (f)->num_colors;
1020 list = FRAME_DISPLAY_INFO (f)->color_list;
1021 for (i = 0;
1022 i < FRAME_DISPLAY_INFO (f)->num_colors;
1023 i++, list = list->next)
1024 log_palette->palPalEntry[i] = list->entry;
1026 new_palette = CreatePalette (log_palette);
1028 enter_crit ();
1030 if (FRAME_DISPLAY_INFO (f)->palette)
1031 DeleteObject (FRAME_DISPLAY_INFO (f)->palette);
1032 FRAME_DISPLAY_INFO (f)->palette = new_palette;
1034 /* Realize display palette and garbage all frames. */
1035 release_frame_dc (f, get_frame_dc (f));
1037 leave_crit ();
1040 #define W32_COLOR(pe) RGB (pe.peRed, pe.peGreen, pe.peBlue)
1041 #define SET_W32_COLOR(pe, color) \
1042 do \
1044 pe.peRed = GetRValue (color); \
1045 pe.peGreen = GetGValue (color); \
1046 pe.peBlue = GetBValue (color); \
1047 pe.peFlags = 0; \
1048 } while (0)
1050 #if 0
1051 /* Keep these around in case we ever want to track color usage. */
1052 void
1053 w32_map_color (struct frame *f, COLORREF color)
1055 struct w32_palette_entry * list = FRAME_DISPLAY_INFO (f)->color_list;
1057 if (NILP (Vw32_enable_palette))
1058 return;
1060 /* check if color is already mapped */
1061 while (list)
1063 if (W32_COLOR (list->entry) == color)
1065 ++list->refcount;
1066 return;
1068 list = list->next;
1071 /* not already mapped, so add to list and recreate Windows palette */
1072 list = xmalloc (sizeof (struct w32_palette_entry));
1073 SET_W32_COLOR (list->entry, color);
1074 list->refcount = 1;
1075 list->next = FRAME_DISPLAY_INFO (f)->color_list;
1076 FRAME_DISPLAY_INFO (f)->color_list = list;
1077 FRAME_DISPLAY_INFO (f)->num_colors++;
1079 /* set flag that palette must be regenerated */
1080 FRAME_DISPLAY_INFO (f)->regen_palette = TRUE;
1083 void
1084 w32_unmap_color (struct frame *f, COLORREF color)
1086 struct w32_palette_entry * list = FRAME_DISPLAY_INFO (f)->color_list;
1087 struct w32_palette_entry **prev = &FRAME_DISPLAY_INFO (f)->color_list;
1089 if (NILP (Vw32_enable_palette))
1090 return;
1092 /* check if color is already mapped */
1093 while (list)
1095 if (W32_COLOR (list->entry) == color)
1097 if (--list->refcount == 0)
1099 *prev = list->next;
1100 xfree (list);
1101 FRAME_DISPLAY_INFO (f)->num_colors--;
1102 break;
1104 else
1105 return;
1107 prev = &list->next;
1108 list = list->next;
1111 /* set flag that palette must be regenerated */
1112 FRAME_DISPLAY_INFO (f)->regen_palette = TRUE;
1114 #endif
1117 /* Gamma-correct COLOR on frame F. */
1119 void
1120 gamma_correct (struct frame *f, COLORREF *color)
1122 if (f->gamma)
1124 *color = PALETTERGB (
1125 pow (GetRValue (*color) / 255.0, f->gamma) * 255.0 + 0.5,
1126 pow (GetGValue (*color) / 255.0, f->gamma) * 255.0 + 0.5,
1127 pow (GetBValue (*color) / 255.0, f->gamma) * 255.0 + 0.5);
1132 /* Decide if color named COLOR is valid for the display associated with
1133 the selected frame; if so, return the rgb values in COLOR_DEF.
1134 If ALLOC is nonzero, allocate a new colormap cell. */
1137 w32_defined_color (struct frame *f, const char *color, XColor *color_def,
1138 bool alloc_p)
1140 register Lisp_Object tem;
1141 COLORREF w32_color_ref;
1143 tem = x_to_w32_color (color);
1145 if (!NILP (tem))
1147 if (f)
1149 /* Apply gamma correction. */
1150 w32_color_ref = XUINT (tem);
1151 gamma_correct (f, &w32_color_ref);
1152 XSETINT (tem, w32_color_ref);
1155 /* Map this color to the palette if it is enabled. */
1156 if (!NILP (Vw32_enable_palette))
1158 struct w32_palette_entry * entry =
1159 one_w32_display_info.color_list;
1160 struct w32_palette_entry ** prev =
1161 &one_w32_display_info.color_list;
1163 /* check if color is already mapped */
1164 while (entry)
1166 if (W32_COLOR (entry->entry) == XUINT (tem))
1167 break;
1168 prev = &entry->next;
1169 entry = entry->next;
1172 if (entry == NULL && alloc_p)
1174 /* not already mapped, so add to list */
1175 entry = xmalloc (sizeof (struct w32_palette_entry));
1176 SET_W32_COLOR (entry->entry, XUINT (tem));
1177 entry->next = NULL;
1178 *prev = entry;
1179 one_w32_display_info.num_colors++;
1181 /* set flag that palette must be regenerated */
1182 one_w32_display_info.regen_palette = TRUE;
1185 /* Ensure COLORREF value is snapped to nearest color in (default)
1186 palette by simulating the PALETTERGB macro. This works whether
1187 or not the display device has a palette. */
1188 w32_color_ref = XUINT (tem) | 0x2000000;
1190 color_def->pixel = w32_color_ref;
1191 color_def->red = GetRValue (w32_color_ref) * 256;
1192 color_def->green = GetGValue (w32_color_ref) * 256;
1193 color_def->blue = GetBValue (w32_color_ref) * 256;
1195 return 1;
1197 else
1199 return 0;
1203 /* Given a string ARG naming a color, compute a pixel value from it
1204 suitable for screen F.
1205 If F is not a color screen, return DEF (default) regardless of what
1206 ARG says. */
1209 x_decode_color (struct frame *f, Lisp_Object arg, int def)
1211 XColor cdef;
1213 CHECK_STRING (arg);
1215 if (strcmp (SSDATA (arg), "black") == 0)
1216 return BLACK_PIX_DEFAULT (f);
1217 else if (strcmp (SSDATA (arg), "white") == 0)
1218 return WHITE_PIX_DEFAULT (f);
1220 if ((FRAME_DISPLAY_INFO (f)->n_planes * FRAME_DISPLAY_INFO (f)->n_cbits) == 1)
1221 return def;
1223 /* w32_defined_color is responsible for coping with failures
1224 by looking for a near-miss. */
1225 if (w32_defined_color (f, SSDATA (arg), &cdef, true))
1226 return cdef.pixel;
1228 /* defined_color failed; return an ultimate default. */
1229 return def;
1234 /* Functions called only from `x_set_frame_param'
1235 to set individual parameters.
1237 If FRAME_W32_WINDOW (f) is 0,
1238 the frame is being created and its window does not exist yet.
1239 In that case, just record the parameter's new value
1240 in the standard place; do not attempt to change the window. */
1242 void
1243 x_set_foreground_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
1245 struct w32_output *x = f->output_data.w32;
1246 PIX_TYPE fg, old_fg;
1248 fg = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1249 old_fg = FRAME_FOREGROUND_PIXEL (f);
1250 FRAME_FOREGROUND_PIXEL (f) = fg;
1252 if (FRAME_W32_WINDOW (f) != 0)
1254 if (x->cursor_pixel == old_fg)
1256 x->cursor_pixel = fg;
1257 x->cursor_gc->background = fg;
1260 update_face_from_frame_parameter (f, Qforeground_color, arg);
1261 if (FRAME_VISIBLE_P (f))
1262 redraw_frame (f);
1266 void
1267 x_set_background_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
1269 FRAME_BACKGROUND_PIXEL (f)
1270 = x_decode_color (f, arg, WHITE_PIX_DEFAULT (f));
1272 if (FRAME_W32_WINDOW (f) != 0)
1274 SetWindowLong (FRAME_W32_WINDOW (f), WND_BACKGROUND_INDEX,
1275 FRAME_BACKGROUND_PIXEL (f));
1277 update_face_from_frame_parameter (f, Qbackground_color, arg);
1279 if (FRAME_VISIBLE_P (f))
1280 redraw_frame (f);
1284 void
1285 x_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
1287 #if 0
1288 Cursor cursor, nontext_cursor, mode_cursor, hand_cursor;
1289 int count;
1290 #endif
1291 int mask_color;
1293 if (!EQ (Qnil, arg))
1294 f->output_data.w32->mouse_pixel
1295 = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1296 mask_color = FRAME_BACKGROUND_PIXEL (f);
1298 /* Don't let pointers be invisible. */
1299 if (mask_color == f->output_data.w32->mouse_pixel
1300 && mask_color == FRAME_BACKGROUND_PIXEL (f))
1301 f->output_data.w32->mouse_pixel = FRAME_FOREGROUND_PIXEL (f);
1303 #if 0 /* TODO : Mouse cursor customization. */
1304 block_input ();
1306 /* It's not okay to crash if the user selects a screwy cursor. */
1307 count = x_catch_errors (FRAME_W32_DISPLAY (f));
1309 if (!EQ (Qnil, Vx_pointer_shape))
1311 CHECK_NUMBER (Vx_pointer_shape);
1312 cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XINT (Vx_pointer_shape));
1314 else
1315 cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_xterm);
1316 x_check_errors (FRAME_W32_DISPLAY (f), "bad text pointer cursor: %s");
1318 if (!EQ (Qnil, Vx_nontext_pointer_shape))
1320 CHECK_NUMBER (Vx_nontext_pointer_shape);
1321 nontext_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f),
1322 XINT (Vx_nontext_pointer_shape));
1324 else
1325 nontext_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_left_ptr);
1326 x_check_errors (FRAME_W32_DISPLAY (f), "bad nontext pointer cursor: %s");
1328 if (!EQ (Qnil, Vx_hourglass_pointer_shape))
1330 CHECK_NUMBER (Vx_hourglass_pointer_shape);
1331 hourglass_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f),
1332 XINT (Vx_hourglass_pointer_shape));
1334 else
1335 hourglass_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_watch);
1336 x_check_errors (FRAME_W32_DISPLAY (f), "bad busy pointer cursor: %s");
1338 x_check_errors (FRAME_W32_DISPLAY (f), "bad nontext pointer cursor: %s");
1339 if (!EQ (Qnil, Vx_mode_pointer_shape))
1341 CHECK_NUMBER (Vx_mode_pointer_shape);
1342 mode_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f),
1343 XINT (Vx_mode_pointer_shape));
1345 else
1346 mode_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_xterm);
1347 x_check_errors (FRAME_W32_DISPLAY (f), "bad modeline pointer cursor: %s");
1349 if (!EQ (Qnil, Vx_sensitive_text_pointer_shape))
1351 CHECK_NUMBER (Vx_sensitive_text_pointer_shape);
1352 hand_cursor
1353 = XCreateFontCursor (FRAME_W32_DISPLAY (f),
1354 XINT (Vx_sensitive_text_pointer_shape));
1356 else
1357 hand_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_crosshair);
1359 if (!NILP (Vx_window_horizontal_drag_shape))
1361 CHECK_NUMBER (Vx_window_horizontal_drag_shape);
1362 horizontal_drag_cursor
1363 = XCreateFontCursor (FRAME_W32_DISPLAY (f),
1364 XINT (Vx_window_horizontal_drag_shape));
1366 else
1367 horizontal_drag_cursor
1368 = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_sb_h_double_arrow);
1370 if (!NILP (Vx_window_vertical_drag_shape))
1372 CHECK_NUMBER (Vx_window_vertical_drag_shape);
1373 vertical_drag_cursor
1374 = XCreateFontCursor (FRAME_W32_DISPLAY (f),
1375 XINT (Vx_window_vertical_drag_shape));
1377 else
1378 vertical_drag_cursor
1379 = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_sb_v_double_arrow);
1381 /* Check and report errors with the above calls. */
1382 x_check_errors (FRAME_W32_DISPLAY (f), "can't set cursor shape: %s");
1383 x_uncatch_errors (FRAME_W32_DISPLAY (f), count);
1386 XColor fore_color, back_color;
1388 fore_color.pixel = f->output_data.w32->mouse_pixel;
1389 back_color.pixel = mask_color;
1390 XQueryColor (FRAME_W32_DISPLAY (f),
1391 DefaultColormap (FRAME_W32_DISPLAY (f),
1392 DefaultScreen (FRAME_W32_DISPLAY (f))),
1393 &fore_color);
1394 XQueryColor (FRAME_W32_DISPLAY (f),
1395 DefaultColormap (FRAME_W32_DISPLAY (f),
1396 DefaultScreen (FRAME_W32_DISPLAY (f))),
1397 &back_color);
1398 XRecolorCursor (FRAME_W32_DISPLAY (f), cursor,
1399 &fore_color, &back_color);
1400 XRecolorCursor (FRAME_W32_DISPLAY (f), nontext_cursor,
1401 &fore_color, &back_color);
1402 XRecolorCursor (FRAME_W32_DISPLAY (f), mode_cursor,
1403 &fore_color, &back_color);
1404 XRecolorCursor (FRAME_W32_DISPLAY (f), hand_cursor,
1405 &fore_color, &back_color);
1406 XRecolorCursor (FRAME_W32_DISPLAY (f), hourglass_cursor,
1407 &fore_color, &back_color);
1410 if (FRAME_W32_WINDOW (f) != 0)
1411 XDefineCursor (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f), cursor);
1413 if (cursor != f->output_data.w32->text_cursor && f->output_data.w32->text_cursor != 0)
1414 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->text_cursor);
1415 f->output_data.w32->text_cursor = cursor;
1417 if (nontext_cursor != f->output_data.w32->nontext_cursor
1418 && f->output_data.w32->nontext_cursor != 0)
1419 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->nontext_cursor);
1420 f->output_data.w32->nontext_cursor = nontext_cursor;
1422 if (hourglass_cursor != f->output_data.w32->hourglass_cursor
1423 && f->output_data.w32->hourglass_cursor != 0)
1424 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->hourglass_cursor);
1425 f->output_data.w32->hourglass_cursor = hourglass_cursor;
1427 if (mode_cursor != f->output_data.w32->modeline_cursor
1428 && f->output_data.w32->modeline_cursor != 0)
1429 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->modeline_cursor);
1430 f->output_data.w32->modeline_cursor = mode_cursor;
1432 if (hand_cursor != f->output_data.w32->hand_cursor
1433 && f->output_data.w32->hand_cursor != 0)
1434 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->hand_cursor);
1435 f->output_data.w32->hand_cursor = hand_cursor;
1437 XFlush (FRAME_W32_DISPLAY (f));
1438 unblock_input ();
1440 update_face_from_frame_parameter (f, Qmouse_color, arg);
1441 #endif /* TODO */
1444 void
1445 x_set_cursor_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
1447 unsigned long fore_pixel, pixel;
1449 if (!NILP (Vx_cursor_fore_pixel))
1450 fore_pixel = x_decode_color (f, Vx_cursor_fore_pixel,
1451 WHITE_PIX_DEFAULT (f));
1452 else
1453 fore_pixel = FRAME_BACKGROUND_PIXEL (f);
1455 pixel = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1457 /* Make sure that the cursor color differs from the background color. */
1458 if (pixel == FRAME_BACKGROUND_PIXEL (f))
1460 pixel = f->output_data.w32->mouse_pixel;
1461 if (pixel == fore_pixel)
1462 fore_pixel = FRAME_BACKGROUND_PIXEL (f);
1465 f->output_data.w32->cursor_foreground_pixel = fore_pixel;
1466 f->output_data.w32->cursor_pixel = pixel;
1468 if (FRAME_W32_WINDOW (f) != 0)
1470 block_input ();
1471 /* Update frame's cursor_gc. */
1472 f->output_data.w32->cursor_gc->foreground = fore_pixel;
1473 f->output_data.w32->cursor_gc->background = pixel;
1475 unblock_input ();
1477 if (FRAME_VISIBLE_P (f))
1479 x_update_cursor (f, 0);
1480 x_update_cursor (f, 1);
1484 update_face_from_frame_parameter (f, Qcursor_color, arg);
1487 /* Set the border-color of frame F to pixel value PIX.
1488 Note that this does not fully take effect if done before
1489 F has a window. */
1491 void
1492 x_set_border_pixel (struct frame *f, int pix)
1495 f->output_data.w32->border_pixel = pix;
1497 if (FRAME_W32_WINDOW (f) != 0 && f->border_width > 0)
1499 if (FRAME_VISIBLE_P (f))
1500 redraw_frame (f);
1504 /* Set the border-color of frame F to value described by ARG.
1505 ARG can be a string naming a color.
1506 The border-color is used for the border that is drawn by the server.
1507 Note that this does not fully take effect if done before
1508 F has a window; it must be redone when the window is created. */
1510 void
1511 x_set_border_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
1513 int pix;
1515 CHECK_STRING (arg);
1516 pix = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1517 x_set_border_pixel (f, pix);
1518 update_face_from_frame_parameter (f, Qborder_color, arg);
1522 void
1523 x_set_cursor_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
1525 set_frame_cursor_types (f, arg);
1528 void
1529 x_set_icon_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
1531 bool result;
1533 if (NILP (arg) && NILP (oldval))
1534 return;
1536 if (STRINGP (arg) && STRINGP (oldval)
1537 && EQ (Fstring_equal (oldval, arg), Qt))
1538 return;
1540 if (SYMBOLP (arg) && SYMBOLP (oldval) && EQ (arg, oldval))
1541 return;
1543 block_input ();
1545 result = x_bitmap_icon (f, arg);
1546 if (result)
1548 unblock_input ();
1549 error ("No icon window available");
1552 unblock_input ();
1555 void
1556 x_set_icon_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
1558 if (STRINGP (arg))
1560 if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
1561 return;
1563 else if (!NILP (arg) || NILP (oldval))
1564 return;
1566 fset_icon_name (f, arg);
1568 #if 0
1569 if (f->output_data.w32->icon_bitmap != 0)
1570 return;
1572 block_input ();
1574 result = x_text_icon (f,
1575 SSDATA ((!NILP (f->icon_name)
1576 ? f->icon_name
1577 : !NILP (f->title)
1578 ? f->title
1579 : f->name)));
1581 if (result)
1583 unblock_input ();
1584 error ("No icon window available");
1587 /* If the window was unmapped (and its icon was mapped),
1588 the new icon is not mapped, so map the window in its stead. */
1589 if (FRAME_VISIBLE_P (f))
1591 #ifdef USE_X_TOOLKIT
1592 XtPopup (f->output_data.w32->widget, XtGrabNone);
1593 #endif
1594 XMapWindow (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f));
1597 XFlush (FRAME_W32_DISPLAY (f));
1598 unblock_input ();
1599 #endif
1602 void
1603 x_clear_under_internal_border (struct frame *f)
1605 int border = FRAME_INTERNAL_BORDER_WIDTH (f);
1607 /* Clear border if it's larger than before. */
1608 if (border != 0)
1610 HDC hdc = get_frame_dc (f);
1611 int width = FRAME_PIXEL_WIDTH (f);
1612 int height = FRAME_PIXEL_HEIGHT (f);
1614 block_input ();
1615 w32_clear_area (f, hdc, 0, FRAME_TOP_MARGIN_HEIGHT (f), width, border);
1616 w32_clear_area (f, hdc, 0, 0, border, height);
1617 w32_clear_area (f, hdc, width - border, 0, border, height);
1618 w32_clear_area (f, hdc, 0, height - border, width, border);
1619 release_frame_dc (f, hdc);
1620 unblock_input ();
1625 void
1626 x_set_internal_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
1628 int border;
1630 CHECK_TYPE_RANGED_INTEGER (int, arg);
1631 border = max (XINT (arg), 0);
1633 if (border != FRAME_INTERNAL_BORDER_WIDTH (f))
1635 FRAME_INTERNAL_BORDER_WIDTH (f) = border;
1637 if (FRAME_X_WINDOW (f) != 0)
1639 adjust_frame_size (f, -1, -1, 3, false, Qinternal_border_width);
1641 if (FRAME_VISIBLE_P (f))
1642 x_clear_under_internal_border (f);
1648 void
1649 x_set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
1651 int nlines;
1653 /* Right now, menu bars don't work properly in minibuf-only frames;
1654 most of the commands try to apply themselves to the minibuffer
1655 frame itself, and get an error because you can't switch buffers
1656 in or split the minibuffer window. */
1657 if (FRAME_MINIBUF_ONLY_P (f))
1658 return;
1660 if (INTEGERP (value))
1661 nlines = XINT (value);
1662 else
1663 nlines = 0;
1665 FRAME_MENU_BAR_LINES (f) = 0;
1666 FRAME_MENU_BAR_HEIGHT (f) = 0;
1667 if (nlines)
1669 FRAME_EXTERNAL_MENU_BAR (f) = 1;
1670 windows_or_buffers_changed = 23;
1672 else
1674 if (FRAME_EXTERNAL_MENU_BAR (f) == 1)
1675 free_frame_menubar (f);
1676 FRAME_EXTERNAL_MENU_BAR (f) = 0;
1678 /* Adjust the frame size so that the client (text) dimensions
1679 remain the same. This depends on FRAME_EXTERNAL_MENU_BAR being
1680 set correctly. Note that we resize twice: The first time upon
1681 a request from the window manager who wants to keep the height
1682 of the outer rectangle (including decorations) unchanged, and a
1683 second time because we want to keep the height of the inner
1684 rectangle (without the decorations unchanged). */
1685 adjust_frame_size (f, -1, -1, 2, true, Qmenu_bar_lines);
1687 /* Not sure whether this is needed. */
1688 x_clear_under_internal_border (f);
1693 /* Set the number of lines used for the tool bar of frame F to VALUE.
1694 VALUE not an integer, or < 0 means set the lines to zero. OLDVAL is
1695 the old number of tool bar lines (and is unused). This function may
1696 change the height of all windows on frame F to match the new tool bar
1697 height. By design, the frame's height doesn't change (but maybe it
1698 should if we don't get enough space otherwise). */
1700 void
1701 x_set_tool_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
1703 int nlines;
1705 /* Treat tool bars like menu bars. */
1706 if (FRAME_MINIBUF_ONLY_P (f))
1707 return;
1709 /* Use VALUE only if an integer >= 0. */
1710 if (INTEGERP (value) && XINT (value) >= 0)
1711 nlines = XFASTINT (value);
1712 else
1713 nlines = 0;
1715 x_change_tool_bar_height (f, nlines * FRAME_LINE_HEIGHT (f));
1719 /* Set the pixel height of the tool bar of frame F to HEIGHT. */
1720 void
1721 x_change_tool_bar_height (struct frame *f, int height)
1723 int unit = FRAME_LINE_HEIGHT (f);
1724 int old_height = FRAME_TOOL_BAR_HEIGHT (f);
1725 int lines = (height + unit - 1) / unit;
1726 Lisp_Object fullscreen;
1728 /* Make sure we redisplay all windows in this frame. */
1729 windows_or_buffers_changed = 23;
1731 /* Recalculate tool bar and frame text sizes. */
1732 FRAME_TOOL_BAR_HEIGHT (f) = height;
1733 FRAME_TOOL_BAR_LINES (f) = lines;
1734 /* Store `tool-bar-lines' and `height' frame parameters. */
1735 store_frame_param (f, Qtool_bar_lines, make_number (lines));
1736 store_frame_param (f, Qheight, make_number (FRAME_LINES (f)));
1738 if (FRAME_W32_WINDOW (f) && FRAME_TOOL_BAR_HEIGHT (f) == 0)
1740 clear_frame (f);
1741 clear_current_matrices (f);
1744 if ((height < old_height) && WINDOWP (f->tool_bar_window))
1745 clear_glyph_matrix (XWINDOW (f->tool_bar_window)->current_matrix);
1747 /* Recalculate toolbar height. */
1748 f->n_tool_bar_rows = 0;
1749 if (old_height == 0
1750 && (!f->after_make_frame
1751 || NILP (frame_inhibit_implied_resize)
1752 || (CONSP (frame_inhibit_implied_resize)
1753 && NILP (Fmemq (Qtool_bar_lines, frame_inhibit_implied_resize)))))
1754 f->tool_bar_redisplayed = f->tool_bar_resized = false;
1756 adjust_frame_size (f, -1, -1,
1757 ((!f->tool_bar_resized
1758 && (NILP (fullscreen =
1759 get_frame_param (f, Qfullscreen))
1760 || EQ (fullscreen, Qfullwidth))) ? 1
1761 : (old_height == 0 || height == 0) ? 2
1762 : 4),
1763 false, Qtool_bar_lines);
1765 f->tool_bar_resized = f->tool_bar_redisplayed;
1767 /* adjust_frame_size might not have done anything, garbage frame
1768 here. */
1769 adjust_frame_glyphs (f);
1770 SET_FRAME_GARBAGED (f);
1771 if (FRAME_X_WINDOW (f))
1772 x_clear_under_internal_border (f);
1775 static void
1776 w32_set_title_bar_text (struct frame *f, Lisp_Object name)
1778 if (FRAME_W32_WINDOW (f))
1780 block_input ();
1781 #ifdef __CYGWIN__
1782 GUI_FN (SetWindowText) (FRAME_W32_WINDOW (f),
1783 GUI_SDATA (GUI_ENCODE_SYSTEM (name)));
1784 #else
1785 /* The frame's title many times shows the name of the file
1786 visited in the selected window's buffer, so it makes sense to
1787 support non-ASCII characters outside of the current system
1788 codepage in the title. */
1789 if (w32_unicode_filenames)
1791 Lisp_Object encoded_title = ENCODE_UTF_8 (name);
1792 wchar_t *title_w;
1793 int tlen = pMultiByteToWideChar (CP_UTF8, 0, SSDATA (encoded_title),
1794 -1, NULL, 0);
1796 if (tlen > 0)
1798 /* Windows truncates the title text beyond what fits on
1799 a single line, so we can limit the length to some
1800 reasonably large value, and use alloca. */
1801 if (tlen > 10000)
1802 tlen = 10000;
1803 title_w = alloca ((tlen + 1) * sizeof (wchar_t));
1804 pMultiByteToWideChar (CP_UTF8, 0, SSDATA (encoded_title), -1,
1805 title_w, tlen);
1806 title_w[tlen] = L'\0';
1807 SetWindowTextW (FRAME_W32_WINDOW (f), title_w);
1809 else /* Conversion to UTF-16 failed, so we punt. */
1810 SetWindowTextA (FRAME_W32_WINDOW (f),
1811 SSDATA (ENCODE_SYSTEM (name)));
1813 else
1814 SetWindowTextA (FRAME_W32_WINDOW (f), SSDATA (ENCODE_SYSTEM (name)));
1815 #endif
1816 unblock_input ();
1820 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
1821 w32_id_name.
1823 If EXPLICIT is non-zero, that indicates that lisp code is setting the
1824 name; if NAME is a string, set F's name to NAME and set
1825 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
1827 If EXPLICIT is zero, that indicates that Emacs redisplay code is
1828 suggesting a new name, which lisp code should override; if
1829 F->explicit_name is set, ignore the new name; otherwise, set it. */
1831 void
1832 x_set_name (struct frame *f, Lisp_Object name, bool explicit)
1834 /* Make sure that requests from lisp code override requests from
1835 Emacs redisplay code. */
1836 if (explicit)
1838 /* If we're switching from explicit to implicit, we had better
1839 update the mode lines and thereby update the title. */
1840 if (f->explicit_name && NILP (name))
1841 update_mode_lines = 25;
1843 f->explicit_name = ! NILP (name);
1845 else if (f->explicit_name)
1846 return;
1848 /* If NAME is nil, set the name to the w32_id_name. */
1849 if (NILP (name))
1851 /* Check for no change needed in this very common case
1852 before we do any consing. */
1853 if (!strcmp (FRAME_DISPLAY_INFO (f)->w32_id_name,
1854 SSDATA (f->name)))
1855 return;
1856 name = build_string (FRAME_DISPLAY_INFO (f)->w32_id_name);
1858 else
1859 CHECK_STRING (name);
1861 /* Don't change the name if it's already NAME. */
1862 if (! NILP (Fstring_equal (name, f->name)))
1863 return;
1865 fset_name (f, name);
1867 /* For setting the frame title, the title parameter should override
1868 the name parameter. */
1869 if (! NILP (f->title))
1870 name = f->title;
1872 w32_set_title_bar_text (f, name);
1875 /* This function should be called when the user's lisp code has
1876 specified a name for the frame; the name will override any set by the
1877 redisplay code. */
1878 void
1879 x_explicitly_set_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
1881 x_set_name (f, arg, true);
1884 /* This function should be called by Emacs redisplay code to set the
1885 name; names set this way will never override names set by the user's
1886 lisp code. */
1887 void
1888 x_implicitly_set_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
1890 x_set_name (f, arg, false);
1893 /* Change the title of frame F to NAME.
1894 If NAME is nil, use the frame name as the title. */
1896 void
1897 x_set_title (struct frame *f, Lisp_Object name, Lisp_Object old_name)
1899 /* Don't change the title if it's already NAME. */
1900 if (EQ (name, f->title))
1901 return;
1903 update_mode_lines = 26;
1905 fset_title (f, name);
1907 if (NILP (name))
1908 name = f->name;
1910 w32_set_title_bar_text (f, name);
1913 void
1914 x_set_scroll_bar_default_width (struct frame *f)
1916 int unit = FRAME_COLUMN_WIDTH (f);
1918 FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = GetSystemMetrics (SM_CXVSCROLL);
1919 FRAME_CONFIG_SCROLL_BAR_COLS (f)
1920 = (FRAME_CONFIG_SCROLL_BAR_WIDTH (f) + unit - 1) / unit;
1924 void
1925 x_set_scroll_bar_default_height (struct frame *f)
1927 int unit = FRAME_LINE_HEIGHT (f);
1929 FRAME_CONFIG_SCROLL_BAR_HEIGHT (f) = GetSystemMetrics (SM_CXHSCROLL);
1930 FRAME_CONFIG_SCROLL_BAR_LINES (f)
1931 = (FRAME_CONFIG_SCROLL_BAR_HEIGHT (f) + unit - 1) / unit;
1934 /* Subroutines for creating a frame. */
1936 Cursor
1937 w32_load_cursor (LPCTSTR name)
1939 /* Try first to load cursor from application resource. */
1940 Cursor cursor = LoadImage ((HINSTANCE) GetModuleHandle (NULL),
1941 name, IMAGE_CURSOR, 0, 0,
1942 LR_DEFAULTCOLOR | LR_DEFAULTSIZE | LR_SHARED);
1943 if (!cursor)
1945 /* Then try to load a shared predefined cursor. */
1946 cursor = LoadImage (NULL, name, IMAGE_CURSOR, 0, 0,
1947 LR_DEFAULTCOLOR | LR_DEFAULTSIZE | LR_SHARED);
1949 return cursor;
1952 static LRESULT CALLBACK w32_wnd_proc (HWND, UINT, WPARAM, LPARAM);
1954 #define INIT_WINDOW_CLASS(WC) \
1955 (WC).style = CS_HREDRAW | CS_VREDRAW; \
1956 (WC).lpfnWndProc = (WNDPROC) w32_wnd_proc; \
1957 (WC).cbClsExtra = 0; \
1958 (WC).cbWndExtra = WND_EXTRA_BYTES; \
1959 (WC).hInstance = hinst; \
1960 (WC).hIcon = LoadIcon (hinst, EMACS_CLASS); \
1961 (WC).hCursor = w32_load_cursor (IDC_ARROW); \
1962 (WC).hbrBackground = NULL; \
1963 (WC).lpszMenuName = NULL; \
1965 static BOOL
1966 w32_init_class (HINSTANCE hinst)
1968 if (w32_unicode_gui)
1970 WNDCLASSW uwc;
1971 INIT_WINDOW_CLASS(uwc);
1972 uwc.lpszClassName = L"Emacs";
1974 return RegisterClassW (&uwc);
1976 else
1978 WNDCLASS wc;
1979 INIT_WINDOW_CLASS(wc);
1980 wc.lpszClassName = EMACS_CLASS;
1982 return RegisterClassA (&wc);
1986 static HWND
1987 w32_createvscrollbar (struct frame *f, struct scroll_bar * bar)
1989 return CreateWindow ("SCROLLBAR", "", SBS_VERT | WS_CHILD | WS_VISIBLE,
1990 /* Position and size of scroll bar. */
1991 bar->left, bar->top, bar->width, bar->height,
1992 FRAME_W32_WINDOW (f), NULL, hinst, NULL);
1995 static HWND
1996 w32_createhscrollbar (struct frame *f, struct scroll_bar * bar)
1998 return CreateWindow ("SCROLLBAR", "", SBS_HORZ | WS_CHILD | WS_VISIBLE,
1999 /* Position and size of scroll bar. */
2000 bar->left, bar->top, bar->width, bar->height,
2001 FRAME_W32_WINDOW (f), NULL, hinst, NULL);
2004 static void
2005 w32_createwindow (struct frame *f, int *coords)
2007 HWND hwnd;
2008 RECT rect;
2009 int top;
2010 int left;
2012 rect.left = rect.top = 0;
2013 rect.right = FRAME_PIXEL_WIDTH (f);
2014 rect.bottom = FRAME_PIXEL_HEIGHT (f);
2016 AdjustWindowRect (&rect, f->output_data.w32->dwStyle,
2017 FRAME_EXTERNAL_MENU_BAR (f));
2019 /* Do first time app init */
2021 w32_init_class (hinst);
2023 if (f->size_hint_flags & USPosition || f->size_hint_flags & PPosition)
2025 left = f->left_pos;
2026 top = f->top_pos;
2028 else
2030 left = coords[0];
2031 top = coords[1];
2034 FRAME_W32_WINDOW (f) = hwnd
2035 = CreateWindow (EMACS_CLASS,
2036 f->namebuf,
2037 f->output_data.w32->dwStyle | WS_CLIPCHILDREN,
2038 left, top,
2039 rect.right - rect.left, rect.bottom - rect.top,
2040 NULL,
2041 NULL,
2042 hinst,
2043 NULL);
2045 if (hwnd)
2047 SetWindowLong (hwnd, WND_FONTWIDTH_INDEX, FRAME_COLUMN_WIDTH (f));
2048 SetWindowLong (hwnd, WND_LINEHEIGHT_INDEX, FRAME_LINE_HEIGHT (f));
2049 SetWindowLong (hwnd, WND_BORDER_INDEX, FRAME_INTERNAL_BORDER_WIDTH (f));
2050 SetWindowLong (hwnd, WND_VSCROLLBAR_INDEX, FRAME_SCROLL_BAR_AREA_WIDTH (f));
2051 SetWindowLong (hwnd, WND_HSCROLLBAR_INDEX, FRAME_SCROLL_BAR_AREA_HEIGHT (f));
2052 SetWindowLong (hwnd, WND_BACKGROUND_INDEX, FRAME_BACKGROUND_PIXEL (f));
2054 /* Enable drag-n-drop. */
2055 DragAcceptFiles (hwnd, TRUE);
2057 /* Do this to discard the default setting specified by our parent. */
2058 ShowWindow (hwnd, SW_HIDE);
2060 /* Update frame positions. */
2061 GetWindowRect (hwnd, &rect);
2062 f->left_pos = rect.left;
2063 f->top_pos = rect.top;
2067 static void
2068 my_post_msg (W32Msg * wmsg, HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam)
2070 wmsg->msg.hwnd = hwnd;
2071 wmsg->msg.message = msg;
2072 wmsg->msg.wParam = wParam;
2073 wmsg->msg.lParam = lParam;
2074 wmsg->msg.time = GetMessageTime ();
2076 post_msg (wmsg);
2079 /* GetKeyState and MapVirtualKey on Windows 95 do not actually distinguish
2080 between left and right keys as advertised. We test for this
2081 support dynamically, and set a flag when the support is absent. If
2082 absent, we keep track of the left and right control and alt keys
2083 ourselves. This is particularly necessary on keyboards that rely
2084 upon the AltGr key, which is represented as having the left control
2085 and right alt keys pressed. For these keyboards, we need to know
2086 when the left alt key has been pressed in addition to the AltGr key
2087 so that we can properly support M-AltGr-key sequences (such as M-@
2088 on Swedish keyboards). */
2090 #define EMACS_LCONTROL 0
2091 #define EMACS_RCONTROL 1
2092 #define EMACS_LMENU 2
2093 #define EMACS_RMENU 3
2095 static int modifiers[4];
2096 static int modifiers_recorded;
2097 static int modifier_key_support_tested;
2099 static void
2100 test_modifier_support (unsigned int wparam)
2102 unsigned int l, r;
2104 if (wparam != VK_CONTROL && wparam != VK_MENU)
2105 return;
2106 if (wparam == VK_CONTROL)
2108 l = VK_LCONTROL;
2109 r = VK_RCONTROL;
2111 else
2113 l = VK_LMENU;
2114 r = VK_RMENU;
2116 if (!(GetKeyState (l) & 0x8000) && !(GetKeyState (r) & 0x8000))
2117 modifiers_recorded = 1;
2118 else
2119 modifiers_recorded = 0;
2120 modifier_key_support_tested = 1;
2123 static void
2124 record_keydown (unsigned int wparam, unsigned int lparam)
2126 int i;
2128 if (!modifier_key_support_tested)
2129 test_modifier_support (wparam);
2131 if ((wparam != VK_CONTROL && wparam != VK_MENU) || !modifiers_recorded)
2132 return;
2134 if (wparam == VK_CONTROL)
2135 i = (lparam & 0x1000000) ? EMACS_RCONTROL : EMACS_LCONTROL;
2136 else
2137 i = (lparam & 0x1000000) ? EMACS_RMENU : EMACS_LMENU;
2139 modifiers[i] = 1;
2142 static void
2143 record_keyup (unsigned int wparam, unsigned int lparam)
2145 int i;
2147 if ((wparam != VK_CONTROL && wparam != VK_MENU) || !modifiers_recorded)
2148 return;
2150 if (wparam == VK_CONTROL)
2151 i = (lparam & 0x1000000) ? EMACS_RCONTROL : EMACS_LCONTROL;
2152 else
2153 i = (lparam & 0x1000000) ? EMACS_RMENU : EMACS_LMENU;
2155 modifiers[i] = 0;
2158 /* Emacs can lose focus while a modifier key has been pressed. When
2159 it regains focus, be conservative and clear all modifiers since
2160 we cannot reconstruct the left and right modifier state. */
2161 static void
2162 reset_modifiers (void)
2164 SHORT ctrl, alt;
2166 if (GetFocus () == NULL)
2167 /* Emacs doesn't have keyboard focus. Do nothing. */
2168 return;
2170 ctrl = GetAsyncKeyState (VK_CONTROL);
2171 alt = GetAsyncKeyState (VK_MENU);
2173 if (!(ctrl & 0x08000))
2174 /* Clear any recorded control modifier state. */
2175 modifiers[EMACS_RCONTROL] = modifiers[EMACS_LCONTROL] = 0;
2177 if (!(alt & 0x08000))
2178 /* Clear any recorded alt modifier state. */
2179 modifiers[EMACS_RMENU] = modifiers[EMACS_LMENU] = 0;
2181 /* Update the state of all modifier keys, because modifiers used in
2182 hot-key combinations can get stuck on if Emacs loses focus as a
2183 result of a hot-key being pressed. */
2185 BYTE keystate[256];
2187 #define CURRENT_STATE(key) ((GetAsyncKeyState (key) & 0x8000) >> 8)
2189 memset (keystate, 0, sizeof (keystate));
2190 GetKeyboardState (keystate);
2191 keystate[VK_SHIFT] = CURRENT_STATE (VK_SHIFT);
2192 keystate[VK_CONTROL] = CURRENT_STATE (VK_CONTROL);
2193 keystate[VK_LCONTROL] = CURRENT_STATE (VK_LCONTROL);
2194 keystate[VK_RCONTROL] = CURRENT_STATE (VK_RCONTROL);
2195 keystate[VK_MENU] = CURRENT_STATE (VK_MENU);
2196 keystate[VK_LMENU] = CURRENT_STATE (VK_LMENU);
2197 keystate[VK_RMENU] = CURRENT_STATE (VK_RMENU);
2198 keystate[VK_LWIN] = CURRENT_STATE (VK_LWIN);
2199 keystate[VK_RWIN] = CURRENT_STATE (VK_RWIN);
2200 keystate[VK_APPS] = CURRENT_STATE (VK_APPS);
2201 SetKeyboardState (keystate);
2205 /* Synchronize modifier state with what is reported with the current
2206 keystroke. Even if we cannot distinguish between left and right
2207 modifier keys, we know that, if no modifiers are set, then neither
2208 the left or right modifier should be set. */
2209 static void
2210 sync_modifiers (void)
2212 if (!modifiers_recorded)
2213 return;
2215 if (!(GetKeyState (VK_CONTROL) & 0x8000))
2216 modifiers[EMACS_RCONTROL] = modifiers[EMACS_LCONTROL] = 0;
2218 if (!(GetKeyState (VK_MENU) & 0x8000))
2219 modifiers[EMACS_RMENU] = modifiers[EMACS_LMENU] = 0;
2222 static int
2223 modifier_set (int vkey)
2225 /* Warning: The fact that VK_NUMLOCK is not treated as the other 2
2226 toggle keys is not an omission! If you want to add it, you will
2227 have to make changes in the default sub-case of the WM_KEYDOWN
2228 switch, because if the NUMLOCK modifier is set, the code there
2229 will directly convert any key that looks like an ASCII letter,
2230 and also downcase those that look like upper-case ASCII. */
2231 if (vkey == VK_CAPITAL)
2233 if (NILP (Vw32_enable_caps_lock))
2234 return 0;
2235 else
2236 return (GetKeyState (vkey) & 0x1);
2238 if (vkey == VK_SCROLL)
2240 if (NILP (Vw32_scroll_lock_modifier)
2241 /* w32-scroll-lock-modifier can be any non-nil value that is
2242 not one of the modifiers, in which case it shall be ignored. */
2243 || !( EQ (Vw32_scroll_lock_modifier, Qhyper)
2244 || EQ (Vw32_scroll_lock_modifier, Qsuper)
2245 || EQ (Vw32_scroll_lock_modifier, Qmeta)
2246 || EQ (Vw32_scroll_lock_modifier, Qalt)
2247 || EQ (Vw32_scroll_lock_modifier, Qcontrol)
2248 || EQ (Vw32_scroll_lock_modifier, Qshift)))
2249 return 0;
2250 else
2251 return (GetKeyState (vkey) & 0x1);
2254 if (!modifiers_recorded)
2255 return (GetKeyState (vkey) & 0x8000);
2257 switch (vkey)
2259 case VK_LCONTROL:
2260 return modifiers[EMACS_LCONTROL];
2261 case VK_RCONTROL:
2262 return modifiers[EMACS_RCONTROL];
2263 case VK_LMENU:
2264 return modifiers[EMACS_LMENU];
2265 case VK_RMENU:
2266 return modifiers[EMACS_RMENU];
2268 return (GetKeyState (vkey) & 0x8000);
2271 /* Convert between the modifier bits W32 uses and the modifier bits
2272 Emacs uses. */
2274 unsigned int
2275 w32_key_to_modifier (int key)
2277 Lisp_Object key_mapping;
2279 switch (key)
2281 case VK_LWIN:
2282 key_mapping = Vw32_lwindow_modifier;
2283 break;
2284 case VK_RWIN:
2285 key_mapping = Vw32_rwindow_modifier;
2286 break;
2287 case VK_APPS:
2288 key_mapping = Vw32_apps_modifier;
2289 break;
2290 case VK_SCROLL:
2291 key_mapping = Vw32_scroll_lock_modifier;
2292 break;
2293 default:
2294 key_mapping = Qnil;
2297 /* NB. This code runs in the input thread, asynchronously to the lisp
2298 thread, so we must be careful to ensure access to lisp data is
2299 thread-safe. The following code is safe because the modifier
2300 variable values are updated atomically from lisp and symbols are
2301 not relocated by GC. Also, we don't have to worry about seeing GC
2302 markbits here. */
2303 if (EQ (key_mapping, Qhyper))
2304 return hyper_modifier;
2305 if (EQ (key_mapping, Qsuper))
2306 return super_modifier;
2307 if (EQ (key_mapping, Qmeta))
2308 return meta_modifier;
2309 if (EQ (key_mapping, Qalt))
2310 return alt_modifier;
2311 if (EQ (key_mapping, Qctrl))
2312 return ctrl_modifier;
2313 if (EQ (key_mapping, Qcontrol)) /* synonym for ctrl */
2314 return ctrl_modifier;
2315 if (EQ (key_mapping, Qshift))
2316 return shift_modifier;
2318 /* Don't generate any modifier if not explicitly requested. */
2319 return 0;
2322 static unsigned int
2323 w32_get_modifiers (void)
2325 return ((modifier_set (VK_SHIFT) ? shift_modifier : 0) |
2326 (modifier_set (VK_CONTROL) ? ctrl_modifier : 0) |
2327 (modifier_set (VK_LWIN) ? w32_key_to_modifier (VK_LWIN) : 0) |
2328 (modifier_set (VK_RWIN) ? w32_key_to_modifier (VK_RWIN) : 0) |
2329 (modifier_set (VK_APPS) ? w32_key_to_modifier (VK_APPS) : 0) |
2330 (modifier_set (VK_SCROLL) ? w32_key_to_modifier (VK_SCROLL) : 0) |
2331 (modifier_set (VK_MENU) ?
2332 ((NILP (Vw32_alt_is_meta)) ? alt_modifier : meta_modifier) : 0));
2335 /* We map the VK_* modifiers into console modifier constants
2336 so that we can use the same routines to handle both console
2337 and window input. */
2339 static int
2340 construct_console_modifiers (void)
2342 int mods;
2344 mods = 0;
2345 mods |= (modifier_set (VK_SHIFT)) ? SHIFT_PRESSED : 0;
2346 mods |= (modifier_set (VK_CAPITAL)) ? CAPSLOCK_ON : 0;
2347 mods |= (modifier_set (VK_SCROLL)) ? SCROLLLOCK_ON : 0;
2348 mods |= (modifier_set (VK_NUMLOCK)) ? NUMLOCK_ON : 0;
2349 mods |= (modifier_set (VK_LCONTROL)) ? LEFT_CTRL_PRESSED : 0;
2350 mods |= (modifier_set (VK_RCONTROL)) ? RIGHT_CTRL_PRESSED : 0;
2351 mods |= (modifier_set (VK_LMENU)) ? LEFT_ALT_PRESSED : 0;
2352 mods |= (modifier_set (VK_RMENU)) ? RIGHT_ALT_PRESSED : 0;
2353 mods |= (modifier_set (VK_LWIN)) ? LEFT_WIN_PRESSED : 0;
2354 mods |= (modifier_set (VK_RWIN)) ? RIGHT_WIN_PRESSED : 0;
2355 mods |= (modifier_set (VK_APPS)) ? APPS_PRESSED : 0;
2357 return mods;
2360 static int
2361 w32_get_key_modifiers (unsigned int wparam, unsigned int lparam)
2363 int mods;
2365 /* Convert to emacs modifiers. */
2366 mods = w32_kbd_mods_to_emacs (construct_console_modifiers (), wparam);
2368 return mods;
2371 unsigned int
2372 map_keypad_keys (unsigned int virt_key, unsigned int extended)
2374 if (virt_key < VK_CLEAR || virt_key > VK_DELETE)
2375 return virt_key;
2377 if (virt_key == VK_RETURN)
2378 return (extended ? VK_NUMPAD_ENTER : VK_RETURN);
2380 if (virt_key >= VK_PRIOR && virt_key <= VK_DOWN)
2381 return (!extended ? (VK_NUMPAD_PRIOR + (virt_key - VK_PRIOR)) : virt_key);
2383 if (virt_key == VK_INSERT || virt_key == VK_DELETE)
2384 return (!extended ? (VK_NUMPAD_INSERT + (virt_key - VK_INSERT)) : virt_key);
2386 if (virt_key == VK_CLEAR)
2387 return (!extended ? VK_NUMPAD_CLEAR : virt_key);
2389 return virt_key;
2392 /* List of special key combinations which w32 would normally capture,
2393 but Emacs should grab instead. Not directly visible to lisp, to
2394 simplify synchronization. Each item is an integer encoding a virtual
2395 key code and modifier combination to capture. */
2396 static Lisp_Object w32_grabbed_keys;
2398 #define HOTKEY(vk, mods) make_number (((vk) & 255) | ((mods) << 8))
2399 #define HOTKEY_ID(k) (XFASTINT (k) & 0xbfff)
2400 #define HOTKEY_VK_CODE(k) (XFASTINT (k) & 255)
2401 #define HOTKEY_MODIFIERS(k) (XFASTINT (k) >> 8)
2403 #define RAW_HOTKEY_ID(k) ((k) & 0xbfff)
2404 #define RAW_HOTKEY_VK_CODE(k) ((k) & 255)
2405 #define RAW_HOTKEY_MODIFIERS(k) ((k) >> 8)
2407 /* Register hot-keys for reserved key combinations when Emacs has
2408 keyboard focus, since this is the only way Emacs can receive key
2409 combinations like Alt-Tab which are used by the system. */
2411 static void
2412 register_hot_keys (HWND hwnd)
2414 Lisp_Object keylist;
2416 /* Use CONSP, since we are called asynchronously. */
2417 for (keylist = w32_grabbed_keys; CONSP (keylist); keylist = XCDR (keylist))
2419 Lisp_Object key = XCAR (keylist);
2421 /* Deleted entries get set to nil. */
2422 if (!INTEGERP (key))
2423 continue;
2425 RegisterHotKey (hwnd, HOTKEY_ID (key),
2426 HOTKEY_MODIFIERS (key), HOTKEY_VK_CODE (key));
2430 static void
2431 unregister_hot_keys (HWND hwnd)
2433 Lisp_Object keylist;
2435 for (keylist = w32_grabbed_keys; CONSP (keylist); keylist = XCDR (keylist))
2437 Lisp_Object key = XCAR (keylist);
2439 if (!INTEGERP (key))
2440 continue;
2442 UnregisterHotKey (hwnd, HOTKEY_ID (key));
2446 #if EMACSDEBUG
2447 const char*
2448 w32_name_of_message (UINT msg)
2450 unsigned i;
2451 static char buf[64];
2452 static const struct {
2453 UINT msg;
2454 const char* name;
2455 } msgnames[] = {
2456 #define M(msg) { msg, # msg }
2457 M (WM_PAINT),
2458 M (WM_TIMER),
2459 M (WM_USER),
2460 M (WM_MOUSEMOVE),
2461 M (WM_LBUTTONUP),
2462 M (WM_KEYDOWN),
2463 M (WM_EMACS_KILL),
2464 M (WM_EMACS_CREATEWINDOW),
2465 M (WM_EMACS_DONE),
2466 M (WM_EMACS_CREATEVSCROLLBAR),
2467 M (WM_EMACS_CREATEHSCROLLBAR),
2468 M (WM_EMACS_SHOWWINDOW),
2469 M (WM_EMACS_SETWINDOWPOS),
2470 M (WM_EMACS_DESTROYWINDOW),
2471 M (WM_EMACS_TRACKPOPUPMENU),
2472 M (WM_EMACS_SETFOCUS),
2473 M (WM_EMACS_SETFOREGROUND),
2474 M (WM_EMACS_SETLOCALE),
2475 M (WM_EMACS_SETKEYBOARDLAYOUT),
2476 M (WM_EMACS_REGISTER_HOT_KEY),
2477 M (WM_EMACS_UNREGISTER_HOT_KEY),
2478 M (WM_EMACS_TOGGLE_LOCK_KEY),
2479 M (WM_EMACS_TRACK_CARET),
2480 M (WM_EMACS_DESTROY_CARET),
2481 M (WM_EMACS_SHOW_CARET),
2482 M (WM_EMACS_HIDE_CARET),
2483 M (WM_EMACS_SETCURSOR),
2484 M (WM_EMACS_SHOWCURSOR),
2485 M (WM_EMACS_PAINT),
2486 M (WM_CHAR),
2487 #undef M
2488 { 0, 0 }
2491 for (i = 0; msgnames[i].name; ++i)
2492 if (msgnames[i].msg == msg)
2493 return msgnames[i].name;
2495 sprintf (buf, "message 0x%04x", (unsigned)msg);
2496 return buf;
2498 #endif /* EMACSDEBUG */
2500 /* Here's an overview of how Emacs input works in GUI sessions on
2501 MS-Windows. (For description of non-GUI input, see the commentary
2502 before w32_console_read_socket in w32inevt.c.)
2504 System messages are read and processed by w32_msg_pump below. This
2505 function runs in a separate thread. It handles a small number of
2506 custom WM_EMACS_* messages (posted by the main thread, look for
2507 PostMessage calls), and dispatches the rest to w32_wnd_proc, which
2508 is the main window procedure for the entire Emacs application.
2510 w32_wnd_proc also runs in the same separate input thread. It
2511 handles some messages, mostly those that need GDI calls, by itself.
2512 For the others, it calls my_post_msg, which inserts the messages
2513 into the input queue serviced by w32_read_socket.
2515 w32_read_socket runs in the main (a.k.a. "Lisp") thread, and is
2516 called synchronously from keyboard.c when it is known or suspected
2517 that some input is available. w32_read_socket either handles
2518 messages immediately, or converts them into Emacs input events and
2519 stuffs them into kbd_buffer, where kbd_buffer_get_event can get at
2520 them and process them when read_char and its callers require
2521 input.
2523 Under Cygwin with the W32 toolkit, the use of /dev/windows with
2524 select(2) takes the place of w32_read_socket.
2528 /* Main message dispatch loop. */
2530 static void
2531 w32_msg_pump (deferred_msg * msg_buf)
2533 MSG msg;
2534 WPARAM result;
2535 HWND focus_window;
2537 msh_mousewheel = RegisterWindowMessage (MSH_MOUSEWHEEL);
2539 while ((w32_unicode_gui ? GetMessageW : GetMessageA) (&msg, NULL, 0, 0))
2542 /* DebPrint (("w32_msg_pump: %s time:%u\n", */
2543 /* w32_name_of_message (msg.message), msg.time)); */
2545 if (msg.hwnd == NULL)
2547 switch (msg.message)
2549 case WM_NULL:
2550 /* Produced by complete_deferred_msg; just ignore. */
2551 break;
2552 case WM_EMACS_CREATEWINDOW:
2553 /* Initialize COM for this window. Even though we don't use it,
2554 some third party shell extensions can cause it to be used in
2555 system dialogs, which causes a crash if it is not initialized.
2556 This is a known bug in Windows, which was fixed long ago, but
2557 the patch for XP is not publicly available until XP SP3,
2558 and older versions will never be patched. */
2559 CoInitialize (NULL);
2560 w32_createwindow ((struct frame *) msg.wParam,
2561 (int *) msg.lParam);
2562 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE, 0, 0))
2563 emacs_abort ();
2564 break;
2565 case WM_EMACS_SETLOCALE:
2566 SetThreadLocale (msg.wParam);
2567 /* Reply is not expected. */
2568 break;
2569 case WM_EMACS_SETKEYBOARDLAYOUT:
2570 result = (WPARAM) ActivateKeyboardLayout ((HKL) msg.wParam, 0);
2571 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE,
2572 result, 0))
2573 emacs_abort ();
2574 break;
2575 case WM_EMACS_REGISTER_HOT_KEY:
2576 focus_window = GetFocus ();
2577 if (focus_window != NULL)
2578 RegisterHotKey (focus_window,
2579 RAW_HOTKEY_ID (msg.wParam),
2580 RAW_HOTKEY_MODIFIERS (msg.wParam),
2581 RAW_HOTKEY_VK_CODE (msg.wParam));
2582 /* Reply is not expected. */
2583 break;
2584 case WM_EMACS_UNREGISTER_HOT_KEY:
2585 focus_window = GetFocus ();
2586 if (focus_window != NULL)
2587 UnregisterHotKey (focus_window, RAW_HOTKEY_ID (msg.wParam));
2588 /* Mark item as erased. NB: this code must be
2589 thread-safe. The next line is okay because the cons
2590 cell is never made into garbage and is not relocated by
2591 GC. */
2592 XSETCAR (make_lisp_ptr ((void *)msg.lParam, Lisp_Cons), Qnil);
2593 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE, 0, 0))
2594 emacs_abort ();
2595 break;
2596 case WM_EMACS_TOGGLE_LOCK_KEY:
2598 int vk_code = (int) msg.wParam;
2599 int cur_state = (GetKeyState (vk_code) & 1);
2600 int new_state = msg.lParam;
2602 if (new_state == -1
2603 || ((new_state & 1) != cur_state))
2605 one_w32_display_info.faked_key = vk_code;
2607 keybd_event ((BYTE) vk_code,
2608 (BYTE) MapVirtualKey (vk_code, 0),
2609 KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
2610 keybd_event ((BYTE) vk_code,
2611 (BYTE) MapVirtualKey (vk_code, 0),
2612 KEYEVENTF_EXTENDEDKEY | 0, 0);
2613 keybd_event ((BYTE) vk_code,
2614 (BYTE) MapVirtualKey (vk_code, 0),
2615 KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
2616 cur_state = !cur_state;
2618 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE,
2619 cur_state, 0))
2620 emacs_abort ();
2622 break;
2623 #ifdef MSG_DEBUG
2624 /* Broadcast messages make it here, so you need to be looking
2625 for something in particular for this to be useful. */
2626 default:
2627 DebPrint (("msg %x not expected by w32_msg_pump\n", msg.message));
2628 #endif
2631 else
2633 if (w32_unicode_gui)
2634 DispatchMessageW (&msg);
2635 else
2636 DispatchMessageA (&msg);
2639 /* Exit nested loop when our deferred message has completed. */
2640 if (msg_buf->completed)
2641 break;
2645 deferred_msg * deferred_msg_head;
2647 static deferred_msg *
2648 find_deferred_msg (HWND hwnd, UINT msg)
2650 deferred_msg * item;
2652 /* Don't actually need synchronization for read access, since
2653 modification of single pointer is always atomic. */
2654 /* enter_crit (); */
2656 for (item = deferred_msg_head; item != NULL; item = item->next)
2657 if (item->w32msg.msg.hwnd == hwnd
2658 && item->w32msg.msg.message == msg)
2659 break;
2661 /* leave_crit (); */
2663 return item;
2666 static LRESULT
2667 send_deferred_msg (deferred_msg * msg_buf,
2668 HWND hwnd,
2669 UINT msg,
2670 WPARAM wParam,
2671 LPARAM lParam)
2673 /* Only input thread can send deferred messages. */
2674 if (GetCurrentThreadId () != dwWindowsThreadId)
2675 emacs_abort ();
2677 /* It is an error to send a message that is already deferred. */
2678 if (find_deferred_msg (hwnd, msg) != NULL)
2679 emacs_abort ();
2681 /* Enforced synchronization is not needed because this is the only
2682 function that alters deferred_msg_head, and the following critical
2683 section is guaranteed to only be serially reentered (since only the
2684 input thread can call us). */
2686 /* enter_crit (); */
2688 msg_buf->completed = 0;
2689 msg_buf->next = deferred_msg_head;
2690 deferred_msg_head = msg_buf;
2691 my_post_msg (&msg_buf->w32msg, hwnd, msg, wParam, lParam);
2693 /* leave_crit (); */
2695 /* Start a new nested message loop to process other messages until
2696 this one is completed. */
2697 w32_msg_pump (msg_buf);
2699 deferred_msg_head = msg_buf->next;
2701 return msg_buf->result;
2704 void
2705 complete_deferred_msg (HWND hwnd, UINT msg, LRESULT result)
2707 deferred_msg * msg_buf = find_deferred_msg (hwnd, msg);
2709 if (msg_buf == NULL)
2710 /* Message may have been canceled, so don't abort. */
2711 return;
2713 msg_buf->result = result;
2714 msg_buf->completed = 1;
2716 /* Ensure input thread is woken so it notices the completion. */
2717 PostThreadMessage (dwWindowsThreadId, WM_NULL, 0, 0);
2720 static void
2721 cancel_all_deferred_msgs (void)
2723 deferred_msg * item;
2725 /* Don't actually need synchronization for read access, since
2726 modification of single pointer is always atomic. */
2727 /* enter_crit (); */
2729 for (item = deferred_msg_head; item != NULL; item = item->next)
2731 item->result = 0;
2732 item->completed = 1;
2735 /* leave_crit (); */
2737 /* Ensure input thread is woken so it notices the completion. */
2738 PostThreadMessage (dwWindowsThreadId, WM_NULL, 0, 0);
2741 DWORD WINAPI
2742 w32_msg_worker (void *arg)
2744 MSG msg;
2745 deferred_msg dummy_buf;
2747 /* Ensure our message queue is created */
2749 PeekMessage (&msg, NULL, 0, 0, PM_NOREMOVE);
2751 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE, 0, 0))
2752 emacs_abort ();
2754 memset (&dummy_buf, 0, sizeof (dummy_buf));
2755 dummy_buf.w32msg.msg.hwnd = NULL;
2756 dummy_buf.w32msg.msg.message = WM_NULL;
2758 /* This is the initial message loop which should only exit when the
2759 application quits. */
2760 w32_msg_pump (&dummy_buf);
2762 return 0;
2765 static void
2766 signal_user_input (void)
2768 /* Interrupt any lisp that wants to be interrupted by input. */
2769 if (!NILP (Vthrow_on_input))
2771 Vquit_flag = Vthrow_on_input;
2772 /* Doing a QUIT from this thread is a bad idea, since this
2773 unwinds the stack of the Lisp thread, and the Windows runtime
2774 rightfully barfs. Disabled. */
2775 #if 0
2776 /* If we're inside a function that wants immediate quits,
2777 do it now. */
2778 if (immediate_quit && NILP (Vinhibit_quit))
2780 immediate_quit = 0;
2781 QUIT;
2783 #endif
2788 static void
2789 post_character_message (HWND hwnd, UINT msg,
2790 WPARAM wParam, LPARAM lParam,
2791 DWORD modifiers)
2793 W32Msg wmsg;
2795 wmsg.dwModifiers = modifiers;
2797 /* Detect quit_char and set quit-flag directly. Note that we
2798 still need to post a message to ensure the main thread will be
2799 woken up if blocked in sys_select, but we do NOT want to post
2800 the quit_char message itself (because it will usually be as if
2801 the user had typed quit_char twice). Instead, we post a dummy
2802 message that has no particular effect. */
2804 int c = wParam;
2805 if (isalpha (c) && wmsg.dwModifiers == ctrl_modifier)
2806 c = make_ctrl_char (c) & 0377;
2807 if (c == quit_char
2808 || (wmsg.dwModifiers == 0
2809 && w32_quit_key && wParam == w32_quit_key))
2811 Vquit_flag = Qt;
2813 /* The choice of message is somewhat arbitrary, as long as
2814 the main thread handler just ignores it. */
2815 msg = WM_NULL;
2817 /* Interrupt any blocking system calls. */
2818 signal_quit ();
2820 /* As a safety precaution, forcibly complete any deferred
2821 messages. This is a kludge, but I don't see any particularly
2822 clean way to handle the situation where a deferred message is
2823 "dropped" in the lisp thread, and will thus never be
2824 completed, eg. by the user trying to activate the menubar
2825 when the lisp thread is busy, and then typing C-g when the
2826 menubar doesn't open promptly (with the result that the
2827 menubar never responds at all because the deferred
2828 WM_INITMENU message is never completed). Another problem
2829 situation is when the lisp thread calls SendMessage (to send
2830 a window manager command) when a message has been deferred;
2831 the lisp thread gets blocked indefinitely waiting for the
2832 deferred message to be completed, which itself is waiting for
2833 the lisp thread to respond.
2835 Note that we don't want to block the input thread waiting for
2836 a response from the lisp thread (although that would at least
2837 solve the deadlock problem above), because we want to be able
2838 to receive C-g to interrupt the lisp thread. */
2839 cancel_all_deferred_msgs ();
2841 else
2842 signal_user_input ();
2845 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
2848 static int
2849 get_wm_chars (HWND aWnd, int *buf, int buflen, int ignore_ctrl, int ctrl,
2850 int *ctrl_cnt, int *is_dead, int vk, int exp)
2852 MSG msg;
2853 /* If doubled is at the end, ignore it. */
2854 int i = buflen, doubled = 0, code_unit;
2856 if (ctrl_cnt)
2857 *ctrl_cnt = 0;
2858 if (is_dead)
2859 *is_dead = -1;
2860 eassert (w32_unicode_gui);
2861 while (buflen
2862 /* Should be called only when w32_unicode_gui: */
2863 && PeekMessageW (&msg, aWnd, WM_KEYFIRST, WM_KEYLAST,
2864 PM_NOREMOVE | PM_NOYIELD)
2865 && (msg.message == WM_CHAR || msg.message == WM_SYSCHAR
2866 || msg.message == WM_DEADCHAR || msg.message == WM_SYSDEADCHAR
2867 || msg.message == WM_UNICHAR))
2869 /* We extract character payload, but in this call we handle only the
2870 characters which come BEFORE the next keyup/keydown message. */
2871 int dead;
2873 GetMessageW (&msg, aWnd, msg.message, msg.message);
2874 dead = (msg.message == WM_DEADCHAR || msg.message == WM_SYSDEADCHAR);
2875 if (is_dead)
2876 *is_dead = (dead ? msg.wParam : -1);
2877 if (dead)
2878 continue;
2879 code_unit = msg.wParam;
2880 if (doubled)
2882 /* Had surrogate. */
2883 if (msg.message == WM_UNICHAR
2884 || code_unit < 0xDC00 || code_unit > 0xDFFF)
2885 { /* Mismatched first surrogate.
2886 Pass both code units as if they were two characters. */
2887 *buf++ = doubled;
2888 if (!--buflen)
2889 return i; /* Drop the 2nd char if at the end of the buffer. */
2891 else /* see https://en.wikipedia.org/wiki/UTF-16 */
2892 code_unit = (doubled << 10) + code_unit - 0x35FDC00;
2893 doubled = 0;
2895 else if (code_unit >= 0xD800 && code_unit <= 0xDBFF)
2897 /* Handle mismatched 2nd surrogate the same as a normal character. */
2898 doubled = code_unit;
2899 continue;
2902 /* The only "fake" characters delivered by ToUnicode() or
2903 TranslateMessage() are:
2904 0x01 .. 0x1a for Ctrl-letter, Enter, Tab, Ctrl-Break, Esc, Backspace
2905 0x00 and 0x1b .. 0x1f for Control- []\@^_
2906 0x7f for Control-BackSpace
2907 0x20 for Control-Space */
2908 if (ignore_ctrl
2909 && (code_unit < 0x20 || code_unit == 0x7f
2910 || (code_unit == 0x20 && ctrl)))
2912 /* Non-character payload in a WM_CHAR
2913 (Ctrl-something pressed, see above). Ignore, and report. */
2914 if (ctrl_cnt)
2915 (*ctrl_cnt)++;
2916 continue;
2918 /* Traditionally, Emacs would ignore the character payload of VK_NUMPAD*
2919 keys, and would treat them later via `function-key-map'. In addition
2920 to usual 102-key NUMPAD keys, this map also treats `kp-'-variants of
2921 space, tab, enter, separator, equal. TAB and EQUAL, apparently,
2922 cannot be generated on Win-GUI branch. ENTER is already handled
2923 by the code above. According to `lispy_function_keys', kp_space is
2924 generated by not-extended VK_CLEAR. (kp-tab != VK_OEM_NEC_EQUAL!).
2926 We do similarly for backward-compatibility, but ignore only the
2927 characters restorable later by `function-key-map'. */
2928 if (code_unit < 0x7f
2929 && ((vk >= VK_NUMPAD0 && vk <= VK_DIVIDE)
2930 || (exp && ((vk >= VK_PRIOR && vk <= VK_DOWN) ||
2931 vk == VK_INSERT || vk == VK_DELETE || vk == VK_CLEAR)))
2932 && strchr ("0123456789/*-+.,", code_unit))
2933 continue;
2934 *buf++ = code_unit;
2935 buflen--;
2937 return i - buflen;
2940 #ifdef DBG_WM_CHARS
2941 # define FPRINTF_WM_CHARS(ARG) fprintf ARG
2942 #else
2943 # define FPRINTF_WM_CHARS(ARG) (void)0
2944 #endif
2946 /* This is a heuristic only. This is supposed to track the state of the
2947 finite automaton in the language environment of Windows.
2949 However, separate windows (if with the same different language
2950 environments!) should have different values. Moreover, switching to a
2951 non-Emacs window with the same language environment, and using (dead)keys
2952 there would change the value stored in the kernel, but not this value. */
2953 /* A layout may emit deadkey=0. It looks like this would reset the state
2954 of the kernel's finite automaton (equivalent to emiting 0-length string,
2955 which is otherwise impossible in the dead-key map of a layout).
2956 Be ready to treat the case when this delivers WM_(SYS)DEADCHAR. */
2957 static int after_deadkey = -1;
2960 deliver_wm_chars (int do_translate, HWND hwnd, UINT msg, UINT wParam,
2961 UINT lParam, int legacy_alt_meta)
2963 /* An "old style" keyboard description may assign up to 125 UTF-16 code
2964 points to a keypress.
2965 (However, the "old style" TranslateMessage() would deliver at most 16 of
2966 them.) Be on a safe side, and prepare to treat many more. */
2967 int ctrl_cnt, buf[1024], count, is_dead, after_dead = (after_deadkey > 0);
2969 /* Since the keypress processing logic of Windows has a lot of state, it
2970 is important to call TranslateMessage() for every keyup/keydown, AND
2971 do it exactly once. (The actual change of state is done by
2972 ToUnicode[Ex](), which is called by TranslateMessage(). So one can
2973 call ToUnicode[Ex]() instead.)
2975 The "usual" message pump calls TranslateMessage() for EVERY event.
2976 Emacs calls TranslateMessage() very selectively (is it needed for doing
2977 some tricky stuff with Win95??? With newer Windows, selectiveness is,
2978 most probably, not needed -- and harms a lot).
2980 So, with the usual message pump, the following call to TranslateMessage()
2981 is not needed (and is going to be VERY harmful). With Emacs' message
2982 pump, the call is needed. */
2983 if (do_translate)
2985 MSG windows_msg = { hwnd, msg, wParam, lParam, 0, {0,0} };
2987 windows_msg.time = GetMessageTime ();
2988 TranslateMessage (&windows_msg);
2990 count = get_wm_chars (hwnd, buf, sizeof (buf)/sizeof (*buf), 1,
2991 /* The message may have been synthesized by
2992 who knows what; be conservative. */
2993 modifier_set (VK_LCONTROL)
2994 || modifier_set (VK_RCONTROL)
2995 || modifier_set (VK_CONTROL),
2996 &ctrl_cnt, &is_dead, wParam,
2997 (lParam & 0x1000000L) != 0);
2998 if (count)
3000 W32Msg wmsg;
3001 DWORD console_modifiers = construct_console_modifiers ();
3002 int *b = buf, strip_ExtraMods = 1, hairy = 0;
3003 char *type_CtrlAlt = NULL;
3005 /* XXXX In fact, there may be another case when we need to do the same:
3006 What happens if the string defined in the LIGATURES has length
3007 0? Probably, we will get count==0, but the state of the finite
3008 automaton would reset to 0??? */
3009 after_deadkey = -1;
3011 /* wParam is checked when converting CapsLock to Shift; this is a clone
3012 of w32_get_key_modifiers (). */
3013 wmsg.dwModifiers = w32_kbd_mods_to_emacs (console_modifiers, wParam);
3015 /* What follows is just heuristics; the correct treatement requires
3016 non-destructive ToUnicode():
3017 http://search.cpan.org/~ilyaz/UI-KeyboardLayout/lib/UI/KeyboardLayout.pm#Can_an_application_on_Windows_accept_keyboard_events?_Part_IV:_application-specific_modifiers
3019 What one needs to find is:
3020 * which of the present modifiers AFFECT the resulting char(s)
3021 (so should be stripped, since their EFFECT is "already
3022 taken into account" in the string in buf), and
3023 * which modifiers are not affecting buf, so should be reported to
3024 the application for further treatment.
3026 Example: assume that we know:
3027 (A) lCtrl+rCtrl+rAlt modifiers with VK_A key produce a Latin "f"
3028 ("may be logical" in JCUKEN-flavored Russian keyboard flavors);
3029 (B) removing any of lCtrl, rCtrl, rAlt changes the produced char;
3030 (C) Win-modifier is not affecting the produced character
3031 (this is the common case: happens with all "standard" layouts).
3033 Suppose the user presses Win+lCtrl+rCtrl+rAlt modifiers with VK_A.
3034 What is the intent of the user? We need to guess the intent to decide
3035 which event to deliver to the application.
3037 This looks like a reasonable logic: since Win- modifier doesn't affect
3038 the output string, the user was pressing Win for SOME OTHER purpose.
3039 So the user wanted to generate Win-SOMETHING event. Now, what is
3040 something? If one takes the mantra that "character payload is more
3041 important than the combination of keypresses which resulted in this
3042 payload", then one should ignore lCtrl+rCtrl+rAlt, ignore VK_A, and
3043 assume that the user wanted to generate Win-f.
3045 Unfortunately, without non-destructive ToUnicode(), checking (B),(C)
3046 is out of question. So we use heuristics (hopefully, covering
3047 99.9999% of cases). */
3049 /* Another thing to watch for is a possibility to use AltGr-* and
3050 Ctrl-Alt-* with different semantic.
3052 Background: the layout defining the KLLF_ALTGR bit are treated
3053 specially by the kernel: when VK_RMENU (=rightAlt, =AltGr) is pressed
3054 (released), a press (release) of VK_LCONTROL is emulated (unless Ctrl
3055 is already down). As a result, any press/release of AltGr is seen
3056 by applications as a press/release of lCtrl AND rAlt. This is
3057 applicable, in particular, to ToUnicode[Ex](). (Keyrepeat is covered
3058 the same way!)
3060 NOTE: it IS possible to see bare rAlt even with KLLF_ALTGR; but this
3061 requires a good finger coordination: doing (physically)
3062 Down-lCtrl Down-rAlt Up-lCtrl Down-a
3063 (doing quick enough, so that key repeat of rAlt [which would
3064 generate new "fake" Down-lCtrl events] does not happens before 'a'
3065 is down) results in no "fake" events, so the application will see
3066 only rAlt down when 'a' is pressed. (However, fake Up-lCtrl WILL
3067 be generated when rAlt goes UP.)
3069 In fact, note also that KLLF_ALTGR does not prohibit construction of
3070 rCtrl-rAlt (just press them in this order!).
3072 Moreover: "traditional" layouts do not define distinct modifier-masks
3073 for VK_LMENU and VK_RMENU (same for VK_L/RCONTROL). Instead, they
3074 rely on the KLLF_ALTGR bit to make the behavior of VK_LMENU and
3075 VK_RMENU distinct. As a corollary, for such layouts, the produced
3076 character is the same for AltGr-* (=rAlt-*) and Ctrl-Alt-* (in any
3077 combination of handedness). For description of masks, see
3079 http://search.cpan.org/~ilyaz/UI-KeyboardLayout/lib/UI/KeyboardLayout.pm#Keyboard_input_on_Windows,_Part_I:_what_is_the_kernel_doing?
3081 By default, Emacs was using these coincidences via the following
3082 heuristics: it was treating:
3083 (*) keypresses with lCtrl-rAlt modifiers as if they are carrying
3084 ONLY the character payload (no matter what the actual keyboard
3085 was defining: if lCtrl-lAlt-b was delivering U+05df=beta, then
3086 Emacs saw [beta]; if lCtrl-lAlt-b was undefined in the layout,
3087 the keypress was completely ignored), and
3088 (*) keypresses with the other combinations of handedness of Ctrl-Alt
3089 modifiers (e.g., lCtrl-lAlt) as if they NEVER carry a character
3090 payload (so they were reported "raw": if lCtrl-lAlt-b was
3091 delivering beta, then Emacs saw event [C-A-b], and not [beta]).
3092 This worked good for "traditional" layouts: users could type both
3093 AltGr-x and Ctrl-Alt-x, and one was a character, another a bindable
3094 event.
3096 However, for layouts which deliver different characters for AltGr-x
3097 and lCtrl-lAlt-x, this scheme makes the latter character unaccessible
3098 in Emacs. While it is easy to access functionality of [C-M-x] in
3099 Emacs by other means (for example, by the `controlify' prefix, or
3100 using lCtrl-rCtrl-x, or rCtrl-rAlt-x [in this order]), missing
3101 characters cannot be reconstructed without a tedious manual work. */
3103 /* These two cases are often going to be distinguishable, since at most
3104 one of these character is defined with KBDCTRL | KBDMENU modifier
3105 bitmap. (This heuristic breaks if both lCtrl-lAlt- AND lCtrl-rAlt-
3106 are translated to modifier bitmaps distinct from KBDCTRL | KBDMENU,
3107 or in the cases when lCtrl-lAlt-* and lCtrl-rAlt-* are generally
3108 different, but lCtrl-lAlt-x and lCtrl-rAlt-x happen to deliver the
3109 same character.)
3111 So we have 2 chunks of info:
3112 (A) is it lCtrl-rAlt-, or lCtrl-lAlt, or some other combination?
3113 (B) is the delivered character defined with KBDCTRL | KBDMENU bits?
3114 Basing on (A) and (B), we should decide whether to ignore the
3115 delivered character. (Before, Emacs was completely ignoring (B), and
3116 was treating the 3-state of (A) as a bit.) This means that we have 6
3117 bits of customization.
3119 Additionally, a presence of two Ctrl down may be AltGr-rCtrl-. */
3121 /* Strip all non-Shift modifiers if:
3122 - more than one UTF-16 code point delivered (can't call VkKeyScanW ())
3123 - or the character is a result of combining with a prefix key. */
3124 if (!after_dead && count == 1 && *b < 0x10000)
3126 if (console_modifiers & (RIGHT_ALT_PRESSED | LEFT_ALT_PRESSED)
3127 && console_modifiers & (RIGHT_CTRL_PRESSED | LEFT_CTRL_PRESSED))
3129 type_CtrlAlt = "bB"; /* generic bindable Ctrl-Alt- modifiers */
3130 if ((console_modifiers & (LEFT_CTRL_PRESSED | RIGHT_CTRL_PRESSED))
3131 == (LEFT_CTRL_PRESSED | RIGHT_CTRL_PRESSED))
3132 /* double-Ctrl:
3133 e.g. AltGr-rCtrl on some layouts (in this order!) */
3134 type_CtrlAlt = "dD";
3135 else if ((console_modifiers
3136 & (LEFT_CTRL_PRESSED | LEFT_ALT_PRESSED))
3137 == (LEFT_CTRL_PRESSED | LEFT_ALT_PRESSED))
3138 type_CtrlAlt = "lL"; /* Ctrl-Alt- modifiers on the left */
3139 else if (!NILP (Vw32_recognize_altgr)
3140 && ((console_modifiers
3141 & (RIGHT_ALT_PRESSED | LEFT_CTRL_PRESSED)))
3142 == (RIGHT_ALT_PRESSED | LEFT_CTRL_PRESSED))
3143 type_CtrlAlt = "gG"; /* modifiers as in AltGr */
3145 else if (wmsg.dwModifiers & (alt_modifier | meta_modifier)
3146 || ((console_modifiers
3147 & (LEFT_WIN_PRESSED | RIGHT_WIN_PRESSED
3148 | APPS_PRESSED | SCROLLLOCK_ON))))
3150 /* Pure Alt (or combination of Alt, Win, APPS, scrolllock. */
3151 type_CtrlAlt = "aA";
3153 if (type_CtrlAlt)
3155 /* Out of bound bitmap: */
3156 SHORT r = VkKeyScanW (*b), bitmap = 0x1FF;
3158 FPRINTF_WM_CHARS((stderr, "VkKeyScanW %#06x %#04x\n", (int)r,
3159 wParam));
3160 if ((r & 0xFF) == wParam)
3161 bitmap = r>>8; /* *b is reachable via simple interface */
3162 if (*type_CtrlAlt == 'a') /* Simple Alt seen */
3164 if ((bitmap & ~1) == 0) /* 1: KBDSHIFT */
3166 /* In "traditional" layouts, Alt without Ctrl does not
3167 change the delivered character. This detects this
3168 situation; it is safe to report this as Alt-something
3169 -- as opposed to delivering the reported character
3170 without modifiers. */
3171 if (legacy_alt_meta
3172 && *b > 0x7f && ('A' <= wParam && wParam <= 'Z'))
3173 /* For backward-compatibility with older Emacsen, let
3174 this be processed by another branch below (which
3175 would convert it to Alt-Latin char via wParam). */
3176 return 0;
3178 else
3179 hairy = 1;
3181 /* Check whether the delivered character(s) is accessible via
3182 KBDCTRL | KBDALT ( | KBDSHIFT ) modifier mask (which is 7). */
3183 else if ((bitmap & ~1) != 6)
3185 /* The character is not accessible via plain Ctrl-Alt(-Shift)
3186 (which is, probably, same as AltGr) modifiers.
3187 Either it was after a prefix key, or is combined with
3188 modifier keys which we don't see, or there is an asymmetry
3189 between left-hand and right-hand modifiers, or other hairy
3190 stuff. */
3191 hairy = 1;
3193 /* The best solution is to delegate these tough (but rarely
3194 needed) choices to the user. Temporarily (???), it is
3195 implemented as C macros.
3197 Essentially, there are 3 things to do: return 0 (handle to the
3198 legacy processing code [ignoring the character payload]; keep
3199 some modifiers (so that they will be processed by the binding
3200 system [on top of the character payload]; strip modifiers [so
3201 that `self-insert' is going to be triggered with the character
3202 payload]).
3204 The default below should cover 99.9999% of cases:
3205 (a) strip Alt- in the hairy case only;
3206 (stripping = not ignoring)
3207 (l) for lAlt-lCtrl, ignore the char in simple cases only;
3208 (g) for what looks like AltGr, ignore the modifiers;
3209 (d) for what looks like lCtrl-rCtrl-Alt (probably
3210 AltGr-rCtrl), ignore the character in simple cases only;
3211 (b) for other cases of Ctrl-Alt, ignore the character in
3212 simple cases only.
3214 Essentially, in all hairy cases, and in looks-like-AltGr case,
3215 we keep the character, ignoring the modifiers. In all the
3216 other cases, we ignore the delivered character. */
3217 #define S_TYPES_TO_IGNORE_CHARACTER_PAYLOAD "aldb"
3218 #define S_TYPES_TO_REPORT_CHARACTER_PAYLOAD_WITH_MODIFIERS ""
3219 if (strchr (S_TYPES_TO_IGNORE_CHARACTER_PAYLOAD,
3220 type_CtrlAlt[hairy]))
3221 return 0;
3222 /* If in neither list, report all the modifiers we see COMBINED
3223 WITH the reported character. */
3224 if (strchr (S_TYPES_TO_REPORT_CHARACTER_PAYLOAD_WITH_MODIFIERS,
3225 type_CtrlAlt[hairy]))
3226 strip_ExtraMods = 0;
3229 if (strip_ExtraMods)
3230 wmsg.dwModifiers = wmsg.dwModifiers & shift_modifier;
3232 signal_user_input ();
3233 while (count--)
3235 FPRINTF_WM_CHARS((stderr, "unichar %#06x\n", *b));
3236 my_post_msg (&wmsg, hwnd, WM_UNICHAR, *b++, lParam);
3238 if (!ctrl_cnt) /* Process ALSO as ctrl */
3239 return 1;
3240 else
3241 FPRINTF_WM_CHARS((stderr, "extra ctrl char\n"));
3242 return -1;
3244 else if (is_dead >= 0)
3246 FPRINTF_WM_CHARS((stderr, "dead %#06x\n", is_dead));
3247 after_deadkey = is_dead;
3248 return 1;
3250 return 0;
3253 /* Main window procedure */
3255 static LRESULT CALLBACK
3256 w32_wnd_proc (HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam)
3258 struct frame *f;
3259 struct w32_display_info *dpyinfo = &one_w32_display_info;
3260 W32Msg wmsg;
3261 int windows_translate;
3262 int key;
3264 /* Note that it is okay to call x_window_to_frame, even though we are
3265 not running in the main lisp thread, because frame deletion
3266 requires the lisp thread to synchronize with this thread. Thus, if
3267 a frame struct is returned, it can be used without concern that the
3268 lisp thread might make it disappear while we are using it.
3270 NB. Walking the frame list in this thread is safe (as long as
3271 writes of Lisp_Object slots are atomic, which they are on Windows).
3272 Although delete-frame can destructively modify the frame list while
3273 we are walking it, a garbage collection cannot occur until after
3274 delete-frame has synchronized with this thread.
3276 It is also safe to use functions that make GDI calls, such as
3277 w32_clear_rect, because these functions must obtain a DC handle
3278 from the frame struct using get_frame_dc which is thread-aware. */
3280 switch (msg)
3282 case WM_ERASEBKGND:
3283 f = x_window_to_frame (dpyinfo, hwnd);
3284 if (f)
3286 HDC hdc = get_frame_dc (f);
3287 GetUpdateRect (hwnd, &wmsg.rect, FALSE);
3288 w32_clear_rect (f, hdc, &wmsg.rect);
3289 release_frame_dc (f, hdc);
3291 #if defined (W32_DEBUG_DISPLAY)
3292 DebPrint (("WM_ERASEBKGND (frame %p): erasing %d,%d-%d,%d\n",
3294 wmsg.rect.left, wmsg.rect.top,
3295 wmsg.rect.right, wmsg.rect.bottom));
3296 #endif /* W32_DEBUG_DISPLAY */
3298 return 1;
3299 case WM_PALETTECHANGED:
3300 /* ignore our own changes */
3301 if ((HWND)wParam != hwnd)
3303 f = x_window_to_frame (dpyinfo, hwnd);
3304 if (f)
3305 /* get_frame_dc will realize our palette and force all
3306 frames to be redrawn if needed. */
3307 release_frame_dc (f, get_frame_dc (f));
3309 return 0;
3310 case WM_PAINT:
3312 PAINTSTRUCT paintStruct;
3313 RECT update_rect;
3314 memset (&update_rect, 0, sizeof (update_rect));
3316 f = x_window_to_frame (dpyinfo, hwnd);
3317 if (f == 0)
3319 DebPrint (("WM_PAINT received for unknown window %p\n", hwnd));
3320 return 0;
3323 /* MSDN Docs say not to call BeginPaint if GetUpdateRect
3324 fails. Apparently this can happen under some
3325 circumstances. */
3326 if (GetUpdateRect (hwnd, &update_rect, FALSE) || !w32_strict_painting)
3328 enter_crit ();
3329 BeginPaint (hwnd, &paintStruct);
3331 /* The rectangles returned by GetUpdateRect and BeginPaint
3332 do not always match. Play it safe by assuming both areas
3333 are invalid. */
3334 UnionRect (&(wmsg.rect), &update_rect, &(paintStruct.rcPaint));
3336 #if defined (W32_DEBUG_DISPLAY)
3337 DebPrint (("WM_PAINT (frame %p): painting %d,%d-%d,%d\n",
3339 wmsg.rect.left, wmsg.rect.top,
3340 wmsg.rect.right, wmsg.rect.bottom));
3341 DebPrint ((" [update region is %d,%d-%d,%d]\n",
3342 update_rect.left, update_rect.top,
3343 update_rect.right, update_rect.bottom));
3344 #endif
3345 EndPaint (hwnd, &paintStruct);
3346 leave_crit ();
3348 /* Change the message type to prevent Windows from
3349 combining WM_PAINT messages in the Lisp thread's queue,
3350 since Windows assumes that each message queue is
3351 dedicated to one frame and does not bother checking
3352 that hwnd matches before combining them. */
3353 my_post_msg (&wmsg, hwnd, WM_EMACS_PAINT, wParam, lParam);
3355 return 0;
3358 /* If GetUpdateRect returns 0 (meaning there is no update
3359 region), assume the whole window needs to be repainted. */
3360 GetClientRect (hwnd, &wmsg.rect);
3361 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3362 return 0;
3365 case WM_INPUTLANGCHANGE:
3366 /* Inform lisp thread of keyboard layout changes. */
3367 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3369 /* The state of the finite automaton is separate per every input
3370 language environment (so it does not change when one switches
3371 to a different window with the same environment). Moreover,
3372 the experiments show that the state is not remembered when
3373 one switches back to the pre-previous environment. */
3374 after_deadkey = -1;
3376 /* XXXX??? What follows is a COMPLETE misunderstanding of Windows! */
3378 /* Clear dead keys in the keyboard state; for simplicity only
3379 preserve modifier key states. */
3381 int i;
3382 BYTE keystate[256];
3384 GetKeyboardState (keystate);
3385 for (i = 0; i < 256; i++)
3386 if (1
3387 && i != VK_SHIFT
3388 && i != VK_LSHIFT
3389 && i != VK_RSHIFT
3390 && i != VK_CAPITAL
3391 && i != VK_NUMLOCK
3392 && i != VK_SCROLL
3393 && i != VK_CONTROL
3394 && i != VK_LCONTROL
3395 && i != VK_RCONTROL
3396 && i != VK_MENU
3397 && i != VK_LMENU
3398 && i != VK_RMENU
3399 && i != VK_LWIN
3400 && i != VK_RWIN)
3401 keystate[i] = 0;
3402 SetKeyboardState (keystate);
3404 goto dflt;
3406 case WM_HOTKEY:
3407 /* Synchronize hot keys with normal input. */
3408 PostMessage (hwnd, WM_KEYDOWN, HIWORD (lParam), 0);
3409 return (0);
3411 case WM_KEYUP:
3412 case WM_SYSKEYUP:
3413 record_keyup (wParam, lParam);
3414 goto dflt;
3416 case WM_KEYDOWN:
3417 case WM_SYSKEYDOWN:
3418 /* Ignore keystrokes we fake ourself; see below. */
3419 if (dpyinfo->faked_key == wParam)
3421 dpyinfo->faked_key = 0;
3422 /* Make sure TranslateMessage sees them though (as long as
3423 they don't produce WM_CHAR messages). This ensures that
3424 indicator lights are toggled promptly on Windows 9x, for
3425 example. */
3426 if (wParam < 256 && lispy_function_keys[wParam])
3428 windows_translate = 1;
3429 goto translate;
3431 return 0;
3434 /* Synchronize modifiers with current keystroke. */
3435 sync_modifiers ();
3436 record_keydown (wParam, lParam);
3437 if (w32_use_fallback_wm_chars_method)
3438 wParam = map_keypad_keys (wParam, (lParam & 0x1000000L) != 0);
3440 windows_translate = 0;
3442 switch (wParam)
3444 case VK_LWIN:
3445 if (NILP (Vw32_pass_lwindow_to_system))
3447 /* Prevent system from acting on keyup (which opens the
3448 Start menu if no other key was pressed) by simulating a
3449 press of Space which we will ignore. */
3450 if (GetAsyncKeyState (wParam) & 1)
3452 if (NUMBERP (Vw32_phantom_key_code))
3453 key = XUINT (Vw32_phantom_key_code) & 255;
3454 else
3455 key = VK_SPACE;
3456 dpyinfo->faked_key = key;
3457 keybd_event (key, (BYTE) MapVirtualKey (key, 0), 0, 0);
3460 if (!NILP (Vw32_lwindow_modifier))
3461 return 0;
3462 break;
3463 case VK_RWIN:
3464 if (NILP (Vw32_pass_rwindow_to_system))
3466 if (GetAsyncKeyState (wParam) & 1)
3468 if (NUMBERP (Vw32_phantom_key_code))
3469 key = XUINT (Vw32_phantom_key_code) & 255;
3470 else
3471 key = VK_SPACE;
3472 dpyinfo->faked_key = key;
3473 keybd_event (key, (BYTE) MapVirtualKey (key, 0), 0, 0);
3476 if (!NILP (Vw32_rwindow_modifier))
3477 return 0;
3478 break;
3479 case VK_APPS:
3480 if (!NILP (Vw32_apps_modifier))
3481 return 0;
3482 break;
3483 case VK_MENU:
3484 if (NILP (Vw32_pass_alt_to_system))
3485 /* Prevent DefWindowProc from activating the menu bar if an
3486 Alt key is pressed and released by itself. */
3487 return 0;
3488 windows_translate = 1;
3489 break;
3490 case VK_CAPITAL:
3491 /* Decide whether to treat as modifier or function key. */
3492 if (NILP (Vw32_enable_caps_lock))
3493 goto disable_lock_key;
3494 windows_translate = 1;
3495 break;
3496 case VK_NUMLOCK:
3497 /* Decide whether to treat as modifier or function key. */
3498 if (NILP (Vw32_enable_num_lock))
3499 goto disable_lock_key;
3500 windows_translate = 1;
3501 break;
3502 case VK_SCROLL:
3503 /* Decide whether to treat as modifier or function key. */
3504 if (NILP (Vw32_scroll_lock_modifier))
3505 goto disable_lock_key;
3506 windows_translate = 1;
3507 break;
3508 disable_lock_key:
3509 /* Ensure the appropriate lock key state (and indicator light)
3510 remains in the same state. We do this by faking another
3511 press of the relevant key. Apparently, this really is the
3512 only way to toggle the state of the indicator lights. */
3513 dpyinfo->faked_key = wParam;
3514 keybd_event ((BYTE) wParam, (BYTE) MapVirtualKey (wParam, 0),
3515 KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
3516 keybd_event ((BYTE) wParam, (BYTE) MapVirtualKey (wParam, 0),
3517 KEYEVENTF_EXTENDEDKEY | 0, 0);
3518 keybd_event ((BYTE) wParam, (BYTE) MapVirtualKey (wParam, 0),
3519 KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
3520 /* Ensure indicator lights are updated promptly on Windows 9x
3521 (TranslateMessage apparently does this), after forwarding
3522 input event. */
3523 post_character_message (hwnd, msg, wParam, lParam,
3524 w32_get_key_modifiers (wParam, lParam));
3525 windows_translate = 1;
3526 break;
3527 case VK_CONTROL:
3528 case VK_SHIFT:
3529 case VK_PROCESSKEY: /* Generated by IME. */
3530 windows_translate = 1;
3531 break;
3532 case VK_CANCEL:
3533 /* Windows maps Ctrl-Pause (aka Ctrl-Break) into VK_CANCEL,
3534 which is confusing for purposes of key binding; convert
3535 VK_CANCEL events into VK_PAUSE events. */
3536 wParam = VK_PAUSE;
3537 break;
3538 case VK_PAUSE:
3539 /* Windows maps Ctrl-NumLock into VK_PAUSE, which is confusing
3540 for purposes of key binding; convert these back into
3541 VK_NUMLOCK events, at least when we want to see NumLock key
3542 presses. (Note that there is never any possibility that
3543 VK_PAUSE with Ctrl really is C-Pause as per above.) */
3544 if (NILP (Vw32_enable_num_lock) && modifier_set (VK_CONTROL))
3545 wParam = VK_NUMLOCK;
3546 break;
3547 default:
3548 if (w32_unicode_gui && !w32_use_fallback_wm_chars_method)
3550 /* If this event generates characters or deadkeys, do
3551 not interpret it as a "raw combination of modifiers
3552 and keysym". Hide deadkeys, and use the generated
3553 character(s) instead of the keysym. (Backward
3554 compatibility: exceptions for numpad keys generating
3555 0-9 . , / * - +, and for extra-Alt combined with a
3556 non-Latin char.)
3558 Try to not report modifiers which have effect on
3559 which character or deadkey is generated.
3561 Example (contrived): if rightAlt-? generates f (on a
3562 Cyrillic keyboard layout), and Ctrl, leftAlt do not
3563 affect the generated character, one wants to report
3564 Ctrl-leftAlt-f if the user presses
3565 Ctrl-leftAlt-rightAlt-?. */
3566 int res;
3567 #if 0
3568 /* Some of WM_CHAR may be fed to us directly, some are
3569 results of TranslateMessage(). Using 0 as the first
3570 argument (in a separate call) might help us
3571 distinguish these two cases.
3573 However, the keypress feeders would most probably
3574 expect the "standard" message pump, when
3575 TranslateMessage() is called on EVERY KeyDown/KeyUp
3576 event. So they may feed us Down-Ctrl Down-FAKE
3577 Char-o and expect us to recognize it as Ctrl-o.
3578 Using 0 as the first argument would interfere with
3579 this. */
3580 deliver_wm_chars (0, hwnd, msg, wParam, lParam, 1);
3581 #endif
3582 /* Processing the generated WM_CHAR messages *WHILE* we
3583 handle KEYDOWN/UP event is the best choice, since
3584 without any fuss, we know all 3 of: scancode, virtual
3585 keycode, and expansion. (Additionally, one knows
3586 boundaries of expansion of different keypresses.) */
3587 res = deliver_wm_chars (1, hwnd, msg, wParam, lParam, 1);
3588 windows_translate = -(res != 0);
3589 if (res > 0) /* Bound to character(s) or a deadkey */
3590 break;
3591 /* deliver_wm_chars may make some branches after this vestigal. */
3593 wParam = map_keypad_keys (wParam, (lParam & 0x1000000L) != 0);
3594 /* If not defined as a function key, change it to a WM_CHAR message. */
3595 if (wParam > 255 || !lispy_function_keys[wParam])
3597 DWORD modifiers = construct_console_modifiers ();
3599 if (!NILP (Vw32_recognize_altgr)
3600 && modifier_set (VK_LCONTROL) && modifier_set (VK_RMENU))
3602 /* Always let TranslateMessage handle AltGr key chords;
3603 for some reason, ToAscii doesn't always process AltGr
3604 chords correctly. */
3605 windows_translate = 1;
3607 else if ((modifiers & (~SHIFT_PRESSED & ~CAPSLOCK_ON)) != 0)
3609 /* Handle key chords including any modifiers other
3610 than shift directly, in order to preserve as much
3611 modifier information as possible. */
3612 if ('A' <= wParam && wParam <= 'Z')
3614 /* Don't translate modified alphabetic keystrokes,
3615 so the user doesn't need to constantly switch
3616 layout to type control or meta keystrokes when
3617 the normal layout translates alphabetic
3618 characters to non-ascii characters. */
3619 if (!modifier_set (VK_SHIFT))
3620 wParam += ('a' - 'A');
3621 msg = WM_CHAR;
3623 else
3625 /* Try to handle other keystrokes by determining the
3626 base character (ie. translating the base key plus
3627 shift modifier). */
3628 int add;
3629 KEY_EVENT_RECORD key;
3631 key.bKeyDown = TRUE;
3632 key.wRepeatCount = 1;
3633 key.wVirtualKeyCode = wParam;
3634 key.wVirtualScanCode = (lParam & 0xFF0000) >> 16;
3635 key.uChar.AsciiChar = 0;
3636 key.dwControlKeyState = modifiers;
3638 add = w32_kbd_patch_key (&key, w32_keyboard_codepage);
3639 /* 0 means an unrecognized keycode, negative means
3640 dead key. Ignore both. */
3641 while (--add >= 0)
3643 /* Forward asciified character sequence. */
3644 post_character_message
3645 (hwnd, WM_CHAR,
3646 (unsigned char) key.uChar.AsciiChar, lParam,
3647 w32_get_key_modifiers (wParam, lParam));
3648 w32_kbd_patch_key (&key, w32_keyboard_codepage);
3650 return 0;
3653 else
3655 /* Let TranslateMessage handle everything else. */
3656 windows_translate = 1;
3661 if (windows_translate == -1)
3662 break;
3663 translate:
3664 if (windows_translate)
3666 MSG windows_msg = { hwnd, msg, wParam, lParam, 0, {0,0} };
3667 windows_msg.time = GetMessageTime ();
3668 TranslateMessage (&windows_msg);
3669 goto dflt;
3672 /* Fall through */
3674 case WM_SYSCHAR:
3675 case WM_CHAR:
3676 if (wParam > 255 )
3678 W32Msg wmsg;
3680 wmsg.dwModifiers = w32_get_key_modifiers (wParam, lParam);
3681 signal_user_input ();
3682 my_post_msg (&wmsg, hwnd, WM_UNICHAR, wParam, lParam);
3685 else
3686 post_character_message (hwnd, msg, wParam, lParam,
3687 w32_get_key_modifiers (wParam, lParam));
3688 break;
3690 case WM_UNICHAR:
3691 /* WM_UNICHAR looks promising from the docs, but the exact
3692 circumstances in which TranslateMessage sends it is one of those
3693 Microsoft secret API things that EU and US courts are supposed
3694 to have put a stop to already. Spy++ shows it being sent to Notepad
3695 and other MS apps, but never to Emacs.
3697 Some third party IMEs send it in accordance with the official
3698 documentation though, so handle it here.
3700 UNICODE_NOCHAR is used to test for support for this message.
3701 TRUE indicates that the message is supported. */
3702 if (wParam == UNICODE_NOCHAR)
3703 return TRUE;
3706 W32Msg wmsg;
3707 wmsg.dwModifiers = w32_get_key_modifiers (wParam, lParam);
3708 signal_user_input ();
3709 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3711 break;
3713 case WM_IME_CHAR:
3714 /* If we can't get the IME result as Unicode, use default processing,
3715 which will at least allow characters decodable in the system locale
3716 get through. */
3717 if (!get_composition_string_fn)
3718 goto dflt;
3720 else if (!ignore_ime_char)
3722 wchar_t * buffer;
3723 int size, i;
3724 W32Msg wmsg;
3725 HIMC context = get_ime_context_fn (hwnd);
3726 wmsg.dwModifiers = w32_get_key_modifiers (wParam, lParam);
3727 /* Get buffer size. */
3728 size = get_composition_string_fn (context, GCS_RESULTSTR, NULL, 0);
3729 buffer = alloca (size);
3730 size = get_composition_string_fn (context, GCS_RESULTSTR,
3731 buffer, size);
3732 release_ime_context_fn (hwnd, context);
3734 signal_user_input ();
3735 for (i = 0; i < size / sizeof (wchar_t); i++)
3737 my_post_msg (&wmsg, hwnd, WM_UNICHAR, (WPARAM) buffer[i],
3738 lParam);
3740 /* Ignore the messages for the rest of the
3741 characters in the string that was output above. */
3742 ignore_ime_char = (size / sizeof (wchar_t)) - 1;
3744 else
3745 ignore_ime_char--;
3747 break;
3749 case WM_IME_STARTCOMPOSITION:
3750 if (!set_ime_composition_window_fn)
3751 goto dflt;
3752 else
3754 COMPOSITIONFORM form;
3755 HIMC context;
3756 struct window *w;
3758 /* Implementation note: The code below does something that
3759 one shouldn't do: it accesses the window object from a
3760 separate thread, while the main (a.k.a. "Lisp") thread
3761 runs and can legitimately delete and even GC it. That is
3762 why we are extra careful not to futz with a window that
3763 is different from the one recorded when the system caret
3764 coordinates were last modified. That is also why we are
3765 careful not to move the IME window if the window
3766 described by W was deleted, as indicated by its buffer
3767 field being reset to nil. */
3768 f = x_window_to_frame (dpyinfo, hwnd);
3769 if (!(f && FRAME_LIVE_P (f)))
3770 goto dflt;
3771 w = XWINDOW (FRAME_SELECTED_WINDOW (f));
3772 /* Punt if someone changed the frame's selected window
3773 behind our back. */
3774 if (w != w32_system_caret_window)
3775 goto dflt;
3777 form.dwStyle = CFS_RECT;
3778 form.ptCurrentPos.x = w32_system_caret_x;
3779 form.ptCurrentPos.y = w32_system_caret_y;
3781 form.rcArea.left = WINDOW_TEXT_TO_FRAME_PIXEL_X (w, 0);
3782 form.rcArea.top = (WINDOW_TOP_EDGE_Y (w)
3783 + w32_system_caret_hdr_height);
3784 form.rcArea.right = (WINDOW_BOX_RIGHT_EDGE_X (w)
3785 - WINDOW_RIGHT_MARGIN_WIDTH (w)
3786 - WINDOW_RIGHT_FRINGE_WIDTH (w));
3787 form.rcArea.bottom = (WINDOW_BOTTOM_EDGE_Y (w)
3788 - WINDOW_BOTTOM_DIVIDER_WIDTH (w)
3789 - w32_system_caret_mode_height);
3791 /* Punt if the window was deleted behind our back. */
3792 if (!BUFFERP (w->contents))
3793 goto dflt;
3795 context = get_ime_context_fn (hwnd);
3797 if (!context)
3798 goto dflt;
3800 set_ime_composition_window_fn (context, &form);
3801 release_ime_context_fn (hwnd, context);
3803 /* We should "goto dflt" here to pass WM_IME_STARTCOMPOSITION to
3804 DefWindowProc, so that the composition window will actually
3805 be displayed. But doing so causes trouble with displaying
3806 dialog boxes, such as the file selection dialog or font
3807 selection dialog. So something else is needed to fix the
3808 former without breaking the latter. See bug#11732. */
3809 break;
3811 case WM_IME_ENDCOMPOSITION:
3812 ignore_ime_char = 0;
3813 goto dflt;
3815 /* Simulate middle mouse button events when left and right buttons
3816 are used together, but only if user has two button mouse. */
3817 case WM_LBUTTONDOWN:
3818 case WM_RBUTTONDOWN:
3819 if (w32_num_mouse_buttons > 2)
3820 goto handle_plain_button;
3823 int this = (msg == WM_LBUTTONDOWN) ? LMOUSE : RMOUSE;
3824 int other = (msg == WM_LBUTTONDOWN) ? RMOUSE : LMOUSE;
3826 if (button_state & this)
3827 return 0;
3829 if (button_state == 0)
3830 SetCapture (hwnd);
3832 button_state |= this;
3834 if (button_state & other)
3836 if (mouse_button_timer)
3838 KillTimer (hwnd, mouse_button_timer);
3839 mouse_button_timer = 0;
3841 /* Generate middle mouse event instead. */
3842 msg = WM_MBUTTONDOWN;
3843 button_state |= MMOUSE;
3845 else if (button_state & MMOUSE)
3847 /* Ignore button event if we've already generated a
3848 middle mouse down event. This happens if the
3849 user releases and press one of the two buttons
3850 after we've faked a middle mouse event. */
3851 return 0;
3853 else
3855 /* Flush out saved message. */
3856 post_msg (&saved_mouse_button_msg);
3858 wmsg.dwModifiers = w32_get_modifiers ();
3859 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3860 signal_user_input ();
3862 /* Clear message buffer. */
3863 saved_mouse_button_msg.msg.hwnd = 0;
3865 else
3867 /* Hold onto message for now. */
3868 mouse_button_timer =
3869 SetTimer (hwnd, MOUSE_BUTTON_ID,
3870 w32_mouse_button_tolerance, NULL);
3871 saved_mouse_button_msg.msg.hwnd = hwnd;
3872 saved_mouse_button_msg.msg.message = msg;
3873 saved_mouse_button_msg.msg.wParam = wParam;
3874 saved_mouse_button_msg.msg.lParam = lParam;
3875 saved_mouse_button_msg.msg.time = GetMessageTime ();
3876 saved_mouse_button_msg.dwModifiers = w32_get_modifiers ();
3879 return 0;
3881 case WM_LBUTTONUP:
3882 case WM_RBUTTONUP:
3883 if (w32_num_mouse_buttons > 2)
3884 goto handle_plain_button;
3887 int this = (msg == WM_LBUTTONUP) ? LMOUSE : RMOUSE;
3888 int other = (msg == WM_LBUTTONUP) ? RMOUSE : LMOUSE;
3890 if ((button_state & this) == 0)
3891 return 0;
3893 button_state &= ~this;
3895 if (button_state & MMOUSE)
3897 /* Only generate event when second button is released. */
3898 if ((button_state & other) == 0)
3900 msg = WM_MBUTTONUP;
3901 button_state &= ~MMOUSE;
3903 if (button_state) emacs_abort ();
3905 else
3906 return 0;
3908 else
3910 /* Flush out saved message if necessary. */
3911 if (saved_mouse_button_msg.msg.hwnd)
3913 post_msg (&saved_mouse_button_msg);
3916 wmsg.dwModifiers = w32_get_modifiers ();
3917 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3918 signal_user_input ();
3920 /* Always clear message buffer and cancel timer. */
3921 saved_mouse_button_msg.msg.hwnd = 0;
3922 KillTimer (hwnd, mouse_button_timer);
3923 mouse_button_timer = 0;
3925 if (button_state == 0)
3926 ReleaseCapture ();
3928 return 0;
3930 case WM_XBUTTONDOWN:
3931 case WM_XBUTTONUP:
3932 if (w32_pass_extra_mouse_buttons_to_system)
3933 goto dflt;
3934 /* else fall through and process them. */
3935 case WM_MBUTTONDOWN:
3936 case WM_MBUTTONUP:
3937 handle_plain_button:
3939 BOOL up;
3940 int button;
3942 /* Ignore middle and extra buttons as long as the menu is active. */
3943 f = x_window_to_frame (dpyinfo, hwnd);
3944 if (f && f->output_data.w32->menubar_active)
3945 return 0;
3947 if (parse_button (msg, HIWORD (wParam), &button, &up))
3949 if (up) ReleaseCapture ();
3950 else SetCapture (hwnd);
3951 button = (button == 0) ? LMOUSE :
3952 ((button == 1) ? MMOUSE : RMOUSE);
3953 if (up)
3954 button_state &= ~button;
3955 else
3956 button_state |= button;
3960 wmsg.dwModifiers = w32_get_modifiers ();
3961 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3962 signal_user_input ();
3964 /* Need to return true for XBUTTON messages, false for others,
3965 to indicate that we processed the message. */
3966 return (msg == WM_XBUTTONDOWN || msg == WM_XBUTTONUP);
3968 case WM_MOUSEMOVE:
3969 f = x_window_to_frame (dpyinfo, hwnd);
3970 if (f)
3972 /* Ignore mouse movements as long as the menu is active.
3973 These movements are processed by the window manager
3974 anyway, and it's wrong to handle them as if they happened
3975 on the underlying frame. */
3976 if (f->output_data.w32->menubar_active)
3977 return 0;
3979 /* If the mouse moved, and the mouse pointer is invisible,
3980 make it visible again. We do this here so as to be able
3981 to show the mouse pointer even when the main
3982 (a.k.a. "Lisp") thread is busy doing something. */
3983 static int last_x, last_y;
3984 int x = GET_X_LPARAM (lParam);
3985 int y = GET_Y_LPARAM (lParam);
3987 if (f->pointer_invisible
3988 && (x != last_x || y != last_y))
3989 f->pointer_invisible = false;
3991 last_x = x;
3992 last_y = y;
3995 /* If the mouse has just moved into the frame, start tracking
3996 it, so we will be notified when it leaves the frame. Mouse
3997 tracking only works under W98 and NT4 and later. On earlier
3998 versions, there is no way of telling when the mouse leaves the
3999 frame, so we just have to put up with help-echo and mouse
4000 highlighting remaining while the frame is not active. */
4001 if (track_mouse_event_fn && !track_mouse_window
4002 /* If the menu bar is active, turning on tracking of mouse
4003 movement events might send these events to the tooltip
4004 frame, if the user happens to move the mouse pointer over
4005 the tooltip. But since we don't process events for
4006 tooltip frames, this causes Windows to present a
4007 hourglass cursor, which is ugly and unexpected. So don't
4008 enable tracking mouse events in this case; they will be
4009 restarted when the menu pops down. (Confusingly, the
4010 menubar_active member of f->output_data.w32, tested
4011 above, is only set when a menu was popped up _not_ from
4012 the frame's menu bar, but via x-popup-menu.) */
4013 && !menubar_in_use)
4015 TRACKMOUSEEVENT tme;
4016 tme.cbSize = sizeof (tme);
4017 tme.dwFlags = TME_LEAVE;
4018 tme.hwndTrack = hwnd;
4019 tme.dwHoverTime = HOVER_DEFAULT;
4021 track_mouse_event_fn (&tme);
4022 track_mouse_window = hwnd;
4024 case WM_HSCROLL:
4025 case WM_VSCROLL:
4026 if (w32_mouse_move_interval <= 0
4027 || (msg == WM_MOUSEMOVE && button_state == 0))
4029 wmsg.dwModifiers = w32_get_modifiers ();
4030 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4031 return 0;
4034 /* Hang onto mouse move and scroll messages for a bit, to avoid
4035 sending such events to Emacs faster than it can process them.
4036 If we get more events before the timer from the first message
4037 expires, we just replace the first message. */
4039 if (saved_mouse_move_msg.msg.hwnd == 0)
4040 mouse_move_timer =
4041 SetTimer (hwnd, MOUSE_MOVE_ID,
4042 w32_mouse_move_interval, NULL);
4044 /* Hold onto message for now. */
4045 saved_mouse_move_msg.msg.hwnd = hwnd;
4046 saved_mouse_move_msg.msg.message = msg;
4047 saved_mouse_move_msg.msg.wParam = wParam;
4048 saved_mouse_move_msg.msg.lParam = lParam;
4049 saved_mouse_move_msg.msg.time = GetMessageTime ();
4050 saved_mouse_move_msg.dwModifiers = w32_get_modifiers ();
4052 return 0;
4054 case WM_MOUSEWHEEL:
4055 case WM_DROPFILES:
4056 wmsg.dwModifiers = w32_get_modifiers ();
4057 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4058 signal_user_input ();
4059 return 0;
4061 case WM_APPCOMMAND:
4062 if (w32_pass_multimedia_buttons_to_system)
4063 goto dflt;
4064 /* Otherwise, pass to lisp, the same way we do with mousehwheel. */
4065 case WM_MOUSEHWHEEL:
4066 wmsg.dwModifiers = w32_get_modifiers ();
4067 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4068 signal_user_input ();
4069 /* Non-zero must be returned when WM_MOUSEHWHEEL messages are
4070 handled, to prevent the system trying to handle it by faking
4071 scroll bar events. */
4072 return 1;
4074 case WM_TIMER:
4075 /* Flush out saved messages if necessary. */
4076 if (wParam == mouse_button_timer)
4078 if (saved_mouse_button_msg.msg.hwnd)
4080 post_msg (&saved_mouse_button_msg);
4081 signal_user_input ();
4082 saved_mouse_button_msg.msg.hwnd = 0;
4084 KillTimer (hwnd, mouse_button_timer);
4085 mouse_button_timer = 0;
4087 else if (wParam == mouse_move_timer)
4089 if (saved_mouse_move_msg.msg.hwnd)
4091 post_msg (&saved_mouse_move_msg);
4092 saved_mouse_move_msg.msg.hwnd = 0;
4094 KillTimer (hwnd, mouse_move_timer);
4095 mouse_move_timer = 0;
4097 else if (wParam == menu_free_timer)
4099 KillTimer (hwnd, menu_free_timer);
4100 menu_free_timer = 0;
4101 f = x_window_to_frame (dpyinfo, hwnd);
4102 /* If a popup menu is active, don't wipe its strings. */
4103 if (menubar_in_use
4104 && current_popup_menu == NULL)
4106 /* Free memory used by owner-drawn and help-echo strings. */
4107 w32_free_menu_strings (hwnd);
4108 if (f)
4109 f->output_data.w32->menubar_active = 0;
4110 menubar_in_use = 0;
4113 return 0;
4115 case WM_NCACTIVATE:
4116 /* Windows doesn't send us focus messages when putting up and
4117 taking down a system popup dialog as for Ctrl-Alt-Del on Windows 95.
4118 The only indication we get that something happened is receiving
4119 this message afterwards. So this is a good time to reset our
4120 keyboard modifiers' state. */
4121 reset_modifiers ();
4122 goto dflt;
4124 case WM_INITMENU:
4125 button_state = 0;
4126 ReleaseCapture ();
4127 /* We must ensure menu bar is fully constructed and up to date
4128 before allowing user interaction with it. To achieve this
4129 we send this message to the lisp thread and wait for a
4130 reply (whose value is not actually needed) to indicate that
4131 the menu bar is now ready for use, so we can now return.
4133 To remain responsive in the meantime, we enter a nested message
4134 loop that can process all other messages.
4136 However, we skip all this if the message results from calling
4137 TrackPopupMenu - in fact, we must NOT attempt to send the lisp
4138 thread a message because it is blocked on us at this point. We
4139 set menubar_active before calling TrackPopupMenu to indicate
4140 this (there is no possibility of confusion with real menubar
4141 being active). */
4143 f = x_window_to_frame (dpyinfo, hwnd);
4144 if (f
4145 && (f->output_data.w32->menubar_active
4146 /* We can receive this message even in the absence of a
4147 menubar (ie. when the system menu is activated) - in this
4148 case we do NOT want to forward the message, otherwise it
4149 will cause the menubar to suddenly appear when the user
4150 had requested it to be turned off! */
4151 || f->output_data.w32->menubar_widget == NULL))
4152 return 0;
4155 deferred_msg msg_buf;
4157 /* Detect if message has already been deferred; in this case
4158 we cannot return any sensible value to ignore this. */
4159 if (find_deferred_msg (hwnd, msg) != NULL)
4160 emacs_abort ();
4162 menubar_in_use = 1;
4164 return send_deferred_msg (&msg_buf, hwnd, msg, wParam, lParam);
4167 case WM_EXITMENULOOP:
4168 f = x_window_to_frame (dpyinfo, hwnd);
4170 /* If a menu is still active, check again after a short delay,
4171 since Windows often (always?) sends the WM_EXITMENULOOP
4172 before the corresponding WM_COMMAND message.
4173 Don't do this if a popup menu is active, since it is only
4174 menubar menus that require cleaning up in this way.
4176 if (f && menubar_in_use && current_popup_menu == NULL)
4177 menu_free_timer = SetTimer (hwnd, MENU_FREE_ID, MENU_FREE_DELAY, NULL);
4179 /* If hourglass cursor should be displayed, display it now. */
4180 if (f && f->output_data.w32->hourglass_p)
4181 SetCursor (f->output_data.w32->hourglass_cursor);
4183 goto dflt;
4185 case WM_MENUSELECT:
4186 /* Direct handling of help_echo in menus. Should be safe now
4187 that we generate the help_echo by placing a help event in the
4188 keyboard buffer. */
4190 HMENU menu = (HMENU) lParam;
4191 UINT menu_item = (UINT) LOWORD (wParam);
4192 UINT flags = (UINT) HIWORD (wParam);
4194 w32_menu_display_help (hwnd, menu, menu_item, flags);
4196 return 0;
4198 case WM_MEASUREITEM:
4199 f = x_window_to_frame (dpyinfo, hwnd);
4200 if (f)
4202 MEASUREITEMSTRUCT * pMis = (MEASUREITEMSTRUCT *) lParam;
4204 if (pMis->CtlType == ODT_MENU)
4206 /* Work out dimensions for popup menu titles. */
4207 char * title = (char *) pMis->itemData;
4208 HDC hdc = GetDC (hwnd);
4209 HFONT menu_font = GetCurrentObject (hdc, OBJ_FONT);
4210 LOGFONT menu_logfont;
4211 HFONT old_font;
4212 SIZE size;
4214 GetObject (menu_font, sizeof (menu_logfont), &menu_logfont);
4215 menu_logfont.lfWeight = FW_BOLD;
4216 menu_font = CreateFontIndirect (&menu_logfont);
4217 old_font = SelectObject (hdc, menu_font);
4219 pMis->itemHeight = GetSystemMetrics (SM_CYMENUSIZE);
4220 if (title)
4222 if (unicode_append_menu)
4223 GetTextExtentPoint32W (hdc, (WCHAR *) title,
4224 wcslen ((WCHAR *) title),
4225 &size);
4226 else
4227 GetTextExtentPoint32 (hdc, title, strlen (title), &size);
4229 pMis->itemWidth = size.cx;
4230 if (pMis->itemHeight < size.cy)
4231 pMis->itemHeight = size.cy;
4233 else
4234 pMis->itemWidth = 0;
4236 SelectObject (hdc, old_font);
4237 DeleteObject (menu_font);
4238 ReleaseDC (hwnd, hdc);
4239 return TRUE;
4242 return 0;
4244 case WM_DRAWITEM:
4245 f = x_window_to_frame (dpyinfo, hwnd);
4246 if (f)
4248 DRAWITEMSTRUCT * pDis = (DRAWITEMSTRUCT *) lParam;
4250 if (pDis->CtlType == ODT_MENU)
4252 /* Draw popup menu title. */
4253 char * title = (char *) pDis->itemData;
4254 if (title)
4256 HDC hdc = pDis->hDC;
4257 HFONT menu_font = GetCurrentObject (hdc, OBJ_FONT);
4258 LOGFONT menu_logfont;
4259 HFONT old_font;
4261 GetObject (menu_font, sizeof (menu_logfont), &menu_logfont);
4262 menu_logfont.lfWeight = FW_BOLD;
4263 menu_font = CreateFontIndirect (&menu_logfont);
4264 old_font = SelectObject (hdc, menu_font);
4266 /* Always draw title as if not selected. */
4267 if (unicode_append_menu)
4268 ExtTextOutW (hdc,
4269 pDis->rcItem.left
4270 + GetSystemMetrics (SM_CXMENUCHECK),
4271 pDis->rcItem.top,
4272 ETO_OPAQUE, &pDis->rcItem,
4273 (WCHAR *) title,
4274 wcslen ((WCHAR *) title), NULL);
4275 else
4276 ExtTextOut (hdc,
4277 pDis->rcItem.left
4278 + GetSystemMetrics (SM_CXMENUCHECK),
4279 pDis->rcItem.top,
4280 ETO_OPAQUE, &pDis->rcItem,
4281 title, strlen (title), NULL);
4283 SelectObject (hdc, old_font);
4284 DeleteObject (menu_font);
4286 return TRUE;
4289 return 0;
4291 #if 0
4292 /* Still not right - can't distinguish between clicks in the
4293 client area of the frame from clicks forwarded from the scroll
4294 bars - may have to hook WM_NCHITTEST to remember the mouse
4295 position and then check if it is in the client area ourselves. */
4296 case WM_MOUSEACTIVATE:
4297 /* Discard the mouse click that activates a frame, allowing the
4298 user to click anywhere without changing point (or worse!).
4299 Don't eat mouse clicks on scrollbars though!! */
4300 if (LOWORD (lParam) == HTCLIENT )
4301 return MA_ACTIVATEANDEAT;
4302 goto dflt;
4303 #endif
4305 case WM_MOUSELEAVE:
4306 /* No longer tracking mouse. */
4307 track_mouse_window = NULL;
4309 case WM_ACTIVATEAPP:
4310 case WM_ACTIVATE:
4311 case WM_WINDOWPOSCHANGED:
4312 case WM_SHOWWINDOW:
4313 /* Inform lisp thread that a frame might have just been obscured
4314 or exposed, so should recheck visibility of all frames. */
4315 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4316 goto dflt;
4318 case WM_SETFOCUS:
4319 dpyinfo->faked_key = 0;
4320 reset_modifiers ();
4321 register_hot_keys (hwnd);
4322 goto command;
4323 case WM_KILLFOCUS:
4324 unregister_hot_keys (hwnd);
4325 button_state = 0;
4326 ReleaseCapture ();
4327 /* Relinquish the system caret. */
4328 if (w32_system_caret_hwnd)
4330 w32_visible_system_caret_hwnd = NULL;
4331 w32_system_caret_hwnd = NULL;
4332 DestroyCaret ();
4334 goto command;
4335 case WM_COMMAND:
4336 menubar_in_use = 0;
4337 f = x_window_to_frame (dpyinfo, hwnd);
4338 if (f && HIWORD (wParam) == 0)
4340 if (menu_free_timer)
4342 KillTimer (hwnd, menu_free_timer);
4343 menu_free_timer = 0;
4346 case WM_MOVE:
4347 case WM_SIZE:
4348 command:
4349 wmsg.dwModifiers = w32_get_modifiers ();
4350 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4351 goto dflt;
4353 case WM_DESTROY:
4354 CoUninitialize ();
4355 return 0;
4357 case WM_CLOSE:
4358 wmsg.dwModifiers = w32_get_modifiers ();
4359 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4360 return 0;
4362 case WM_WINDOWPOSCHANGING:
4363 /* Don't restrict the sizing of any kind of frames. If the window
4364 manager doesn't, there's no reason to do it ourselves. */
4365 return 0;
4367 case WM_GETMINMAXINFO:
4368 /* Hack to allow resizing the Emacs frame above the screen size.
4369 Note that Windows 9x limits coordinates to 16-bits. */
4370 ((LPMINMAXINFO) lParam)->ptMaxTrackSize.x = 32767;
4371 ((LPMINMAXINFO) lParam)->ptMaxTrackSize.y = 32767;
4372 return 0;
4374 case WM_SETCURSOR:
4375 if (LOWORD (lParam) == HTCLIENT)
4377 f = x_window_to_frame (dpyinfo, hwnd);
4378 if (f)
4380 if (f->output_data.w32->hourglass_p
4381 && !menubar_in_use && !current_popup_menu)
4382 SetCursor (f->output_data.w32->hourglass_cursor);
4383 else if (f->pointer_invisible)
4384 SetCursor (NULL);
4385 else
4386 SetCursor (f->output_data.w32->current_cursor);
4389 return 0;
4391 goto dflt;
4393 case WM_EMACS_SETCURSOR:
4395 Cursor cursor = (Cursor) wParam;
4396 f = x_window_to_frame (dpyinfo, hwnd);
4397 if (f && cursor)
4399 f->output_data.w32->current_cursor = cursor;
4400 /* Don't change the cursor while menu-bar menu is in use. */
4401 if (!f->output_data.w32->menubar_active
4402 && !f->output_data.w32->hourglass_p)
4404 if (f->pointer_invisible)
4405 SetCursor (NULL);
4406 else
4407 SetCursor (cursor);
4410 return 0;
4413 case WM_EMACS_SHOWCURSOR:
4415 ShowCursor ((BOOL) wParam);
4417 return 0;
4420 case WM_EMACS_CREATEVSCROLLBAR:
4421 return (LRESULT) w32_createvscrollbar ((struct frame *) wParam,
4422 (struct scroll_bar *) lParam);
4424 case WM_EMACS_CREATEHSCROLLBAR:
4425 return (LRESULT) w32_createhscrollbar ((struct frame *) wParam,
4426 (struct scroll_bar *) lParam);
4428 case WM_EMACS_SHOWWINDOW:
4429 return ShowWindow ((HWND) wParam, (WPARAM) lParam);
4431 case WM_EMACS_BRINGTOTOP:
4432 case WM_EMACS_SETFOREGROUND:
4434 HWND foreground_window;
4435 DWORD foreground_thread, retval;
4437 /* On NT 5.0, and apparently Windows 98, it is necessary to
4438 attach to the thread that currently has focus in order to
4439 pull the focus away from it. */
4440 foreground_window = GetForegroundWindow ();
4441 foreground_thread = GetWindowThreadProcessId (foreground_window, NULL);
4442 if (!foreground_window
4443 || foreground_thread == GetCurrentThreadId ()
4444 || !AttachThreadInput (GetCurrentThreadId (),
4445 foreground_thread, TRUE))
4446 foreground_thread = 0;
4448 retval = SetForegroundWindow ((HWND) wParam);
4449 if (msg == WM_EMACS_BRINGTOTOP)
4450 retval = BringWindowToTop ((HWND) wParam);
4452 /* Detach from the previous foreground thread. */
4453 if (foreground_thread)
4454 AttachThreadInput (GetCurrentThreadId (),
4455 foreground_thread, FALSE);
4457 return retval;
4460 case WM_EMACS_SETWINDOWPOS:
4462 WINDOWPOS * pos = (WINDOWPOS *) wParam;
4463 return SetWindowPos (hwnd, pos->hwndInsertAfter,
4464 pos->x, pos->y, pos->cx, pos->cy, pos->flags);
4467 case WM_EMACS_DESTROYWINDOW:
4468 DragAcceptFiles ((HWND) wParam, FALSE);
4469 return DestroyWindow ((HWND) wParam);
4471 case WM_EMACS_HIDE_CARET:
4472 return HideCaret (hwnd);
4474 case WM_EMACS_SHOW_CARET:
4475 return ShowCaret (hwnd);
4477 case WM_EMACS_DESTROY_CARET:
4478 w32_system_caret_hwnd = NULL;
4479 w32_visible_system_caret_hwnd = NULL;
4480 return DestroyCaret ();
4482 case WM_EMACS_TRACK_CARET:
4483 /* If there is currently no system caret, create one. */
4484 if (w32_system_caret_hwnd == NULL)
4486 /* Use the default caret width, and avoid changing it
4487 unnecessarily, as it confuses screen reader software. */
4488 w32_system_caret_hwnd = hwnd;
4489 CreateCaret (hwnd, NULL, 0,
4490 w32_system_caret_height);
4493 if (!SetCaretPos (w32_system_caret_x, w32_system_caret_y))
4494 return 0;
4495 /* Ensure visible caret gets turned on when requested. */
4496 else if (w32_use_visible_system_caret
4497 && w32_visible_system_caret_hwnd != hwnd)
4499 w32_visible_system_caret_hwnd = hwnd;
4500 return ShowCaret (hwnd);
4502 /* Ensure visible caret gets turned off when requested. */
4503 else if (!w32_use_visible_system_caret
4504 && w32_visible_system_caret_hwnd)
4506 w32_visible_system_caret_hwnd = NULL;
4507 return HideCaret (hwnd);
4509 else
4510 return 1;
4512 case WM_EMACS_TRACKPOPUPMENU:
4514 UINT flags;
4515 POINT *pos;
4516 int retval;
4517 pos = (POINT *)lParam;
4518 flags = TPM_CENTERALIGN;
4519 if (button_state & LMOUSE)
4520 flags |= TPM_LEFTBUTTON;
4521 else if (button_state & RMOUSE)
4522 flags |= TPM_RIGHTBUTTON;
4524 /* Remember we did a SetCapture on the initial mouse down event,
4525 so for safety, we make sure the capture is canceled now. */
4526 ReleaseCapture ();
4527 button_state = 0;
4529 /* Use menubar_active to indicate that WM_INITMENU is from
4530 TrackPopupMenu below, and should be ignored. */
4531 f = x_window_to_frame (dpyinfo, hwnd);
4532 if (f)
4533 f->output_data.w32->menubar_active = 1;
4535 if (TrackPopupMenu ((HMENU)wParam, flags, pos->x, pos->y,
4536 0, hwnd, NULL))
4538 MSG amsg;
4539 /* Eat any mouse messages during popupmenu */
4540 while (PeekMessage (&amsg, hwnd, WM_MOUSEFIRST, WM_MOUSELAST,
4541 PM_REMOVE));
4542 /* Get the menu selection, if any */
4543 if (PeekMessage (&amsg, hwnd, WM_COMMAND, WM_COMMAND, PM_REMOVE))
4545 retval = LOWORD (amsg.wParam);
4547 else
4549 retval = 0;
4552 else
4554 retval = -1;
4557 return retval;
4559 case WM_EMACS_FILENOTIFY:
4560 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4561 return 1;
4563 default:
4564 /* Check for messages registered at runtime. */
4565 if (msg == msh_mousewheel)
4567 wmsg.dwModifiers = w32_get_modifiers ();
4568 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4569 signal_user_input ();
4570 return 0;
4573 dflt:
4574 return (w32_unicode_gui ? DefWindowProcW : DefWindowProcA) (hwnd, msg, wParam, lParam);
4577 /* The most common default return code for handled messages is 0. */
4578 return 0;
4581 static void
4582 my_create_window (struct frame * f)
4584 MSG msg;
4585 static int coords[2];
4586 Lisp_Object left, top;
4587 struct w32_display_info *dpyinfo = &one_w32_display_info;
4589 /* When called with RES_TYPE_NUMBER, x_get_arg will return zero for
4590 anything that is not a number and is not Qunbound. */
4591 left = x_get_arg (dpyinfo, Qnil, Qleft, "left", "Left", RES_TYPE_NUMBER);
4592 top = x_get_arg (dpyinfo, Qnil, Qtop, "top", "Top", RES_TYPE_NUMBER);
4593 if (EQ (left, Qunbound))
4594 coords[0] = CW_USEDEFAULT;
4595 else
4596 coords[0] = XINT (left);
4597 if (EQ (top, Qunbound))
4598 coords[1] = CW_USEDEFAULT;
4599 else
4600 coords[1] = XINT (top);
4602 if (!PostThreadMessage (dwWindowsThreadId, WM_EMACS_CREATEWINDOW,
4603 (WPARAM)f, (LPARAM)coords))
4604 emacs_abort ();
4605 GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE);
4609 /* Create a tooltip window. Unlike my_create_window, we do not do this
4610 indirectly via the Window thread, as we do not need to process Window
4611 messages for the tooltip. Creating tooltips indirectly also creates
4612 deadlocks when tooltips are created for menu items. */
4613 static void
4614 my_create_tip_window (struct frame *f)
4616 RECT rect;
4618 rect.left = rect.top = 0;
4619 rect.right = FRAME_PIXEL_WIDTH (f);
4620 rect.bottom = FRAME_PIXEL_HEIGHT (f);
4622 AdjustWindowRect (&rect, f->output_data.w32->dwStyle,
4623 FRAME_EXTERNAL_MENU_BAR (f));
4625 tip_window = FRAME_W32_WINDOW (f)
4626 = CreateWindow (EMACS_CLASS,
4627 f->namebuf,
4628 f->output_data.w32->dwStyle,
4629 f->left_pos,
4630 f->top_pos,
4631 rect.right - rect.left,
4632 rect.bottom - rect.top,
4633 FRAME_W32_WINDOW (SELECTED_FRAME ()), /* owner */
4634 NULL,
4635 hinst,
4636 NULL);
4638 if (tip_window)
4640 SetWindowLong (tip_window, WND_FONTWIDTH_INDEX, FRAME_COLUMN_WIDTH (f));
4641 SetWindowLong (tip_window, WND_LINEHEIGHT_INDEX, FRAME_LINE_HEIGHT (f));
4642 SetWindowLong (tip_window, WND_BORDER_INDEX, FRAME_INTERNAL_BORDER_WIDTH (f));
4643 SetWindowLong (tip_window, WND_BACKGROUND_INDEX, FRAME_BACKGROUND_PIXEL (f));
4645 /* Tip frames have no scrollbars. */
4646 SetWindowLong (tip_window, WND_VSCROLLBAR_INDEX, 0);
4647 SetWindowLong (tip_window, WND_HSCROLLBAR_INDEX, 0);
4649 /* Do this to discard the default setting specified by our parent. */
4650 ShowWindow (tip_window, SW_HIDE);
4655 /* Create and set up the w32 window for frame F. */
4657 static void
4658 w32_window (struct frame *f, long window_prompting, bool minibuffer_only)
4660 block_input ();
4662 /* Use the resource name as the top-level window name
4663 for looking up resources. Make a non-Lisp copy
4664 for the window manager, so GC relocation won't bother it.
4666 Elsewhere we specify the window name for the window manager. */
4667 f->namebuf = xlispstrdup (Vx_resource_name);
4669 my_create_window (f);
4671 validate_x_resource_name ();
4673 /* x_set_name normally ignores requests to set the name if the
4674 requested name is the same as the current name. This is the one
4675 place where that assumption isn't correct; f->name is set, but
4676 the server hasn't been told. */
4678 Lisp_Object name;
4679 int explicit = f->explicit_name;
4681 f->explicit_name = 0;
4682 name = f->name;
4683 fset_name (f, Qnil);
4684 x_set_name (f, name, explicit);
4687 unblock_input ();
4689 if (!minibuffer_only && FRAME_EXTERNAL_MENU_BAR (f))
4690 initialize_frame_menubar (f);
4692 if (FRAME_W32_WINDOW (f) == 0)
4693 error ("Unable to create window");
4696 /* Handle the icon stuff for this window. Perhaps later we might
4697 want an x_set_icon_position which can be called interactively as
4698 well. */
4700 static void
4701 x_icon (struct frame *f, Lisp_Object parms)
4703 Lisp_Object icon_x, icon_y;
4704 struct w32_display_info *dpyinfo = &one_w32_display_info;
4706 /* Set the position of the icon. Note that Windows 95 groups all
4707 icons in the tray. */
4708 icon_x = x_get_arg (dpyinfo, parms, Qicon_left, 0, 0, RES_TYPE_NUMBER);
4709 icon_y = x_get_arg (dpyinfo, parms, Qicon_top, 0, 0, RES_TYPE_NUMBER);
4710 if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
4712 CHECK_NUMBER (icon_x);
4713 CHECK_NUMBER (icon_y);
4715 else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
4716 error ("Both left and top icon corners of icon must be specified");
4718 block_input ();
4720 #if 0 /* TODO */
4721 /* Start up iconic or window? */
4722 x_wm_set_window_state
4723 (f, (EQ (x_get_arg (dpyinfo, parms, Qvisibility, 0, 0, RES_TYPE_SYMBOL), Qicon)
4724 ? IconicState
4725 : NormalState));
4727 x_text_icon (f, SSDATA ((!NILP (f->icon_name)
4728 ? f->icon_name
4729 : f->name)));
4730 #endif
4732 unblock_input ();
4736 static void
4737 x_make_gc (struct frame *f)
4739 XGCValues gc_values;
4741 block_input ();
4743 /* Create the GC's of this frame.
4744 Note that many default values are used. */
4746 /* Normal video */
4747 gc_values.font = FRAME_FONT (f);
4749 /* Cursor has cursor-color background, background-color foreground. */
4750 gc_values.foreground = FRAME_BACKGROUND_PIXEL (f);
4751 gc_values.background = f->output_data.w32->cursor_pixel;
4752 f->output_data.w32->cursor_gc
4753 = XCreateGC (NULL, FRAME_W32_WINDOW (f),
4754 (GCFont | GCForeground | GCBackground),
4755 &gc_values);
4757 /* Reliefs. */
4758 f->output_data.w32->white_relief.gc = 0;
4759 f->output_data.w32->black_relief.gc = 0;
4761 unblock_input ();
4765 /* Handler for signals raised during x_create_frame and
4766 x_create_tip_frame. FRAME is the frame which is partially
4767 constructed. */
4769 static Lisp_Object
4770 unwind_create_frame (Lisp_Object frame)
4772 struct frame *f = XFRAME (frame);
4774 /* If frame is ``official'', nothing to do. */
4775 if (NILP (Fmemq (frame, Vframe_list)))
4777 #ifdef GLYPH_DEBUG
4778 struct w32_display_info *dpyinfo = FRAME_DISPLAY_INFO (f);
4780 /* If the frame's image cache refcount is still the same as our
4781 private shadow variable, it means we are unwinding a frame
4782 for which we didn't yet call init_frame_faces, where the
4783 refcount is incremented. Therefore, we increment it here, so
4784 that free_frame_faces, called in x_free_frame_resources
4785 below, will not mistakenly decrement the counter that was not
4786 incremented yet to account for this new frame. */
4787 if (FRAME_IMAGE_CACHE (f) != NULL
4788 && FRAME_IMAGE_CACHE (f)->refcount == image_cache_refcount)
4789 FRAME_IMAGE_CACHE (f)->refcount++;
4790 #endif
4792 x_free_frame_resources (f);
4793 free_glyphs (f);
4795 #ifdef GLYPH_DEBUG
4796 /* Check that reference counts are indeed correct. */
4797 eassert (dpyinfo->reference_count == dpyinfo_refcount);
4798 eassert ((dpyinfo->terminal->image_cache == NULL
4799 && image_cache_refcount == 0)
4800 || (dpyinfo->terminal->image_cache != NULL
4801 && dpyinfo->terminal->image_cache->refcount == image_cache_refcount));
4802 #endif
4803 return Qt;
4806 return Qnil;
4809 static void
4810 do_unwind_create_frame (Lisp_Object frame)
4812 unwind_create_frame (frame);
4815 static void
4816 x_default_font_parameter (struct frame *f, Lisp_Object parms)
4818 struct w32_display_info *dpyinfo = FRAME_DISPLAY_INFO (f);
4819 Lisp_Object font_param = x_get_arg (dpyinfo, parms, Qfont, NULL, NULL,
4820 RES_TYPE_STRING);
4821 Lisp_Object font;
4822 if (EQ (font_param, Qunbound))
4823 font_param = Qnil;
4824 font = !NILP (font_param) ? font_param
4825 : x_get_arg (dpyinfo, parms, Qfont, "font", "Font", RES_TYPE_STRING);
4827 if (!STRINGP (font))
4829 int i;
4830 static char *names[]
4831 = { "Courier New-10",
4832 "-*-Courier-normal-r-*-*-13-*-*-*-c-*-iso8859-1",
4833 "-*-Fixedsys-normal-r-*-*-12-*-*-*-c-*-iso8859-1",
4834 "Fixedsys",
4835 NULL };
4837 for (i = 0; names[i]; i++)
4839 font = font_open_by_name (f, build_unibyte_string (names[i]));
4840 if (! NILP (font))
4841 break;
4843 if (NILP (font))
4844 error ("No suitable font was found");
4846 else if (!NILP (font_param))
4848 /* Remember the explicit font parameter, so we can re-apply it after
4849 we've applied the `default' face settings. */
4850 x_set_frame_parameters (f, Fcons (Fcons (Qfont_param, font_param), Qnil));
4852 x_default_parameter (f, parms, Qfont, font, "font", "Font", RES_TYPE_STRING);
4855 DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
4856 1, 1, 0,
4857 doc: /* Make a new window, which is called a \"frame\" in Emacs terms.
4858 Return an Emacs frame object.
4859 PARAMETERS is an alist of frame parameters.
4860 If the parameters specify that the frame should not have a minibuffer,
4861 and do not specify a specific minibuffer window to use,
4862 then `default-minibuffer-frame' must be a frame whose minibuffer can
4863 be shared by the new frame.
4865 This function is an internal primitive--use `make-frame' instead. */)
4866 (Lisp_Object parameters)
4868 struct frame *f;
4869 Lisp_Object frame, tem;
4870 Lisp_Object name;
4871 bool minibuffer_only = false;
4872 long window_prompting = 0;
4873 ptrdiff_t count = SPECPDL_INDEX ();
4874 Lisp_Object display;
4875 struct w32_display_info *dpyinfo = NULL;
4876 Lisp_Object parent;
4877 struct kboard *kb;
4878 int x_width = 0, x_height = 0;
4880 if (!FRAME_W32_P (SELECTED_FRAME ())
4881 && !FRAME_INITIAL_P (SELECTED_FRAME ()))
4882 error ("Cannot create a GUI frame in a -nw session");
4884 /* Make copy of frame parameters because the original is in pure
4885 storage now. */
4886 parameters = Fcopy_alist (parameters);
4888 /* Use this general default value to start with
4889 until we know if this frame has a specified name. */
4890 Vx_resource_name = Vinvocation_name;
4892 display = x_get_arg (dpyinfo, parameters, Qterminal, 0, 0, RES_TYPE_NUMBER);
4893 if (EQ (display, Qunbound))
4894 display = x_get_arg (dpyinfo, parameters, Qdisplay, 0, 0, RES_TYPE_STRING);
4895 if (EQ (display, Qunbound))
4896 display = Qnil;
4897 dpyinfo = check_x_display_info (display);
4898 kb = dpyinfo->terminal->kboard;
4900 if (!dpyinfo->terminal->name)
4901 error ("Terminal is not live, can't create new frames on it");
4903 name = x_get_arg (dpyinfo, parameters, Qname, "name", "Name", RES_TYPE_STRING);
4904 if (!STRINGP (name)
4905 && ! EQ (name, Qunbound)
4906 && ! NILP (name))
4907 error ("Invalid frame name--not a string or nil");
4909 if (STRINGP (name))
4910 Vx_resource_name = name;
4912 /* See if parent window is specified. */
4913 parent = x_get_arg (dpyinfo, parameters, Qparent_id, NULL, NULL, RES_TYPE_NUMBER);
4914 if (EQ (parent, Qunbound))
4915 parent = Qnil;
4916 if (! NILP (parent))
4917 CHECK_NUMBER (parent);
4919 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
4920 /* No need to protect DISPLAY because that's not used after passing
4921 it to make_frame_without_minibuffer. */
4922 frame = Qnil;
4923 tem = x_get_arg (dpyinfo, parameters, Qminibuffer, "minibuffer", "Minibuffer",
4924 RES_TYPE_SYMBOL);
4925 if (EQ (tem, Qnone) || NILP (tem))
4926 f = make_frame_without_minibuffer (Qnil, kb, display);
4927 else if (EQ (tem, Qonly))
4929 f = make_minibuffer_frame ();
4930 minibuffer_only = true;
4932 else if (WINDOWP (tem))
4933 f = make_frame_without_minibuffer (tem, kb, display);
4934 else
4935 f = make_frame (true);
4937 XSETFRAME (frame, f);
4939 /* By default, make scrollbars the system standard width and height. */
4940 FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = GetSystemMetrics (SM_CXVSCROLL);
4941 FRAME_CONFIG_SCROLL_BAR_HEIGHT (f) = GetSystemMetrics (SM_CXHSCROLL);
4943 f->terminal = dpyinfo->terminal;
4945 f->output_method = output_w32;
4946 f->output_data.w32 = xzalloc (sizeof (struct w32_output));
4947 FRAME_FONTSET (f) = -1;
4949 fset_icon_name
4950 (f, x_get_arg (dpyinfo, parameters, Qicon_name, "iconName", "Title",
4951 RES_TYPE_STRING));
4952 if (! STRINGP (f->icon_name))
4953 fset_icon_name (f, Qnil);
4955 /* FRAME_DISPLAY_INFO (f) = dpyinfo; */
4957 /* With FRAME_DISPLAY_INFO set up, this unwind-protect is safe. */
4958 record_unwind_protect (do_unwind_create_frame, frame);
4960 #ifdef GLYPH_DEBUG
4961 image_cache_refcount =
4962 FRAME_IMAGE_CACHE (f) ? FRAME_IMAGE_CACHE (f)->refcount : 0;
4963 dpyinfo_refcount = dpyinfo->reference_count;
4964 #endif /* GLYPH_DEBUG */
4966 /* Specify the parent under which to make this window. */
4967 if (!NILP (parent))
4969 /* Cast to UINT_PTR shuts up compiler warnings about cast to
4970 pointer from integer of different size. */
4971 f->output_data.w32->parent_desc = (Window) (UINT_PTR) XFASTINT (parent);
4972 f->output_data.w32->explicit_parent = true;
4974 else
4976 f->output_data.w32->parent_desc = FRAME_DISPLAY_INFO (f)->root_window;
4977 f->output_data.w32->explicit_parent = false;
4980 /* Set the name; the functions to which we pass f expect the name to
4981 be set. */
4982 if (EQ (name, Qunbound) || NILP (name))
4984 fset_name (f, build_string (dpyinfo->w32_id_name));
4985 f->explicit_name = false;
4987 else
4989 fset_name (f, name);
4990 f->explicit_name = true;
4991 /* Use the frame's title when getting resources for this frame. */
4992 specbind (Qx_resource_name, name);
4995 if (uniscribe_available)
4996 register_font_driver (&uniscribe_font_driver, f);
4997 register_font_driver (&w32font_driver, f);
4999 x_default_parameter (f, parameters, Qfont_backend, Qnil,
5000 "fontBackend", "FontBackend", RES_TYPE_STRING);
5002 /* Extract the window parameters from the supplied values
5003 that are needed to determine window geometry. */
5004 x_default_font_parameter (f, parameters);
5006 x_default_parameter (f, parameters, Qborder_width, make_number (2),
5007 "borderWidth", "BorderWidth", RES_TYPE_NUMBER);
5009 /* We recognize either internalBorderWidth or internalBorder
5010 (which is what xterm calls it). */
5011 if (NILP (Fassq (Qinternal_border_width, parameters)))
5013 Lisp_Object value;
5015 value = x_get_arg (dpyinfo, parameters, Qinternal_border_width,
5016 "internalBorder", "InternalBorder", RES_TYPE_NUMBER);
5017 if (! EQ (value, Qunbound))
5018 parameters = Fcons (Fcons (Qinternal_border_width, value),
5019 parameters);
5021 /* Default internalBorderWidth to 0 on Windows to match other programs. */
5022 x_default_parameter (f, parameters, Qinternal_border_width, make_number (0),
5023 "internalBorderWidth", "InternalBorder", RES_TYPE_NUMBER);
5024 x_default_parameter (f, parameters, Qright_divider_width, make_number (0),
5025 NULL, NULL, RES_TYPE_NUMBER);
5026 x_default_parameter (f, parameters, Qbottom_divider_width, make_number (0),
5027 NULL, NULL, RES_TYPE_NUMBER);
5028 x_default_parameter (f, parameters, Qvertical_scroll_bars, Qright,
5029 "verticalScrollBars", "ScrollBars", RES_TYPE_SYMBOL);
5030 x_default_parameter (f, parameters, Qhorizontal_scroll_bars, Qnil,
5031 "horizontalScrollBars", "ScrollBars", RES_TYPE_SYMBOL);
5033 /* Also do the stuff which must be set before the window exists. */
5034 x_default_parameter (f, parameters, Qforeground_color, build_string ("black"),
5035 "foreground", "Foreground", RES_TYPE_STRING);
5036 x_default_parameter (f, parameters, Qbackground_color, build_string ("white"),
5037 "background", "Background", RES_TYPE_STRING);
5038 x_default_parameter (f, parameters, Qmouse_color, build_string ("black"),
5039 "pointerColor", "Foreground", RES_TYPE_STRING);
5040 x_default_parameter (f, parameters, Qborder_color, build_string ("black"),
5041 "borderColor", "BorderColor", RES_TYPE_STRING);
5042 x_default_parameter (f, parameters, Qscreen_gamma, Qnil,
5043 "screenGamma", "ScreenGamma", RES_TYPE_FLOAT);
5044 x_default_parameter (f, parameters, Qline_spacing, Qnil,
5045 "lineSpacing", "LineSpacing", RES_TYPE_NUMBER);
5046 x_default_parameter (f, parameters, Qleft_fringe, Qnil,
5047 "leftFringe", "LeftFringe", RES_TYPE_NUMBER);
5048 x_default_parameter (f, parameters, Qright_fringe, Qnil,
5049 "rightFringe", "RightFringe", RES_TYPE_NUMBER);
5050 /* Process alpha here (Bug#16619). */
5051 x_default_parameter (f, parameters, Qalpha, Qnil,
5052 "alpha", "Alpha", RES_TYPE_NUMBER);
5054 /* Init faces first since we need the frame's column width/line
5055 height in various occasions. */
5056 init_frame_faces (f);
5058 /* The following call of change_frame_size is needed since otherwise
5059 x_set_tool_bar_lines will already work with the character sizes
5060 installed by init_frame_faces while the frame's pixel size is
5061 still calculated from a character size of 1 and we subsequently
5062 hit the (height >= 0) assertion in window_box_height.
5064 The non-pixelwise code apparently worked around this because it
5065 had one frame line vs one toolbar line which left us with a zero
5066 root window height which was obviously wrong as well ... */
5067 adjust_frame_size (f, FRAME_COLS (f) * FRAME_COLUMN_WIDTH (f),
5068 FRAME_LINES (f) * FRAME_LINE_HEIGHT (f), 5, true,
5069 Qx_create_frame_1);
5071 /* The X resources controlling the menu-bar and tool-bar are
5072 processed specially at startup, and reflected in the mode
5073 variables; ignore them here. */
5074 x_default_parameter (f, parameters, Qmenu_bar_lines,
5075 NILP (Vmenu_bar_mode)
5076 ? make_number (0) : make_number (1),
5077 NULL, NULL, RES_TYPE_NUMBER);
5078 x_default_parameter (f, parameters, Qtool_bar_lines,
5079 NILP (Vtool_bar_mode)
5080 ? make_number (0) : make_number (1),
5081 NULL, NULL, RES_TYPE_NUMBER);
5083 x_default_parameter (f, parameters, Qbuffer_predicate, Qnil,
5084 "bufferPredicate", "BufferPredicate", RES_TYPE_SYMBOL);
5085 x_default_parameter (f, parameters, Qtitle, Qnil,
5086 "title", "Title", RES_TYPE_STRING);
5088 f->output_data.w32->dwStyle = WS_OVERLAPPEDWINDOW;
5089 f->output_data.w32->parent_desc = FRAME_DISPLAY_INFO (f)->root_window;
5091 f->output_data.w32->text_cursor = w32_load_cursor (IDC_IBEAM);
5092 f->output_data.w32->nontext_cursor = w32_load_cursor (IDC_ARROW);
5093 f->output_data.w32->modeline_cursor = w32_load_cursor (IDC_ARROW);
5094 f->output_data.w32->hand_cursor = w32_load_cursor (IDC_HAND);
5095 f->output_data.w32->hourglass_cursor = w32_load_cursor (IDC_WAIT);
5096 f->output_data.w32->horizontal_drag_cursor = w32_load_cursor (IDC_SIZEWE);
5097 f->output_data.w32->vertical_drag_cursor = w32_load_cursor (IDC_SIZENS);
5099 f->output_data.w32->current_cursor = f->output_data.w32->nontext_cursor;
5101 window_prompting = x_figure_window_size (f, parameters, true, &x_width, &x_height);
5103 tem = x_get_arg (dpyinfo, parameters, Qunsplittable, 0, 0, RES_TYPE_BOOLEAN);
5104 f->no_split = minibuffer_only || EQ (tem, Qt);
5106 w32_window (f, window_prompting, minibuffer_only);
5107 x_icon (f, parameters);
5109 x_make_gc (f);
5111 /* Now consider the frame official. */
5112 f->terminal->reference_count++;
5113 FRAME_DISPLAY_INFO (f)->reference_count++;
5114 Vframe_list = Fcons (frame, Vframe_list);
5116 /* We need to do this after creating the window, so that the
5117 icon-creation functions can say whose icon they're describing. */
5118 x_default_parameter (f, parameters, Qicon_type, Qnil,
5119 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL);
5121 x_default_parameter (f, parameters, Qauto_raise, Qnil,
5122 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN);
5123 x_default_parameter (f, parameters, Qauto_lower, Qnil,
5124 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN);
5125 x_default_parameter (f, parameters, Qcursor_type, Qbox,
5126 "cursorType", "CursorType", RES_TYPE_SYMBOL);
5127 x_default_parameter (f, parameters, Qscroll_bar_width, Qnil,
5128 "scrollBarWidth", "ScrollBarWidth", RES_TYPE_NUMBER);
5129 x_default_parameter (f, parameters, Qscroll_bar_height, Qnil,
5130 "scrollBarHeight", "ScrollBarHeight", RES_TYPE_NUMBER);
5132 /* Allow x_set_window_size, now. */
5133 f->can_x_set_window_size = true;
5135 if (x_width > 0)
5136 SET_FRAME_WIDTH (f, x_width);
5137 if (x_height > 0)
5138 SET_FRAME_HEIGHT (f, x_height);
5140 /* Tell the server what size and position, etc, we want, and how
5141 badly we want them. This should be done after we have the menu
5142 bar so that its size can be taken into account. */
5143 block_input ();
5144 x_wm_set_size_hint (f, window_prompting, false);
5145 unblock_input ();
5147 adjust_frame_size (f, FRAME_TEXT_WIDTH (f), FRAME_TEXT_HEIGHT (f), 0, true,
5148 Qx_create_frame_2);
5150 /* Process fullscreen parameter here in the hope that normalizing a
5151 fullheight/fullwidth frame will produce the size set by the last
5152 adjust_frame_size call. */
5153 x_default_parameter (f, parameters, Qfullscreen, Qnil,
5154 "fullscreen", "Fullscreen", RES_TYPE_SYMBOL);
5156 /* Make the window appear on the frame and enable display, unless
5157 the caller says not to. However, with explicit parent, Emacs
5158 cannot control visibility, so don't try. */
5159 if (! f->output_data.w32->explicit_parent)
5161 Lisp_Object visibility;
5163 visibility = x_get_arg (dpyinfo, parameters, Qvisibility, 0, 0, RES_TYPE_SYMBOL);
5164 if (EQ (visibility, Qunbound))
5165 visibility = Qt;
5167 if (EQ (visibility, Qicon))
5168 x_iconify_frame (f);
5169 else if (! NILP (visibility))
5170 x_make_frame_visible (f);
5171 else
5172 /* Must have been Qnil. */
5176 /* Initialize `default-minibuffer-frame' in case this is the first
5177 frame on this terminal. */
5178 if (FRAME_HAS_MINIBUF_P (f)
5179 && (!FRAMEP (KVAR (kb, Vdefault_minibuffer_frame))
5180 || !FRAME_LIVE_P (XFRAME (KVAR (kb, Vdefault_minibuffer_frame)))))
5181 kset_default_minibuffer_frame (kb, frame);
5183 /* All remaining specified parameters, which have not been "used"
5184 by x_get_arg and friends, now go in the misc. alist of the frame. */
5185 for (tem = parameters; CONSP (tem); tem = XCDR (tem))
5186 if (CONSP (XCAR (tem)) && !NILP (XCAR (XCAR (tem))))
5187 fset_param_alist (f, Fcons (XCAR (tem), f->param_alist));
5189 /* Make sure windows on this frame appear in calls to next-window
5190 and similar functions. */
5191 Vwindow_list = Qnil;
5193 return unbind_to (count, frame);
5196 /* FRAME is used only to get a handle on the X display. We don't pass the
5197 display info directly because we're called from frame.c, which doesn't
5198 know about that structure. */
5199 Lisp_Object
5200 x_get_focus_frame (struct frame *frame)
5202 struct w32_display_info *dpyinfo = FRAME_DISPLAY_INFO (frame);
5203 Lisp_Object xfocus;
5204 if (! dpyinfo->w32_focus_frame)
5205 return Qnil;
5207 XSETFRAME (xfocus, dpyinfo->w32_focus_frame);
5208 return xfocus;
5211 DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1, 2, 0,
5212 doc: /* Internal function called by `color-defined-p', which see.
5213 (Note that the Nextstep version of this function ignores FRAME.) */)
5214 (Lisp_Object color, Lisp_Object frame)
5216 XColor foo;
5217 struct frame *f = decode_window_system_frame (frame);
5219 CHECK_STRING (color);
5221 if (w32_defined_color (f, SSDATA (color), &foo, false))
5222 return Qt;
5223 else
5224 return Qnil;
5227 DEFUN ("xw-color-values", Fxw_color_values, Sxw_color_values, 1, 2, 0,
5228 doc: /* Internal function called by `color-values', which see. */)
5229 (Lisp_Object color, Lisp_Object frame)
5231 XColor foo;
5232 struct frame *f = decode_window_system_frame (frame);
5234 CHECK_STRING (color);
5236 if (w32_defined_color (f, SSDATA (color), &foo, false))
5237 return list3i ((GetRValue (foo.pixel) << 8) | GetRValue (foo.pixel),
5238 (GetGValue (foo.pixel) << 8) | GetGValue (foo.pixel),
5239 (GetBValue (foo.pixel) << 8) | GetBValue (foo.pixel));
5240 else
5241 return Qnil;
5244 DEFUN ("xw-display-color-p", Fxw_display_color_p, Sxw_display_color_p, 0, 1, 0,
5245 doc: /* Internal function called by `display-color-p', which see. */)
5246 (Lisp_Object display)
5248 struct w32_display_info *dpyinfo = check_x_display_info (display);
5250 if ((dpyinfo->n_planes * dpyinfo->n_cbits) <= 2)
5251 return Qnil;
5253 return Qt;
5256 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p,
5257 Sx_display_grayscale_p, 0, 1, 0,
5258 doc: /* Return t if DISPLAY supports shades of gray.
5259 Note that color displays do support shades of gray.
5260 The optional argument DISPLAY specifies which display to ask about.
5261 DISPLAY should be either a frame or a display name (a string).
5262 If omitted or nil, that stands for the selected frame's display. */)
5263 (Lisp_Object display)
5265 struct w32_display_info *dpyinfo = check_x_display_info (display);
5267 if ((dpyinfo->n_planes * dpyinfo->n_cbits) <= 1)
5268 return Qnil;
5270 return Qt;
5273 DEFUN ("x-display-pixel-width", Fx_display_pixel_width,
5274 Sx_display_pixel_width, 0, 1, 0,
5275 doc: /* Return the width in pixels of DISPLAY.
5276 The optional argument DISPLAY specifies which display to ask about.
5277 DISPLAY should be either a frame or a display name (a string).
5278 If omitted or nil, that stands for the selected frame's display.
5280 On \"multi-monitor\" setups this refers to the pixel width for all
5281 physical monitors associated with DISPLAY. To get information for
5282 each physical monitor, use `display-monitor-attributes-list'. */)
5283 (Lisp_Object display)
5285 struct w32_display_info *dpyinfo = check_x_display_info (display);
5287 return make_number (x_display_pixel_width (dpyinfo));
5290 DEFUN ("x-display-pixel-height", Fx_display_pixel_height,
5291 Sx_display_pixel_height, 0, 1, 0,
5292 doc: /* Return the height in pixels of DISPLAY.
5293 The optional argument DISPLAY specifies which display to ask about.
5294 DISPLAY should be either a frame or a display name (a string).
5295 If omitted or nil, that stands for the selected frame's display.
5297 On \"multi-monitor\" setups this refers to the pixel height for all
5298 physical monitors associated with DISPLAY. To get information for
5299 each physical monitor, use `display-monitor-attributes-list'. */)
5300 (Lisp_Object display)
5302 struct w32_display_info *dpyinfo = check_x_display_info (display);
5304 return make_number (x_display_pixel_height (dpyinfo));
5307 DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes,
5308 0, 1, 0,
5309 doc: /* Return the number of bitplanes of DISPLAY.
5310 The optional argument DISPLAY specifies which display to ask about.
5311 DISPLAY should be either a frame or a display name (a string).
5312 If omitted or nil, that stands for the selected frame's display. */)
5313 (Lisp_Object display)
5315 struct w32_display_info *dpyinfo = check_x_display_info (display);
5317 return make_number (dpyinfo->n_planes * dpyinfo->n_cbits);
5320 DEFUN ("x-display-color-cells", Fx_display_color_cells, Sx_display_color_cells,
5321 0, 1, 0,
5322 doc: /* Return the number of color cells of DISPLAY.
5323 The optional argument DISPLAY specifies which display to ask about.
5324 DISPLAY should be either a frame or a display name (a string).
5325 If omitted or nil, that stands for the selected frame's display. */)
5326 (Lisp_Object display)
5328 struct w32_display_info *dpyinfo = check_x_display_info (display);
5329 int cap;
5331 /* Don't use NCOLORS: it returns incorrect results under remote
5332 * desktop. We force 24+ bit depths to 24-bit, both to prevent an
5333 * overflow and because probably is more meaningful on Windows
5334 * anyway. */
5336 cap = 1 << min (dpyinfo->n_planes * dpyinfo->n_cbits, 24);
5337 return make_number (cap);
5340 DEFUN ("x-server-max-request-size", Fx_server_max_request_size,
5341 Sx_server_max_request_size,
5342 0, 1, 0,
5343 doc: /* Return the maximum request size of the server of DISPLAY.
5344 The optional argument DISPLAY specifies which display to ask about.
5345 DISPLAY should be either a frame or a display name (a string).
5346 If omitted or nil, that stands for the selected frame's display. */)
5347 (Lisp_Object display)
5349 return make_number (1);
5352 DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0,
5353 doc: /* Return the "vendor ID" string of the GUI software on TERMINAL.
5355 (Labeling every distributor as a "vendor" embodies the false assumption
5356 that operating systems cannot be developed and distributed noncommercially.)
5358 For GNU and Unix systems, this queries the X server software; for
5359 MS-Windows, this queries the OS.
5361 The optional argument TERMINAL specifies which display to ask about.
5362 TERMINAL should be a terminal object, a frame or a display name (a string).
5363 If omitted or nil, that stands for the selected frame's display. */)
5364 (Lisp_Object terminal)
5366 return build_string ("Microsoft Corp.");
5369 DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0,
5370 doc: /* Return the version numbers of the GUI software on TERMINAL.
5371 The value is a list of three integers specifying the version of the GUI
5372 software in use.
5374 For GNU and Unix system, the first 2 numbers are the version of the X
5375 Protocol used on TERMINAL and the 3rd number is the distributor-specific
5376 release number. For MS-Windows, the 3 numbers report the version and
5377 the build number of the OS.
5379 See also the function `x-server-vendor'.
5381 The optional argument TERMINAL specifies which display to ask about.
5382 TERMINAL should be a terminal object, a frame or a display name (a string).
5383 If omitted or nil, that stands for the selected frame's display. */)
5384 (Lisp_Object terminal)
5386 return list3i (w32_major_version, w32_minor_version, w32_build_number);
5389 DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0,
5390 doc: /* Return the number of screens on the server of DISPLAY.
5391 The optional argument DISPLAY specifies which display to ask about.
5392 DISPLAY should be either a frame or a display name (a string).
5393 If omitted or nil, that stands for the selected frame's display. */)
5394 (Lisp_Object display)
5396 return make_number (1);
5399 DEFUN ("x-display-mm-height", Fx_display_mm_height,
5400 Sx_display_mm_height, 0, 1, 0,
5401 doc: /* Return the height in millimeters of DISPLAY.
5402 The optional argument DISPLAY specifies which display to ask about.
5403 DISPLAY should be either a frame or a display name (a string).
5404 If omitted or nil, that stands for the selected frame's display.
5406 On \"multi-monitor\" setups this refers to the height in millimeters for
5407 all physical monitors associated with DISPLAY. To get information
5408 for each physical monitor, use `display-monitor-attributes-list'. */)
5409 (Lisp_Object display)
5411 struct w32_display_info *dpyinfo = check_x_display_info (display);
5412 HDC hdc;
5413 double mm_per_pixel;
5415 hdc = GetDC (NULL);
5416 mm_per_pixel = ((double) GetDeviceCaps (hdc, VERTSIZE)
5417 / GetDeviceCaps (hdc, VERTRES));
5418 ReleaseDC (NULL, hdc);
5420 return make_number (x_display_pixel_height (dpyinfo) * mm_per_pixel + 0.5);
5423 DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0,
5424 doc: /* Return the width in millimeters of DISPLAY.
5425 The optional argument DISPLAY specifies which display to ask about.
5426 DISPLAY should be either a frame or a display name (a string).
5427 If omitted or nil, that stands for the selected frame's display.
5429 On \"multi-monitor\" setups this refers to the width in millimeters for
5430 all physical monitors associated with TERMINAL. To get information
5431 for each physical monitor, use `display-monitor-attributes-list'. */)
5432 (Lisp_Object display)
5434 struct w32_display_info *dpyinfo = check_x_display_info (display);
5435 HDC hdc;
5436 double mm_per_pixel;
5438 hdc = GetDC (NULL);
5439 mm_per_pixel = ((double) GetDeviceCaps (hdc, HORZSIZE)
5440 / GetDeviceCaps (hdc, HORZRES));
5441 ReleaseDC (NULL, hdc);
5443 return make_number (x_display_pixel_width (dpyinfo) * mm_per_pixel + 0.5);
5446 DEFUN ("x-display-backing-store", Fx_display_backing_store,
5447 Sx_display_backing_store, 0, 1, 0,
5448 doc: /* Return an indication of whether DISPLAY does backing store.
5449 The value may be `always', `when-mapped', or `not-useful'.
5450 The optional argument DISPLAY specifies which display to ask about.
5451 DISPLAY should be either a frame or a display name (a string).
5452 If omitted or nil, that stands for the selected frame's display. */)
5453 (Lisp_Object display)
5455 return intern ("not-useful");
5458 DEFUN ("x-display-visual-class", Fx_display_visual_class,
5459 Sx_display_visual_class, 0, 1, 0,
5460 doc: /* Return the visual class of DISPLAY.
5461 The value is one of the symbols `static-gray', `gray-scale',
5462 `static-color', `pseudo-color', `true-color', or `direct-color'.
5464 The optional argument DISPLAY specifies which display to ask about.
5465 DISPLAY should be either a frame or a display name (a string).
5466 If omitted or nil, that stands for the selected frame's display. */)
5467 (Lisp_Object display)
5469 struct w32_display_info *dpyinfo = check_x_display_info (display);
5470 Lisp_Object result = Qnil;
5472 if (dpyinfo->has_palette)
5473 result = intern ("pseudo-color");
5474 else if (dpyinfo->n_planes * dpyinfo->n_cbits == 1)
5475 result = intern ("static-grey");
5476 else if (dpyinfo->n_planes * dpyinfo->n_cbits == 4)
5477 result = intern ("static-color");
5478 else if (dpyinfo->n_planes * dpyinfo->n_cbits > 8)
5479 result = intern ("true-color");
5481 return result;
5484 DEFUN ("x-display-save-under", Fx_display_save_under,
5485 Sx_display_save_under, 0, 1, 0,
5486 doc: /* Return t if DISPLAY supports the save-under feature.
5487 The optional argument DISPLAY specifies which display to ask about.
5488 DISPLAY should be either a frame or a display name (a string).
5489 If omitted or nil, that stands for the selected frame's display. */)
5490 (Lisp_Object display)
5492 return Qnil;
5495 static BOOL CALLBACK ALIGN_STACK
5496 w32_monitor_enum (HMONITOR monitor, HDC hdc, RECT *rcMonitor, LPARAM dwData)
5498 Lisp_Object *monitor_list = (Lisp_Object *) dwData;
5500 *monitor_list = Fcons (make_save_ptr (monitor), *monitor_list);
5502 return TRUE;
5505 static Lisp_Object
5506 w32_display_monitor_attributes_list (void)
5508 Lisp_Object attributes_list = Qnil, primary_monitor_attributes = Qnil;
5509 Lisp_Object monitor_list = Qnil, monitor_frames, rest, frame;
5510 int i, n_monitors;
5511 HMONITOR *monitors;
5513 if (!(enum_display_monitors_fn && get_monitor_info_fn
5514 && monitor_from_window_fn))
5515 return Qnil;
5517 if (!enum_display_monitors_fn (NULL, NULL, w32_monitor_enum,
5518 (LPARAM) &monitor_list)
5519 || NILP (monitor_list))
5520 return Qnil;
5522 n_monitors = 0;
5523 for (rest = monitor_list; CONSP (rest); rest = XCDR (rest))
5524 n_monitors++;
5526 monitors = xmalloc (n_monitors * sizeof (*monitors));
5527 for (i = 0; i < n_monitors; i++)
5529 monitors[i] = XSAVE_POINTER (XCAR (monitor_list), 0);
5530 monitor_list = XCDR (monitor_list);
5533 monitor_frames = Fmake_vector (make_number (n_monitors), Qnil);
5534 FOR_EACH_FRAME (rest, frame)
5536 struct frame *f = XFRAME (frame);
5538 if (FRAME_W32_P (f) && !EQ (frame, tip_frame))
5540 HMONITOR monitor =
5541 monitor_from_window_fn (FRAME_W32_WINDOW (f),
5542 MONITOR_DEFAULT_TO_NEAREST);
5544 for (i = 0; i < n_monitors; i++)
5545 if (monitors[i] == monitor)
5546 break;
5548 if (i < n_monitors)
5549 ASET (monitor_frames, i, Fcons (frame, AREF (monitor_frames, i)));
5553 for (i = 0; i < n_monitors; i++)
5555 Lisp_Object geometry, workarea, name, attributes = Qnil;
5556 HDC hdc;
5557 int width_mm, height_mm;
5558 struct MONITOR_INFO_EX mi;
5560 mi.cbSize = sizeof (mi);
5561 if (!get_monitor_info_fn (monitors[i], (struct MONITOR_INFO *) &mi))
5562 continue;
5564 hdc = CreateDCA ("DISPLAY", mi.szDevice, NULL, NULL);
5565 if (hdc == NULL)
5566 continue;
5567 width_mm = GetDeviceCaps (hdc, HORZSIZE);
5568 height_mm = GetDeviceCaps (hdc, VERTSIZE);
5569 DeleteDC (hdc);
5571 attributes = Fcons (Fcons (Qframes, AREF (monitor_frames, i)),
5572 attributes);
5574 name = DECODE_SYSTEM (build_unibyte_string (mi.szDevice));
5576 attributes = Fcons (Fcons (Qname, name), attributes);
5578 attributes = Fcons (Fcons (Qmm_size, list2i (width_mm, height_mm)),
5579 attributes);
5581 workarea = list4i (mi.rcWork.left, mi.rcWork.top,
5582 mi.rcWork.right - mi.rcWork.left,
5583 mi.rcWork.bottom - mi.rcWork.top);
5584 attributes = Fcons (Fcons (Qworkarea, workarea), attributes);
5586 geometry = list4i (mi.rcMonitor.left, mi.rcMonitor.top,
5587 mi.rcMonitor.right - mi.rcMonitor.left,
5588 mi.rcMonitor.bottom - mi.rcMonitor.top);
5589 attributes = Fcons (Fcons (Qgeometry, geometry), attributes);
5591 if (mi.dwFlags & MONITORINFOF_PRIMARY)
5592 primary_monitor_attributes = attributes;
5593 else
5594 attributes_list = Fcons (attributes, attributes_list);
5597 if (!NILP (primary_monitor_attributes))
5598 attributes_list = Fcons (primary_monitor_attributes, attributes_list);
5600 xfree (monitors);
5602 return attributes_list;
5605 static Lisp_Object
5606 w32_display_monitor_attributes_list_fallback (struct w32_display_info *dpyinfo)
5608 Lisp_Object geometry, workarea, frames, rest, frame, attributes = Qnil;
5609 HDC hdc;
5610 double mm_per_pixel;
5611 int pixel_width, pixel_height, width_mm, height_mm;
5612 RECT workarea_rect;
5614 /* Fallback: treat (possibly) multiple physical monitors as if they
5615 formed a single monitor as a whole. This should provide a
5616 consistent result at least on single monitor environments. */
5617 attributes = Fcons (Fcons (Qname, build_string ("combined screen")),
5618 attributes);
5620 frames = Qnil;
5621 FOR_EACH_FRAME (rest, frame)
5623 struct frame *f = XFRAME (frame);
5625 if (FRAME_W32_P (f) && !EQ (frame, tip_frame))
5626 frames = Fcons (frame, frames);
5628 attributes = Fcons (Fcons (Qframes, frames), attributes);
5630 pixel_width = x_display_pixel_width (dpyinfo);
5631 pixel_height = x_display_pixel_height (dpyinfo);
5633 hdc = GetDC (NULL);
5634 mm_per_pixel = ((double) GetDeviceCaps (hdc, HORZSIZE)
5635 / GetDeviceCaps (hdc, HORZRES));
5636 width_mm = pixel_width * mm_per_pixel + 0.5;
5637 mm_per_pixel = ((double) GetDeviceCaps (hdc, VERTSIZE)
5638 / GetDeviceCaps (hdc, VERTRES));
5639 height_mm = pixel_height * mm_per_pixel + 0.5;
5640 ReleaseDC (NULL, hdc);
5641 attributes = Fcons (Fcons (Qmm_size, list2i (width_mm, height_mm)),
5642 attributes);
5644 /* GetSystemMetrics below may return 0 for Windows 95 or NT 4.0, but
5645 we don't care. */
5646 geometry = list4i (GetSystemMetrics (SM_XVIRTUALSCREEN),
5647 GetSystemMetrics (SM_YVIRTUALSCREEN),
5648 pixel_width, pixel_height);
5649 if (SystemParametersInfo (SPI_GETWORKAREA, 0, &workarea_rect, 0))
5650 workarea = list4i (workarea_rect.left, workarea_rect.top,
5651 workarea_rect.right - workarea_rect.left,
5652 workarea_rect.bottom - workarea_rect.top);
5653 else
5654 workarea = geometry;
5655 attributes = Fcons (Fcons (Qworkarea, workarea), attributes);
5657 attributes = Fcons (Fcons (Qgeometry, geometry), attributes);
5659 return list1 (attributes);
5662 DEFUN ("w32-display-monitor-attributes-list", Fw32_display_monitor_attributes_list,
5663 Sw32_display_monitor_attributes_list,
5664 0, 1, 0,
5665 doc: /* Return a list of physical monitor attributes on the W32 display DISPLAY.
5667 The optional argument DISPLAY specifies which display to ask about.
5668 DISPLAY should be either a frame or a display name (a string).
5669 If omitted or nil, that stands for the selected frame's display.
5671 Internal use only, use `display-monitor-attributes-list' instead. */)
5672 (Lisp_Object display)
5674 struct w32_display_info *dpyinfo = check_x_display_info (display);
5675 Lisp_Object attributes_list;
5677 block_input ();
5678 attributes_list = w32_display_monitor_attributes_list ();
5679 if (NILP (attributes_list))
5680 attributes_list = w32_display_monitor_attributes_list_fallback (dpyinfo);
5681 unblock_input ();
5683 return attributes_list;
5686 DEFUN ("set-message-beep", Fset_message_beep, Sset_message_beep, 1, 1, 0,
5687 doc: /* Set the sound generated when the bell is rung.
5688 SOUND is `asterisk', `exclamation', `hand', `question', `ok', or `silent'
5689 to use the corresponding system sound for the bell. The `silent' sound
5690 prevents Emacs from making any sound at all.
5691 SOUND is nil to use the normal beep. */)
5692 (Lisp_Object sound)
5694 CHECK_SYMBOL (sound);
5696 if (NILP (sound))
5697 sound_type = 0xFFFFFFFF;
5698 else if (EQ (sound, intern ("asterisk")))
5699 sound_type = MB_ICONASTERISK;
5700 else if (EQ (sound, intern ("exclamation")))
5701 sound_type = MB_ICONEXCLAMATION;
5702 else if (EQ (sound, intern ("hand")))
5703 sound_type = MB_ICONHAND;
5704 else if (EQ (sound, intern ("question")))
5705 sound_type = MB_ICONQUESTION;
5706 else if (EQ (sound, intern ("ok")))
5707 sound_type = MB_OK;
5708 else if (EQ (sound, intern ("silent")))
5709 sound_type = MB_EMACS_SILENT;
5710 else
5711 sound_type = 0xFFFFFFFF;
5713 return sound;
5717 x_screen_planes (register struct frame *f)
5719 return FRAME_DISPLAY_INFO (f)->n_planes;
5722 /* Return the display structure for the display named NAME.
5723 Open a new connection if necessary. */
5725 struct w32_display_info *
5726 x_display_info_for_name (Lisp_Object name)
5728 struct w32_display_info *dpyinfo;
5730 CHECK_STRING (name);
5732 for (dpyinfo = &one_w32_display_info; dpyinfo; dpyinfo = dpyinfo->next)
5733 if (!NILP (Fstring_equal (XCAR (dpyinfo->name_list_element), name)))
5734 return dpyinfo;
5736 /* Use this general default value to start with. */
5737 Vx_resource_name = Vinvocation_name;
5739 validate_x_resource_name ();
5741 dpyinfo = w32_term_init (name, NULL, SSDATA (Vx_resource_name));
5743 if (dpyinfo == 0)
5744 error ("Cannot connect to server %s", SDATA (name));
5746 XSETFASTINT (Vwindow_system_version, w32_major_version);
5748 return dpyinfo;
5751 DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
5752 1, 3, 0, doc: /* Open a connection to a display server.
5753 DISPLAY is the name of the display to connect to.
5754 Optional second arg XRM-STRING is a string of resources in xrdb format.
5755 If the optional third arg MUST-SUCCEED is non-nil,
5756 terminate Emacs if we can't open the connection.
5757 (In the Nextstep version, the last two arguments are currently ignored.) */)
5758 (Lisp_Object display, Lisp_Object xrm_string, Lisp_Object must_succeed)
5760 char *xrm_option;
5761 struct w32_display_info *dpyinfo;
5763 CHECK_STRING (display);
5765 /* Signal an error in order to encourage correct use from callers.
5766 * If we ever support multiple window systems in the same Emacs,
5767 * we'll need callers to be precise about what window system they
5768 * want. */
5770 if (strcmp (SSDATA (display), "w32") != 0)
5771 error ("The name of the display in this Emacs must be \"w32\"");
5773 /* If initialization has already been done, return now to avoid
5774 overwriting critical parts of one_w32_display_info. */
5775 if (window_system_available (NULL))
5776 return Qnil;
5778 if (! NILP (xrm_string))
5779 CHECK_STRING (xrm_string);
5781 /* Allow color mapping to be defined externally; first look in user's
5782 HOME directory, then in Emacs etc dir for a file called rgb.txt. */
5784 Lisp_Object color_file;
5786 color_file = build_string ("~/rgb.txt");
5788 if (NILP (Ffile_readable_p (color_file)))
5789 color_file =
5790 Fexpand_file_name (build_string ("rgb.txt"),
5791 Fsymbol_value (intern ("data-directory")));
5793 Vw32_color_map = Fx_load_color_file (color_file);
5795 if (NILP (Vw32_color_map))
5796 Vw32_color_map = w32_default_color_map ();
5798 /* Merge in system logical colors. */
5799 add_system_logical_colors_to_map (&Vw32_color_map);
5801 if (! NILP (xrm_string))
5802 xrm_option = SSDATA (xrm_string);
5803 else
5804 xrm_option = NULL;
5806 /* Use this general default value to start with. */
5807 /* First remove .exe suffix from invocation-name - it looks ugly. */
5809 char basename[ MAX_PATH ], *str;
5811 lispstpcpy (basename, Vinvocation_name);
5812 str = strrchr (basename, '.');
5813 if (str) *str = 0;
5814 Vinvocation_name = build_string (basename);
5816 Vx_resource_name = Vinvocation_name;
5818 validate_x_resource_name ();
5820 /* This is what opens the connection and sets x_current_display.
5821 This also initializes many symbols, such as those used for input. */
5822 dpyinfo = w32_term_init (display, xrm_option, SSDATA (Vx_resource_name));
5824 if (dpyinfo == 0)
5826 if (!NILP (must_succeed))
5827 fatal ("Cannot connect to server %s.\n",
5828 SDATA (display));
5829 else
5830 error ("Cannot connect to server %s", SDATA (display));
5833 XSETFASTINT (Vwindow_system_version, w32_major_version);
5834 return Qnil;
5837 DEFUN ("x-close-connection", Fx_close_connection,
5838 Sx_close_connection, 1, 1, 0,
5839 doc: /* Close the connection to DISPLAY's server.
5840 For DISPLAY, specify either a frame or a display name (a string).
5841 If DISPLAY is nil, that stands for the selected frame's display. */)
5842 (Lisp_Object display)
5844 struct w32_display_info *dpyinfo = check_x_display_info (display);
5846 if (dpyinfo->reference_count > 0)
5847 error ("Display still has frames on it");
5849 block_input ();
5850 x_destroy_all_bitmaps (dpyinfo);
5852 x_delete_display (dpyinfo);
5853 unblock_input ();
5855 return Qnil;
5858 DEFUN ("x-display-list", Fx_display_list, Sx_display_list, 0, 0, 0,
5859 doc: /* Return the list of display names that Emacs has connections to. */)
5860 (void)
5862 Lisp_Object result = Qnil;
5863 struct w32_display_info *wdi;
5865 for (wdi = x_display_list; wdi; wdi = wdi->next)
5866 result = Fcons (XCAR (wdi->name_list_element), result);
5868 return result;
5871 DEFUN ("x-synchronize", Fx_synchronize, Sx_synchronize, 1, 2, 0,
5872 doc: /* If ON is non-nil, report X errors as soon as the erring request is made.
5873 This function only has an effect on X Windows. With MS Windows, it is
5874 defined but does nothing.
5876 If ON is nil, allow buffering of requests.
5877 Turning on synchronization prohibits the Xlib routines from buffering
5878 requests and seriously degrades performance, but makes debugging much
5879 easier.
5880 The optional second argument TERMINAL specifies which display to act on.
5881 TERMINAL should be a terminal object, a frame or a display name (a string).
5882 If TERMINAL is omitted or nil, that stands for the selected frame's display. */)
5883 (Lisp_Object on, Lisp_Object display)
5885 return Qnil;
5890 /***********************************************************************
5891 Window properties
5892 ***********************************************************************/
5894 #if 0 /* TODO : port window properties to W32 */
5896 DEFUN ("x-change-window-property", Fx_change_window_property,
5897 Sx_change_window_property, 2, 6, 0,
5898 doc: /* Change window property PROP to VALUE on the X window of FRAME.
5899 PROP must be a string. VALUE may be a string or a list of conses,
5900 numbers and/or strings. If an element in the list is a string, it is
5901 converted to an atom and the value of the Atom is used. If an element
5902 is a cons, it is converted to a 32 bit number where the car is the 16
5903 top bits and the cdr is the lower 16 bits.
5905 FRAME nil or omitted means use the selected frame.
5906 If TYPE is given and non-nil, it is the name of the type of VALUE.
5907 If TYPE is not given or nil, the type is STRING.
5908 FORMAT gives the size in bits of each element if VALUE is a list.
5909 It must be one of 8, 16 or 32.
5910 If VALUE is a string or FORMAT is nil or not given, FORMAT defaults to 8.
5911 If OUTER-P is non-nil, the property is changed for the outer X window of
5912 FRAME. Default is to change on the edit X window. */)
5913 (Lisp_Object prop, Lisp_Object value, Lisp_Object frame,
5914 Lisp_Object type, Lisp_Object format, Lisp_Object outer_p)
5916 struct frame *f = decode_window_system_frame (frame);
5917 Atom prop_atom;
5919 CHECK_STRING (prop);
5920 CHECK_STRING (value);
5922 block_input ();
5923 prop_atom = XInternAtom (FRAME_W32_DISPLAY (f), SDATA (prop), False);
5924 XChangeProperty (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f),
5925 prop_atom, XA_STRING, 8, PropModeReplace,
5926 SDATA (value), SCHARS (value));
5928 /* Make sure the property is set when we return. */
5929 XFlush (FRAME_W32_DISPLAY (f));
5930 unblock_input ();
5932 return value;
5936 DEFUN ("x-delete-window-property", Fx_delete_window_property,
5937 Sx_delete_window_property, 1, 2, 0,
5938 doc: /* Remove window property PROP from X window of FRAME.
5939 FRAME nil or omitted means use the selected frame. Value is PROP. */)
5940 (Lisp_Object prop, Lisp_Object frame)
5942 struct frame *f = decode_window_system_frame (frame);
5943 Atom prop_atom;
5945 CHECK_STRING (prop);
5946 block_input ();
5947 prop_atom = XInternAtom (FRAME_W32_DISPLAY (f), SDATA (prop), False);
5948 XDeleteProperty (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f), prop_atom);
5950 /* Make sure the property is removed when we return. */
5951 XFlush (FRAME_W32_DISPLAY (f));
5952 unblock_input ();
5954 return prop;
5958 DEFUN ("x-window-property", Fx_window_property, Sx_window_property,
5959 1, 6, 0,
5960 doc: /* Value is the value of window property PROP on FRAME.
5961 If FRAME is nil or omitted, use the selected frame.
5963 On X Windows, the following optional arguments are also accepted:
5964 If TYPE is nil or omitted, get the property as a string.
5965 Otherwise TYPE is the name of the atom that denotes the type expected.
5966 If SOURCE is non-nil, get the property on that window instead of from
5967 FRAME. The number 0 denotes the root window.
5968 If DELETE-P is non-nil, delete the property after retrieving it.
5969 If VECTOR-RET-P is non-nil, don't return a string but a vector of values.
5971 On MS Windows, this function accepts but ignores those optional arguments.
5973 Value is nil if FRAME hasn't a property with name PROP or if PROP has
5974 no value of TYPE (always string in the MS Windows case). */)
5975 (Lisp_Object prop, Lisp_Object frame, Lisp_Object type,
5976 Lisp_Object source, Lisp_Object delete_p, Lisp_Object vector_ret_p)
5978 struct frame *f = decode_window_system_frame (frame);
5979 Atom prop_atom;
5980 int rc;
5981 Lisp_Object prop_value = Qnil;
5982 char *tmp_data = NULL;
5983 Atom actual_type;
5984 int actual_format;
5985 unsigned long actual_size, bytes_remaining;
5987 CHECK_STRING (prop);
5988 block_input ();
5989 prop_atom = XInternAtom (FRAME_W32_DISPLAY (f), SDATA (prop), False);
5990 rc = XGetWindowProperty (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f),
5991 prop_atom, 0, 0, False, XA_STRING,
5992 &actual_type, &actual_format, &actual_size,
5993 &bytes_remaining, (unsigned char **) &tmp_data);
5994 if (rc == Success)
5996 int size = bytes_remaining;
5998 XFree (tmp_data);
5999 tmp_data = NULL;
6001 rc = XGetWindowProperty (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f),
6002 prop_atom, 0, bytes_remaining,
6003 False, XA_STRING,
6004 &actual_type, &actual_format,
6005 &actual_size, &bytes_remaining,
6006 (unsigned char **) &tmp_data);
6007 if (rc == Success)
6008 prop_value = make_string (tmp_data, size);
6010 XFree (tmp_data);
6013 unblock_input ();
6015 return prop_value;
6017 return Qnil;
6020 #endif /* TODO */
6022 /***********************************************************************
6023 Tool tips
6024 ***********************************************************************/
6026 static Lisp_Object x_create_tip_frame (struct w32_display_info *,
6027 Lisp_Object, Lisp_Object);
6028 static void compute_tip_xy (struct frame *, Lisp_Object, Lisp_Object,
6029 Lisp_Object, int, int, int *, int *);
6031 /* The frame of a currently visible tooltip. */
6033 Lisp_Object tip_frame;
6035 /* If non-nil, a timer started that hides the last tooltip when it
6036 fires. */
6038 Lisp_Object tip_timer;
6039 Window tip_window;
6041 /* If non-nil, a vector of 3 elements containing the last args
6042 with which x-show-tip was called. See there. */
6044 Lisp_Object last_show_tip_args;
6047 static void
6048 unwind_create_tip_frame (Lisp_Object frame)
6050 Lisp_Object deleted;
6052 deleted = unwind_create_frame (frame);
6053 if (EQ (deleted, Qt))
6055 tip_window = NULL;
6056 tip_frame = Qnil;
6061 /* Create a frame for a tooltip on the display described by DPYINFO.
6062 PARMS is a list of frame parameters. TEXT is the string to
6063 display in the tip frame. Value is the frame.
6065 Note that functions called here, esp. x_default_parameter can
6066 signal errors, for instance when a specified color name is
6067 undefined. We have to make sure that we're in a consistent state
6068 when this happens. */
6070 static Lisp_Object
6071 x_create_tip_frame (struct w32_display_info *dpyinfo,
6072 Lisp_Object parms, Lisp_Object text)
6074 struct frame *f;
6075 Lisp_Object frame;
6076 Lisp_Object name;
6077 int width, height;
6078 ptrdiff_t count = SPECPDL_INDEX ();
6079 struct kboard *kb;
6080 bool face_change_before = face_change;
6081 Lisp_Object buffer;
6082 struct buffer *old_buffer;
6083 int x_width = 0, x_height = 0;
6085 /* Use this general default value to start with until we know if
6086 this frame has a specified name. */
6087 Vx_resource_name = Vinvocation_name;
6089 kb = dpyinfo->terminal->kboard;
6091 /* The calls to x_get_arg remove elements from PARMS, so copy it to
6092 avoid destructive changes behind our caller's back. */
6093 parms = Fcopy_alist (parms);
6095 /* Get the name of the frame to use for resource lookup. */
6096 name = x_get_arg (dpyinfo, parms, Qname, "name", "Name", RES_TYPE_STRING);
6097 if (!STRINGP (name)
6098 && !EQ (name, Qunbound)
6099 && !NILP (name))
6100 error ("Invalid frame name--not a string or nil");
6101 Vx_resource_name = name;
6103 frame = Qnil;
6104 /* Make a frame without minibuffer nor mode-line. */
6105 f = make_frame (false);
6106 f->wants_modeline = 0;
6107 XSETFRAME (frame, f);
6109 AUTO_STRING (tip, " *tip*");
6110 buffer = Fget_buffer_create (tip);
6111 /* Use set_window_buffer instead of Fset_window_buffer (see
6112 discussion of bug#11984, bug#12025, bug#12026). */
6113 set_window_buffer (FRAME_ROOT_WINDOW (f), buffer, false, false);
6114 old_buffer = current_buffer;
6115 set_buffer_internal_1 (XBUFFER (buffer));
6116 bset_truncate_lines (current_buffer, Qnil);
6117 specbind (Qinhibit_read_only, Qt);
6118 specbind (Qinhibit_modification_hooks, Qt);
6119 Ferase_buffer ();
6120 Finsert (1, &text);
6121 set_buffer_internal_1 (old_buffer);
6123 record_unwind_protect (unwind_create_tip_frame, frame);
6125 /* By setting the output method, we're essentially saying that
6126 the frame is live, as per FRAME_LIVE_P. If we get a signal
6127 from this point on, x_destroy_window might screw up reference
6128 counts etc. */
6129 f->terminal = dpyinfo->terminal;
6130 f->output_method = output_w32;
6131 f->output_data.w32 = xzalloc (sizeof (struct w32_output));
6133 FRAME_FONTSET (f) = -1;
6134 fset_icon_name (f, Qnil);
6136 #ifdef GLYPH_DEBUG
6137 image_cache_refcount =
6138 FRAME_IMAGE_CACHE (f) ? FRAME_IMAGE_CACHE (f)->refcount : 0;
6139 dpyinfo_refcount = dpyinfo->reference_count;
6140 #endif /* GLYPH_DEBUG */
6141 FRAME_KBOARD (f) = kb;
6142 f->output_data.w32->parent_desc = FRAME_DISPLAY_INFO (f)->root_window;
6143 f->output_data.w32->explicit_parent = false;
6145 /* Set the name; the functions to which we pass f expect the name to
6146 be set. */
6147 if (EQ (name, Qunbound) || NILP (name))
6149 fset_name (f, build_string (dpyinfo->w32_id_name));
6150 f->explicit_name = false;
6152 else
6154 fset_name (f, name);
6155 f->explicit_name = true;
6156 /* use the frame's title when getting resources for this frame. */
6157 specbind (Qx_resource_name, name);
6160 if (uniscribe_available)
6161 register_font_driver (&uniscribe_font_driver, f);
6162 register_font_driver (&w32font_driver, f);
6164 x_default_parameter (f, parms, Qfont_backend, Qnil,
6165 "fontBackend", "FontBackend", RES_TYPE_STRING);
6167 /* Extract the window parameters from the supplied values
6168 that are needed to determine window geometry. */
6169 x_default_font_parameter (f, parms);
6171 x_default_parameter (f, parms, Qborder_width, make_number (2),
6172 "borderWidth", "BorderWidth", RES_TYPE_NUMBER);
6173 /* This defaults to 2 in order to match xterm. We recognize either
6174 internalBorderWidth or internalBorder (which is what xterm calls
6175 it). */
6176 if (NILP (Fassq (Qinternal_border_width, parms)))
6178 Lisp_Object value;
6180 value = x_get_arg (dpyinfo, parms, Qinternal_border_width,
6181 "internalBorder", "internalBorder", RES_TYPE_NUMBER);
6182 if (! EQ (value, Qunbound))
6183 parms = Fcons (Fcons (Qinternal_border_width, value),
6184 parms);
6186 x_default_parameter (f, parms, Qinternal_border_width, make_number (1),
6187 "internalBorderWidth", "internalBorderWidth",
6188 RES_TYPE_NUMBER);
6189 x_default_parameter (f, parms, Qright_divider_width, make_number (0),
6190 NULL, NULL, RES_TYPE_NUMBER);
6191 x_default_parameter (f, parms, Qbottom_divider_width, make_number (0),
6192 NULL, NULL, RES_TYPE_NUMBER);
6194 /* Also do the stuff which must be set before the window exists. */
6195 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
6196 "foreground", "Foreground", RES_TYPE_STRING);
6197 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
6198 "background", "Background", RES_TYPE_STRING);
6199 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
6200 "pointerColor", "Foreground", RES_TYPE_STRING);
6201 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
6202 "cursorColor", "Foreground", RES_TYPE_STRING);
6203 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
6204 "borderColor", "BorderColor", RES_TYPE_STRING);
6206 /* Init faces before x_default_parameter is called for the
6207 scroll-bar-width parameter because otherwise we end up in
6208 init_iterator with a null face cache, which should not happen. */
6209 init_frame_faces (f);
6211 f->output_data.w32->dwStyle = WS_BORDER | WS_POPUP | WS_DISABLED;
6212 f->output_data.w32->parent_desc = FRAME_DISPLAY_INFO (f)->root_window;
6214 x_figure_window_size (f, parms, true, &x_width, &x_height);
6216 /* No fringes on tip frame. */
6217 f->fringe_cols = 0;
6218 f->left_fringe_width = 0;
6219 f->right_fringe_width = 0;
6221 block_input ();
6222 my_create_tip_window (f);
6223 unblock_input ();
6225 x_make_gc (f);
6227 x_default_parameter (f, parms, Qauto_raise, Qnil,
6228 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN);
6229 x_default_parameter (f, parms, Qauto_lower, Qnil,
6230 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN);
6231 x_default_parameter (f, parms, Qcursor_type, Qbox,
6232 "cursorType", "CursorType", RES_TYPE_SYMBOL);
6233 /* Process alpha here (Bug#17344). */
6234 x_default_parameter (f, parms, Qalpha, Qnil,
6235 "alpha", "Alpha", RES_TYPE_NUMBER);
6237 /* Dimensions, especially FRAME_LINES (f), must be done via
6238 change_frame_size. Change will not be effected unless different
6239 from the current FRAME_LINES (f). */
6240 width = FRAME_COLS (f);
6241 height = FRAME_LINES (f);
6242 SET_FRAME_COLS (f, 0);
6243 SET_FRAME_LINES (f, 0);
6244 adjust_frame_size (f, width * FRAME_COLUMN_WIDTH (f),
6245 height * FRAME_LINE_HEIGHT (f), 0, true, Qtip_frame);
6247 /* Add `tooltip' frame parameter's default value. */
6248 if (NILP (Fframe_parameter (frame, Qtooltip)))
6249 Fmodify_frame_parameters (frame, Fcons (Fcons (Qtooltip, Qt), Qnil));
6251 /* Set up faces after all frame parameters are known. This call
6252 also merges in face attributes specified for new frames.
6254 Frame parameters may be changed if .Xdefaults contains
6255 specifications for the default font. For example, if there is an
6256 `Emacs.default.attributeBackground: pink', the `background-color'
6257 attribute of the frame get's set, which let's the internal border
6258 of the tooltip frame appear in pink. Prevent this. */
6260 Lisp_Object bg = Fframe_parameter (frame, Qbackground_color);
6261 Lisp_Object fg = Fframe_parameter (frame, Qforeground_color);
6262 Lisp_Object colors = Qnil;
6264 /* Set tip_frame here, so that */
6265 tip_frame = frame;
6266 call2 (Qface_set_after_frame_default, frame, Qnil);
6268 if (!EQ (bg, Fframe_parameter (frame, Qbackground_color)))
6269 colors = Fcons (Fcons (Qbackground_color, bg), colors);
6270 if (!EQ (fg, Fframe_parameter (frame, Qforeground_color)))
6271 colors = Fcons (Fcons (Qforeground_color, fg), colors);
6273 if (!NILP (colors))
6274 Fmodify_frame_parameters (frame, colors);
6277 f->no_split = true;
6279 /* Now that the frame is official, it counts as a reference to
6280 its display. */
6281 FRAME_DISPLAY_INFO (f)->reference_count++;
6282 f->terminal->reference_count++;
6284 /* It is now ok to make the frame official even if we get an error
6285 below. And the frame needs to be on Vframe_list or making it
6286 visible won't work. */
6287 Vframe_list = Fcons (frame, Vframe_list);
6288 f->can_x_set_window_size = true;
6290 /* Setting attributes of faces of the tooltip frame from resources
6291 and similar will set face_change, which leads to the
6292 clearing of all current matrices. Since this isn't necessary
6293 here, avoid it by resetting face_change to the value it
6294 had before we created the tip frame. */
6295 face_change = face_change_before;
6297 /* Discard the unwind_protect. */
6298 return unbind_to (count, frame);
6302 /* Compute where to display tip frame F. PARMS is the list of frame
6303 parameters for F. DX and DY are specified offsets from the current
6304 location of the mouse. WIDTH and HEIGHT are the width and height
6305 of the tooltip. Return coordinates relative to the root window of
6306 the display in *ROOT_X and *ROOT_Y. */
6308 static void
6309 compute_tip_xy (struct frame *f,
6310 Lisp_Object parms, Lisp_Object dx, Lisp_Object dy,
6311 int width, int height, int *root_x, int *root_y)
6313 Lisp_Object left, top, right, bottom;
6314 int min_x, min_y, max_x, max_y;
6316 /* User-specified position? */
6317 left = Fcdr (Fassq (Qleft, parms));
6318 top = Fcdr (Fassq (Qtop, parms));
6319 right = Fcdr (Fassq (Qright, parms));
6320 bottom = Fcdr (Fassq (Qbottom, parms));
6322 /* Move the tooltip window where the mouse pointer is. Resize and
6323 show it. */
6324 if ((!INTEGERP (left) && !INTEGERP (right))
6325 || (!INTEGERP (top) && !INTEGERP (bottom)))
6327 POINT pt;
6329 /* Default min and max values. */
6330 min_x = 0;
6331 min_y = 0;
6332 max_x = x_display_pixel_width (FRAME_DISPLAY_INFO (f));
6333 max_y = x_display_pixel_height (FRAME_DISPLAY_INFO (f));
6335 block_input ();
6336 GetCursorPos (&pt);
6337 *root_x = pt.x;
6338 *root_y = pt.y;
6339 unblock_input ();
6341 /* If multiple monitor support is available, constrain the tip onto
6342 the current monitor. This improves the above by allowing negative
6343 co-ordinates if monitor positions are such that they are valid, and
6344 snaps a tooltip onto a single monitor if we are close to the edge
6345 where it would otherwise flow onto the other monitor (or into
6346 nothingness if there is a gap in the overlap). */
6347 if (monitor_from_point_fn && get_monitor_info_fn)
6349 struct MONITOR_INFO info;
6350 HMONITOR monitor
6351 = monitor_from_point_fn (pt, MONITOR_DEFAULT_TO_NEAREST);
6352 info.cbSize = sizeof (info);
6354 if (get_monitor_info_fn (monitor, &info))
6356 min_x = info.rcWork.left;
6357 min_y = info.rcWork.top;
6358 max_x = info.rcWork.right;
6359 max_y = info.rcWork.bottom;
6364 if (INTEGERP (top))
6365 *root_y = XINT (top);
6366 else if (INTEGERP (bottom))
6367 *root_y = XINT (bottom) - height;
6368 else if (*root_y + XINT (dy) <= min_y)
6369 *root_y = min_y; /* Can happen for negative dy */
6370 else if (*root_y + XINT (dy) + height <= max_y)
6371 /* It fits below the pointer */
6372 *root_y += XINT (dy);
6373 else if (height + XINT (dy) + min_y <= *root_y)
6374 /* It fits above the pointer. */
6375 *root_y -= height + XINT (dy);
6376 else
6377 /* Put it on the top. */
6378 *root_y = min_y;
6380 if (INTEGERP (left))
6381 *root_x = XINT (left);
6382 else if (INTEGERP (right))
6383 *root_y = XINT (right) - width;
6384 else if (*root_x + XINT (dx) <= min_x)
6385 *root_x = 0; /* Can happen for negative dx */
6386 else if (*root_x + XINT (dx) + width <= max_x)
6387 /* It fits to the right of the pointer. */
6388 *root_x += XINT (dx);
6389 else if (width + XINT (dx) + min_x <= *root_x)
6390 /* It fits to the left of the pointer. */
6391 *root_x -= width + XINT (dx);
6392 else
6393 /* Put it left justified on the screen -- it ought to fit that way. */
6394 *root_x = min_x;
6398 DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0,
6399 doc: /* Show STRING in a \"tooltip\" window on frame FRAME.
6400 A tooltip window is a small window displaying a string.
6402 This is an internal function; Lisp code should call `tooltip-show'.
6404 FRAME nil or omitted means use the selected frame.
6406 PARMS is an optional list of frame parameters which can be
6407 used to change the tooltip's appearance.
6409 Automatically hide the tooltip after TIMEOUT seconds. TIMEOUT nil
6410 means use the default timeout of 5 seconds.
6412 If the list of frame parameters PARMS contains a `left' parameter,
6413 display the tooltip at that x-position. If the list of frame parameters
6414 PARMS contains no `left' but a `right' parameter, display the tooltip
6415 right-adjusted at that x-position. Otherwise display it at the
6416 x-position of the mouse, with offset DX added (default is 5 if DX isn't
6417 specified).
6419 Likewise for the y-position: If a `top' frame parameter is specified, it
6420 determines the position of the upper edge of the tooltip window. If a
6421 `bottom' parameter but no `top' frame parameter is specified, it
6422 determines the position of the lower edge of the tooltip window.
6423 Otherwise display the tooltip window at the y-position of the mouse,
6424 with offset DY added (default is -10).
6426 A tooltip's maximum size is specified by `x-max-tooltip-size'.
6427 Text larger than the specified size is clipped. */)
6428 (Lisp_Object string, Lisp_Object frame, Lisp_Object parms, Lisp_Object timeout, Lisp_Object dx, Lisp_Object dy)
6430 struct frame *f;
6431 struct window *w;
6432 int root_x, root_y;
6433 struct buffer *old_buffer;
6434 struct text_pos pos;
6435 int i, width, height;
6436 bool seen_reversed_p;
6437 int old_windows_or_buffers_changed = windows_or_buffers_changed;
6438 ptrdiff_t count = SPECPDL_INDEX ();
6440 specbind (Qinhibit_redisplay, Qt);
6442 CHECK_STRING (string);
6443 f = decode_window_system_frame (frame);
6444 if (NILP (timeout))
6445 timeout = make_number (5);
6446 else
6447 CHECK_NATNUM (timeout);
6449 if (NILP (dx))
6450 dx = make_number (5);
6451 else
6452 CHECK_NUMBER (dx);
6454 if (NILP (dy))
6455 dy = make_number (-10);
6456 else
6457 CHECK_NUMBER (dy);
6459 if (NILP (last_show_tip_args))
6460 last_show_tip_args = Fmake_vector (make_number (3), Qnil);
6462 if (!NILP (tip_frame))
6464 Lisp_Object last_string = AREF (last_show_tip_args, 0);
6465 Lisp_Object last_frame = AREF (last_show_tip_args, 1);
6466 Lisp_Object last_parms = AREF (last_show_tip_args, 2);
6468 if (EQ (frame, last_frame)
6469 && !NILP (Fequal (last_string, string))
6470 && !NILP (Fequal (last_parms, parms)))
6472 struct frame *f = XFRAME (tip_frame);
6474 /* Only DX and DY have changed. */
6475 if (!NILP (tip_timer))
6477 Lisp_Object timer = tip_timer;
6478 tip_timer = Qnil;
6479 call1 (Qcancel_timer, timer);
6482 block_input ();
6483 compute_tip_xy (f, parms, dx, dy, FRAME_PIXEL_WIDTH (f),
6484 FRAME_PIXEL_HEIGHT (f), &root_x, &root_y);
6486 /* Put tooltip in topmost group and in position. */
6487 SetWindowPos (FRAME_W32_WINDOW (f), HWND_TOPMOST,
6488 root_x, root_y, 0, 0,
6489 SWP_NOSIZE | SWP_NOACTIVATE | SWP_NOOWNERZORDER);
6491 /* Ensure tooltip is on top of other topmost windows (eg menus). */
6492 SetWindowPos (FRAME_W32_WINDOW (f), HWND_TOP,
6493 0, 0, 0, 0,
6494 SWP_NOMOVE | SWP_NOSIZE
6495 | SWP_NOACTIVATE | SWP_NOOWNERZORDER);
6497 unblock_input ();
6498 goto start_timer;
6502 /* Hide a previous tip, if any. */
6503 Fx_hide_tip ();
6505 ASET (last_show_tip_args, 0, string);
6506 ASET (last_show_tip_args, 1, frame);
6507 ASET (last_show_tip_args, 2, parms);
6509 /* Add default values to frame parameters. */
6510 if (NILP (Fassq (Qname, parms)))
6511 parms = Fcons (Fcons (Qname, build_string ("tooltip")), parms);
6512 if (NILP (Fassq (Qinternal_border_width, parms)))
6513 parms = Fcons (Fcons (Qinternal_border_width, make_number (3)), parms);
6514 if (NILP (Fassq (Qright_divider_width, parms)))
6515 parms = Fcons (Fcons (Qright_divider_width, make_number (0)), parms);
6516 if (NILP (Fassq (Qbottom_divider_width, parms)))
6517 parms = Fcons (Fcons (Qbottom_divider_width, make_number (0)), parms);
6518 if (NILP (Fassq (Qborder_width, parms)))
6519 parms = Fcons (Fcons (Qborder_width, make_number (1)), parms);
6520 if (NILP (Fassq (Qborder_color, parms)))
6521 parms = Fcons (Fcons (Qborder_color, build_string ("lightyellow")), parms);
6522 if (NILP (Fassq (Qbackground_color, parms)))
6523 parms = Fcons (Fcons (Qbackground_color, build_string ("lightyellow")),
6524 parms);
6526 /* Block input until the tip has been fully drawn, to avoid crashes
6527 when drawing tips in menus. */
6528 block_input ();
6530 /* Create a frame for the tooltip, and record it in the global
6531 variable tip_frame. */
6532 frame = x_create_tip_frame (FRAME_DISPLAY_INFO (f), parms, string);
6533 f = XFRAME (frame);
6535 /* Set up the frame's root window. */
6536 w = XWINDOW (FRAME_ROOT_WINDOW (f));
6537 w->left_col = 0;
6538 w->top_line = 0;
6539 w->pixel_left = 0;
6540 w->pixel_top = 0;
6542 if (CONSP (Vx_max_tooltip_size)
6543 && INTEGERP (XCAR (Vx_max_tooltip_size))
6544 && XINT (XCAR (Vx_max_tooltip_size)) > 0
6545 && INTEGERP (XCDR (Vx_max_tooltip_size))
6546 && XINT (XCDR (Vx_max_tooltip_size)) > 0)
6548 w->total_cols = XFASTINT (XCAR (Vx_max_tooltip_size));
6549 w->total_lines = XFASTINT (XCDR (Vx_max_tooltip_size));
6551 else
6553 w->total_cols = 80;
6554 w->total_lines = 40;
6557 w->pixel_width = w->total_cols * FRAME_COLUMN_WIDTH (f);
6558 w->pixel_height = w->total_lines * FRAME_LINE_HEIGHT (f);
6560 FRAME_TOTAL_COLS (f) = WINDOW_TOTAL_COLS (w);
6561 adjust_frame_glyphs (f);
6562 w->pseudo_window_p = true;
6564 /* Display the tooltip text in a temporary buffer. */
6565 old_buffer = current_buffer;
6566 set_buffer_internal_1 (XBUFFER (XWINDOW (FRAME_ROOT_WINDOW (f))->contents));
6567 bset_truncate_lines (current_buffer, Qnil);
6568 clear_glyph_matrix (w->desired_matrix);
6569 clear_glyph_matrix (w->current_matrix);
6570 SET_TEXT_POS (pos, BEGV, BEGV_BYTE);
6571 try_window (FRAME_ROOT_WINDOW (f), pos, TRY_WINDOW_IGNORE_FONTS_CHANGE);
6573 /* Compute width and height of the tooltip. */
6574 width = height = 0;
6575 seen_reversed_p = false;
6576 for (i = 0; i < w->desired_matrix->nrows; ++i)
6578 struct glyph_row *row = &w->desired_matrix->rows[i];
6579 struct glyph *last;
6580 int row_width;
6582 /* Stop at the first empty row at the end. */
6583 if (!row->enabled_p || !MATRIX_ROW_DISPLAYS_TEXT_P (row))
6584 break;
6586 /* Let the row go over the full width of the frame. */
6587 row->full_width_p = true;
6589 row_width = row->pixel_width;
6590 if (row->used[TEXT_AREA])
6592 if (!row->reversed_p)
6594 /* There's a glyph at the end of rows that is used to
6595 place the cursor there. Don't include the width of
6596 this glyph. */
6597 last = &row->glyphs[TEXT_AREA][row->used[TEXT_AREA] - 1];
6598 if (NILP (last->object))
6599 row_width -= last->pixel_width;
6601 else
6603 /* There could be a stretch glyph at the beginning of R2L
6604 rows that is produced by extend_face_to_end_of_line.
6605 Don't count that glyph. */
6606 struct glyph *g = row->glyphs[TEXT_AREA];
6608 if (g->type == STRETCH_GLYPH && NILP (g->object))
6610 row_width -= g->pixel_width;
6611 seen_reversed_p = true;
6616 height += row->height;
6617 width = max (width, row_width);
6620 /* If we've seen partial-length R2L rows, we need to re-adjust the
6621 tool-tip frame width and redisplay it again, to avoid over-wide
6622 tips due to the stretch glyph that extends R2L lines to full
6623 width of the frame. */
6624 if (seen_reversed_p)
6626 /* PXW: Why do we do the pixel-to-cols conversion only if
6627 seen_reversed_p holds? Don't we have to set other fields of
6628 the window/frame structure?
6630 w->total_cols and FRAME_TOTAL_COLS want the width in columns,
6631 not in pixels. */
6632 w->pixel_width = width;
6633 width /= WINDOW_FRAME_COLUMN_WIDTH (w);
6634 w->total_cols = width;
6635 FRAME_TOTAL_COLS (f) = width;
6636 SET_FRAME_WIDTH (f, width);
6637 adjust_frame_glyphs (f);
6638 w->pseudo_window_p = 1;
6639 clear_glyph_matrix (w->desired_matrix);
6640 clear_glyph_matrix (w->current_matrix);
6641 try_window (FRAME_ROOT_WINDOW (f), pos, TRY_WINDOW_IGNORE_FONTS_CHANGE);
6642 width = height = 0;
6643 /* Recompute width and height of the tooltip. */
6644 for (i = 0; i < w->desired_matrix->nrows; ++i)
6646 struct glyph_row *row = &w->desired_matrix->rows[i];
6647 struct glyph *last;
6648 int row_width;
6650 if (!row->enabled_p || !MATRIX_ROW_DISPLAYS_TEXT_P (row))
6651 break;
6652 row->full_width_p = true;
6653 row_width = row->pixel_width;
6654 if (row->used[TEXT_AREA] && !row->reversed_p)
6656 last = &row->glyphs[TEXT_AREA][row->used[TEXT_AREA] - 1];
6657 if (NILP (last->object))
6658 row_width -= last->pixel_width;
6661 height += row->height;
6662 width = max (width, row_width);
6666 /* Add the frame's internal border to the width and height the w32
6667 window should have. */
6668 height += 2 * FRAME_INTERNAL_BORDER_WIDTH (f);
6669 width += 2 * FRAME_INTERNAL_BORDER_WIDTH (f);
6671 /* Move the tooltip window where the mouse pointer is. Resize and
6672 show it.
6674 PXW: This should use the frame's pixel coordinates. */
6675 compute_tip_xy (f, parms, dx, dy, width, height, &root_x, &root_y);
6678 /* Adjust Window size to take border into account. */
6679 RECT rect;
6680 rect.left = rect.top = 0;
6681 rect.right = width;
6682 rect.bottom = height;
6683 AdjustWindowRect (&rect, f->output_data.w32->dwStyle,
6684 FRAME_EXTERNAL_MENU_BAR (f));
6686 /* Position and size tooltip, and put it in the topmost group.
6687 The add-on of FRAME_COLUMN_WIDTH to the 5th argument is a
6688 peculiarity of w32 display: without it, some fonts cause the
6689 last character of the tip to be truncated or wrapped around to
6690 the next line. */
6691 SetWindowPos (FRAME_W32_WINDOW (f), HWND_TOPMOST,
6692 root_x, root_y,
6693 rect.right - rect.left + FRAME_COLUMN_WIDTH (f),
6694 rect.bottom - rect.top, SWP_NOACTIVATE | SWP_NOOWNERZORDER);
6696 /* Ensure tooltip is on top of other topmost windows (eg menus). */
6697 SetWindowPos (FRAME_W32_WINDOW (f), HWND_TOP,
6698 0, 0, 0, 0,
6699 SWP_NOMOVE | SWP_NOSIZE
6700 | SWP_NOACTIVATE | SWP_NOOWNERZORDER);
6702 /* Let redisplay know that we have made the frame visible already. */
6703 SET_FRAME_VISIBLE (f, 1);
6705 ShowWindow (FRAME_W32_WINDOW (f), SW_SHOWNOACTIVATE);
6708 /* Draw into the window. */
6709 w->must_be_updated_p = true;
6710 update_single_window (w);
6712 unblock_input ();
6714 /* Restore original current buffer. */
6715 set_buffer_internal_1 (old_buffer);
6716 windows_or_buffers_changed = old_windows_or_buffers_changed;
6718 start_timer:
6719 /* Let the tip disappear after timeout seconds. */
6720 tip_timer = call3 (intern ("run-at-time"), timeout, Qnil,
6721 intern ("x-hide-tip"));
6723 return unbind_to (count, Qnil);
6727 DEFUN ("x-hide-tip", Fx_hide_tip, Sx_hide_tip, 0, 0, 0,
6728 doc: /* Hide the current tooltip window, if there is any.
6729 Value is t if tooltip was open, nil otherwise. */)
6730 (void)
6732 ptrdiff_t count;
6733 Lisp_Object deleted, frame, timer;
6735 /* Return quickly if nothing to do. */
6736 if (NILP (tip_timer) && NILP (tip_frame))
6737 return Qnil;
6739 frame = tip_frame;
6740 timer = tip_timer;
6741 tip_frame = tip_timer = deleted = Qnil;
6743 count = SPECPDL_INDEX ();
6744 specbind (Qinhibit_redisplay, Qt);
6745 specbind (Qinhibit_quit, Qt);
6747 if (!NILP (timer))
6748 call1 (Qcancel_timer, timer);
6750 if (FRAMEP (frame))
6752 delete_frame (frame, Qnil);
6753 deleted = Qt;
6756 return unbind_to (count, deleted);
6759 /***********************************************************************
6760 File selection dialog
6761 ***********************************************************************/
6763 #define FILE_NAME_TEXT_FIELD edt1
6764 #define FILE_NAME_COMBO_BOX cmb13
6765 #define FILE_NAME_LIST lst1
6767 /* Callback for altering the behavior of the Open File dialog.
6768 Makes the Filename text field contain "Current Directory" and be
6769 read-only when "Directories" is selected in the filter. This
6770 allows us to work around the fact that the standard Open File
6771 dialog does not support directories. */
6772 static UINT_PTR CALLBACK
6773 file_dialog_callback (HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam)
6775 if (msg == WM_NOTIFY)
6777 OFNOTIFYW * notify_w = (OFNOTIFYW *)lParam;
6778 OFNOTIFYA * notify_a = (OFNOTIFYA *)lParam;
6779 int dropdown_changed;
6780 int dir_index;
6781 #ifdef NTGUI_UNICODE
6782 const int use_unicode = 1;
6783 #else /* !NTGUI_UNICODE */
6784 int use_unicode = w32_unicode_filenames;
6785 #endif /* NTGUI_UNICODE */
6787 /* Detect when the Filter dropdown is changed. */
6788 if (use_unicode)
6789 dropdown_changed =
6790 notify_w->hdr.code == CDN_TYPECHANGE
6791 || notify_w->hdr.code == CDN_INITDONE;
6792 else
6793 dropdown_changed =
6794 notify_a->hdr.code == CDN_TYPECHANGE
6795 || notify_a->hdr.code == CDN_INITDONE;
6796 if (dropdown_changed)
6798 HWND dialog = GetParent (hwnd);
6799 HWND edit_control = GetDlgItem (dialog, FILE_NAME_TEXT_FIELD);
6800 HWND list = GetDlgItem (dialog, FILE_NAME_LIST);
6801 int hdr_code;
6803 /* At least on Windows 7, the above attempt to get the window handle
6804 to the File Name Text Field fails. The following code does the
6805 job though. Note that this code is based on my examination of the
6806 window hierarchy using Microsoft Spy++. bk */
6807 if (edit_control == NULL)
6809 HWND tmp = GetDlgItem (dialog, FILE_NAME_COMBO_BOX);
6810 if (tmp)
6812 tmp = GetWindow (tmp, GW_CHILD);
6813 if (tmp)
6814 edit_control = GetWindow (tmp, GW_CHILD);
6818 /* Directories is in index 2. */
6819 if (use_unicode)
6821 dir_index = notify_w->lpOFN->nFilterIndex;
6822 hdr_code = notify_w->hdr.code;
6824 else
6826 dir_index = notify_a->lpOFN->nFilterIndex;
6827 hdr_code = notify_a->hdr.code;
6829 if (dir_index == 2)
6831 if (use_unicode)
6832 SendMessageW (dialog, CDM_SETCONTROLTEXT, FILE_NAME_TEXT_FIELD,
6833 (LPARAM)L"Current Directory");
6834 else
6835 SendMessageA (dialog, CDM_SETCONTROLTEXT, FILE_NAME_TEXT_FIELD,
6836 (LPARAM)"Current Directory");
6837 EnableWindow (edit_control, FALSE);
6838 /* Note that at least on Windows 7, the above call to EnableWindow
6839 disables the window that would ordinarily have focus. If we
6840 do not set focus to some other window here, focus will land in
6841 no man's land and the user will be unable to tab through the
6842 dialog box (pressing tab will only result in a beep).
6843 Avoid that problem by setting focus to the list here. */
6844 if (hdr_code == CDN_INITDONE)
6845 SetFocus (list);
6847 else
6849 /* Don't override default filename on init done. */
6850 if (hdr_code == CDN_TYPECHANGE)
6852 if (use_unicode)
6853 SendMessageW (dialog, CDM_SETCONTROLTEXT,
6854 FILE_NAME_TEXT_FIELD, (LPARAM)L"");
6855 else
6856 SendMessageA (dialog, CDM_SETCONTROLTEXT,
6857 FILE_NAME_TEXT_FIELD, (LPARAM)"");
6859 EnableWindow (edit_control, TRUE);
6863 return 0;
6866 DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 5, 0,
6867 doc: /* Read file name, prompting with PROMPT in directory DIR.
6868 Use a file selection dialog. Select DEFAULT-FILENAME in the dialog's file
6869 selection box, if specified. If MUSTMATCH is non-nil, the returned file
6870 or directory must exist.
6872 This function is only defined on NS, MS Windows, and X Windows with the
6873 Motif or Gtk toolkits. With the Motif toolkit, ONLY-DIR-P is ignored.
6874 Otherwise, if ONLY-DIR-P is non-nil, the user can only select directories.
6875 On Windows 7 and later, the file selection dialog "remembers" the last
6876 directory where the user selected a file, and will open that directory
6877 instead of DIR on subsequent invocations of this function with the same
6878 value of DIR as in previous invocations; this is standard Windows behavior. */)
6879 (Lisp_Object prompt, Lisp_Object dir, Lisp_Object default_filename, Lisp_Object mustmatch, Lisp_Object only_dir_p)
6881 /* Filter index: 1: All Files, 2: Directories only */
6882 static const wchar_t filter_w[] = L"All Files (*.*)\0*.*\0Directories\0*|*\0";
6883 static const char filter_a[] = "All Files (*.*)\0*.*\0Directories\0*|*\0";
6885 Lisp_Object filename = default_filename;
6886 struct frame *f = SELECTED_FRAME ();
6887 BOOL file_opened = FALSE;
6888 Lisp_Object orig_dir = dir;
6889 Lisp_Object orig_prompt = prompt;
6891 /* If we compile with _WIN32_WINNT set to 0x0400 (for NT4
6892 compatibility) we end up with the old file dialogs. Define a big
6893 enough struct for the new dialog to trick GetOpenFileName into
6894 giving us the new dialogs on newer versions of Windows. */
6895 struct {
6896 OPENFILENAMEW details;
6897 #if _WIN32_WINNT < 0x500 /* < win2k */
6898 PVOID pvReserved;
6899 DWORD dwReserved;
6900 DWORD FlagsEx;
6901 #endif /* < win2k */
6902 } new_file_details_w;
6904 #ifdef NTGUI_UNICODE
6905 wchar_t filename_buf_w[32*1024 + 1]; // NT kernel maximum
6906 OPENFILENAMEW * file_details_w = &new_file_details_w.details;
6907 const int use_unicode = 1;
6908 #else /* not NTGUI_UNICODE */
6909 struct {
6910 OPENFILENAMEA details;
6911 #if _WIN32_WINNT < 0x500 /* < win2k */
6912 PVOID pvReserved;
6913 DWORD dwReserved;
6914 DWORD FlagsEx;
6915 #endif /* < win2k */
6916 } new_file_details_a;
6917 wchar_t filename_buf_w[MAX_PATH + 1], dir_w[MAX_PATH];
6918 char filename_buf_a[MAX_PATH + 1], dir_a[MAX_PATH];
6919 OPENFILENAMEW * file_details_w = &new_file_details_w.details;
6920 OPENFILENAMEA * file_details_a = &new_file_details_a.details;
6921 int use_unicode = w32_unicode_filenames;
6922 wchar_t *prompt_w;
6923 char *prompt_a;
6924 int len;
6925 char fname_ret[MAX_UTF8_PATH];
6926 #endif /* NTGUI_UNICODE */
6929 /* Note: under NTGUI_UNICODE, we do _NOT_ use ENCODE_FILE: the
6930 system file encoding expected by the platform APIs (e.g. Cygwin's
6931 POSIX implementation) may not be the same as the encoding expected
6932 by the Windows "ANSI" APIs! */
6934 CHECK_STRING (prompt);
6935 CHECK_STRING (dir);
6937 dir = Fexpand_file_name (dir, Qnil);
6939 if (STRINGP (filename))
6940 filename = Ffile_name_nondirectory (filename);
6941 else
6942 filename = empty_unibyte_string;
6944 #ifdef CYGWIN
6945 dir = Fcygwin_convert_file_name_to_windows (dir, Qt);
6946 if (SCHARS (filename) > 0)
6947 filename = Fcygwin_convert_file_name_to_windows (filename, Qnil);
6948 #endif
6950 CHECK_STRING (dir);
6951 CHECK_STRING (filename);
6953 /* The code in file_dialog_callback that attempts to set the text
6954 of the file name edit window when handling the CDN_INITDONE
6955 WM_NOTIFY message does not work. Setting filename to "Current
6956 Directory" in the only_dir_p case here does work however. */
6957 if (SCHARS (filename) == 0 && ! NILP (only_dir_p))
6958 filename = build_string ("Current Directory");
6960 /* Convert the values we've computed so far to system form. */
6961 #ifdef NTGUI_UNICODE
6962 to_unicode (prompt, &prompt);
6963 to_unicode (dir, &dir);
6964 to_unicode (filename, &filename);
6965 if (SBYTES (filename) + 1 > sizeof (filename_buf_w))
6966 report_file_error ("filename too long", default_filename);
6968 memcpy (filename_buf_w, SDATA (filename), SBYTES (filename) + 1);
6969 #else /* !NTGUI_UNICODE */
6970 prompt = ENCODE_FILE (prompt);
6971 dir = ENCODE_FILE (dir);
6972 filename = ENCODE_FILE (filename);
6974 /* We modify these in-place, so make copies for safety. */
6975 dir = Fcopy_sequence (dir);
6976 unixtodos_filename (SSDATA (dir));
6977 filename = Fcopy_sequence (filename);
6978 unixtodos_filename (SSDATA (filename));
6979 if (SBYTES (filename) >= MAX_UTF8_PATH)
6980 report_file_error ("filename too long", default_filename);
6981 if (w32_unicode_filenames)
6983 filename_to_utf16 (SSDATA (dir), dir_w);
6984 if (filename_to_utf16 (SSDATA (filename), filename_buf_w) != 0)
6986 /* filename_to_utf16 sets errno to ENOENT when the file
6987 name is too long or cannot be converted to UTF-16. */
6988 if (errno == ENOENT && filename_buf_w[MAX_PATH - 1] != 0)
6989 report_file_error ("filename too long", default_filename);
6991 len = pMultiByteToWideChar (CP_UTF8, MB_ERR_INVALID_CHARS,
6992 SSDATA (prompt), -1, NULL, 0);
6993 if (len > 32768)
6994 len = 32768;
6995 prompt_w = alloca (len * sizeof (wchar_t));
6996 pMultiByteToWideChar (CP_UTF8, MB_ERR_INVALID_CHARS,
6997 SSDATA (prompt), -1, prompt_w, len);
6999 else
7001 filename_to_ansi (SSDATA (dir), dir_a);
7002 if (filename_to_ansi (SSDATA (filename), filename_buf_a) != '\0')
7004 /* filename_to_ansi sets errno to ENOENT when the file
7005 name is too long or cannot be converted to UTF-16. */
7006 if (errno == ENOENT && filename_buf_a[MAX_PATH - 1] != 0)
7007 report_file_error ("filename too long", default_filename);
7009 len = pMultiByteToWideChar (CP_UTF8, MB_ERR_INVALID_CHARS,
7010 SSDATA (prompt), -1, NULL, 0);
7011 if (len > 32768)
7012 len = 32768;
7013 prompt_w = alloca (len * sizeof (wchar_t));
7014 pMultiByteToWideChar (CP_UTF8, MB_ERR_INVALID_CHARS,
7015 SSDATA (prompt), -1, prompt_w, len);
7016 len = pWideCharToMultiByte (CP_ACP, 0, prompt_w, -1, NULL, 0, NULL, NULL);
7017 if (len > 32768)
7018 len = 32768;
7019 prompt_a = alloca (len);
7020 pWideCharToMultiByte (CP_ACP, 0, prompt_w, -1, prompt_a, len, NULL, NULL);
7022 #endif /* NTGUI_UNICODE */
7024 /* Fill in the structure for the call to GetOpenFileName below.
7025 For NTGUI_UNICODE builds (which run only on NT), we just use
7026 the actual size of the structure. For non-NTGUI_UNICODE
7027 builds, we tell the OS we're using an old version of the
7028 structure if the OS isn't new enough to support the newer
7029 version. */
7030 if (use_unicode)
7032 memset (&new_file_details_w, 0, sizeof (new_file_details_w));
7033 if (w32_major_version > 4 && w32_major_version < 95)
7034 file_details_w->lStructSize = sizeof (new_file_details_w);
7035 else
7036 file_details_w->lStructSize = sizeof (*file_details_w);
7037 /* Set up the inout parameter for the selected file name. */
7038 file_details_w->lpstrFile = filename_buf_w;
7039 file_details_w->nMaxFile =
7040 sizeof (filename_buf_w) / sizeof (*filename_buf_w);
7041 file_details_w->hwndOwner = FRAME_W32_WINDOW (f);
7042 /* Undocumented Bug in Common File Dialog:
7043 If a filter is not specified, shell links are not resolved. */
7044 file_details_w->lpstrFilter = filter_w;
7045 #ifdef NTGUI_UNICODE
7046 file_details_w->lpstrInitialDir = (wchar_t*) SDATA (dir);
7047 file_details_w->lpstrTitle = (guichar_t*) SDATA (prompt);
7048 #else
7049 file_details_w->lpstrInitialDir = dir_w;
7050 file_details_w->lpstrTitle = prompt_w;
7051 #endif
7052 file_details_w->nFilterIndex = NILP (only_dir_p) ? 1 : 2;
7053 file_details_w->Flags = (OFN_HIDEREADONLY | OFN_NOCHANGEDIR
7054 | OFN_EXPLORER | OFN_ENABLEHOOK);
7055 if (!NILP (mustmatch))
7057 /* Require that the path to the parent directory exists. */
7058 file_details_w->Flags |= OFN_PATHMUSTEXIST;
7059 /* If we are looking for a file, require that it exists. */
7060 if (NILP (only_dir_p))
7061 file_details_w->Flags |= OFN_FILEMUSTEXIST;
7064 #ifndef NTGUI_UNICODE
7065 else
7067 memset (&new_file_details_a, 0, sizeof (new_file_details_a));
7068 if (w32_major_version > 4 && w32_major_version < 95)
7069 file_details_a->lStructSize = sizeof (new_file_details_a);
7070 else
7071 file_details_a->lStructSize = sizeof (*file_details_a);
7072 file_details_a->lpstrFile = filename_buf_a;
7073 file_details_a->nMaxFile =
7074 sizeof (filename_buf_a) / sizeof (*filename_buf_a);
7075 file_details_a->hwndOwner = FRAME_W32_WINDOW (f);
7076 file_details_a->lpstrFilter = filter_a;
7077 file_details_a->lpstrInitialDir = dir_a;
7078 file_details_a->lpstrTitle = prompt_a;
7079 file_details_a->nFilterIndex = NILP (only_dir_p) ? 1 : 2;
7080 file_details_a->Flags = (OFN_HIDEREADONLY | OFN_NOCHANGEDIR
7081 | OFN_EXPLORER | OFN_ENABLEHOOK);
7082 if (!NILP (mustmatch))
7084 /* Require that the path to the parent directory exists. */
7085 file_details_a->Flags |= OFN_PATHMUSTEXIST;
7086 /* If we are looking for a file, require that it exists. */
7087 if (NILP (only_dir_p))
7088 file_details_a->Flags |= OFN_FILEMUSTEXIST;
7091 #endif /* !NTGUI_UNICODE */
7094 int count = SPECPDL_INDEX ();
7095 /* Prevent redisplay. */
7096 specbind (Qinhibit_redisplay, Qt);
7097 block_input ();
7098 if (use_unicode)
7100 file_details_w->lpfnHook = file_dialog_callback;
7102 file_opened = GetOpenFileNameW (file_details_w);
7104 #ifndef NTGUI_UNICODE
7105 else
7107 file_details_a->lpfnHook = file_dialog_callback;
7109 file_opened = GetOpenFileNameA (file_details_a);
7111 #endif /* !NTGUI_UNICODE */
7112 unblock_input ();
7113 unbind_to (count, Qnil);
7116 if (file_opened)
7118 /* Get an Emacs string from the value Windows gave us. */
7119 #ifdef NTGUI_UNICODE
7120 filename = from_unicode_buffer (filename_buf_w);
7121 #else /* !NTGUI_UNICODE */
7122 if (use_unicode)
7123 filename_from_utf16 (filename_buf_w, fname_ret);
7124 else
7125 filename_from_ansi (filename_buf_a, fname_ret);
7126 dostounix_filename (fname_ret);
7127 filename = DECODE_FILE (build_unibyte_string (fname_ret));
7128 #endif /* NTGUI_UNICODE */
7130 #ifdef CYGWIN
7131 filename = Fcygwin_convert_file_name_from_windows (filename, Qt);
7132 #endif /* CYGWIN */
7134 /* Strip the dummy filename off the end of the string if we
7135 added it to select a directory. */
7136 if ((use_unicode && file_details_w->nFilterIndex == 2)
7137 #ifndef NTGUI_UNICODE
7138 || (!use_unicode && file_details_a->nFilterIndex == 2)
7139 #endif
7141 filename = Ffile_name_directory (filename);
7143 /* User canceled the dialog without making a selection. */
7144 else if (!CommDlgExtendedError ())
7145 filename = Qnil;
7146 /* An error occurred, fallback on reading from the mini-buffer. */
7147 else
7148 filename = Fcompleting_read (
7149 orig_prompt,
7150 intern ("read-file-name-internal"),
7151 orig_dir,
7152 mustmatch,
7153 orig_dir,
7154 Qfile_name_history,
7155 default_filename,
7156 Qnil);
7159 /* Make "Cancel" equivalent to C-g. */
7160 if (NILP (filename))
7161 Fsignal (Qquit, Qnil);
7163 return filename;
7167 #ifdef WINDOWSNT
7168 /* Moving files to the system recycle bin.
7169 Used by `move-file-to-trash' instead of the default moving to ~/.Trash */
7170 DEFUN ("system-move-file-to-trash", Fsystem_move_file_to_trash,
7171 Ssystem_move_file_to_trash, 1, 1, 0,
7172 doc: /* Move file or directory named FILENAME to the recycle bin. */)
7173 (Lisp_Object filename)
7175 Lisp_Object handler;
7176 Lisp_Object encoded_file;
7177 Lisp_Object operation;
7179 operation = Qdelete_file;
7180 if (!NILP (Ffile_directory_p (filename))
7181 && NILP (Ffile_symlink_p (filename)))
7183 operation = intern ("delete-directory");
7184 filename = Fdirectory_file_name (filename);
7187 /* Must have fully qualified file names for moving files to Recycle
7188 Bin. */
7189 filename = Fexpand_file_name (filename, Qnil);
7191 handler = Ffind_file_name_handler (filename, operation);
7192 if (!NILP (handler))
7193 return call2 (handler, operation, filename);
7194 else
7196 const char * path;
7197 int result;
7199 encoded_file = ENCODE_FILE (filename);
7201 path = map_w32_filename (SSDATA (encoded_file), NULL);
7203 /* The Unicode version of SHFileOperation is not supported on
7204 Windows 9X. */
7205 if (w32_unicode_filenames && os_subtype != OS_9X)
7207 SHFILEOPSTRUCTW file_op_w;
7208 /* We need one more element beyond MAX_PATH because this is
7209 a list of file names, with the last element double-null
7210 terminated. */
7211 wchar_t tmp_path_w[MAX_PATH + 1];
7213 memset (tmp_path_w, 0, sizeof (tmp_path_w));
7214 filename_to_utf16 (path, tmp_path_w);
7216 /* On Windows, write permission is required to delete/move files. */
7217 _wchmod (tmp_path_w, 0666);
7219 memset (&file_op_w, 0, sizeof (file_op_w));
7220 file_op_w.hwnd = HWND_DESKTOP;
7221 file_op_w.wFunc = FO_DELETE;
7222 file_op_w.pFrom = tmp_path_w;
7223 file_op_w.fFlags = FOF_SILENT | FOF_NOCONFIRMATION | FOF_ALLOWUNDO
7224 | FOF_NOERRORUI | FOF_NO_CONNECTED_ELEMENTS;
7225 file_op_w.fAnyOperationsAborted = FALSE;
7227 result = SHFileOperationW (&file_op_w);
7229 else
7231 SHFILEOPSTRUCTA file_op_a;
7232 char tmp_path_a[MAX_PATH + 1];
7234 memset (tmp_path_a, 0, sizeof (tmp_path_a));
7235 filename_to_ansi (path, tmp_path_a);
7237 /* If a file cannot be represented in ANSI codepage, don't
7238 let them inadvertently delete other files because some
7239 characters are interpreted as a wildcards. */
7240 if (_mbspbrk ((unsigned char *)tmp_path_a,
7241 (const unsigned char *)"?*"))
7242 result = ERROR_FILE_NOT_FOUND;
7243 else
7245 _chmod (tmp_path_a, 0666);
7247 memset (&file_op_a, 0, sizeof (file_op_a));
7248 file_op_a.hwnd = HWND_DESKTOP;
7249 file_op_a.wFunc = FO_DELETE;
7250 file_op_a.pFrom = tmp_path_a;
7251 file_op_a.fFlags = FOF_SILENT | FOF_NOCONFIRMATION | FOF_ALLOWUNDO
7252 | FOF_NOERRORUI | FOF_NO_CONNECTED_ELEMENTS;
7253 file_op_a.fAnyOperationsAborted = FALSE;
7255 result = SHFileOperationA (&file_op_a);
7258 if (result != 0)
7259 report_file_error ("Removing old name", list1 (filename));
7261 return Qnil;
7264 #endif /* WINDOWSNT */
7267 /***********************************************************************
7268 w32 specialized functions
7269 ***********************************************************************/
7271 DEFUN ("w32-send-sys-command", Fw32_send_sys_command,
7272 Sw32_send_sys_command, 1, 2, 0,
7273 doc: /* Send frame a Windows WM_SYSCOMMAND message of type COMMAND.
7274 Some useful values for COMMAND are #xf030 to maximize frame (#xf020
7275 to minimize), #xf120 to restore frame to original size, and #xf100
7276 to activate the menubar for keyboard access. #xf140 activates the
7277 screen saver if defined.
7279 If optional parameter FRAME is not specified, use selected frame. */)
7280 (Lisp_Object command, Lisp_Object frame)
7282 struct frame *f = decode_window_system_frame (frame);
7284 CHECK_NUMBER (command);
7286 if (FRAME_W32_P (f))
7287 PostMessage (FRAME_W32_WINDOW (f), WM_SYSCOMMAND, XINT (command), 0);
7289 return Qnil;
7292 DEFUN ("w32-shell-execute", Fw32_shell_execute, Sw32_shell_execute, 2, 4, 0,
7293 doc: /* Get Windows to perform OPERATION on DOCUMENT.
7294 This is a wrapper around the ShellExecute system function, which
7295 invokes the application registered to handle OPERATION for DOCUMENT.
7297 OPERATION is either nil or a string that names a supported operation.
7298 What operations can be used depends on the particular DOCUMENT and its
7299 handler application, but typically it is one of the following common
7300 operations:
7302 \"open\" - open DOCUMENT, which could be a file, a directory, or an
7303 executable program (application). If it is an application,
7304 that application is launched in the current buffer's default
7305 directory. Otherwise, the application associated with
7306 DOCUMENT is launched in the buffer's default directory.
7307 \"opennew\" - like \"open\", but instruct the application to open
7308 DOCUMENT in a new window.
7309 \"openas\" - open the \"Open With\" dialog for DOCUMENT.
7310 \"print\" - print DOCUMENT, which must be a file.
7311 \"printto\" - print DOCUMENT, which must be a file, to a specified printer.
7312 The printer should be provided in PARAMETERS, see below.
7313 \"explore\" - start the Windows Explorer on DOCUMENT.
7314 \"edit\" - launch an editor and open DOCUMENT for editing; which
7315 editor is launched depends on the association for the
7316 specified DOCUMENT.
7317 \"find\" - initiate search starting from DOCUMENT, which must specify
7318 a directory.
7319 \"delete\" - move DOCUMENT, a file or a directory, to Recycle Bin.
7320 \"copy\" - copy DOCUMENT, which must be a file or a directory, into
7321 the clipboard.
7322 \"cut\" - move DOCUMENT, a file or a directory, into the clipboard.
7323 \"paste\" - paste the file whose name is in the clipboard into DOCUMENT,
7324 which must be a directory.
7325 \"pastelink\"
7326 - create a shortcut in DOCUMENT (which must be a directory)
7327 the file or directory whose name is in the clipboard.
7328 \"runas\" - run DOCUMENT, which must be an excutable file, with
7329 elevated privileges (a.k.a. \"as Administrator\").
7330 \"properties\"
7331 - open the property sheet dialog for DOCUMENT.
7332 nil - invoke the default OPERATION, or \"open\" if default is
7333 not defined or unavailable.
7335 DOCUMENT is typically the name of a document file or a URL, but can
7336 also be an executable program to run, or a directory to open in the
7337 Windows Explorer. If it is a file or a directory, it must be a local
7338 one; this function does not support remote file names.
7340 If DOCUMENT is an executable program, the optional third arg PARAMETERS
7341 can be a string containing command line parameters, separated by blanks,
7342 that will be passed to the program. Some values of OPERATION also require
7343 parameters (e.g., \"printto\" requires the printer address). Otherwise,
7344 PARAMETERS should be nil or unspecified. Note that double quote characters
7345 in PARAMETERS must each be enclosed in 2 additional quotes, as in \"\"\".
7347 Optional fourth argument SHOW-FLAG can be used to control how the
7348 application will be displayed when it is invoked. If SHOW-FLAG is nil
7349 or unspecified, the application is displayed as if SHOW-FLAG of 10 was
7350 specified, otherwise it is an integer between 0 and 11 representing
7351 a ShowWindow flag:
7353 0 - start hidden
7354 1 - start as normal-size window
7355 3 - start in a maximized window
7356 6 - start in a minimized window
7357 10 - start as the application itself specifies; this is the default. */)
7358 (Lisp_Object operation, Lisp_Object document, Lisp_Object parameters, Lisp_Object show_flag)
7360 char *errstr;
7361 Lisp_Object current_dir = BVAR (current_buffer, directory);;
7362 wchar_t *doc_w = NULL, *params_w = NULL, *ops_w = NULL;
7363 #ifdef CYGWIN
7364 intptr_t result;
7365 #else
7366 int use_unicode = w32_unicode_filenames;
7367 char *doc_a = NULL, *params_a = NULL, *ops_a = NULL;
7368 Lisp_Object absdoc, handler;
7369 BOOL success;
7370 #endif
7372 CHECK_STRING (document);
7374 #ifdef CYGWIN
7375 current_dir = Fcygwin_convert_file_name_to_windows (current_dir, Qt);
7376 document = Fcygwin_convert_file_name_to_windows (document, Qt);
7378 /* Encode filename, current directory and parameters. */
7379 current_dir = GUI_ENCODE_FILE (current_dir);
7380 document = GUI_ENCODE_FILE (document);
7381 doc_w = GUI_SDATA (document);
7382 if (STRINGP (parameters))
7384 parameters = GUI_ENCODE_SYSTEM (parameters);
7385 params_w = GUI_SDATA (parameters);
7387 if (STRINGP (operation))
7389 operation = GUI_ENCODE_SYSTEM (operation);
7390 ops_w = GUI_SDATA (operation);
7392 result = (intptr_t) ShellExecuteW (NULL, ops_w, doc_w, params_w,
7393 GUI_SDATA (current_dir),
7394 (INTEGERP (show_flag)
7395 ? XINT (show_flag) : SW_SHOWDEFAULT));
7397 if (result > 32)
7398 return Qt;
7400 switch (result)
7402 case SE_ERR_ACCESSDENIED:
7403 errstr = w32_strerror (ERROR_ACCESS_DENIED);
7404 break;
7405 case SE_ERR_ASSOCINCOMPLETE:
7406 case SE_ERR_NOASSOC:
7407 errstr = w32_strerror (ERROR_NO_ASSOCIATION);
7408 break;
7409 case SE_ERR_DDEBUSY:
7410 case SE_ERR_DDEFAIL:
7411 errstr = w32_strerror (ERROR_DDE_FAIL);
7412 break;
7413 case SE_ERR_DDETIMEOUT:
7414 errstr = w32_strerror (ERROR_TIMEOUT);
7415 break;
7416 case SE_ERR_DLLNOTFOUND:
7417 errstr = w32_strerror (ERROR_DLL_NOT_FOUND);
7418 break;
7419 case SE_ERR_FNF:
7420 errstr = w32_strerror (ERROR_FILE_NOT_FOUND);
7421 break;
7422 case SE_ERR_OOM:
7423 errstr = w32_strerror (ERROR_NOT_ENOUGH_MEMORY);
7424 break;
7425 case SE_ERR_PNF:
7426 errstr = w32_strerror (ERROR_PATH_NOT_FOUND);
7427 break;
7428 case SE_ERR_SHARE:
7429 errstr = w32_strerror (ERROR_SHARING_VIOLATION);
7430 break;
7431 default:
7432 errstr = w32_strerror (0);
7433 break;
7436 #else /* !CYGWIN */
7438 const char file_url_str[] = "file:///";
7439 const int file_url_len = sizeof (file_url_str) - 1;
7440 int doclen;
7442 if (strncmp (SSDATA (document), file_url_str, file_url_len) == 0)
7444 /* Passing "file:///" URLs to ShellExecute causes shlwapi.dll to
7445 start a thread in some rare system configurations, for
7446 unknown reasons. That thread is started in the context of
7447 the Emacs process, but out of control of our code, and seems
7448 to never exit afterwards. Each such thread reserves 8MB of
7449 stack space (because that's the value recorded in the Emacs
7450 executable at link time: Emacs needs a large stack). So a
7451 large enough number of invocations of w32-shell-execute can
7452 potentially cause the Emacs process to run out of available
7453 address space, which is nasty. To work around this, we
7454 convert such URLs to local file names, which seems to prevent
7455 those threads from starting. See bug #20220. */
7456 char *p = SSDATA (document) + file_url_len;
7458 if (c_isalpha (*p) && p[1] == ':' && IS_DIRECTORY_SEP (p[2]))
7459 document = Fsubstring_no_properties (document,
7460 make_number (file_url_len), Qnil);
7462 /* We have a situation here. If DOCUMENT is a relative file name,
7463 but its name includes leading directories, i.e. it lives not in
7464 CURRENT_DIR, but in its subdirectory, then ShellExecute below
7465 will fail to find it. So we need to make the file name is
7466 absolute. But DOCUMENT does not have to be a file, it can be a
7467 URL, for example. So we make it absolute only if it is an
7468 existing file; if it is a file that does not exist, tough. */
7469 absdoc = Fexpand_file_name (document, Qnil);
7470 /* Don't call file handlers for file-exists-p, since they might
7471 attempt to access the file, which could fail or produce undesired
7472 consequences, see bug#16558 for an example. */
7473 handler = Ffind_file_name_handler (absdoc, Qfile_exists_p);
7474 if (NILP (handler))
7476 Lisp_Object absdoc_encoded = ENCODE_FILE (absdoc);
7478 if (faccessat (AT_FDCWD, SSDATA (absdoc_encoded), F_OK, AT_EACCESS) == 0)
7480 /* ShellExecute fails if DOCUMENT is a UNC with forward
7481 slashes (expand-file-name above converts all backslashes
7482 to forward slashes). Now that we know DOCUMENT is a
7483 file, we can mirror all forward slashes into backslashes. */
7484 unixtodos_filename (SSDATA (absdoc_encoded));
7485 document = absdoc_encoded;
7487 else
7488 document = ENCODE_FILE (document);
7490 else
7491 document = ENCODE_FILE (document);
7493 current_dir = ENCODE_FILE (current_dir);
7494 /* Cannot use filename_to_utf16/ansi with DOCUMENT, since it could
7495 be a URL that is not limited to MAX_PATH chararcters. */
7496 doclen = pMultiByteToWideChar (CP_UTF8, MB_ERR_INVALID_CHARS,
7497 SSDATA (document), -1, NULL, 0);
7498 doc_w = xmalloc (doclen * sizeof (wchar_t));
7499 pMultiByteToWideChar (CP_UTF8, MB_ERR_INVALID_CHARS,
7500 SSDATA (document), -1, doc_w, doclen);
7501 if (use_unicode)
7503 wchar_t current_dir_w[MAX_PATH];
7504 SHELLEXECUTEINFOW shexinfo_w;
7506 /* Encode the current directory and parameters, and convert
7507 operation to UTF-16. */
7508 filename_to_utf16 (SSDATA (current_dir), current_dir_w);
7509 if (STRINGP (parameters))
7511 int len;
7513 parameters = ENCODE_SYSTEM (parameters);
7514 len = pMultiByteToWideChar (CP_ACP, MB_ERR_INVALID_CHARS,
7515 SSDATA (parameters), -1, NULL, 0);
7516 if (len > 32768)
7517 len = 32768;
7518 params_w = alloca (len * sizeof (wchar_t));
7519 pMultiByteToWideChar (CP_ACP, MB_ERR_INVALID_CHARS,
7520 SSDATA (parameters), -1, params_w, len);
7521 params_w[len - 1] = 0;
7523 if (STRINGP (operation))
7525 /* Assume OPERATION is pure ASCII. */
7526 const char *s = SSDATA (operation);
7527 wchar_t *d;
7528 int len = SBYTES (operation) + 1;
7530 if (len > 32768)
7531 len = 32768;
7532 d = ops_w = alloca (len * sizeof (wchar_t));
7533 while (d < ops_w + len - 1)
7534 *d++ = *s++;
7535 *d = 0;
7538 /* Using ShellExecuteEx and setting the SEE_MASK_INVOKEIDLIST
7539 flag succeeds with more OPERATIONs (a.k.a. "verbs"), as it is
7540 able to invoke verbs from shortcut menu extensions, not just
7541 static verbs listed in the Registry. */
7542 memset (&shexinfo_w, 0, sizeof (shexinfo_w));
7543 shexinfo_w.cbSize = sizeof (shexinfo_w);
7544 shexinfo_w.fMask =
7545 SEE_MASK_INVOKEIDLIST | SEE_MASK_FLAG_DDEWAIT | SEE_MASK_FLAG_NO_UI;
7546 shexinfo_w.hwnd = NULL;
7547 shexinfo_w.lpVerb = ops_w;
7548 shexinfo_w.lpFile = doc_w;
7549 shexinfo_w.lpParameters = params_w;
7550 shexinfo_w.lpDirectory = current_dir_w;
7551 shexinfo_w.nShow =
7552 (INTEGERP (show_flag) ? XINT (show_flag) : SW_SHOWDEFAULT);
7553 success = ShellExecuteExW (&shexinfo_w);
7554 xfree (doc_w);
7556 else
7558 char current_dir_a[MAX_PATH];
7559 SHELLEXECUTEINFOA shexinfo_a;
7560 int codepage = codepage_for_filenames (NULL);
7561 int ldoc_a = pWideCharToMultiByte (codepage, 0, doc_w, -1, NULL, 0,
7562 NULL, NULL);
7564 doc_a = xmalloc (ldoc_a);
7565 pWideCharToMultiByte (codepage, 0, doc_w, -1, doc_a, ldoc_a, NULL, NULL);
7566 filename_to_ansi (SSDATA (current_dir), current_dir_a);
7567 if (STRINGP (parameters))
7569 parameters = ENCODE_SYSTEM (parameters);
7570 params_a = SSDATA (parameters);
7572 if (STRINGP (operation))
7574 /* Assume OPERATION is pure ASCII. */
7575 ops_a = SSDATA (operation);
7577 memset (&shexinfo_a, 0, sizeof (shexinfo_a));
7578 shexinfo_a.cbSize = sizeof (shexinfo_a);
7579 shexinfo_a.fMask =
7580 SEE_MASK_INVOKEIDLIST | SEE_MASK_FLAG_DDEWAIT | SEE_MASK_FLAG_NO_UI;
7581 shexinfo_a.hwnd = NULL;
7582 shexinfo_a.lpVerb = ops_a;
7583 shexinfo_a.lpFile = doc_a;
7584 shexinfo_a.lpParameters = params_a;
7585 shexinfo_a.lpDirectory = current_dir_a;
7586 shexinfo_a.nShow =
7587 (INTEGERP (show_flag) ? XINT (show_flag) : SW_SHOWDEFAULT);
7588 success = ShellExecuteExA (&shexinfo_a);
7589 xfree (doc_w);
7590 xfree (doc_a);
7593 if (success)
7594 return Qt;
7596 errstr = w32_strerror (0);
7598 #endif /* !CYGWIN */
7600 /* The error string might be encoded in the locale's encoding. */
7601 if (!NILP (Vlocale_coding_system))
7603 Lisp_Object decoded =
7604 code_convert_string_norecord (build_unibyte_string (errstr),
7605 Vlocale_coding_system, 0);
7606 errstr = SSDATA (decoded);
7608 error ("ShellExecute failed: %s", errstr);
7611 /* Lookup virtual keycode from string representing the name of a
7612 non-ascii keystroke into the corresponding virtual key, using
7613 lispy_function_keys. */
7614 static int
7615 lookup_vk_code (char *key)
7617 int i;
7619 for (i = 0; i < 256; i++)
7620 if (lispy_function_keys[i]
7621 && strcmp (lispy_function_keys[i], key) == 0)
7622 return i;
7624 return -1;
7627 /* Convert a one-element vector style key sequence to a hot key
7628 definition. */
7629 static Lisp_Object
7630 w32_parse_hot_key (Lisp_Object key)
7632 /* Copied from Fdefine_key and store_in_keymap. */
7633 register Lisp_Object c;
7634 int vk_code;
7635 int lisp_modifiers;
7636 int w32_modifiers;
7638 CHECK_VECTOR (key);
7640 if (ASIZE (key) != 1)
7641 return Qnil;
7643 c = AREF (key, 0);
7645 if (CONSP (c) && lucid_event_type_list_p (c))
7646 c = Fevent_convert_list (c);
7648 if (! INTEGERP (c) && ! SYMBOLP (c))
7649 error ("Key definition is invalid");
7651 /* Work out the base key and the modifiers. */
7652 if (SYMBOLP (c))
7654 c = parse_modifiers (c);
7655 lisp_modifiers = XINT (Fcar (Fcdr (c)));
7656 c = Fcar (c);
7657 if (!SYMBOLP (c))
7658 emacs_abort ();
7659 vk_code = lookup_vk_code (SSDATA (SYMBOL_NAME (c)));
7661 else if (INTEGERP (c))
7663 lisp_modifiers = XINT (c) & ~CHARACTERBITS;
7664 /* Many ascii characters are their own virtual key code. */
7665 vk_code = XINT (c) & CHARACTERBITS;
7668 if (vk_code < 0 || vk_code > 255)
7669 return Qnil;
7671 if ((lisp_modifiers & meta_modifier) != 0
7672 && !NILP (Vw32_alt_is_meta))
7673 lisp_modifiers |= alt_modifier;
7675 /* Supply defs missing from mingw32. */
7676 #ifndef MOD_ALT
7677 #define MOD_ALT 0x0001
7678 #define MOD_CONTROL 0x0002
7679 #define MOD_SHIFT 0x0004
7680 #define MOD_WIN 0x0008
7681 #endif
7683 /* Convert lisp modifiers to Windows hot-key form. */
7684 w32_modifiers = (lisp_modifiers & hyper_modifier) ? MOD_WIN : 0;
7685 w32_modifiers |= (lisp_modifiers & alt_modifier) ? MOD_ALT : 0;
7686 w32_modifiers |= (lisp_modifiers & ctrl_modifier) ? MOD_CONTROL : 0;
7687 w32_modifiers |= (lisp_modifiers & shift_modifier) ? MOD_SHIFT : 0;
7689 return HOTKEY (vk_code, w32_modifiers);
7692 DEFUN ("w32-register-hot-key", Fw32_register_hot_key,
7693 Sw32_register_hot_key, 1, 1, 0,
7694 doc: /* Register KEY as a hot-key combination.
7695 Certain key combinations like Alt-Tab are reserved for system use on
7696 Windows, and therefore are normally intercepted by the system. However,
7697 most of these key combinations can be received by registering them as
7698 hot-keys, overriding their special meaning.
7700 KEY must be a one element key definition in vector form that would be
7701 acceptable to `define-key' (e.g. [A-tab] for Alt-Tab). The meta
7702 modifier is interpreted as Alt if `w32-alt-is-meta' is t, and hyper
7703 is always interpreted as the Windows modifier keys.
7705 The return value is the hotkey-id if registered, otherwise nil. */)
7706 (Lisp_Object key)
7708 key = w32_parse_hot_key (key);
7710 if (!NILP (key) && NILP (Fmemq (key, w32_grabbed_keys)))
7712 /* Reuse an empty slot if possible. */
7713 Lisp_Object item = Fmemq (Qnil, w32_grabbed_keys);
7715 /* Safe to add new key to list, even if we have focus. */
7716 if (NILP (item))
7717 w32_grabbed_keys = Fcons (key, w32_grabbed_keys);
7718 else
7719 XSETCAR (item, key);
7721 /* Notify input thread about new hot-key definition, so that it
7722 takes effect without needing to switch focus. */
7723 PostThreadMessage (dwWindowsThreadId, WM_EMACS_REGISTER_HOT_KEY,
7724 (WPARAM) XINT (key), 0);
7727 return key;
7730 DEFUN ("w32-unregister-hot-key", Fw32_unregister_hot_key,
7731 Sw32_unregister_hot_key, 1, 1, 0,
7732 doc: /* Unregister KEY as a hot-key combination. */)
7733 (Lisp_Object key)
7735 Lisp_Object item;
7737 if (!INTEGERP (key))
7738 key = w32_parse_hot_key (key);
7740 item = Fmemq (key, w32_grabbed_keys);
7742 if (!NILP (item))
7744 LPARAM lparam;
7746 eassert (CONSP (item));
7747 /* Pass the tail of the list as a pointer to a Lisp_Cons cell,
7748 so that it works in a --with-wide-int build as well. */
7749 lparam = (LPARAM) XUNTAG (item, Lisp_Cons);
7751 /* Notify input thread about hot-key definition being removed, so
7752 that it takes effect without needing focus switch. */
7753 if (PostThreadMessage (dwWindowsThreadId, WM_EMACS_UNREGISTER_HOT_KEY,
7754 (WPARAM) XINT (XCAR (item)), lparam))
7756 MSG msg;
7757 GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE);
7759 return Qt;
7761 return Qnil;
7764 DEFUN ("w32-registered-hot-keys", Fw32_registered_hot_keys,
7765 Sw32_registered_hot_keys, 0, 0, 0,
7766 doc: /* Return list of registered hot-key IDs. */)
7767 (void)
7769 return Fdelq (Qnil, Fcopy_sequence (w32_grabbed_keys));
7772 DEFUN ("w32-reconstruct-hot-key", Fw32_reconstruct_hot_key,
7773 Sw32_reconstruct_hot_key, 1, 1, 0,
7774 doc: /* Convert hot-key ID to a lisp key combination.
7775 usage: (w32-reconstruct-hot-key ID) */)
7776 (Lisp_Object hotkeyid)
7778 int vk_code, w32_modifiers;
7779 Lisp_Object key;
7781 CHECK_NUMBER (hotkeyid);
7783 vk_code = HOTKEY_VK_CODE (hotkeyid);
7784 w32_modifiers = HOTKEY_MODIFIERS (hotkeyid);
7786 if (vk_code < 256 && lispy_function_keys[vk_code])
7787 key = intern (lispy_function_keys[vk_code]);
7788 else
7789 key = make_number (vk_code);
7791 key = Fcons (key, Qnil);
7792 if (w32_modifiers & MOD_SHIFT)
7793 key = Fcons (Qshift, key);
7794 if (w32_modifiers & MOD_CONTROL)
7795 key = Fcons (Qctrl, key);
7796 if (w32_modifiers & MOD_ALT)
7797 key = Fcons (NILP (Vw32_alt_is_meta) ? Qalt : Qmeta, key);
7798 if (w32_modifiers & MOD_WIN)
7799 key = Fcons (Qhyper, key);
7801 return key;
7804 DEFUN ("w32-toggle-lock-key", Fw32_toggle_lock_key,
7805 Sw32_toggle_lock_key, 1, 2, 0,
7806 doc: /* Toggle the state of the lock key KEY.
7807 KEY can be `capslock', `kp-numlock', or `scroll'.
7808 If the optional parameter NEW-STATE is a number, then the state of KEY
7809 is set to off if the low bit of NEW-STATE is zero, otherwise on.
7810 If NEW-STATE is omitted or nil, the function toggles the state,
7812 Value is the new state of the key, or nil if the function failed
7813 to change the state. */)
7814 (Lisp_Object key, Lisp_Object new_state)
7816 int vk_code;
7817 LPARAM lparam;
7819 if (EQ (key, intern ("capslock")))
7820 vk_code = VK_CAPITAL;
7821 else if (EQ (key, intern ("kp-numlock")))
7822 vk_code = VK_NUMLOCK;
7823 else if (EQ (key, intern ("scroll")))
7824 vk_code = VK_SCROLL;
7825 else
7826 return Qnil;
7828 if (!dwWindowsThreadId)
7829 return make_number (w32_console_toggle_lock_key (vk_code, new_state));
7831 if (NILP (new_state))
7832 lparam = -1;
7833 else
7834 lparam = (XUINT (new_state)) & 1;
7835 if (PostThreadMessage (dwWindowsThreadId, WM_EMACS_TOGGLE_LOCK_KEY,
7836 (WPARAM) vk_code, lparam))
7838 MSG msg;
7839 GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE);
7840 return make_number (msg.wParam);
7842 return Qnil;
7845 DEFUN ("w32-window-exists-p", Fw32_window_exists_p, Sw32_window_exists_p,
7846 2, 2, 0,
7847 doc: /* Return non-nil if a window exists with the specified CLASS and NAME.
7849 This is a direct interface to the Windows API FindWindow function. */)
7850 (Lisp_Object class, Lisp_Object name)
7852 HWND hnd;
7854 if (!NILP (class))
7855 CHECK_STRING (class);
7856 if (!NILP (name))
7857 CHECK_STRING (name);
7859 hnd = FindWindow (STRINGP (class) ? ((LPCTSTR) SDATA (class)) : NULL,
7860 STRINGP (name) ? ((LPCTSTR) SDATA (name)) : NULL);
7861 if (!hnd)
7862 return Qnil;
7863 return Qt;
7866 DEFUN ("w32-frame-geometry", Fw32_frame_geometry, Sw32_frame_geometry, 0, 1, 0,
7867 doc: /* Return geometric attributes of FRAME.
7868 FRAME must be a live frame and defaults to the selected one. The return
7869 value is an association list of the attributes listed below. All height
7870 and width values are in pixels.
7872 `outer-position' is a cons of the outer left and top edges of FRAME
7873 relative to the origin - the position (0, 0) - of FRAME's display.
7875 `outer-size' is a cons of the outer width and height of FRAME. The
7876 outer size includes the title bar and the external borders as well as
7877 any menu and/or tool bar of frame.
7879 `external-border-size' is a cons of the horizontal and vertical width of
7880 FRAME's external borders as supplied by the window manager.
7882 `title-bar-size' is a cons of the width and height of the title bar of
7883 FRAME as supplied by the window manager. If both of them are zero,
7884 FRAME has no title bar. If only the width is zero, Emacs was not
7885 able to retrieve the width information.
7887 `menu-bar-external', if non-nil, means the menu bar is external (never
7888 included in the inner edges of FRAME).
7890 `menu-bar-size' is a cons of the width and height of the menu bar of
7891 FRAME.
7893 `tool-bar-external', if non-nil, means the tool bar is external (never
7894 included in the inner edges of FRAME).
7896 `tool-bar-position' tells on which side the tool bar on FRAME is and can
7897 be one of `left', `top', `right' or `bottom'. If this is nil, FRAME
7898 has no tool bar.
7900 `tool-bar-size' is a cons of the width and height of the tool bar of
7901 FRAME.
7903 `internal-border-width' is the width of the internal border of
7904 FRAME. */)
7905 (Lisp_Object frame)
7907 struct frame *f = decode_live_frame (frame);
7909 MENUBARINFO menu_bar;
7910 WINDOWINFO window;
7911 int left, top, right, bottom;
7912 unsigned int external_border_width, external_border_height;
7913 int title_bar_width = 0, title_bar_height = 0;
7914 int single_menu_bar_height, wrapped_menu_bar_height, menu_bar_height;
7915 int tool_bar_height = FRAME_TOOL_BAR_HEIGHT (f);
7916 int internal_border_width = FRAME_INTERNAL_BORDER_WIDTH (f);
7918 if (FRAME_INITIAL_P (f) || !FRAME_W32_P (f))
7919 return Qnil;
7921 block_input ();
7922 /* Outer rectangle and borders. */
7923 window.cbSize = sizeof (window);
7924 GetWindowInfo (FRAME_W32_WINDOW (f), &window);
7925 external_border_width = window.cxWindowBorders;
7926 external_border_height = window.cyWindowBorders;
7927 /* Title bar. */
7928 if (get_title_bar_info_fn)
7930 TITLEBAR_INFO title_bar;
7932 title_bar.cbSize = sizeof (title_bar);
7933 title_bar.rcTitleBar.left = title_bar.rcTitleBar.right = 0;
7934 title_bar.rcTitleBar.top = title_bar.rcTitleBar.bottom = 0;
7935 for (int i = 0; i < 6; i++)
7936 title_bar.rgstate[i] = 0;
7937 if (get_title_bar_info_fn (FRAME_W32_WINDOW (f), &title_bar)
7938 && !(title_bar.rgstate[0] & 0x00008001))
7940 title_bar_width
7941 = title_bar.rcTitleBar.right - title_bar.rcTitleBar.left;
7942 title_bar_height
7943 = title_bar.rcTitleBar.bottom - title_bar.rcTitleBar.top;
7946 else if ((window.dwStyle & WS_CAPTION) == WS_CAPTION)
7947 title_bar_height = GetSystemMetrics (SM_CYCAPTION);
7948 /* Menu bar. */
7949 menu_bar.cbSize = sizeof (menu_bar);
7950 menu_bar.rcBar.right = menu_bar.rcBar.left = 0;
7951 menu_bar.rcBar.top = menu_bar.rcBar.bottom = 0;
7952 GetMenuBarInfo (FRAME_W32_WINDOW (f), 0xFFFFFFFD, 0, &menu_bar);
7953 single_menu_bar_height = GetSystemMetrics (SM_CYMENU);
7954 wrapped_menu_bar_height = GetSystemMetrics (SM_CYMENUSIZE);
7955 unblock_input ();
7957 left = window.rcWindow.left;
7958 top = window.rcWindow.top;
7959 right = window.rcWindow.right;
7960 bottom = window.rcWindow.bottom;
7962 /* Menu bar. */
7963 menu_bar_height = menu_bar.rcBar.bottom - menu_bar.rcBar.top;
7964 /* Fix menu bar height reported by GetMenuBarInfo. */
7965 if (menu_bar_height > single_menu_bar_height)
7966 /* A wrapped menu bar. */
7967 menu_bar_height += single_menu_bar_height - wrapped_menu_bar_height;
7968 else if (menu_bar_height > 0)
7969 /* A single line menu bar. */
7970 menu_bar_height = single_menu_bar_height;
7972 return listn (CONSTYPE_HEAP, 10,
7973 Fcons (Qouter_position,
7974 Fcons (make_number (left), make_number (top))),
7975 Fcons (Qouter_size,
7976 Fcons (make_number (right - left),
7977 make_number (bottom - top))),
7978 Fcons (Qexternal_border_size,
7979 Fcons (make_number (external_border_width),
7980 make_number (external_border_height))),
7981 Fcons (Qtitle_bar_size,
7982 Fcons (make_number (title_bar_width),
7983 make_number (title_bar_height))),
7984 Fcons (Qmenu_bar_external, Qt),
7985 Fcons (Qmenu_bar_size,
7986 Fcons (make_number
7987 (menu_bar.rcBar.right - menu_bar.rcBar.left),
7988 make_number (menu_bar_height))),
7989 Fcons (Qtool_bar_external, Qnil),
7990 Fcons (Qtool_bar_position, tool_bar_height ? Qtop : Qnil),
7991 Fcons (Qtool_bar_size,
7992 Fcons (make_number
7993 (tool_bar_height
7994 ? right - left - 2 * internal_border_width
7995 : 0),
7996 make_number (tool_bar_height))),
7997 Fcons (Qinternal_border_width,
7998 make_number (internal_border_width)));
8001 DEFUN ("w32-frame-edges", Fw32_frame_edges, Sw32_frame_edges, 0, 2, 0,
8002 doc: /* Return edge coordinates of FRAME.
8003 FRAME must be a live frame and defaults to the selected one. The return
8004 value is a list of the form (LEFT, TOP, RIGHT, BOTTOM). All values are
8005 in pixels relative to the origin - the position (0, 0) - of FRAME's
8006 display.
8008 If optional argument TYPE is the symbol `outer-edges', return the outer
8009 edges of FRAME. The outer edges comprise the decorations of the window
8010 manager (like the title bar or external borders) as well as any external
8011 menu or tool bar of FRAME. If optional argument TYPE is the symbol
8012 `native-edges' or nil, return the native edges of FRAME. The native
8013 edges exclude the decorations of the window manager and any external
8014 menu or tool bar of FRAME. If TYPE is the symbol `inner-edges', return
8015 the inner edges of FRAME. These edges exclude title bar, any borders,
8016 menu bar or tool bar of FRAME. */)
8017 (Lisp_Object frame, Lisp_Object type)
8019 struct frame *f = decode_live_frame (frame);
8021 if (FRAME_INITIAL_P (f) || !FRAME_W32_P (f))
8022 return Qnil;
8024 if (EQ (type, Qouter_edges))
8026 RECT rectangle;
8028 block_input ();
8029 /* Outer frame rectangle, including outer borders and title bar. */
8030 GetWindowRect (FRAME_W32_WINDOW (f), &rectangle);
8031 unblock_input ();
8033 return list4 (make_number (rectangle.left),
8034 make_number (rectangle.top),
8035 make_number (rectangle.right),
8036 make_number (rectangle.bottom));
8038 else
8040 RECT rectangle;
8041 POINT pt;
8042 int left, top, right, bottom;
8044 block_input ();
8045 /* Inner frame rectangle, excluding borders and title bar. */
8046 GetClientRect (FRAME_W32_WINDOW (f), &rectangle);
8047 /* Get top-left corner of native rectangle in screen
8048 coordinates. */
8049 pt.x = 0;
8050 pt.y = 0;
8051 ClientToScreen (FRAME_W32_WINDOW (f), &pt);
8052 unblock_input ();
8054 left = pt.x;
8055 top = pt.y;
8056 right = left + rectangle.right;
8057 bottom = top + rectangle.bottom;
8059 if (EQ (type, Qinner_edges))
8061 int internal_border_width = FRAME_INTERNAL_BORDER_WIDTH (f);
8063 return list4 (make_number (left + internal_border_width),
8064 make_number (top
8065 + FRAME_TOOL_BAR_HEIGHT (f)
8066 + internal_border_width),
8067 make_number (right - internal_border_width),
8068 make_number (bottom - internal_border_width));
8070 else
8071 return list4 (make_number (left), make_number (top),
8072 make_number (right), make_number (bottom));
8076 DEFUN ("w32-mouse-absolute-pixel-position", Fw32_mouse_absolute_pixel_position,
8077 Sw32_mouse_absolute_pixel_position, 0, 0, 0,
8078 doc: /* Return absolute position of mouse cursor in pixels.
8079 The position is returned as a cons cell (X . Y) of the coordinates of
8080 the mouse cursor position in pixels relative to a position (0, 0) of the
8081 selected frame's display. */)
8082 (void)
8084 POINT pt;
8086 block_input ();
8087 GetCursorPos (&pt);
8088 unblock_input ();
8090 return Fcons (make_number (pt.x), make_number (pt.y));
8093 DEFUN ("w32-set-mouse-absolute-pixel-position", Fw32_set_mouse_absolute_pixel_position,
8094 Sw32_set_mouse_absolute_pixel_position, 2, 2, 0,
8095 doc: /* Move mouse pointer to absolute pixel position (X, Y).
8096 The coordinates X and Y are interpreted in pixels relative to a position
8097 (0, 0) of the selected frame's display. */)
8098 (Lisp_Object x, Lisp_Object y)
8100 CHECK_TYPE_RANGED_INTEGER (int, x);
8101 CHECK_TYPE_RANGED_INTEGER (int, y);
8103 block_input ();
8104 SetCursorPos (XINT (x), XINT (y));
8105 unblock_input ();
8107 return Qnil;
8110 DEFUN ("w32-battery-status", Fw32_battery_status, Sw32_battery_status, 0, 0, 0,
8111 doc: /* Get power status information from Windows system.
8113 The following %-sequences are provided:
8114 %L AC line status (verbose)
8115 %B Battery status (verbose)
8116 %b Battery status, empty means high, `-' means low,
8117 `!' means critical, and `+' means charging
8118 %p Battery load percentage
8119 %s Remaining time (to charge or discharge) in seconds
8120 %m Remaining time (to charge or discharge) in minutes
8121 %h Remaining time (to charge or discharge) in hours
8122 %t Remaining time (to charge or discharge) in the form `h:min' */)
8123 (void)
8125 Lisp_Object status = Qnil;
8127 SYSTEM_POWER_STATUS system_status;
8128 if (GetSystemPowerStatus (&system_status))
8130 Lisp_Object line_status, battery_status, battery_status_symbol;
8131 Lisp_Object load_percentage, seconds, minutes, hours, remain;
8133 long seconds_left = (long) system_status.BatteryLifeTime;
8135 if (system_status.ACLineStatus == 0)
8136 line_status = build_string ("off-line");
8137 else if (system_status.ACLineStatus == 1)
8138 line_status = build_string ("on-line");
8139 else
8140 line_status = build_string ("N/A");
8142 if (system_status.BatteryFlag & 128)
8144 battery_status = build_string ("N/A");
8145 battery_status_symbol = empty_unibyte_string;
8147 else if (system_status.BatteryFlag & 8)
8149 battery_status = build_string ("charging");
8150 battery_status_symbol = build_string ("+");
8151 if (system_status.BatteryFullLifeTime != -1L)
8152 seconds_left = system_status.BatteryFullLifeTime - seconds_left;
8154 else if (system_status.BatteryFlag & 4)
8156 battery_status = build_string ("critical");
8157 battery_status_symbol = build_string ("!");
8159 else if (system_status.BatteryFlag & 2)
8161 battery_status = build_string ("low");
8162 battery_status_symbol = build_string ("-");
8164 else if (system_status.BatteryFlag & 1)
8166 battery_status = build_string ("high");
8167 battery_status_symbol = empty_unibyte_string;
8169 else
8171 battery_status = build_string ("medium");
8172 battery_status_symbol = empty_unibyte_string;
8175 if (system_status.BatteryLifePercent > 100)
8176 load_percentage = build_string ("N/A");
8177 else
8179 char buffer[16];
8180 snprintf (buffer, 16, "%d", system_status.BatteryLifePercent);
8181 load_percentage = build_string (buffer);
8184 if (seconds_left < 0)
8185 seconds = minutes = hours = remain = build_string ("N/A");
8186 else
8188 long m;
8189 float h;
8190 char buffer[16];
8191 snprintf (buffer, 16, "%ld", seconds_left);
8192 seconds = build_string (buffer);
8194 m = seconds_left / 60;
8195 snprintf (buffer, 16, "%ld", m);
8196 minutes = build_string (buffer);
8198 h = seconds_left / 3600.0;
8199 snprintf (buffer, 16, "%3.1f", h);
8200 hours = build_string (buffer);
8202 snprintf (buffer, 16, "%ld:%02ld", m / 60, m % 60);
8203 remain = build_string (buffer);
8206 status = listn (CONSTYPE_HEAP, 8,
8207 Fcons (make_number ('L'), line_status),
8208 Fcons (make_number ('B'), battery_status),
8209 Fcons (make_number ('b'), battery_status_symbol),
8210 Fcons (make_number ('p'), load_percentage),
8211 Fcons (make_number ('s'), seconds),
8212 Fcons (make_number ('m'), minutes),
8213 Fcons (make_number ('h'), hours),
8214 Fcons (make_number ('t'), remain));
8216 return status;
8220 #ifdef WINDOWSNT
8221 typedef BOOL (WINAPI *GetDiskFreeSpaceExW_Proc)
8222 (LPCWSTR, PULARGE_INTEGER, PULARGE_INTEGER, PULARGE_INTEGER);
8223 typedef BOOL (WINAPI *GetDiskFreeSpaceExA_Proc)
8224 (LPCSTR, PULARGE_INTEGER, PULARGE_INTEGER, PULARGE_INTEGER);
8226 DEFUN ("file-system-info", Ffile_system_info, Sfile_system_info, 1, 1, 0,
8227 doc: /* Return storage information about the file system FILENAME is on.
8228 Value is a list of floats (TOTAL FREE AVAIL), where TOTAL is the total
8229 storage of the file system, FREE is the free storage, and AVAIL is the
8230 storage available to a non-superuser. All 3 numbers are in bytes.
8231 If the underlying system call fails, value is nil. */)
8232 (Lisp_Object filename)
8234 Lisp_Object encoded, value;
8236 CHECK_STRING (filename);
8237 filename = Fexpand_file_name (filename, Qnil);
8238 encoded = ENCODE_FILE (filename);
8240 value = Qnil;
8242 /* Determining the required information on Windows turns out, sadly,
8243 to be more involved than one would hope. The original Windows API
8244 call for this will return bogus information on some systems, but we
8245 must dynamically probe for the replacement api, since that was
8246 added rather late on. */
8248 HMODULE hKernel = GetModuleHandle ("kernel32");
8249 GetDiskFreeSpaceExW_Proc pfn_GetDiskFreeSpaceExW =
8250 (GetDiskFreeSpaceExW_Proc) GetProcAddress (hKernel, "GetDiskFreeSpaceExW");
8251 GetDiskFreeSpaceExA_Proc pfn_GetDiskFreeSpaceExA =
8252 (GetDiskFreeSpaceExA_Proc) GetProcAddress (hKernel, "GetDiskFreeSpaceExA");
8253 bool have_pfn_GetDiskFreeSpaceEx =
8254 ((w32_unicode_filenames && pfn_GetDiskFreeSpaceExW)
8255 || (!w32_unicode_filenames && pfn_GetDiskFreeSpaceExA));
8257 /* On Windows, we may need to specify the root directory of the
8258 volume holding FILENAME. */
8259 char rootname[MAX_UTF8_PATH];
8260 wchar_t rootname_w[MAX_PATH];
8261 char rootname_a[MAX_PATH];
8262 char *name = SSDATA (encoded);
8263 BOOL result;
8265 /* find the root name of the volume if given */
8266 if (isalpha (name[0]) && name[1] == ':')
8268 rootname[0] = name[0];
8269 rootname[1] = name[1];
8270 rootname[2] = '\\';
8271 rootname[3] = 0;
8273 else if (IS_DIRECTORY_SEP (name[0]) && IS_DIRECTORY_SEP (name[1]))
8275 char *str = rootname;
8276 int slashes = 4;
8279 if (IS_DIRECTORY_SEP (*name) && --slashes == 0)
8280 break;
8281 *str++ = *name++;
8283 while ( *name );
8285 *str++ = '\\';
8286 *str = 0;
8289 if (w32_unicode_filenames)
8290 filename_to_utf16 (rootname, rootname_w);
8291 else
8292 filename_to_ansi (rootname, rootname_a);
8294 if (have_pfn_GetDiskFreeSpaceEx)
8296 /* Unsigned large integers cannot be cast to double, so
8297 use signed ones instead. */
8298 LARGE_INTEGER availbytes;
8299 LARGE_INTEGER freebytes;
8300 LARGE_INTEGER totalbytes;
8302 if (w32_unicode_filenames)
8303 result = pfn_GetDiskFreeSpaceExW (rootname_w,
8304 (ULARGE_INTEGER *)&availbytes,
8305 (ULARGE_INTEGER *)&totalbytes,
8306 (ULARGE_INTEGER *)&freebytes);
8307 else
8308 result = pfn_GetDiskFreeSpaceExA (rootname_a,
8309 (ULARGE_INTEGER *)&availbytes,
8310 (ULARGE_INTEGER *)&totalbytes,
8311 (ULARGE_INTEGER *)&freebytes);
8312 if (result)
8313 value = list3 (make_float ((double) totalbytes.QuadPart),
8314 make_float ((double) freebytes.QuadPart),
8315 make_float ((double) availbytes.QuadPart));
8317 else
8319 DWORD sectors_per_cluster;
8320 DWORD bytes_per_sector;
8321 DWORD free_clusters;
8322 DWORD total_clusters;
8324 if (w32_unicode_filenames)
8325 result = GetDiskFreeSpaceW (rootname_w,
8326 &sectors_per_cluster,
8327 &bytes_per_sector,
8328 &free_clusters,
8329 &total_clusters);
8330 else
8331 result = GetDiskFreeSpaceA (rootname_a,
8332 &sectors_per_cluster,
8333 &bytes_per_sector,
8334 &free_clusters,
8335 &total_clusters);
8336 if (result)
8337 value = list3 (make_float ((double) total_clusters
8338 * sectors_per_cluster * bytes_per_sector),
8339 make_float ((double) free_clusters
8340 * sectors_per_cluster * bytes_per_sector),
8341 make_float ((double) free_clusters
8342 * sectors_per_cluster * bytes_per_sector));
8346 return value;
8348 #endif /* WINDOWSNT */
8351 #ifdef WINDOWSNT
8352 DEFUN ("default-printer-name", Fdefault_printer_name, Sdefault_printer_name,
8353 0, 0, 0, doc: /* Return the name of Windows default printer device. */)
8354 (void)
8356 static char pname_buf[256];
8357 int err;
8358 HANDLE hPrn;
8359 PRINTER_INFO_2W *ppi2w = NULL;
8360 PRINTER_INFO_2A *ppi2a = NULL;
8361 DWORD dwNeeded = 0, dwReturned = 0;
8362 char server_name[MAX_UTF8_PATH], share_name[MAX_UTF8_PATH];
8363 char port_name[MAX_UTF8_PATH];
8365 /* Retrieve the default string from Win.ini (the registry).
8366 * String will be in form "printername,drivername,portname".
8367 * This is the most portable way to get the default printer. */
8368 if (GetProfileString ("windows", "device", ",,", pname_buf, sizeof (pname_buf)) <= 0)
8369 return Qnil;
8370 /* printername precedes first "," character */
8371 strtok (pname_buf, ",");
8372 /* We want to know more than the printer name */
8373 if (!OpenPrinter (pname_buf, &hPrn, NULL))
8374 return Qnil;
8375 /* GetPrinterW is not supported by unicows.dll. */
8376 if (w32_unicode_filenames && os_subtype != OS_9X)
8377 GetPrinterW (hPrn, 2, NULL, 0, &dwNeeded);
8378 else
8379 GetPrinterA (hPrn, 2, NULL, 0, &dwNeeded);
8380 if (dwNeeded == 0)
8382 ClosePrinter (hPrn);
8383 return Qnil;
8385 /* Call GetPrinter again with big enough memory block. */
8386 if (w32_unicode_filenames && os_subtype != OS_9X)
8388 /* Allocate memory for the PRINTER_INFO_2 struct. */
8389 ppi2w = xmalloc (dwNeeded);
8390 err = GetPrinterW (hPrn, 2, (LPBYTE)ppi2w, dwNeeded, &dwReturned);
8391 ClosePrinter (hPrn);
8392 if (!err)
8394 xfree (ppi2w);
8395 return Qnil;
8398 if ((ppi2w->Attributes & PRINTER_ATTRIBUTE_SHARED)
8399 && ppi2w->pServerName)
8401 filename_from_utf16 (ppi2w->pServerName, server_name);
8402 filename_from_utf16 (ppi2w->pShareName, share_name);
8404 else
8406 server_name[0] = '\0';
8407 filename_from_utf16 (ppi2w->pPortName, port_name);
8410 else
8412 ppi2a = xmalloc (dwNeeded);
8413 err = GetPrinterA (hPrn, 2, (LPBYTE)ppi2a, dwNeeded, &dwReturned);
8414 ClosePrinter (hPrn);
8415 if (!err)
8417 xfree (ppi2a);
8418 return Qnil;
8421 if ((ppi2a->Attributes & PRINTER_ATTRIBUTE_SHARED)
8422 && ppi2a->pServerName)
8424 filename_from_ansi (ppi2a->pServerName, server_name);
8425 filename_from_ansi (ppi2a->pShareName, share_name);
8427 else
8429 server_name[0] = '\0';
8430 filename_from_ansi (ppi2a->pPortName, port_name);
8434 if (server_name[0])
8436 /* a remote printer */
8437 if (server_name[0] == '\\')
8438 snprintf (pname_buf, sizeof (pname_buf), "%s\\%s", server_name,
8439 share_name);
8440 else
8441 snprintf (pname_buf, sizeof (pname_buf), "\\\\%s\\%s", server_name,
8442 share_name);
8443 pname_buf[sizeof (pname_buf) - 1] = '\0';
8445 else
8447 /* a local printer */
8448 strncpy (pname_buf, port_name, sizeof (pname_buf));
8449 pname_buf[sizeof (pname_buf) - 1] = '\0';
8450 /* `pPortName' can include several ports, delimited by ','.
8451 * we only use the first one. */
8452 strtok (pname_buf, ",");
8455 return DECODE_FILE (build_unibyte_string (pname_buf));
8457 #endif /* WINDOWSNT */
8460 /* Equivalent of strerror for W32 error codes. */
8461 char *
8462 w32_strerror (int error_no)
8464 static char buf[500];
8465 DWORD ret;
8467 if (error_no == 0)
8468 error_no = GetLastError ();
8470 ret = FormatMessage (FORMAT_MESSAGE_FROM_SYSTEM |
8471 FORMAT_MESSAGE_IGNORE_INSERTS,
8472 NULL,
8473 error_no,
8474 0, /* choose most suitable language */
8475 buf, sizeof (buf), NULL);
8477 while (ret > 0 && (buf[ret - 1] == '\n' ||
8478 buf[ret - 1] == '\r' ))
8479 --ret;
8480 buf[ret] = '\0';
8481 if (!ret)
8482 sprintf (buf, "w32 error %u", error_no);
8484 return buf;
8487 /* For convenience when debugging. (You cannot call GetLastError
8488 directly from GDB: it will crash, because it uses the __stdcall
8489 calling convention, not the _cdecl convention assumed by GDB.) */
8490 DWORD
8491 w32_last_error (void)
8493 return GetLastError ();
8496 /* Cache information describing the NT system for later use. */
8497 void
8498 cache_system_info (void)
8500 union
8502 struct info
8504 char major;
8505 char minor;
8506 short platform;
8507 } info;
8508 DWORD data;
8509 } version;
8511 /* Cache the module handle of Emacs itself. */
8512 hinst = GetModuleHandle (NULL);
8514 /* Cache the version of the operating system. */
8515 version.data = GetVersion ();
8516 w32_major_version = version.info.major;
8517 w32_minor_version = version.info.minor;
8519 if (version.info.platform & 0x8000)
8520 os_subtype = OS_9X;
8521 else
8522 os_subtype = OS_NT;
8524 /* Cache page size, allocation unit, processor type, etc. */
8525 GetSystemInfo (&sysinfo_cache);
8526 syspage_mask = (DWORD_PTR)sysinfo_cache.dwPageSize - 1;
8528 /* Cache os info. */
8529 osinfo_cache.dwOSVersionInfoSize = sizeof (OSVERSIONINFO);
8530 GetVersionEx (&osinfo_cache);
8532 w32_build_number = osinfo_cache.dwBuildNumber;
8533 if (os_subtype == OS_9X)
8534 w32_build_number &= 0xffff;
8536 w32_num_mouse_buttons = GetSystemMetrics (SM_CMOUSEBUTTONS);
8539 #ifdef EMACSDEBUG
8540 void
8541 _DebPrint (const char *fmt, ...)
8543 char buf[1024];
8544 va_list args;
8546 va_start (args, fmt);
8547 vsprintf (buf, fmt, args);
8548 va_end (args);
8549 #if CYGWIN
8550 fprintf (stderr, "%s", buf);
8551 #endif
8552 OutputDebugString (buf);
8554 #endif
8557 w32_console_toggle_lock_key (int vk_code, Lisp_Object new_state)
8559 int cur_state = (GetKeyState (vk_code) & 1);
8561 if (NILP (new_state)
8562 || (NUMBERP (new_state)
8563 && ((XUINT (new_state)) & 1) != cur_state))
8565 #ifdef WINDOWSNT
8566 faked_key = vk_code;
8567 #endif /* WINDOWSNT */
8569 keybd_event ((BYTE) vk_code,
8570 (BYTE) MapVirtualKey (vk_code, 0),
8571 KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
8572 keybd_event ((BYTE) vk_code,
8573 (BYTE) MapVirtualKey (vk_code, 0),
8574 KEYEVENTF_EXTENDEDKEY | 0, 0);
8575 keybd_event ((BYTE) vk_code,
8576 (BYTE) MapVirtualKey (vk_code, 0),
8577 KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
8578 cur_state = !cur_state;
8581 return cur_state;
8584 /* Translate console modifiers to emacs modifiers.
8585 German keyboard support (Kai Morgan Zeise 2/18/95). */
8587 w32_kbd_mods_to_emacs (DWORD mods, WORD key)
8589 int retval = 0;
8591 /* If we recognize right-alt and left-ctrl as AltGr, and it has been
8592 pressed, first remove those modifiers. */
8593 if (!NILP (Vw32_recognize_altgr)
8594 && (mods & (RIGHT_ALT_PRESSED | LEFT_CTRL_PRESSED))
8595 == (RIGHT_ALT_PRESSED | LEFT_CTRL_PRESSED))
8596 mods &= ~ (RIGHT_ALT_PRESSED | LEFT_CTRL_PRESSED);
8598 if (mods & (RIGHT_ALT_PRESSED | LEFT_ALT_PRESSED))
8599 retval = ((NILP (Vw32_alt_is_meta)) ? alt_modifier : meta_modifier);
8601 if (mods & (RIGHT_CTRL_PRESSED | LEFT_CTRL_PRESSED))
8603 retval |= ctrl_modifier;
8604 if ((mods & (RIGHT_CTRL_PRESSED | LEFT_CTRL_PRESSED))
8605 == (RIGHT_CTRL_PRESSED | LEFT_CTRL_PRESSED))
8606 retval |= meta_modifier;
8609 if (mods & LEFT_WIN_PRESSED)
8610 retval |= w32_key_to_modifier (VK_LWIN);
8611 if (mods & RIGHT_WIN_PRESSED)
8612 retval |= w32_key_to_modifier (VK_RWIN);
8613 if (mods & APPS_PRESSED)
8614 retval |= w32_key_to_modifier (VK_APPS);
8615 if (mods & SCROLLLOCK_ON)
8616 retval |= w32_key_to_modifier (VK_SCROLL);
8618 /* Just in case someone wanted the original behavior, make it
8619 optional by setting w32-capslock-is-shiftlock to t. */
8620 if (NILP (Vw32_capslock_is_shiftlock)
8621 /* Keys that should _not_ be affected by CapsLock. */
8622 && ( (key == VK_BACK)
8623 || (key == VK_TAB)
8624 || (key == VK_CLEAR)
8625 || (key == VK_RETURN)
8626 || (key == VK_ESCAPE)
8627 || ((key >= VK_SPACE) && (key <= VK_HELP))
8628 || ((key >= VK_NUMPAD0) && (key <= VK_F24))
8629 || ((key >= VK_NUMPAD_CLEAR) && (key <= VK_NUMPAD_DELETE))
8632 /* Only consider shift state. */
8633 if ((mods & SHIFT_PRESSED) != 0)
8634 retval |= shift_modifier;
8636 else
8638 /* Ignore CapsLock state if not enabled. */
8639 if (NILP (Vw32_enable_caps_lock))
8640 mods &= ~CAPSLOCK_ON;
8641 if ((mods & (SHIFT_PRESSED | CAPSLOCK_ON)) != 0)
8642 retval |= shift_modifier;
8645 return retval;
8648 /* The return code indicates key code size. cpID is the codepage to
8649 use for translation to Unicode; -1 means use the current console
8650 input codepage. */
8652 w32_kbd_patch_key (KEY_EVENT_RECORD *event, int cpId)
8654 unsigned int key_code = event->wVirtualKeyCode;
8655 unsigned int mods = event->dwControlKeyState;
8656 BYTE keystate[256];
8657 static BYTE ansi_code[4];
8658 static int isdead = 0;
8660 if (isdead == 2)
8662 event->uChar.AsciiChar = ansi_code[2];
8663 isdead = 0;
8664 return 1;
8666 if (event->uChar.AsciiChar != 0)
8667 return 1;
8669 memset (keystate, 0, sizeof (keystate));
8670 keystate[key_code] = 0x80;
8671 if (mods & SHIFT_PRESSED)
8672 keystate[VK_SHIFT] = 0x80;
8673 if (mods & CAPSLOCK_ON)
8674 keystate[VK_CAPITAL] = 1;
8675 /* If we recognize right-alt and left-ctrl as AltGr, set the key
8676 states accordingly before invoking ToAscii. */
8677 if (!NILP (Vw32_recognize_altgr)
8678 && (mods & LEFT_CTRL_PRESSED) && (mods & RIGHT_ALT_PRESSED))
8680 keystate[VK_CONTROL] = 0x80;
8681 keystate[VK_LCONTROL] = 0x80;
8682 keystate[VK_MENU] = 0x80;
8683 keystate[VK_RMENU] = 0x80;
8686 #if 0
8687 /* Because of an OS bug, ToAscii corrupts the stack when called to
8688 convert a dead key in console mode on NT4. Unfortunately, trying
8689 to check for dead keys using MapVirtualKey doesn't work either -
8690 these functions apparently use internal information about keyboard
8691 layout which doesn't get properly updated in console programs when
8692 changing layout (though apparently it gets partly updated,
8693 otherwise ToAscii wouldn't crash). */
8694 if (is_dead_key (event->wVirtualKeyCode))
8695 return 0;
8696 #endif
8698 /* On NT, call ToUnicode instead and then convert to the current
8699 console input codepage. */
8700 if (os_subtype == OS_NT)
8702 WCHAR buf[128];
8704 isdead = ToUnicode (event->wVirtualKeyCode, event->wVirtualScanCode,
8705 keystate, buf, 128, 0);
8706 if (isdead > 0)
8708 /* When we are called from the GUI message processing code,
8709 we are passed the current keyboard codepage, a positive
8710 number, to use below. */
8711 if (cpId == -1)
8712 cpId = GetConsoleCP ();
8714 event->uChar.UnicodeChar = buf[isdead - 1];
8715 isdead = WideCharToMultiByte (cpId, 0, buf, isdead,
8716 (LPSTR)ansi_code, 4, NULL, NULL);
8718 else
8719 isdead = 0;
8721 else
8723 isdead = ToAscii (event->wVirtualKeyCode, event->wVirtualScanCode,
8724 keystate, (LPWORD) ansi_code, 0);
8727 if (isdead == 0)
8728 return 0;
8729 event->uChar.AsciiChar = ansi_code[0];
8730 return isdead;
8734 void
8735 w32_sys_ring_bell (struct frame *f)
8737 if (sound_type == 0xFFFFFFFF)
8739 Beep (666, 100);
8741 else if (sound_type == MB_EMACS_SILENT)
8743 /* Do nothing. */
8745 else
8746 MessageBeep (sound_type);
8749 DEFUN ("w32--menu-bar-in-use", Fw32__menu_bar_in_use, Sw32__menu_bar_in_use,
8750 0, 0, 0,
8751 doc: /* Return non-nil when a menu-bar menu is being used.
8752 Internal use only. */)
8753 (void)
8755 return menubar_in_use ? Qt : Qnil;
8759 /***********************************************************************
8760 Initialization
8761 ***********************************************************************/
8763 /* Keep this list in the same order as frame_parms in frame.c.
8764 Use 0 for unsupported frame parameters. */
8766 frame_parm_handler w32_frame_parm_handlers[] =
8768 x_set_autoraise,
8769 x_set_autolower,
8770 x_set_background_color,
8771 x_set_border_color,
8772 x_set_border_width,
8773 x_set_cursor_color,
8774 x_set_cursor_type,
8775 x_set_font,
8776 x_set_foreground_color,
8777 x_set_icon_name,
8778 x_set_icon_type,
8779 x_set_internal_border_width,
8780 x_set_right_divider_width,
8781 x_set_bottom_divider_width,
8782 x_set_menu_bar_lines,
8783 x_set_mouse_color,
8784 x_explicitly_set_name,
8785 x_set_scroll_bar_width,
8786 x_set_scroll_bar_height,
8787 x_set_title,
8788 x_set_unsplittable,
8789 x_set_vertical_scroll_bars,
8790 x_set_horizontal_scroll_bars,
8791 x_set_visibility,
8792 x_set_tool_bar_lines,
8793 0, /* x_set_scroll_bar_foreground, */
8794 0, /* x_set_scroll_bar_background, */
8795 x_set_screen_gamma,
8796 x_set_line_spacing,
8797 x_set_left_fringe,
8798 x_set_right_fringe,
8799 0, /* x_set_wait_for_wm, */
8800 x_set_fullscreen,
8801 x_set_font_backend,
8802 x_set_alpha,
8803 0, /* x_set_sticky */
8804 0, /* x_set_tool_bar_position */
8807 void
8808 syms_of_w32fns (void)
8810 globals_of_w32fns ();
8811 track_mouse_window = NULL;
8813 w32_visible_system_caret_hwnd = NULL;
8815 DEFSYM (Qundefined_color, "undefined-color");
8816 DEFSYM (Qcancel_timer, "cancel-timer");
8817 DEFSYM (Qhyper, "hyper");
8818 DEFSYM (Qsuper, "super");
8819 DEFSYM (Qmeta, "meta");
8820 DEFSYM (Qalt, "alt");
8821 DEFSYM (Qctrl, "ctrl");
8822 DEFSYM (Qcontrol, "control");
8823 DEFSYM (Qshift, "shift");
8824 DEFSYM (Qfont_param, "font-parameter");
8825 DEFSYM (Qgeometry, "geometry");
8826 DEFSYM (Qworkarea, "workarea");
8827 DEFSYM (Qmm_size, "mm-size");
8828 DEFSYM (Qframes, "frames");
8829 DEFSYM (Qtip_frame, "tip-frame");
8830 DEFSYM (Qunicode_sip, "unicode-sip");
8832 /* Symbols used elsewhere, but only in MS-Windows-specific code. */
8833 DEFSYM (Qgnutls_dll, "gnutls");
8834 DEFSYM (Qlibxml2_dll, "libxml2");
8835 DEFSYM (Qserif, "serif");
8836 DEFSYM (Qzlib_dll, "zlib");
8838 Fput (Qundefined_color, Qerror_conditions,
8839 listn (CONSTYPE_PURE, 2, Qundefined_color, Qerror));
8840 Fput (Qundefined_color, Qerror_message,
8841 build_pure_c_string ("Undefined color"));
8843 staticpro (&w32_grabbed_keys);
8844 w32_grabbed_keys = Qnil;
8846 DEFVAR_LISP ("w32-color-map", Vw32_color_map,
8847 doc: /* An array of color name mappings for Windows. */);
8848 Vw32_color_map = Qnil;
8850 DEFVAR_LISP ("w32-pass-alt-to-system", Vw32_pass_alt_to_system,
8851 doc: /* Non-nil if Alt key presses are passed on to Windows.
8852 When non-nil, for example, Alt pressed and released and then space will
8853 open the System menu. When nil, Emacs processes the Alt key events, and
8854 then silently swallows them. */);
8855 Vw32_pass_alt_to_system = Qnil;
8857 DEFVAR_LISP ("w32-alt-is-meta", Vw32_alt_is_meta,
8858 doc: /* Non-nil if the Alt key is to be considered the same as the META key.
8859 When nil, Emacs will translate the Alt key to the ALT modifier, not to META. */);
8860 Vw32_alt_is_meta = Qt;
8862 DEFVAR_INT ("w32-quit-key", w32_quit_key,
8863 doc: /* If non-zero, the virtual key code for an alternative quit key. */);
8864 w32_quit_key = 0;
8866 DEFVAR_LISP ("w32-pass-lwindow-to-system",
8867 Vw32_pass_lwindow_to_system,
8868 doc: /* If non-nil, the left \"Windows\" key is passed on to Windows.
8870 When non-nil, the Start menu is opened by tapping the key.
8871 If you set this to nil, the left \"Windows\" key is processed by Emacs
8872 according to the value of `w32-lwindow-modifier', which see.
8874 Note that some combinations of the left \"Windows\" key with other keys are
8875 caught by Windows at low level, and so binding them in Emacs will have no
8876 effect. For example, <lwindow>-r always pops up the Windows Run dialog,
8877 <lwindow>-<Pause> pops up the "System Properties" dialog, etc. However, see
8878 the doc string of `w32-phantom-key-code'. */);
8879 Vw32_pass_lwindow_to_system = Qt;
8881 DEFVAR_LISP ("w32-pass-rwindow-to-system",
8882 Vw32_pass_rwindow_to_system,
8883 doc: /* If non-nil, the right \"Windows\" key is passed on to Windows.
8885 When non-nil, the Start menu is opened by tapping the key.
8886 If you set this to nil, the right \"Windows\" key is processed by Emacs
8887 according to the value of `w32-rwindow-modifier', which see.
8889 Note that some combinations of the right \"Windows\" key with other keys are
8890 caught by Windows at low level, and so binding them in Emacs will have no
8891 effect. For example, <rwindow>-r always pops up the Windows Run dialog,
8892 <rwindow>-<Pause> pops up the "System Properties" dialog, etc. However, see
8893 the doc string of `w32-phantom-key-code'. */);
8894 Vw32_pass_rwindow_to_system = Qt;
8896 DEFVAR_LISP ("w32-phantom-key-code",
8897 Vw32_phantom_key_code,
8898 doc: /* Virtual key code used to generate \"phantom\" key presses.
8899 Value is a number between 0 and 255.
8901 Phantom key presses are generated in order to stop the system from
8902 acting on \"Windows\" key events when `w32-pass-lwindow-to-system' or
8903 `w32-pass-rwindow-to-system' is nil. */);
8904 /* Although 255 is technically not a valid key code, it works and
8905 means that this hack won't interfere with any real key code. */
8906 XSETINT (Vw32_phantom_key_code, 255);
8908 DEFVAR_LISP ("w32-enable-num-lock",
8909 Vw32_enable_num_lock,
8910 doc: /* If non-nil, the Num Lock key acts normally.
8911 Set to nil to handle Num Lock as the `kp-numlock' key. */);
8912 Vw32_enable_num_lock = Qt;
8914 DEFVAR_LISP ("w32-enable-caps-lock",
8915 Vw32_enable_caps_lock,
8916 doc: /* If non-nil, the Caps Lock key acts normally.
8917 Set to nil to handle Caps Lock as the `capslock' key. */);
8918 Vw32_enable_caps_lock = Qt;
8920 DEFVAR_LISP ("w32-scroll-lock-modifier",
8921 Vw32_scroll_lock_modifier,
8922 doc: /* Modifier to use for the Scroll Lock ON state.
8923 The value can be hyper, super, meta, alt, control or shift for the
8924 respective modifier, or nil to handle Scroll Lock as the `scroll' key.
8925 Any other value will cause the Scroll Lock key to be ignored. */);
8926 Vw32_scroll_lock_modifier = Qnil;
8928 DEFVAR_LISP ("w32-lwindow-modifier",
8929 Vw32_lwindow_modifier,
8930 doc: /* Modifier to use for the left \"Windows\" key.
8931 The value can be hyper, super, meta, alt, control or shift for the
8932 respective modifier, or nil to appear as the `lwindow' key.
8933 Any other value will cause the key to be ignored. */);
8934 Vw32_lwindow_modifier = Qnil;
8936 DEFVAR_LISP ("w32-rwindow-modifier",
8937 Vw32_rwindow_modifier,
8938 doc: /* Modifier to use for the right \"Windows\" key.
8939 The value can be hyper, super, meta, alt, control or shift for the
8940 respective modifier, or nil to appear as the `rwindow' key.
8941 Any other value will cause the key to be ignored. */);
8942 Vw32_rwindow_modifier = Qnil;
8944 DEFVAR_LISP ("w32-apps-modifier",
8945 Vw32_apps_modifier,
8946 doc: /* Modifier to use for the \"Apps\" key.
8947 The value can be hyper, super, meta, alt, control or shift for the
8948 respective modifier, or nil to appear as the `apps' key.
8949 Any other value will cause the key to be ignored. */);
8950 Vw32_apps_modifier = Qnil;
8952 DEFVAR_BOOL ("w32-enable-synthesized-fonts", w32_enable_synthesized_fonts,
8953 doc: /* Non-nil enables selection of artificially italicized and bold fonts. */);
8954 w32_enable_synthesized_fonts = 0;
8956 DEFVAR_LISP ("w32-enable-palette", Vw32_enable_palette,
8957 doc: /* Non-nil enables Windows palette management to map colors exactly. */);
8958 Vw32_enable_palette = Qt;
8960 DEFVAR_INT ("w32-mouse-button-tolerance",
8961 w32_mouse_button_tolerance,
8962 doc: /* Analogue of double click interval for faking middle mouse events.
8963 The value is the minimum time in milliseconds that must elapse between
8964 left and right button down events before they are considered distinct events.
8965 If both mouse buttons are depressed within this interval, a middle mouse
8966 button down event is generated instead. */);
8967 w32_mouse_button_tolerance = GetDoubleClickTime () / 2;
8969 DEFVAR_INT ("w32-mouse-move-interval",
8970 w32_mouse_move_interval,
8971 doc: /* Minimum interval between mouse move events.
8972 The value is the minimum time in milliseconds that must elapse between
8973 successive mouse move (or scroll bar drag) events before they are
8974 reported as lisp events. */);
8975 w32_mouse_move_interval = 0;
8977 DEFVAR_BOOL ("w32-pass-extra-mouse-buttons-to-system",
8978 w32_pass_extra_mouse_buttons_to_system,
8979 doc: /* If non-nil, the fourth and fifth mouse buttons are passed to Windows.
8980 Recent versions of Windows support mice with up to five buttons.
8981 Since most applications don't support these extra buttons, most mouse
8982 drivers will allow you to map them to functions at the system level.
8983 If this variable is non-nil, Emacs will pass them on, allowing the
8984 system to handle them. */);
8985 w32_pass_extra_mouse_buttons_to_system = 0;
8987 DEFVAR_BOOL ("w32-pass-multimedia-buttons-to-system",
8988 w32_pass_multimedia_buttons_to_system,
8989 doc: /* If non-nil, media buttons are passed to Windows.
8990 Some modern keyboards contain buttons for controlling media players, web
8991 browsers and other applications. Generally these buttons are handled on a
8992 system wide basis, but by setting this to nil they are made available
8993 to Emacs for binding. Depending on your keyboard, additional keys that
8994 may be available are:
8996 browser-back, browser-forward, browser-refresh, browser-stop,
8997 browser-search, browser-favorites, browser-home,
8998 mail, mail-reply, mail-forward, mail-send,
8999 app-1, app-2,
9000 help, find, new, open, close, save, print, undo, redo, copy, cut, paste,
9001 spell-check, correction-list, toggle-dictate-command,
9002 media-next, media-previous, media-stop, media-play-pause, media-select,
9003 media-play, media-pause, media-record, media-fast-forward, media-rewind,
9004 media-channel-up, media-channel-down,
9005 volume-mute, volume-up, volume-down,
9006 mic-volume-mute, mic-volume-down, mic-volume-up, mic-toggle,
9007 bass-down, bass-boost, bass-up, treble-down, treble-up */);
9008 w32_pass_multimedia_buttons_to_system = 1;
9010 #if 0 /* TODO: Mouse cursor customization. */
9011 DEFVAR_LISP ("x-pointer-shape", Vx_pointer_shape,
9012 doc: /* The shape of the pointer when over text.
9013 Changing the value does not affect existing frames
9014 unless you set the mouse color. */);
9015 Vx_pointer_shape = Qnil;
9017 Vx_nontext_pointer_shape = Qnil;
9019 Vx_mode_pointer_shape = Qnil;
9021 DEFVAR_LISP ("x-hourglass-pointer-shape", Vx_hourglass_pointer_shape,
9022 doc: /* The shape of the pointer when Emacs is busy.
9023 This variable takes effect when you create a new frame
9024 or when you set the mouse color. */);
9025 Vx_hourglass_pointer_shape = Qnil;
9027 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
9028 Vx_sensitive_text_pointer_shape,
9029 doc: /* The shape of the pointer when over mouse-sensitive text.
9030 This variable takes effect when you create a new frame
9031 or when you set the mouse color. */);
9032 Vx_sensitive_text_pointer_shape = Qnil;
9034 DEFVAR_LISP ("x-window-horizontal-drag-cursor",
9035 Vx_window_horizontal_drag_shape,
9036 doc: /* Pointer shape to use for indicating a window can be dragged horizontally.
9037 This variable takes effect when you create a new frame
9038 or when you set the mouse color. */);
9039 Vx_window_horizontal_drag_shape = Qnil;
9041 DEFVAR_LISP ("x-window-vertical-drag-cursor",
9042 Vx_window_vertical_drag_shape,
9043 doc: /* Pointer shape to use for indicating a window can be dragged vertically.
9044 This variable takes effect when you create a new frame
9045 or when you set the mouse color. */);
9046 Vx_window_vertical_drag_shape = Qnil;
9047 #endif
9049 DEFVAR_LISP ("x-cursor-fore-pixel", Vx_cursor_fore_pixel,
9050 doc: /* A string indicating the foreground color of the cursor box. */);
9051 Vx_cursor_fore_pixel = Qnil;
9053 DEFVAR_LISP ("x-max-tooltip-size", Vx_max_tooltip_size,
9054 doc: /* Maximum size for tooltips.
9055 Value is a pair (COLUMNS . ROWS). Text larger than this is clipped. */);
9056 Vx_max_tooltip_size = Fcons (make_number (80), make_number (40));
9058 DEFVAR_LISP ("x-no-window-manager", Vx_no_window_manager,
9059 doc: /* Non-nil if no window manager is in use.
9060 Emacs doesn't try to figure this out; this is always nil
9061 unless you set it to something else. */);
9062 /* We don't have any way to find this out, so set it to nil
9063 and maybe the user would like to set it to t. */
9064 Vx_no_window_manager = Qnil;
9066 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
9067 Vx_pixel_size_width_font_regexp,
9068 doc: /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'.
9070 Since Emacs gets width of a font matching with this regexp from
9071 PIXEL_SIZE field of the name, font finding mechanism gets faster for
9072 such a font. This is especially effective for such large fonts as
9073 Chinese, Japanese, and Korean. */);
9074 Vx_pixel_size_width_font_regexp = Qnil;
9076 DEFVAR_LISP ("w32-bdf-filename-alist",
9077 Vw32_bdf_filename_alist,
9078 doc: /* List of bdf fonts and their corresponding filenames. */);
9079 Vw32_bdf_filename_alist = Qnil;
9081 DEFVAR_BOOL ("w32-strict-fontnames",
9082 w32_strict_fontnames,
9083 doc: /* Non-nil means only use fonts that are exact matches for those requested.
9084 Default is nil, which allows old fontnames that are not XLFD compliant,
9085 and allows third-party CJK display to work by specifying false charset
9086 fields to trick Emacs into translating to Big5, SJIS etc.
9087 Setting this to t will prevent wrong fonts being selected when
9088 fontsets are automatically created. */);
9089 w32_strict_fontnames = 0;
9091 DEFVAR_BOOL ("w32-strict-painting",
9092 w32_strict_painting,
9093 doc: /* Non-nil means use strict rules for repainting frames.
9094 Set this to nil to get the old behavior for repainting; this should
9095 only be necessary if the default setting causes problems. */);
9096 w32_strict_painting = 1;
9098 DEFVAR_BOOL ("w32-use-fallback-wm-chars-method",
9099 w32_use_fallback_wm_chars_method,
9100 doc: /* Non-nil means use old method of processing character keys.
9101 This is intended only for debugging of the new processing method.
9102 Default is nil.
9104 This variable has effect only on NT family of systems, not on Windows 9X. */);
9105 w32_use_fallback_wm_chars_method = 0;
9107 DEFVAR_BOOL ("w32-disable-new-uniscribe-apis",
9108 w32_disable_new_uniscribe_apis,
9109 doc: /* Non-nil means don't use new Uniscribe APIs.
9110 The new APIs are used to access OTF features supported by fonts.
9111 This is intended only for debugging of the new Uniscribe-related code.
9112 Default is nil.
9114 This variable has effect only on Windows Vista and later. */);
9115 w32_disable_new_uniscribe_apis = 0;
9117 #if 0 /* TODO: Port to W32 */
9118 defsubr (&Sx_change_window_property);
9119 defsubr (&Sx_delete_window_property);
9120 defsubr (&Sx_window_property);
9121 #endif
9122 defsubr (&Sxw_display_color_p);
9123 defsubr (&Sx_display_grayscale_p);
9124 defsubr (&Sxw_color_defined_p);
9125 defsubr (&Sxw_color_values);
9126 defsubr (&Sx_server_max_request_size);
9127 defsubr (&Sx_server_vendor);
9128 defsubr (&Sx_server_version);
9129 defsubr (&Sx_display_pixel_width);
9130 defsubr (&Sx_display_pixel_height);
9131 defsubr (&Sx_display_mm_width);
9132 defsubr (&Sx_display_mm_height);
9133 defsubr (&Sx_display_screens);
9134 defsubr (&Sx_display_planes);
9135 defsubr (&Sx_display_color_cells);
9136 defsubr (&Sx_display_visual_class);
9137 defsubr (&Sx_display_backing_store);
9138 defsubr (&Sx_display_save_under);
9139 defsubr (&Sx_create_frame);
9140 defsubr (&Sx_open_connection);
9141 defsubr (&Sx_close_connection);
9142 defsubr (&Sx_display_list);
9143 defsubr (&Sw32_frame_geometry);
9144 defsubr (&Sw32_frame_edges);
9145 defsubr (&Sw32_mouse_absolute_pixel_position);
9146 defsubr (&Sw32_set_mouse_absolute_pixel_position);
9147 defsubr (&Sx_synchronize);
9149 /* W32 specific functions */
9151 defsubr (&Sw32_define_rgb_color);
9152 defsubr (&Sw32_default_color_map);
9153 defsubr (&Sw32_display_monitor_attributes_list);
9154 defsubr (&Sw32_send_sys_command);
9155 defsubr (&Sw32_shell_execute);
9156 defsubr (&Sw32_register_hot_key);
9157 defsubr (&Sw32_unregister_hot_key);
9158 defsubr (&Sw32_registered_hot_keys);
9159 defsubr (&Sw32_reconstruct_hot_key);
9160 defsubr (&Sw32_toggle_lock_key);
9161 defsubr (&Sw32_window_exists_p);
9162 defsubr (&Sw32_battery_status);
9163 defsubr (&Sw32__menu_bar_in_use);
9165 #ifdef WINDOWSNT
9166 defsubr (&Sfile_system_info);
9167 defsubr (&Sdefault_printer_name);
9168 #endif
9170 defsubr (&Sset_message_beep);
9171 defsubr (&Sx_show_tip);
9172 defsubr (&Sx_hide_tip);
9173 tip_timer = Qnil;
9174 staticpro (&tip_timer);
9175 tip_frame = Qnil;
9176 staticpro (&tip_frame);
9178 last_show_tip_args = Qnil;
9179 staticpro (&last_show_tip_args);
9181 defsubr (&Sx_file_dialog);
9182 #ifdef WINDOWSNT
9183 defsubr (&Ssystem_move_file_to_trash);
9184 #endif
9189 /* Crashing and reporting backtrace. */
9191 #ifndef CYGWIN
9192 static LONG CALLBACK my_exception_handler (EXCEPTION_POINTERS *);
9193 static LPTOP_LEVEL_EXCEPTION_FILTER prev_exception_handler;
9194 #endif
9195 static DWORD except_code;
9196 static PVOID except_addr;
9198 #ifndef CYGWIN
9200 /* Stack overflow recovery. */
9202 /* Re-establish the guard page at stack limit. This is needed because
9203 when a stack overflow is detected, Windows removes the guard bit
9204 from the guard page, so if we don't re-establish that protection,
9205 the next stack overflow will cause a crash. */
9206 void
9207 w32_reset_stack_overflow_guard (void)
9209 /* MinGW headers don't declare this (should be in malloc.h). */
9210 _CRTIMP int __cdecl _resetstkoflw (void);
9212 /* We ignore the return value. If _resetstkoflw fails, the next
9213 stack overflow will crash the program. */
9214 (void)_resetstkoflw ();
9217 static void
9218 stack_overflow_handler (void)
9220 /* Hard GC error may lead to stack overflow caused by
9221 too nested calls to mark_object. No way to survive. */
9222 if (gc_in_progress)
9223 terminate_due_to_signal (SIGSEGV, 40);
9224 #ifdef _WIN64
9225 /* See ms-w32.h: MinGW64's longjmp crashes if invoked in this context. */
9226 __builtin_longjmp (return_to_command_loop, 1);
9227 #else
9228 sys_longjmp (return_to_command_loop, 1);
9229 #endif
9232 /* This handler records the exception code and the address where it
9233 was triggered so that this info could be included in the backtrace.
9234 Without that, the backtrace in some cases has no information
9235 whatsoever about the offending code, and looks as if the top-level
9236 exception handler in the MinGW startup code was the one that
9237 crashed. We also recover from stack overflow, by calling our stack
9238 overflow handler that jumps back to top level. */
9239 static LONG CALLBACK
9240 my_exception_handler (EXCEPTION_POINTERS * exception_data)
9242 except_code = exception_data->ExceptionRecord->ExceptionCode;
9243 except_addr = exception_data->ExceptionRecord->ExceptionAddress;
9245 /* If this is a stack overflow exception, attempt to recover. */
9246 if (exception_data->ExceptionRecord->ExceptionCode == EXCEPTION_STACK_OVERFLOW
9247 && exception_data->ExceptionRecord->NumberParameters == 2
9248 /* We can only longjmp to top level from the main thread. */
9249 && GetCurrentThreadId () == dwMainThreadId)
9251 /* Call stack_overflow_handler (). */
9252 #ifdef _WIN64
9253 exception_data->ContextRecord->Rip = (DWORD_PTR) &stack_overflow_handler;
9254 #else
9255 exception_data->ContextRecord->Eip = (DWORD_PTR) &stack_overflow_handler;
9256 #endif
9257 /* Zero this out, so the stale address of the stack overflow
9258 exception we handled is not displayed in some future
9259 unrelated crash. */
9260 except_addr = 0;
9261 return EXCEPTION_CONTINUE_EXECUTION;
9264 if (prev_exception_handler)
9265 return prev_exception_handler (exception_data);
9266 return EXCEPTION_EXECUTE_HANDLER;
9268 #endif
9270 typedef USHORT (WINAPI * CaptureStackBackTrace_proc) (ULONG, ULONG, PVOID *,
9271 PULONG);
9273 #define BACKTRACE_LIMIT_MAX 62
9276 w32_backtrace (void **buffer, int limit)
9278 static CaptureStackBackTrace_proc s_pfn_CaptureStackBackTrace = NULL;
9279 HMODULE hm_kernel32 = NULL;
9281 if (!s_pfn_CaptureStackBackTrace)
9283 hm_kernel32 = LoadLibrary ("Kernel32.dll");
9284 s_pfn_CaptureStackBackTrace =
9285 (CaptureStackBackTrace_proc) GetProcAddress (hm_kernel32,
9286 "RtlCaptureStackBackTrace");
9288 if (s_pfn_CaptureStackBackTrace)
9289 return s_pfn_CaptureStackBackTrace (0, min (BACKTRACE_LIMIT_MAX, limit),
9290 buffer, NULL);
9291 return 0;
9294 void
9295 emacs_abort (void)
9297 int button;
9298 button = MessageBox (NULL,
9299 "A fatal error has occurred!\n\n"
9300 "Would you like to attach a debugger?\n\n"
9301 "Select:\n"
9302 "YES -- to debug Emacs, or\n"
9303 "NO -- to abort Emacs and produce a backtrace\n"
9304 " (emacs_backtrace.txt in current directory)."
9305 #if __GNUC__
9306 "\n\n(type \"gdb -p <emacs-PID>\" and\n"
9307 "\"continue\" inside GDB before clicking YES.)"
9308 #endif
9309 , "Emacs Abort Dialog",
9310 MB_ICONEXCLAMATION | MB_TASKMODAL
9311 | MB_SETFOREGROUND | MB_YESNO);
9312 switch (button)
9314 case IDYES:
9315 DebugBreak ();
9316 exit (2); /* tell the compiler we will never return */
9317 case IDNO:
9318 default:
9320 void *stack[BACKTRACE_LIMIT_MAX + 1];
9321 int i = w32_backtrace (stack, BACKTRACE_LIMIT_MAX + 1);
9323 if (i)
9325 int errfile_fd = -1;
9326 int j;
9327 char buf[sizeof ("\r\nException at this address:\r\n\r\n")
9328 /* The type below should really be 'void *', but
9329 INT_BUFSIZE_BOUND cannot handle that without
9330 triggering compiler warnings (under certain
9331 pedantic warning switches), it wants an
9332 integer type. */
9333 + 2 * INT_BUFSIZE_BOUND (intptr_t)];
9334 #ifdef CYGWIN
9335 int stderr_fd = 2;
9336 #else
9337 HANDLE errout = GetStdHandle (STD_ERROR_HANDLE);
9338 int stderr_fd = -1;
9340 if (errout && errout != INVALID_HANDLE_VALUE)
9341 stderr_fd = _open_osfhandle ((intptr_t)errout, O_APPEND | O_BINARY);
9342 #endif
9344 /* We use %p, not 0x%p, as %p produces a leading "0x" on XP,
9345 but not on Windows 7. addr2line doesn't mind a missing
9346 "0x", but will be confused by an extra one. */
9347 if (except_addr)
9348 sprintf (buf, "\r\nException 0x%lx at this address:\r\n%p\r\n",
9349 except_code, except_addr);
9350 if (stderr_fd >= 0)
9352 if (except_addr)
9353 write (stderr_fd, buf, strlen (buf));
9354 write (stderr_fd, "\r\nBacktrace:\r\n", 14);
9356 #ifdef CYGWIN
9357 #define _open open
9358 #endif
9359 errfile_fd = _open ("emacs_backtrace.txt", O_RDWR | O_CREAT | O_BINARY, S_IREAD | S_IWRITE);
9360 if (errfile_fd >= 0)
9362 lseek (errfile_fd, 0L, SEEK_END);
9363 if (except_addr)
9364 write (errfile_fd, buf, strlen (buf));
9365 write (errfile_fd, "\r\nBacktrace:\r\n", 14);
9368 for (j = 0; j < i; j++)
9370 /* stack[] gives the return addresses, whereas we want
9371 the address of the call, so decrease each address
9372 by approximate size of 1 CALL instruction. */
9373 sprintf (buf, "%p\r\n", (char *)stack[j] - sizeof(void *));
9374 if (stderr_fd >= 0)
9375 write (stderr_fd, buf, strlen (buf));
9376 if (errfile_fd >= 0)
9377 write (errfile_fd, buf, strlen (buf));
9379 if (i == BACKTRACE_LIMIT_MAX)
9381 if (stderr_fd >= 0)
9382 write (stderr_fd, "...\r\n", 5);
9383 if (errfile_fd >= 0)
9384 write (errfile_fd, "...\r\n", 5);
9386 if (errfile_fd >= 0)
9387 close (errfile_fd);
9389 abort ();
9390 break;
9397 /* Initialization. */
9400 globals_of_w32fns is used to initialize those global variables that
9401 must always be initialized on startup even when the global variable
9402 initialized is non zero (see the function main in emacs.c).
9403 globals_of_w32fns is called from syms_of_w32fns when the global
9404 variable initialized is 0 and directly from main when initialized
9405 is non zero.
9407 void
9408 globals_of_w32fns (void)
9410 HMODULE user32_lib = GetModuleHandle ("user32.dll");
9412 TrackMouseEvent not available in all versions of Windows, so must load
9413 it dynamically. Do it once, here, instead of every time it is used.
9415 track_mouse_event_fn = (TrackMouseEvent_Proc)
9416 GetProcAddress (user32_lib, "TrackMouseEvent");
9418 monitor_from_point_fn = (MonitorFromPoint_Proc)
9419 GetProcAddress (user32_lib, "MonitorFromPoint");
9420 get_monitor_info_fn = (GetMonitorInfo_Proc)
9421 GetProcAddress (user32_lib, "GetMonitorInfoA");
9422 monitor_from_window_fn = (MonitorFromWindow_Proc)
9423 GetProcAddress (user32_lib, "MonitorFromWindow");
9424 enum_display_monitors_fn = (EnumDisplayMonitors_Proc)
9425 GetProcAddress (user32_lib, "EnumDisplayMonitors");
9426 get_title_bar_info_fn = (GetTitleBarInfo_Proc)
9427 GetProcAddress (user32_lib, "GetTitleBarInfo");
9430 HMODULE imm32_lib = GetModuleHandle ("imm32.dll");
9431 get_composition_string_fn = (ImmGetCompositionString_Proc)
9432 GetProcAddress (imm32_lib, "ImmGetCompositionStringW");
9433 get_ime_context_fn = (ImmGetContext_Proc)
9434 GetProcAddress (imm32_lib, "ImmGetContext");
9435 release_ime_context_fn = (ImmReleaseContext_Proc)
9436 GetProcAddress (imm32_lib, "ImmReleaseContext");
9437 set_ime_composition_window_fn = (ImmSetCompositionWindow_Proc)
9438 GetProcAddress (imm32_lib, "ImmSetCompositionWindow");
9441 except_code = 0;
9442 except_addr = 0;
9443 #ifndef CYGWIN
9444 prev_exception_handler = SetUnhandledExceptionFilter (my_exception_handler);
9445 #endif
9447 DEFVAR_INT ("w32-ansi-code-page",
9448 w32_ansi_code_page,
9449 doc: /* The ANSI code page used by the system. */);
9450 w32_ansi_code_page = GetACP ();
9452 if (os_subtype == OS_NT)
9453 w32_unicode_gui = 1;
9454 else
9455 w32_unicode_gui = 0;
9457 after_deadkey = -1;
9459 /* MessageBox does not work without this when linked to comctl32.dll 6.0. */
9460 InitCommonControls ();
9462 syms_of_w32uniscribe ();
9464 /* Needed for recovery from C stack overflows in batch mode. */
9465 if (noninteractive)
9466 dwMainThreadId = GetCurrentThreadId ();
9469 #ifdef NTGUI_UNICODE
9471 Lisp_Object
9472 ntgui_encode_system (Lisp_Object str)
9474 Lisp_Object encoded;
9475 to_unicode (str, &encoded);
9476 return encoded;
9479 #endif /* NTGUI_UNICODE */