]> code.delx.au - gnu-emacs/blob - src/w32fns.c
delx.au / code / gnu-emacs / blob
summary | shortlog | log | commit | commitdiff | tree
history | raw | HEAD
Fix removal of variables from process-environment
[gnu-emacs] / src / w32fns.c
1 /* Graphical user interface functions for the Microsoft Windows API.
2
3 Copyright (C) 1989, 1992-2016 Free Software Foundation, Inc.
4
5 This file is part of GNU Emacs.
6
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 (at
10 your option) any later version.
11
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.
16
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/>. */
19
20 /* Added by Kevin Gallo */
21
22 #include <config.h>
23
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>
31
32 #include <c-ctype.h>
33
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"
42
43 #include "w32common.h"
44
45 #ifdef WINDOWSNT
46 #include <mbstring.h>
47 #endif /* WINDOWSNT */
48
49 #if CYGWIN
50 #include "cygw32.h"
51 #else
52 #include "w32.h"
53 #endif
54
55 #include <commctrl.h>
56 #include <commdlg.h>
57 #include <shellapi.h>
58 #include <shlwapi.h>
59 #include <ctype.h>
60 #include <winspool.h>
61 #include <objbase.h>
62
63 #include <dlgs.h>
64 #include <imm.h>
65 #include <windowsx.h>
66
67 #ifndef FOF_NO_CONNECTED_ELEMENTS
68 #define FOF_NO_CONNECTED_ELEMENTS 0x2000
69 #endif
70
71 void syms_of_w32fns (void);
72 void globals_of_w32fns (void);
73
74 extern void free_frame_menubar (struct frame *);
75 extern int w32_console_toggle_lock_key (int, Lisp_Object);
76 extern void w32_menu_display_help (HWND, HMENU, UINT, UINT);
77 extern void w32_free_menu_strings (HWND);
78 extern const char *map_w32_filename (const char *, const char **);
79 extern char * w32_strerror (int error_no);
80
81 #ifndef IDC_HAND
82 #define IDC_HAND MAKEINTRESOURCE(32649)
83 #endif
84
85 /* Prefix for system colors. */
86 #define SYSTEM_COLOR_PREFIX "System"
87 #define SYSTEM_COLOR_PREFIX_LEN (sizeof (SYSTEM_COLOR_PREFIX) - 1)
88
89 /* State variables for emulating a three button mouse. */
90 #define LMOUSE 1
91 #define MMOUSE 2
92 #define RMOUSE 4
93
94 static int button_state = 0;
95 static W32Msg saved_mouse_button_msg;
96 static unsigned mouse_button_timer = 0; /* non-zero when timer is active */
97 static W32Msg saved_mouse_move_msg;
98 static unsigned mouse_move_timer = 0;
99
100 /* Window that is tracking the mouse. */
101 static HWND track_mouse_window;
102
103 /* Multi-monitor API definitions that are not pulled from the headers
104 since we are compiling for NT 4. */
105 #ifndef MONITOR_DEFAULT_TO_NEAREST
106 #define MONITOR_DEFAULT_TO_NEAREST 2
107 #endif
108 #ifndef MONITORINFOF_PRIMARY
109 #define MONITORINFOF_PRIMARY 1
110 #endif
111 #ifndef SM_XVIRTUALSCREEN
112 #define SM_XVIRTUALSCREEN 76
113 #endif
114 #ifndef SM_YVIRTUALSCREEN
115 #define SM_YVIRTUALSCREEN 77
116 #endif
117 /* MinGW headers define MONITORINFO unconditionally, but MSVC ones don't.
118 To avoid a compile error on one or the other, redefine with a new name. */
119 struct MONITOR_INFO
120 {
121 DWORD cbSize;
122 RECT rcMonitor;
123 RECT rcWork;
124 DWORD dwFlags;
125 };
126
127 #if _WIN32_WINDOWS >= 0x0410
128 #define C_CHILDREN_TITLEBAR CCHILDREN_TITLEBAR
129 typedef TITLEBARINFO TITLEBAR_INFO;
130 #else
131 #define C_CHILDREN_TITLEBAR 5
132 typedef struct
133 {
134 DWORD cbSize;
135 RECT rcTitleBar;
136 DWORD rgstate[C_CHILDREN_TITLEBAR+1];
137 } TITLEBAR_INFO, *PTITLEBAR_INFO;
138 #endif
139
140 #ifndef CCHDEVICENAME
141 #define CCHDEVICENAME 32
142 #endif
143 struct MONITOR_INFO_EX
144 {
145 DWORD cbSize;
146 RECT rcMonitor;
147 RECT rcWork;
148 DWORD dwFlags;
149 char szDevice[CCHDEVICENAME];
150 };
151
152 /* Reportedly, MSVC does not have this in its headers. */
153 #if defined (_MSC_VER) && _WIN32_WINNT < 0x0500
154 DECLARE_HANDLE(HMONITOR);
155 #endif
156
157 typedef BOOL (WINAPI * TrackMouseEvent_Proc)
158 (IN OUT LPTRACKMOUSEEVENT lpEventTrack);
159 typedef LONG (WINAPI * ImmGetCompositionString_Proc)
160 (IN HIMC context, IN DWORD index, OUT LPVOID buffer, IN DWORD bufLen);
161 typedef HIMC (WINAPI * ImmGetContext_Proc) (IN HWND window);
162 typedef BOOL (WINAPI * ImmReleaseContext_Proc) (IN HWND wnd, IN HIMC context);
163 typedef BOOL (WINAPI * ImmSetCompositionWindow_Proc) (IN HIMC context,
164 IN COMPOSITIONFORM *form);
165 typedef HMONITOR (WINAPI * MonitorFromPoint_Proc) (IN POINT pt, IN DWORD flags);
166 typedef BOOL (WINAPI * GetMonitorInfo_Proc)
167 (IN HMONITOR monitor, OUT struct MONITOR_INFO* info);
168 typedef HMONITOR (WINAPI * MonitorFromWindow_Proc)
169 (IN HWND hwnd, IN DWORD dwFlags);
170 typedef BOOL CALLBACK (* MonitorEnum_Proc)
171 (IN HMONITOR monitor, IN HDC hdc, IN RECT *rcMonitor, IN LPARAM dwData);
172 typedef BOOL (WINAPI * EnumDisplayMonitors_Proc)
173 (IN HDC hdc, IN RECT *rcClip, IN MonitorEnum_Proc fnEnum, IN LPARAM dwData);
174 typedef BOOL (WINAPI * GetTitleBarInfo_Proc)
175 (IN HWND hwnd, OUT TITLEBAR_INFO* info);
176
177 TrackMouseEvent_Proc track_mouse_event_fn = NULL;
178 ImmGetCompositionString_Proc get_composition_string_fn = NULL;
179 ImmGetContext_Proc get_ime_context_fn = NULL;
180 ImmReleaseContext_Proc release_ime_context_fn = NULL;
181 ImmSetCompositionWindow_Proc set_ime_composition_window_fn = NULL;
182 MonitorFromPoint_Proc monitor_from_point_fn = NULL;
183 GetMonitorInfo_Proc get_monitor_info_fn = NULL;
184 MonitorFromWindow_Proc monitor_from_window_fn = NULL;
185 EnumDisplayMonitors_Proc enum_display_monitors_fn = NULL;
186 GetTitleBarInfo_Proc get_title_bar_info_fn = NULL;
187
188 #ifdef NTGUI_UNICODE
189 #define unicode_append_menu AppendMenuW
190 #else /* !NTGUI_UNICODE */
191 extern AppendMenuW_Proc unicode_append_menu;
192 #endif /* NTGUI_UNICODE */
193
194 /* Flag to selectively ignore WM_IME_CHAR messages. */
195 static int ignore_ime_char = 0;
196
197 /* W95 mousewheel handler */
198 unsigned int msh_mousewheel = 0;
199
200 /* Timers */
201 #define MOUSE_BUTTON_ID 1
202 #define MOUSE_MOVE_ID 2
203 #define MENU_FREE_ID 3
204 /* The delay (milliseconds) before a menu is freed after WM_EXITMENULOOP
205 is received. */
206 #define MENU_FREE_DELAY 1000
207 static unsigned menu_free_timer = 0;
208
209 #ifdef GLYPH_DEBUG
210 static ptrdiff_t image_cache_refcount;
211 static int dpyinfo_refcount;
212 #endif
213
214 static HWND w32_visible_system_caret_hwnd;
215
216 static int w32_unicode_gui;
217
218 /* From w32menu.c */
219 extern HMENU current_popup_menu;
220 int menubar_in_use = 0;
221
222 /* From w32uniscribe.c */
223 extern void syms_of_w32uniscribe (void);
224 extern int uniscribe_available;
225
226 #ifdef WINDOWSNT
227 /* From w32inevt.c */
228 extern int faked_key;
229 #endif /* WINDOWSNT */
230
231 /* This gives us the page size and the size of the allocation unit on NT. */
232 SYSTEM_INFO sysinfo_cache;
233
234 /* This gives us version, build, and platform identification. */
235 OSVERSIONINFO osinfo_cache;
236
237 DWORD_PTR syspage_mask = 0;
238
239 /* The major and minor versions of NT. */
240 int w32_major_version;
241 int w32_minor_version;
242 int w32_build_number;
243
244 /* Distinguish between Windows NT and Windows 95. */
245 int os_subtype;
246
247 #ifdef HAVE_NTGUI
248 HINSTANCE hinst = NULL;
249 #endif
250
251 static unsigned int sound_type = 0xFFFFFFFF;
252 #define MB_EMACS_SILENT (0xFFFFFFFF - 1)
253
254 /* Let the user specify a display with a frame.
255 nil stands for the selected frame--or, if that is not a w32 frame,
256 the first display on the list. */
257
258 struct w32_display_info *
259 check_x_display_info (Lisp_Object object)
260 {
261 if (NILP (object))
262 {
263 struct frame *sf = XFRAME (selected_frame);
264
265 if (FRAME_W32_P (sf) && FRAME_LIVE_P (sf))
266 return FRAME_DISPLAY_INFO (sf);
267 else
268 return &one_w32_display_info;
269 }
270 else if (TERMINALP (object))
271 {
272 struct terminal *t = decode_live_terminal (object);
273
274 if (t->type != output_w32)
275 error ("Terminal %d is not a W32 display", t->id);
276
277 return t->display_info.w32;
278 }
279 else if (STRINGP (object))
280 return x_display_info_for_name (object);
281 else
282 {
283 struct frame *f;
284
285 CHECK_LIVE_FRAME (object);
286 f = XFRAME (object);
287 if (! FRAME_W32_P (f))
288 error ("Non-W32 frame used");
289 return FRAME_DISPLAY_INFO (f);
290 }
291 }
292 \f
293 /* Return the Emacs frame-object corresponding to an w32 window.
294 It could be the frame's main window or an icon window. */
295
296 struct frame *
297 x_window_to_frame (struct w32_display_info *dpyinfo, HWND wdesc)
298 {
299 Lisp_Object tail, frame;
300 struct frame *f;
301
302 FOR_EACH_FRAME (tail, frame)
303 {
304 f = XFRAME (frame);
305 if (!FRAME_W32_P (f) || FRAME_DISPLAY_INFO (f) != dpyinfo)
306 continue;
307
308 if (FRAME_W32_WINDOW (f) == wdesc)
309 return f;
310 }
311 return 0;
312 }
313
314 \f
315 static Lisp_Object unwind_create_frame (Lisp_Object);
316 static void unwind_create_tip_frame (Lisp_Object);
317 static void my_create_window (struct frame *);
318 static void my_create_tip_window (struct frame *);
319
320 /* TODO: Native Input Method support; see x_create_im. */
321 void x_set_foreground_color (struct frame *, Lisp_Object, Lisp_Object);
322 void x_set_background_color (struct frame *, Lisp_Object, Lisp_Object);
323 void x_set_mouse_color (struct frame *, Lisp_Object, Lisp_Object);
324 void x_set_cursor_color (struct frame *, Lisp_Object, Lisp_Object);
325 void x_set_border_color (struct frame *, Lisp_Object, Lisp_Object);
326 void x_set_cursor_type (struct frame *, Lisp_Object, Lisp_Object);
327 void x_set_icon_type (struct frame *, Lisp_Object, Lisp_Object);
328 void x_set_icon_name (struct frame *, Lisp_Object, Lisp_Object);
329 void x_explicitly_set_name (struct frame *, Lisp_Object, Lisp_Object);
330 void x_set_menu_bar_lines (struct frame *, Lisp_Object, Lisp_Object);
331 void x_set_title (struct frame *, Lisp_Object, Lisp_Object);
332 void x_set_tool_bar_lines (struct frame *, Lisp_Object, Lisp_Object);
333 void x_set_internal_border_width (struct frame *f, Lisp_Object, Lisp_Object);
334 \f
335
336 /* Store the screen positions of frame F into XPTR and YPTR.
337 These are the positions of the containing window manager window,
338 not Emacs's own window. */
339
340 void
341 x_real_positions (struct frame *f, int *xptr, int *yptr)
342 {
343 POINT pt;
344 RECT rect;
345
346 /* Get the bounds of the WM window. */
347 GetWindowRect (FRAME_W32_WINDOW (f), &rect);
348
349 pt.x = 0;
350 pt.y = 0;
351
352 /* Convert (0, 0) in the client area to screen co-ordinates. */
353 ClientToScreen (FRAME_W32_WINDOW (f), &pt);
354
355 *xptr = rect.left;
356 *yptr = rect.top;
357 }
358
359 /* Returns the window rectangle appropriate for the given fullscreen mode.
360 The normal rect parameter was the window's rectangle prior to entering
361 fullscreen mode. If multiple monitor support is available, the nearest
362 monitor to the window is chosen. */
363
364 void
365 w32_fullscreen_rect (HWND hwnd, int fsmode, RECT normal, RECT *rect)
366 {
367 struct MONITOR_INFO mi = { sizeof(mi) };
368 if (monitor_from_window_fn && get_monitor_info_fn)
369 {
370 HMONITOR monitor =
371 monitor_from_window_fn (hwnd, MONITOR_DEFAULT_TO_NEAREST);
372 get_monitor_info_fn (monitor, &mi);
373 }
374 else
375 {
376 mi.rcMonitor.left = 0;
377 mi.rcMonitor.top = 0;
378 mi.rcMonitor.right = GetSystemMetrics (SM_CXSCREEN);
379 mi.rcMonitor.bottom = GetSystemMetrics (SM_CYSCREEN);
380 mi.rcWork.left = 0;
381 mi.rcWork.top = 0;
382 mi.rcWork.right = GetSystemMetrics (SM_CXMAXIMIZED);
383 mi.rcWork.bottom = GetSystemMetrics (SM_CYMAXIMIZED);
384 }
385
386 switch (fsmode)
387 {
388 case FULLSCREEN_BOTH:
389 rect->left = mi.rcMonitor.left;
390 rect->top = mi.rcMonitor.top;
391 rect->right = mi.rcMonitor.right;
392 rect->bottom = mi.rcMonitor.bottom;
393 break;
394 case FULLSCREEN_WIDTH:
395 rect->left = mi.rcWork.left;
396 rect->top = normal.top;
397 rect->right = mi.rcWork.right;
398 rect->bottom = normal.bottom;
399 break;
400 case FULLSCREEN_HEIGHT:
401 rect->left = normal.left;
402 rect->top = mi.rcWork.top;
403 rect->right = normal.right;
404 rect->bottom = mi.rcWork.bottom;
405 break;
406 default:
407 *rect = normal;
408 break;
409 }
410 }
411
412 \f
413
414 DEFUN ("w32-define-rgb-color", Fw32_define_rgb_color,
415 Sw32_define_rgb_color, 4, 4, 0,
416 doc: /* Convert RGB numbers to a Windows color reference and associate with NAME.
417 This adds or updates a named color to `w32-color-map', making it
418 available for use. The original entry's RGB ref is returned, or nil
419 if the entry is new. */)
420 (Lisp_Object red, Lisp_Object green, Lisp_Object blue, Lisp_Object name)
421 {
422 Lisp_Object rgb;
423 Lisp_Object oldrgb = Qnil;
424 Lisp_Object entry;
425
426 CHECK_NUMBER (red);
427 CHECK_NUMBER (green);
428 CHECK_NUMBER (blue);
429 CHECK_STRING (name);
430
431 XSETINT (rgb, RGB (XUINT (red), XUINT (green), XUINT (blue)));
432
433 block_input ();
434
435 /* replace existing entry in w32-color-map or add new entry. */
436 entry = Fassoc (name, Vw32_color_map);
437 if (NILP (entry))
438 {
439 entry = Fcons (name, rgb);
440 Vw32_color_map = Fcons (entry, Vw32_color_map);
441 }
442 else
443 {
444 oldrgb = Fcdr (entry);
445 Fsetcdr (entry, rgb);
446 }
447
448 unblock_input ();
449
450 return (oldrgb);
451 }
452
453 /* The default colors for the w32 color map */
454 typedef struct colormap_t
455 {
456 char *name;
457 COLORREF colorref;
458 } colormap_t;
459
460 colormap_t w32_color_map[] =
461 {
462 {"snow" , PALETTERGB (255,250,250)},
463 {"ghost white" , PALETTERGB (248,248,255)},
464 {"GhostWhite" , PALETTERGB (248,248,255)},
465 {"white smoke" , PALETTERGB (245,245,245)},
466 {"WhiteSmoke" , PALETTERGB (245,245,245)},
467 {"gainsboro" , PALETTERGB (220,220,220)},
468 {"floral white" , PALETTERGB (255,250,240)},
469 {"FloralWhite" , PALETTERGB (255,250,240)},
470 {"old lace" , PALETTERGB (253,245,230)},
471 {"OldLace" , PALETTERGB (253,245,230)},
472 {"linen" , PALETTERGB (250,240,230)},
473 {"antique white" , PALETTERGB (250,235,215)},
474 {"AntiqueWhite" , PALETTERGB (250,235,215)},
475 {"papaya whip" , PALETTERGB (255,239,213)},
476 {"PapayaWhip" , PALETTERGB (255,239,213)},
477 {"blanched almond" , PALETTERGB (255,235,205)},
478 {"BlanchedAlmond" , PALETTERGB (255,235,205)},
479 {"bisque" , PALETTERGB (255,228,196)},
480 {"peach puff" , PALETTERGB (255,218,185)},
481 {"PeachPuff" , PALETTERGB (255,218,185)},
482 {"navajo white" , PALETTERGB (255,222,173)},
483 {"NavajoWhite" , PALETTERGB (255,222,173)},
484 {"moccasin" , PALETTERGB (255,228,181)},
485 {"cornsilk" , PALETTERGB (255,248,220)},
486 {"ivory" , PALETTERGB (255,255,240)},
487 {"lemon chiffon" , PALETTERGB (255,250,205)},
488 {"LemonChiffon" , PALETTERGB (255,250,205)},
489 {"seashell" , PALETTERGB (255,245,238)},
490 {"honeydew" , PALETTERGB (240,255,240)},
491 {"mint cream" , PALETTERGB (245,255,250)},
492 {"MintCream" , PALETTERGB (245,255,250)},
493 {"azure" , PALETTERGB (240,255,255)},
494 {"alice blue" , PALETTERGB (240,248,255)},
495 {"AliceBlue" , PALETTERGB (240,248,255)},
496 {"lavender" , PALETTERGB (230,230,250)},
497 {"lavender blush" , PALETTERGB (255,240,245)},
498 {"LavenderBlush" , PALETTERGB (255,240,245)},
499 {"misty rose" , PALETTERGB (255,228,225)},
500 {"MistyRose" , PALETTERGB (255,228,225)},
501 {"white" , PALETTERGB (255,255,255)},
502 {"black" , PALETTERGB ( 0, 0, 0)},
503 {"dark slate gray" , PALETTERGB ( 47, 79, 79)},
504 {"DarkSlateGray" , PALETTERGB ( 47, 79, 79)},
505 {"dark slate grey" , PALETTERGB ( 47, 79, 79)},
506 {"DarkSlateGrey" , PALETTERGB ( 47, 79, 79)},
507 {"dim gray" , PALETTERGB (105,105,105)},
508 {"DimGray" , PALETTERGB (105,105,105)},
509 {"dim grey" , PALETTERGB (105,105,105)},
510 {"DimGrey" , PALETTERGB (105,105,105)},
511 {"slate gray" , PALETTERGB (112,128,144)},
512 {"SlateGray" , PALETTERGB (112,128,144)},
513 {"slate grey" , PALETTERGB (112,128,144)},
514 {"SlateGrey" , PALETTERGB (112,128,144)},
515 {"light slate gray" , PALETTERGB (119,136,153)},
516 {"LightSlateGray" , PALETTERGB (119,136,153)},
517 {"light slate grey" , PALETTERGB (119,136,153)},
518 {"LightSlateGrey" , PALETTERGB (119,136,153)},
519 {"gray" , PALETTERGB (190,190,190)},
520 {"grey" , PALETTERGB (190,190,190)},
521 {"light grey" , PALETTERGB (211,211,211)},
522 {"LightGrey" , PALETTERGB (211,211,211)},
523 {"light gray" , PALETTERGB (211,211,211)},
524 {"LightGray" , PALETTERGB (211,211,211)},
525 {"midnight blue" , PALETTERGB ( 25, 25,112)},
526 {"MidnightBlue" , PALETTERGB ( 25, 25,112)},
527 {"navy" , PALETTERGB ( 0, 0,128)},
528 {"navy blue" , PALETTERGB ( 0, 0,128)},
529 {"NavyBlue" , PALETTERGB ( 0, 0,128)},
530 {"cornflower blue" , PALETTERGB (100,149,237)},
531 {"CornflowerBlue" , PALETTERGB (100,149,237)},
532 {"dark slate blue" , PALETTERGB ( 72, 61,139)},
533 {"DarkSlateBlue" , PALETTERGB ( 72, 61,139)},
534 {"slate blue" , PALETTERGB (106, 90,205)},
535 {"SlateBlue" , PALETTERGB (106, 90,205)},
536 {"medium slate blue" , PALETTERGB (123,104,238)},
537 {"MediumSlateBlue" , PALETTERGB (123,104,238)},
538 {"light slate blue" , PALETTERGB (132,112,255)},
539 {"LightSlateBlue" , PALETTERGB (132,112,255)},
540 {"medium blue" , PALETTERGB ( 0, 0,205)},
541 {"MediumBlue" , PALETTERGB ( 0, 0,205)},
542 {"royal blue" , PALETTERGB ( 65,105,225)},
543 {"RoyalBlue" , PALETTERGB ( 65,105,225)},
544 {"blue" , PALETTERGB ( 0, 0,255)},
545 {"dodger blue" , PALETTERGB ( 30,144,255)},
546 {"DodgerBlue" , PALETTERGB ( 30,144,255)},
547 {"deep sky blue" , PALETTERGB ( 0,191,255)},
548 {"DeepSkyBlue" , PALETTERGB ( 0,191,255)},
549 {"sky blue" , PALETTERGB (135,206,235)},
550 {"SkyBlue" , PALETTERGB (135,206,235)},
551 {"light sky blue" , PALETTERGB (135,206,250)},
552 {"LightSkyBlue" , PALETTERGB (135,206,250)},
553 {"steel blue" , PALETTERGB ( 70,130,180)},
554 {"SteelBlue" , PALETTERGB ( 70,130,180)},
555 {"light steel blue" , PALETTERGB (176,196,222)},
556 {"LightSteelBlue" , PALETTERGB (176,196,222)},
557 {"light blue" , PALETTERGB (173,216,230)},
558 {"LightBlue" , PALETTERGB (173,216,230)},
559 {"powder blue" , PALETTERGB (176,224,230)},
560 {"PowderBlue" , PALETTERGB (176,224,230)},
561 {"pale turquoise" , PALETTERGB (175,238,238)},
562 {"PaleTurquoise" , PALETTERGB (175,238,238)},
563 {"dark turquoise" , PALETTERGB ( 0,206,209)},
564 {"DarkTurquoise" , PALETTERGB ( 0,206,209)},
565 {"medium turquoise" , PALETTERGB ( 72,209,204)},
566 {"MediumTurquoise" , PALETTERGB ( 72,209,204)},
567 {"turquoise" , PALETTERGB ( 64,224,208)},
568 {"cyan" , PALETTERGB ( 0,255,255)},
569 {"light cyan" , PALETTERGB (224,255,255)},
570 {"LightCyan" , PALETTERGB (224,255,255)},
571 {"cadet blue" , PALETTERGB ( 95,158,160)},
572 {"CadetBlue" , PALETTERGB ( 95,158,160)},
573 {"medium aquamarine" , PALETTERGB (102,205,170)},
574 {"MediumAquamarine" , PALETTERGB (102,205,170)},
575 {"aquamarine" , PALETTERGB (127,255,212)},
576 {"dark green" , PALETTERGB ( 0,100, 0)},
577 {"DarkGreen" , PALETTERGB ( 0,100, 0)},
578 {"dark olive green" , PALETTERGB ( 85,107, 47)},
579 {"DarkOliveGreen" , PALETTERGB ( 85,107, 47)},
580 {"dark sea green" , PALETTERGB (143,188,143)},
581 {"DarkSeaGreen" , PALETTERGB (143,188,143)},
582 {"sea green" , PALETTERGB ( 46,139, 87)},
583 {"SeaGreen" , PALETTERGB ( 46,139, 87)},
584 {"medium sea green" , PALETTERGB ( 60,179,113)},
585 {"MediumSeaGreen" , PALETTERGB ( 60,179,113)},
586 {"light sea green" , PALETTERGB ( 32,178,170)},
587 {"LightSeaGreen" , PALETTERGB ( 32,178,170)},
588 {"pale green" , PALETTERGB (152,251,152)},
589 {"PaleGreen" , PALETTERGB (152,251,152)},
590 {"spring green" , PALETTERGB ( 0,255,127)},
591 {"SpringGreen" , PALETTERGB ( 0,255,127)},
592 {"lawn green" , PALETTERGB (124,252, 0)},
593 {"LawnGreen" , PALETTERGB (124,252, 0)},
594 {"green" , PALETTERGB ( 0,255, 0)},
595 {"chartreuse" , PALETTERGB (127,255, 0)},
596 {"medium spring green" , PALETTERGB ( 0,250,154)},
597 {"MediumSpringGreen" , PALETTERGB ( 0,250,154)},
598 {"green yellow" , PALETTERGB (173,255, 47)},
599 {"GreenYellow" , PALETTERGB (173,255, 47)},
600 {"lime green" , PALETTERGB ( 50,205, 50)},
601 {"LimeGreen" , PALETTERGB ( 50,205, 50)},
602 {"yellow green" , PALETTERGB (154,205, 50)},
603 {"YellowGreen" , PALETTERGB (154,205, 50)},
604 {"forest green" , PALETTERGB ( 34,139, 34)},
605 {"ForestGreen" , PALETTERGB ( 34,139, 34)},
606 {"olive drab" , PALETTERGB (107,142, 35)},
607 {"OliveDrab" , PALETTERGB (107,142, 35)},
608 {"dark khaki" , PALETTERGB (189,183,107)},
609 {"DarkKhaki" , PALETTERGB (189,183,107)},
610 {"khaki" , PALETTERGB (240,230,140)},
611 {"pale goldenrod" , PALETTERGB (238,232,170)},
612 {"PaleGoldenrod" , PALETTERGB (238,232,170)},
613 {"light goldenrod yellow" , PALETTERGB (250,250,210)},
614 {"LightGoldenrodYellow" , PALETTERGB (250,250,210)},
615 {"light yellow" , PALETTERGB (255,255,224)},
616 {"LightYellow" , PALETTERGB (255,255,224)},
617 {"yellow" , PALETTERGB (255,255, 0)},
618 {"gold" , PALETTERGB (255,215, 0)},
619 {"light goldenrod" , PALETTERGB (238,221,130)},
620 {"LightGoldenrod" , PALETTERGB (238,221,130)},
621 {"goldenrod" , PALETTERGB (218,165, 32)},
622 {"dark goldenrod" , PALETTERGB (184,134, 11)},
623 {"DarkGoldenrod" , PALETTERGB (184,134, 11)},
624 {"rosy brown" , PALETTERGB (188,143,143)},
625 {"RosyBrown" , PALETTERGB (188,143,143)},
626 {"indian red" , PALETTERGB (205, 92, 92)},
627 {"IndianRed" , PALETTERGB (205, 92, 92)},
628 {"saddle brown" , PALETTERGB (139, 69, 19)},
629 {"SaddleBrown" , PALETTERGB (139, 69, 19)},
630 {"sienna" , PALETTERGB (160, 82, 45)},
631 {"peru" , PALETTERGB (205,133, 63)},
632 {"burlywood" , PALETTERGB (222,184,135)},
633 {"beige" , PALETTERGB (245,245,220)},
634 {"wheat" , PALETTERGB (245,222,179)},
635 {"sandy brown" , PALETTERGB (244,164, 96)},
636 {"SandyBrown" , PALETTERGB (244,164, 96)},
637 {"tan" , PALETTERGB (210,180,140)},
638 {"chocolate" , PALETTERGB (210,105, 30)},
639 {"firebrick" , PALETTERGB (178,34, 34)},
640 {"brown" , PALETTERGB (165,42, 42)},
641 {"dark salmon" , PALETTERGB (233,150,122)},
642 {"DarkSalmon" , PALETTERGB (233,150,122)},
643 {"salmon" , PALETTERGB (250,128,114)},
644 {"light salmon" , PALETTERGB (255,160,122)},
645 {"LightSalmon" , PALETTERGB (255,160,122)},
646 {"orange" , PALETTERGB (255,165, 0)},
647 {"dark orange" , PALETTERGB (255,140, 0)},
648 {"DarkOrange" , PALETTERGB (255,140, 0)},
649 {"coral" , PALETTERGB (255,127, 80)},
650 {"light coral" , PALETTERGB (240,128,128)},
651 {"LightCoral" , PALETTERGB (240,128,128)},
652 {"tomato" , PALETTERGB (255, 99, 71)},
653 {"orange red" , PALETTERGB (255, 69, 0)},
654 {"OrangeRed" , PALETTERGB (255, 69, 0)},
655 {"red" , PALETTERGB (255, 0, 0)},
656 {"hot pink" , PALETTERGB (255,105,180)},
657 {"HotPink" , PALETTERGB (255,105,180)},
658 {"deep pink" , PALETTERGB (255, 20,147)},
659 {"DeepPink" , PALETTERGB (255, 20,147)},
660 {"pink" , PALETTERGB (255,192,203)},
661 {"light pink" , PALETTERGB (255,182,193)},
662 {"LightPink" , PALETTERGB (255,182,193)},
663 {"pale violet red" , PALETTERGB (219,112,147)},
664 {"PaleVioletRed" , PALETTERGB (219,112,147)},
665 {"maroon" , PALETTERGB (176, 48, 96)},
666 {"medium violet red" , PALETTERGB (199, 21,133)},
667 {"MediumVioletRed" , PALETTERGB (199, 21,133)},
668 {"violet red" , PALETTERGB (208, 32,144)},
669 {"VioletRed" , PALETTERGB (208, 32,144)},
670 {"magenta" , PALETTERGB (255, 0,255)},
671 {"violet" , PALETTERGB (238,130,238)},
672 {"plum" , PALETTERGB (221,160,221)},
673 {"orchid" , PALETTERGB (218,112,214)},
674 {"medium orchid" , PALETTERGB (186, 85,211)},
675 {"MediumOrchid" , PALETTERGB (186, 85,211)},
676 {"dark orchid" , PALETTERGB (153, 50,204)},
677 {"DarkOrchid" , PALETTERGB (153, 50,204)},
678 {"dark violet" , PALETTERGB (148, 0,211)},
679 {"DarkViolet" , PALETTERGB (148, 0,211)},
680 {"blue violet" , PALETTERGB (138, 43,226)},
681 {"BlueViolet" , PALETTERGB (138, 43,226)},
682 {"purple" , PALETTERGB (160, 32,240)},
683 {"medium purple" , PALETTERGB (147,112,219)},
684 {"MediumPurple" , PALETTERGB (147,112,219)},
685 {"thistle" , PALETTERGB (216,191,216)},
686 {"gray0" , PALETTERGB ( 0, 0, 0)},
687 {"grey0" , PALETTERGB ( 0, 0, 0)},
688 {"dark grey" , PALETTERGB (169,169,169)},
689 {"DarkGrey" , PALETTERGB (169,169,169)},
690 {"dark gray" , PALETTERGB (169,169,169)},
691 {"DarkGray" , PALETTERGB (169,169,169)},
692 {"dark blue" , PALETTERGB ( 0, 0,139)},
693 {"DarkBlue" , PALETTERGB ( 0, 0,139)},
694 {"dark cyan" , PALETTERGB ( 0,139,139)},
695 {"DarkCyan" , PALETTERGB ( 0,139,139)},
696 {"dark magenta" , PALETTERGB (139, 0,139)},
697 {"DarkMagenta" , PALETTERGB (139, 0,139)},
698 {"dark red" , PALETTERGB (139, 0, 0)},
699 {"DarkRed" , PALETTERGB (139, 0, 0)},
700 {"light green" , PALETTERGB (144,238,144)},
701 {"LightGreen" , PALETTERGB (144,238,144)},
702 };
703
704 static Lisp_Object
705 w32_default_color_map (void)
706 {
707 int i;
708 colormap_t *pc = w32_color_map;
709 Lisp_Object cmap;
710
711 block_input ();
712
713 cmap = Qnil;
714
715 for (i = 0; i < ARRAYELTS (w32_color_map); pc++, i++)
716 cmap = Fcons (Fcons (build_string (pc->name),
717 make_number (pc->colorref)),
718 cmap);
719
720 unblock_input ();
721
722 return (cmap);
723 }
724
725 DEFUN ("w32-default-color-map", Fw32_default_color_map, Sw32_default_color_map,
726 0, 0, 0, doc: /* Return the default color map. */)
727 (void)
728 {
729 return w32_default_color_map ();
730 }
731
732 static Lisp_Object
733 w32_color_map_lookup (const char *colorname)
734 {
735 Lisp_Object tail, ret = Qnil;
736
737 block_input ();
738
739 for (tail = Vw32_color_map; CONSP (tail); tail = XCDR (tail))
740 {
741 register Lisp_Object elt, tem;
742
743 elt = XCAR (tail);
744 if (!CONSP (elt)) continue;
745
746 tem = XCAR (elt);
747
748 if (lstrcmpi (SSDATA (tem), colorname) == 0)
749 {
750 ret = Fcdr (elt);
751 break;
752 }
753
754 QUIT;
755 }
756
757 unblock_input ();
758
759 return ret;
760 }
761
762
763 static void
764 add_system_logical_colors_to_map (Lisp_Object *system_colors)
765 {
766 HKEY colors_key;
767
768 /* Other registry operations are done with input blocked. */
769 block_input ();
770
771 /* Look for "Control Panel/Colors" under User and Machine registry
772 settings. */
773 if (RegOpenKeyEx (HKEY_CURRENT_USER, "Control Panel\\Colors", 0,
774 KEY_READ, &colors_key) == ERROR_SUCCESS
775 || RegOpenKeyEx (HKEY_LOCAL_MACHINE, "Control Panel\\Colors", 0,
776 KEY_READ, &colors_key) == ERROR_SUCCESS)
777 {
778 /* List all keys. */
779 char color_buffer[64];
780 char full_name_buffer[MAX_PATH + SYSTEM_COLOR_PREFIX_LEN];
781 int index = 0;
782 DWORD name_size, color_size;
783 char *name_buffer = full_name_buffer + SYSTEM_COLOR_PREFIX_LEN;
784
785 name_size = sizeof (full_name_buffer) - SYSTEM_COLOR_PREFIX_LEN;
786 color_size = sizeof (color_buffer);
787
788 strcpy (full_name_buffer, SYSTEM_COLOR_PREFIX);
789
790 while (RegEnumValueA (colors_key, index, name_buffer, &name_size,
791 NULL, NULL, (LPBYTE)color_buffer, &color_size)
792 == ERROR_SUCCESS)
793 {
794 int r, g, b;
795 if (sscanf (color_buffer, " %u %u %u", &r, &g, &b) == 3)
796 *system_colors = Fcons (Fcons (build_string (full_name_buffer),
797 make_number (RGB (r, g, b))),
798 *system_colors);
799
800 name_size = sizeof (full_name_buffer) - SYSTEM_COLOR_PREFIX_LEN;
801 color_size = sizeof (color_buffer);
802 index++;
803 }
804 RegCloseKey (colors_key);
805 }
806
807 unblock_input ();
808 }
809
810
811 static Lisp_Object
812 x_to_w32_color (const char * colorname)
813 {
814 register Lisp_Object ret = Qnil;
815
816 block_input ();
817
818 if (colorname[0] == '#')
819 {
820 /* Could be an old-style RGB Device specification. */
821 int size = strlen (colorname + 1);
822 char *color = alloca (size + 1);
823
824 strcpy (color, colorname + 1);
825 if (size == 3 || size == 6 || size == 9 || size == 12)
826 {
827 UINT colorval;
828 int i, pos;
829 pos = 0;
830 size /= 3;
831 colorval = 0;
832
833 for (i = 0; i < 3; i++)
834 {
835 char *end;
836 char t;
837 unsigned long value;
838
839 /* The check for 'x' in the following conditional takes into
840 account the fact that strtol allows a "0x" in front of
841 our numbers, and we don't. */
842 if (!isxdigit (color[0]) || color[1] == 'x')
843 break;
844 t = color[size];
845 color[size] = '\0';
846 value = strtoul (color, &end, 16);
847 color[size] = t;
848 if (errno == ERANGE || end - color != size)
849 break;
850 switch (size)
851 {
852 case 1:
853 value = value * 0x10;
854 break;
855 case 2:
856 break;
857 case 3:
858 value /= 0x10;
859 break;
860 case 4:
861 value /= 0x100;
862 break;
863 }
864 colorval |= (value << pos);
865 pos += 0x8;
866 if (i == 2)
867 {
868 unblock_input ();
869 XSETINT (ret, colorval);
870 return ret;
871 }
872 color = end;
873 }
874 }
875 }
876 else if (strnicmp (colorname, "rgb:", 4) == 0)
877 {
878 const char *color;
879 UINT colorval;
880 int i, pos;
881 pos = 0;
882
883 colorval = 0;
884 color = colorname + 4;
885 for (i = 0; i < 3; i++)
886 {
887 char *end;
888 unsigned long value;
889
890 /* The check for 'x' in the following conditional takes into
891 account the fact that strtol allows a "0x" in front of
892 our numbers, and we don't. */
893 if (!isxdigit (color[0]) || color[1] == 'x')
894 break;
895 value = strtoul (color, &end, 16);
896 if (errno == ERANGE)
897 break;
898 switch (end - color)
899 {
900 case 1:
901 value = value * 0x10 + value;
902 break;
903 case 2:
904 break;
905 case 3:
906 value /= 0x10;
907 break;
908 case 4:
909 value /= 0x100;
910 break;
911 default:
912 value = ULONG_MAX;
913 }
914 if (value == ULONG_MAX)
915 break;
916 colorval |= (value << pos);
917 pos += 0x8;
918 if (i == 2)
919 {
920 if (*end != '\0')
921 break;
922 unblock_input ();
923 XSETINT (ret, colorval);
924 return ret;
925 }
926 if (*end != '/')
927 break;
928 color = end + 1;
929 }
930 }
931 else if (strnicmp (colorname, "rgbi:", 5) == 0)
932 {
933 /* This is an RGB Intensity specification. */
934 const char *color;
935 UINT colorval;
936 int i, pos;
937 pos = 0;
938
939 colorval = 0;
940 color = colorname + 5;
941 for (i = 0; i < 3; i++)
942 {
943 char *end;
944 double value;
945 UINT val;
946
947 value = strtod (color, &end);
948 if (errno == ERANGE)
949 break;
950 if (value < 0.0 || value > 1.0)
951 break;
952 val = (UINT)(0x100 * value);
953 /* We used 0x100 instead of 0xFF to give a continuous
954 range between 0.0 and 1.0 inclusive. The next statement
955 fixes the 1.0 case. */
956 if (val == 0x100)
957 val = 0xFF;
958 colorval |= (val << pos);
959 pos += 0x8;
960 if (i == 2)
961 {
962 if (*end != '\0')
963 break;
964 unblock_input ();
965 XSETINT (ret, colorval);
966 return ret;
967 }
968 if (*end != '/')
969 break;
970 color = end + 1;
971 }
972 }
973 /* I am not going to attempt to handle any of the CIE color schemes
974 or TekHVC, since I don't know the algorithms for conversion to
975 RGB. */
976
977 /* If we fail to lookup the color name in w32_color_map, then check the
978 colorname to see if it can be crudely approximated: If the X color
979 ends in a number (e.g., "darkseagreen2"), strip the number and
980 return the result of looking up the base color name. */
981 ret = w32_color_map_lookup (colorname);
982 if (NILP (ret))
983 {
984 int len = strlen (colorname);
985
986 if (isdigit (colorname[len - 1]))
987 {
988 char *ptr, *approx = alloca (len + 1);
989
990 strcpy (approx, colorname);
991 ptr = &approx[len - 1];
992 while (ptr > approx && isdigit (*ptr))
993 *ptr-- = '\0';
994
995 ret = w32_color_map_lookup (approx);
996 }
997 }
998
999 unblock_input ();
1000 return ret;
1001 }
1002
1003 void
1004 w32_regenerate_palette (struct frame *f)
1005 {
1006 struct w32_palette_entry * list;
1007 LOGPALETTE * log_palette;
1008 HPALETTE new_palette;
1009 int i;
1010
1011 /* don't bother trying to create palette if not supported */
1012 if (! FRAME_DISPLAY_INFO (f)->has_palette)
1013 return;
1014
1015 log_palette = (LOGPALETTE *)
1016 alloca (sizeof (LOGPALETTE) +
1017 FRAME_DISPLAY_INFO (f)->num_colors * sizeof (PALETTEENTRY));
1018 log_palette->palVersion = 0x300;
1019 log_palette->palNumEntries = FRAME_DISPLAY_INFO (f)->num_colors;
1020
1021 list = FRAME_DISPLAY_INFO (f)->color_list;
1022 for (i = 0;
1023 i < FRAME_DISPLAY_INFO (f)->num_colors;
1024 i++, list = list->next)
1025 log_palette->palPalEntry[i] = list->entry;
1026
1027 new_palette = CreatePalette (log_palette);
1028
1029 enter_crit ();
1030
1031 if (FRAME_DISPLAY_INFO (f)->palette)
1032 DeleteObject (FRAME_DISPLAY_INFO (f)->palette);
1033 FRAME_DISPLAY_INFO (f)->palette = new_palette;
1034
1035 /* Realize display palette and garbage all frames. */
1036 release_frame_dc (f, get_frame_dc (f));
1037
1038 leave_crit ();
1039 }
1040
1041 #define W32_COLOR(pe) RGB (pe.peRed, pe.peGreen, pe.peBlue)
1042 #define SET_W32_COLOR(pe, color) \
1043 do \
1044 { \
1045 pe.peRed = GetRValue (color); \
1046 pe.peGreen = GetGValue (color); \
1047 pe.peBlue = GetBValue (color); \
1048 pe.peFlags = 0; \
1049 } while (0)
1050
1051 #if 0
1052 /* Keep these around in case we ever want to track color usage. */
1053 void
1054 w32_map_color (struct frame *f, COLORREF color)
1055 {
1056 struct w32_palette_entry * list = FRAME_DISPLAY_INFO (f)->color_list;
1057
1058 if (NILP (Vw32_enable_palette))
1059 return;
1060
1061 /* check if color is already mapped */
1062 while (list)
1063 {
1064 if (W32_COLOR (list->entry) == color)
1065 {
1066 ++list->refcount;
1067 return;
1068 }
1069 list = list->next;
1070 }
1071
1072 /* not already mapped, so add to list and recreate Windows palette */
1073 list = xmalloc (sizeof (struct w32_palette_entry));
1074 SET_W32_COLOR (list->entry, color);
1075 list->refcount = 1;
1076 list->next = FRAME_DISPLAY_INFO (f)->color_list;
1077 FRAME_DISPLAY_INFO (f)->color_list = list;
1078 FRAME_DISPLAY_INFO (f)->num_colors++;
1079
1080 /* set flag that palette must be regenerated */
1081 FRAME_DISPLAY_INFO (f)->regen_palette = TRUE;
1082 }
1083
1084 void
1085 w32_unmap_color (struct frame *f, COLORREF color)
1086 {
1087 struct w32_palette_entry * list = FRAME_DISPLAY_INFO (f)->color_list;
1088 struct w32_palette_entry **prev = &FRAME_DISPLAY_INFO (f)->color_list;
1089
1090 if (NILP (Vw32_enable_palette))
1091 return;
1092
1093 /* check if color is already mapped */
1094 while (list)
1095 {
1096 if (W32_COLOR (list->entry) == color)
1097 {
1098 if (--list->refcount == 0)
1099 {
1100 *prev = list->next;
1101 xfree (list);
1102 FRAME_DISPLAY_INFO (f)->num_colors--;
1103 break;
1104 }
1105 else
1106 return;
1107 }
1108 prev = &list->next;
1109 list = list->next;
1110 }
1111
1112 /* set flag that palette must be regenerated */
1113 FRAME_DISPLAY_INFO (f)->regen_palette = TRUE;
1114 }
1115 #endif
1116
1117
1118 /* Gamma-correct COLOR on frame F. */
1119
1120 void
1121 gamma_correct (struct frame *f, COLORREF *color)
1122 {
1123 if (f->gamma)
1124 {
1125 *color = PALETTERGB (
1126 pow (GetRValue (*color) / 255.0, f->gamma) * 255.0 + 0.5,
1127 pow (GetGValue (*color) / 255.0, f->gamma) * 255.0 + 0.5,
1128 pow (GetBValue (*color) / 255.0, f->gamma) * 255.0 + 0.5);
1129 }
1130 }
1131
1132
1133 /* Decide if color named COLOR is valid for the display associated with
1134 the selected frame; if so, return the rgb values in COLOR_DEF.
1135 If ALLOC is nonzero, allocate a new colormap cell. */
1136
1137 int
1138 w32_defined_color (struct frame *f, const char *color, XColor *color_def,
1139 bool alloc_p)
1140 {
1141 register Lisp_Object tem;
1142 COLORREF w32_color_ref;
1143
1144 tem = x_to_w32_color (color);
1145
1146 if (!NILP (tem))
1147 {
1148 if (f)
1149 {
1150 /* Apply gamma correction. */
1151 w32_color_ref = XUINT (tem);
1152 gamma_correct (f, &w32_color_ref);
1153 XSETINT (tem, w32_color_ref);
1154 }
1155
1156 /* Map this color to the palette if it is enabled. */
1157 if (!NILP (Vw32_enable_palette))
1158 {
1159 struct w32_palette_entry * entry =
1160 one_w32_display_info.color_list;
1161 struct w32_palette_entry ** prev =
1162 &one_w32_display_info.color_list;
1163
1164 /* check if color is already mapped */
1165 while (entry)
1166 {
1167 if (W32_COLOR (entry->entry) == XUINT (tem))
1168 break;
1169 prev = &entry->next;
1170 entry = entry->next;
1171 }
1172
1173 if (entry == NULL && alloc_p)
1174 {
1175 /* not already mapped, so add to list */
1176 entry = xmalloc (sizeof (struct w32_palette_entry));
1177 SET_W32_COLOR (entry->entry, XUINT (tem));
1178 entry->next = NULL;
1179 *prev = entry;
1180 one_w32_display_info.num_colors++;
1181
1182 /* set flag that palette must be regenerated */
1183 one_w32_display_info.regen_palette = TRUE;
1184 }
1185 }
1186 /* Ensure COLORREF value is snapped to nearest color in (default)
1187 palette by simulating the PALETTERGB macro. This works whether
1188 or not the display device has a palette. */
1189 w32_color_ref = XUINT (tem) | 0x2000000;
1190
1191 color_def->pixel = w32_color_ref;
1192 color_def->red = GetRValue (w32_color_ref) * 256;
1193 color_def->green = GetGValue (w32_color_ref) * 256;
1194 color_def->blue = GetBValue (w32_color_ref) * 256;
1195
1196 return 1;
1197 }
1198 else
1199 {
1200 return 0;
1201 }
1202 }
1203
1204 /* Given a string ARG naming a color, compute a pixel value from it
1205 suitable for screen F.
1206 If F is not a color screen, return DEF (default) regardless of what
1207 ARG says. */
1208
1209 int
1210 x_decode_color (struct frame *f, Lisp_Object arg, int def)
1211 {
1212 XColor cdef;
1213
1214 CHECK_STRING (arg);
1215
1216 if (strcmp (SSDATA (arg), "black") == 0)
1217 return BLACK_PIX_DEFAULT (f);
1218 else if (strcmp (SSDATA (arg), "white") == 0)
1219 return WHITE_PIX_DEFAULT (f);
1220
1221 if ((FRAME_DISPLAY_INFO (f)->n_planes * FRAME_DISPLAY_INFO (f)->n_cbits) == 1)
1222 return def;
1223
1224 /* w32_defined_color is responsible for coping with failures
1225 by looking for a near-miss. */
1226 if (w32_defined_color (f, SSDATA (arg), &cdef, true))
1227 return cdef.pixel;
1228
1229 /* defined_color failed; return an ultimate default. */
1230 return def;
1231 }
1232 \f
1233
1234
1235 /* Functions called only from `x_set_frame_param'
1236 to set individual parameters.
1237
1238 If FRAME_W32_WINDOW (f) is 0,
1239 the frame is being created and its window does not exist yet.
1240 In that case, just record the parameter's new value
1241 in the standard place; do not attempt to change the window. */
1242
1243 void
1244 x_set_foreground_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
1245 {
1246 struct w32_output *x = f->output_data.w32;
1247 PIX_TYPE fg, old_fg;
1248
1249 fg = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1250 old_fg = FRAME_FOREGROUND_PIXEL (f);
1251 FRAME_FOREGROUND_PIXEL (f) = fg;
1252
1253 if (FRAME_W32_WINDOW (f) != 0)
1254 {
1255 if (x->cursor_pixel == old_fg)
1256 {
1257 x->cursor_pixel = fg;
1258 x->cursor_gc->background = fg;
1259 }
1260
1261 update_face_from_frame_parameter (f, Qforeground_color, arg);
1262 if (FRAME_VISIBLE_P (f))
1263 redraw_frame (f);
1264 }
1265 }
1266
1267 void
1268 x_set_background_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
1269 {
1270 FRAME_BACKGROUND_PIXEL (f)
1271 = x_decode_color (f, arg, WHITE_PIX_DEFAULT (f));
1272
1273 if (FRAME_W32_WINDOW (f) != 0)
1274 {
1275 SetWindowLong (FRAME_W32_WINDOW (f), WND_BACKGROUND_INDEX,
1276 FRAME_BACKGROUND_PIXEL (f));
1277
1278 update_face_from_frame_parameter (f, Qbackground_color, arg);
1279
1280 if (FRAME_VISIBLE_P (f))
1281 redraw_frame (f);
1282 }
1283 }
1284
1285 void
1286 x_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
1287 {
1288 #if 0
1289 Cursor cursor, nontext_cursor, mode_cursor, hand_cursor;
1290 int count;
1291 #endif
1292 int mask_color;
1293
1294 if (!EQ (Qnil, arg))
1295 f->output_data.w32->mouse_pixel
1296 = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1297 mask_color = FRAME_BACKGROUND_PIXEL (f);
1298
1299 /* Don't let pointers be invisible. */
1300 if (mask_color == f->output_data.w32->mouse_pixel
1301 && mask_color == FRAME_BACKGROUND_PIXEL (f))
1302 f->output_data.w32->mouse_pixel = FRAME_FOREGROUND_PIXEL (f);
1303
1304 #if 0 /* TODO : Mouse cursor customization. */
1305 block_input ();
1306
1307 /* It's not okay to crash if the user selects a screwy cursor. */
1308 count = x_catch_errors (FRAME_W32_DISPLAY (f));
1309
1310 if (!EQ (Qnil, Vx_pointer_shape))
1311 {
1312 CHECK_NUMBER (Vx_pointer_shape);
1313 cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XINT (Vx_pointer_shape));
1314 }
1315 else
1316 cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_xterm);
1317 x_check_errors (FRAME_W32_DISPLAY (f), "bad text pointer cursor: %s");
1318
1319 if (!EQ (Qnil, Vx_nontext_pointer_shape))
1320 {
1321 CHECK_NUMBER (Vx_nontext_pointer_shape);
1322 nontext_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f),
1323 XINT (Vx_nontext_pointer_shape));
1324 }
1325 else
1326 nontext_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_left_ptr);
1327 x_check_errors (FRAME_W32_DISPLAY (f), "bad nontext pointer cursor: %s");
1328
1329 if (!EQ (Qnil, Vx_hourglass_pointer_shape))
1330 {
1331 CHECK_NUMBER (Vx_hourglass_pointer_shape);
1332 hourglass_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f),
1333 XINT (Vx_hourglass_pointer_shape));
1334 }
1335 else
1336 hourglass_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_watch);
1337 x_check_errors (FRAME_W32_DISPLAY (f), "bad busy pointer cursor: %s");
1338
1339 x_check_errors (FRAME_W32_DISPLAY (f), "bad nontext pointer cursor: %s");
1340 if (!EQ (Qnil, Vx_mode_pointer_shape))
1341 {
1342 CHECK_NUMBER (Vx_mode_pointer_shape);
1343 mode_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f),
1344 XINT (Vx_mode_pointer_shape));
1345 }
1346 else
1347 mode_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_xterm);
1348 x_check_errors (FRAME_W32_DISPLAY (f), "bad modeline pointer cursor: %s");
1349
1350 if (!EQ (Qnil, Vx_sensitive_text_pointer_shape))
1351 {
1352 CHECK_NUMBER (Vx_sensitive_text_pointer_shape);
1353 hand_cursor
1354 = XCreateFontCursor (FRAME_W32_DISPLAY (f),
1355 XINT (Vx_sensitive_text_pointer_shape));
1356 }
1357 else
1358 hand_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_crosshair);
1359
1360 if (!NILP (Vx_window_horizontal_drag_shape))
1361 {
1362 CHECK_NUMBER (Vx_window_horizontal_drag_shape);
1363 horizontal_drag_cursor
1364 = XCreateFontCursor (FRAME_W32_DISPLAY (f),
1365 XINT (Vx_window_horizontal_drag_shape));
1366 }
1367 else
1368 horizontal_drag_cursor
1369 = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_sb_h_double_arrow);
1370
1371 if (!NILP (Vx_window_vertical_drag_shape))
1372 {
1373 CHECK_NUMBER (Vx_window_vertical_drag_shape);
1374 vertical_drag_cursor
1375 = XCreateFontCursor (FRAME_W32_DISPLAY (f),
1376 XINT (Vx_window_vertical_drag_shape));
1377 }
1378 else
1379 vertical_drag_cursor
1380 = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_sb_v_double_arrow);
1381
1382 /* Check and report errors with the above calls. */
1383 x_check_errors (FRAME_W32_DISPLAY (f), "can't set cursor shape: %s");
1384 x_uncatch_errors (FRAME_W32_DISPLAY (f), count);
1385
1386 {
1387 XColor fore_color, back_color;
1388
1389 fore_color.pixel = f->output_data.w32->mouse_pixel;
1390 back_color.pixel = mask_color;
1391 XQueryColor (FRAME_W32_DISPLAY (f),
1392 DefaultColormap (FRAME_W32_DISPLAY (f),
1393 DefaultScreen (FRAME_W32_DISPLAY (f))),
1394 &fore_color);
1395 XQueryColor (FRAME_W32_DISPLAY (f),
1396 DefaultColormap (FRAME_W32_DISPLAY (f),
1397 DefaultScreen (FRAME_W32_DISPLAY (f))),
1398 &back_color);
1399 XRecolorCursor (FRAME_W32_DISPLAY (f), cursor,
1400 &fore_color, &back_color);
1401 XRecolorCursor (FRAME_W32_DISPLAY (f), nontext_cursor,
1402 &fore_color, &back_color);
1403 XRecolorCursor (FRAME_W32_DISPLAY (f), mode_cursor,
1404 &fore_color, &back_color);
1405 XRecolorCursor (FRAME_W32_DISPLAY (f), hand_cursor,
1406 &fore_color, &back_color);
1407 XRecolorCursor (FRAME_W32_DISPLAY (f), hourglass_cursor,
1408 &fore_color, &back_color);
1409 }
1410
1411 if (FRAME_W32_WINDOW (f) != 0)
1412 XDefineCursor (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f), cursor);
1413
1414 if (cursor != f->output_data.w32->text_cursor && f->output_data.w32->text_cursor != 0)
1415 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->text_cursor);
1416 f->output_data.w32->text_cursor = cursor;
1417
1418 if (nontext_cursor != f->output_data.w32->nontext_cursor
1419 && f->output_data.w32->nontext_cursor != 0)
1420 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->nontext_cursor);
1421 f->output_data.w32->nontext_cursor = nontext_cursor;
1422
1423 if (hourglass_cursor != f->output_data.w32->hourglass_cursor
1424 && f->output_data.w32->hourglass_cursor != 0)
1425 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->hourglass_cursor);
1426 f->output_data.w32->hourglass_cursor = hourglass_cursor;
1427
1428 if (mode_cursor != f->output_data.w32->modeline_cursor
1429 && f->output_data.w32->modeline_cursor != 0)
1430 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->modeline_cursor);
1431 f->output_data.w32->modeline_cursor = mode_cursor;
1432
1433 if (hand_cursor != f->output_data.w32->hand_cursor
1434 && f->output_data.w32->hand_cursor != 0)
1435 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->hand_cursor);
1436 f->output_data.w32->hand_cursor = hand_cursor;
1437
1438 XFlush (FRAME_W32_DISPLAY (f));
1439 unblock_input ();
1440
1441 update_face_from_frame_parameter (f, Qmouse_color, arg);
1442 #endif /* TODO */
1443 }
1444
1445 void
1446 x_set_cursor_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
1447 {
1448 unsigned long fore_pixel, pixel;
1449
1450 if (!NILP (Vx_cursor_fore_pixel))
1451 fore_pixel = x_decode_color (f, Vx_cursor_fore_pixel,
1452 WHITE_PIX_DEFAULT (f));
1453 else
1454 fore_pixel = FRAME_BACKGROUND_PIXEL (f);
1455
1456 pixel = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1457
1458 /* Make sure that the cursor color differs from the background color. */
1459 if (pixel == FRAME_BACKGROUND_PIXEL (f))
1460 {
1461 pixel = f->output_data.w32->mouse_pixel;
1462 if (pixel == fore_pixel)
1463 fore_pixel = FRAME_BACKGROUND_PIXEL (f);
1464 }
1465
1466 f->output_data.w32->cursor_foreground_pixel = fore_pixel;
1467 f->output_data.w32->cursor_pixel = pixel;
1468
1469 if (FRAME_W32_WINDOW (f) != 0)
1470 {
1471 block_input ();
1472 /* Update frame's cursor_gc. */
1473 f->output_data.w32->cursor_gc->foreground = fore_pixel;
1474 f->output_data.w32->cursor_gc->background = pixel;
1475
1476 unblock_input ();
1477
1478 if (FRAME_VISIBLE_P (f))
1479 {
1480 x_update_cursor (f, 0);
1481 x_update_cursor (f, 1);
1482 }
1483 }
1484
1485 update_face_from_frame_parameter (f, Qcursor_color, arg);
1486 }
1487
1488 /* Set the border-color of frame F to pixel value PIX.
1489 Note that this does not fully take effect if done before
1490 F has a window. */
1491
1492 void
1493 x_set_border_pixel (struct frame *f, int pix)
1494 {
1495
1496 f->output_data.w32->border_pixel = pix;
1497
1498 if (FRAME_W32_WINDOW (f) != 0 && f->border_width > 0)
1499 {
1500 if (FRAME_VISIBLE_P (f))
1501 redraw_frame (f);
1502 }
1503 }
1504
1505 /* Set the border-color of frame F to value described by ARG.
1506 ARG can be a string naming a color.
1507 The border-color is used for the border that is drawn by the server.
1508 Note that this does not fully take effect if done before
1509 F has a window; it must be redone when the window is created. */
1510
1511 void
1512 x_set_border_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
1513 {
1514 int pix;
1515
1516 CHECK_STRING (arg);
1517 pix = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1518 x_set_border_pixel (f, pix);
1519 update_face_from_frame_parameter (f, Qborder_color, arg);
1520 }
1521
1522
1523 void
1524 x_set_cursor_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
1525 {
1526 set_frame_cursor_types (f, arg);
1527 }
1528
1529 void
1530 x_set_icon_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
1531 {
1532 bool result;
1533
1534 if (NILP (arg) && NILP (oldval))
1535 return;
1536
1537 if (STRINGP (arg) && STRINGP (oldval)
1538 && EQ (Fstring_equal (oldval, arg), Qt))
1539 return;
1540
1541 if (SYMBOLP (arg) && SYMBOLP (oldval) && EQ (arg, oldval))
1542 return;
1543
1544 block_input ();
1545
1546 result = x_bitmap_icon (f, arg);
1547 if (result)
1548 {
1549 unblock_input ();
1550 error ("No icon window available");
1551 }
1552
1553 unblock_input ();
1554 }
1555
1556 void
1557 x_set_icon_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
1558 {
1559 if (STRINGP (arg))
1560 {
1561 if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
1562 return;
1563 }
1564 else if (!NILP (arg) || NILP (oldval))
1565 return;
1566
1567 fset_icon_name (f, arg);
1568
1569 #if 0
1570 if (f->output_data.w32->icon_bitmap != 0)
1571 return;
1572
1573 block_input ();
1574
1575 result = x_text_icon (f,
1576 SSDATA ((!NILP (f->icon_name)
1577 ? f->icon_name
1578 : !NILP (f->title)
1579 ? f->title
1580 : f->name)));
1581
1582 if (result)
1583 {
1584 unblock_input ();
1585 error ("No icon window available");
1586 }
1587
1588 /* If the window was unmapped (and its icon was mapped),
1589 the new icon is not mapped, so map the window in its stead. */
1590 if (FRAME_VISIBLE_P (f))
1591 {
1592 #ifdef USE_X_TOOLKIT
1593 XtPopup (f->output_data.w32->widget, XtGrabNone);
1594 #endif
1595 XMapWindow (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f));
1596 }
1597
1598 XFlush (FRAME_W32_DISPLAY (f));
1599 unblock_input ();
1600 #endif
1601 }
1602 \f
1603 void
1604 x_clear_under_internal_border (struct frame *f)
1605 {
1606 int border = FRAME_INTERNAL_BORDER_WIDTH (f);
1607
1608 /* Clear border if it's larger than before. */
1609 if (border != 0)
1610 {
1611 HDC hdc = get_frame_dc (f);
1612 int width = FRAME_PIXEL_WIDTH (f);
1613 int height = FRAME_PIXEL_HEIGHT (f);
1614
1615 block_input ();
1616 w32_clear_area (f, hdc, 0, FRAME_TOP_MARGIN_HEIGHT (f), width, border);
1617 w32_clear_area (f, hdc, 0, 0, border, height);
1618 w32_clear_area (f, hdc, width - border, 0, border, height);
1619 w32_clear_area (f, hdc, 0, height - border, width, border);
1620 release_frame_dc (f, hdc);
1621 unblock_input ();
1622 }
1623 }
1624
1625
1626 void
1627 x_set_internal_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
1628 {
1629 int border;
1630
1631 CHECK_TYPE_RANGED_INTEGER (int, arg);
1632 border = max (XINT (arg), 0);
1633
1634 if (border != FRAME_INTERNAL_BORDER_WIDTH (f))
1635 {
1636 FRAME_INTERNAL_BORDER_WIDTH (f) = border;
1637
1638 if (FRAME_X_WINDOW (f) != 0)
1639 {
1640 adjust_frame_size (f, -1, -1, 3, false, Qinternal_border_width);
1641
1642 if (FRAME_VISIBLE_P (f))
1643 x_clear_under_internal_border (f);
1644 }
1645 }
1646 }
1647
1648
1649 void
1650 x_set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
1651 {
1652 int nlines;
1653
1654 /* Right now, menu bars don't work properly in minibuf-only frames;
1655 most of the commands try to apply themselves to the minibuffer
1656 frame itself, and get an error because you can't switch buffers
1657 in or split the minibuffer window. */
1658 if (FRAME_MINIBUF_ONLY_P (f))
1659 return;
1660
1661 if (INTEGERP (value))
1662 nlines = XINT (value);
1663 else
1664 nlines = 0;
1665
1666 FRAME_MENU_BAR_LINES (f) = 0;
1667 FRAME_MENU_BAR_HEIGHT (f) = 0;
1668 if (nlines)
1669 FRAME_EXTERNAL_MENU_BAR (f) = 1;
1670 else
1671 {
1672 if (FRAME_EXTERNAL_MENU_BAR (f) == 1)
1673 free_frame_menubar (f);
1674 FRAME_EXTERNAL_MENU_BAR (f) = 0;
1675
1676 /* Adjust the frame size so that the client (text) dimensions
1677 remain the same. This depends on FRAME_EXTERNAL_MENU_BAR being
1678 set correctly. Note that we resize twice: The first time upon
1679 a request from the window manager who wants to keep the height
1680 of the outer rectangle (including decorations) unchanged, and a
1681 second time because we want to keep the height of the inner
1682 rectangle (without the decorations unchanged). */
1683 adjust_frame_size (f, -1, -1, 2, true, Qmenu_bar_lines);
1684
1685 /* Not sure whether this is needed. */
1686 x_clear_under_internal_border (f);
1687 }
1688 }
1689
1690
1691 /* Set the number of lines used for the tool bar of frame F to VALUE.
1692 VALUE not an integer, or < 0 means set the lines to zero. OLDVAL is
1693 the old number of tool bar lines (and is unused). This function may
1694 change the height of all windows on frame F to match the new tool bar
1695 height. By design, the frame's height doesn't change (but maybe it
1696 should if we don't get enough space otherwise). */
1697
1698 void
1699 x_set_tool_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
1700 {
1701 int nlines;
1702
1703 /* Treat tool bars like menu bars. */
1704 if (FRAME_MINIBUF_ONLY_P (f))
1705 return;
1706
1707 /* Use VALUE only if an integer >= 0. */
1708 if (INTEGERP (value) && XINT (value) >= 0)
1709 nlines = XFASTINT (value);
1710 else
1711 nlines = 0;
1712
1713 x_change_tool_bar_height (f, nlines * FRAME_LINE_HEIGHT (f));
1714 }
1715
1716
1717 /* Set the pixel height of the tool bar of frame F to HEIGHT. */
1718 void
1719 x_change_tool_bar_height (struct frame *f, int height)
1720 {
1721 int unit = FRAME_LINE_HEIGHT (f);
1722 int old_height = FRAME_TOOL_BAR_HEIGHT (f);
1723 int lines = (height + unit - 1) / unit;
1724 Lisp_Object fullscreen;
1725
1726 /* Make sure we redisplay all windows in this frame. */
1727 windows_or_buffers_changed = 23;
1728
1729 /* Recalculate tool bar and frame text sizes. */
1730 FRAME_TOOL_BAR_HEIGHT (f) = height;
1731 FRAME_TOOL_BAR_LINES (f) = lines;
1732 /* Store `tool-bar-lines' and `height' frame parameters. */
1733 store_frame_param (f, Qtool_bar_lines, make_number (lines));
1734 store_frame_param (f, Qheight, make_number (FRAME_LINES (f)));
1735
1736 if (FRAME_W32_WINDOW (f) && FRAME_TOOL_BAR_HEIGHT (f) == 0)
1737 {
1738 clear_frame (f);
1739 clear_current_matrices (f);
1740 }
1741
1742 if ((height < old_height) && WINDOWP (f->tool_bar_window))
1743 clear_glyph_matrix (XWINDOW (f->tool_bar_window)->current_matrix);
1744
1745 /* Recalculate toolbar height. */
1746 f->n_tool_bar_rows = 0;
1747 if (old_height == 0
1748 && (!f->after_make_frame
1749 || NILP (frame_inhibit_implied_resize)
1750 || (CONSP (frame_inhibit_implied_resize)
1751 && NILP (Fmemq (Qtool_bar_lines, frame_inhibit_implied_resize)))))
1752 f->tool_bar_redisplayed = f->tool_bar_resized = false;
1753
1754 adjust_frame_size (f, -1, -1,
1755 ((!f->tool_bar_resized
1756 && (NILP (fullscreen =
1757 get_frame_param (f, Qfullscreen))
1758 || EQ (fullscreen, Qfullwidth))) ? 1
1759 : (old_height == 0 || height == 0) ? 2
1760 : 4),
1761 false, Qtool_bar_lines);
1762
1763 f->tool_bar_resized = f->tool_bar_redisplayed;
1764
1765 /* adjust_frame_size might not have done anything, garbage frame
1766 here. */
1767 adjust_frame_glyphs (f);
1768 SET_FRAME_GARBAGED (f);
1769 if (FRAME_X_WINDOW (f))
1770 x_clear_under_internal_border (f);
1771 }
1772
1773 static void
1774 w32_set_title_bar_text (struct frame *f, Lisp_Object name)
1775 {
1776 if (FRAME_W32_WINDOW (f))
1777 {
1778 block_input ();
1779 #ifdef __CYGWIN__
1780 GUI_FN (SetWindowText) (FRAME_W32_WINDOW (f),
1781 GUI_SDATA (GUI_ENCODE_SYSTEM (name)));
1782 #else
1783 /* The frame's title many times shows the name of the file
1784 visited in the selected window's buffer, so it makes sense to
1785 support non-ASCII characters outside of the current system
1786 codepage in the title. */
1787 if (w32_unicode_filenames)
1788 {
1789 Lisp_Object encoded_title = ENCODE_UTF_8 (name);
1790 wchar_t *title_w;
1791 int tlen = pMultiByteToWideChar (CP_UTF8, 0, SSDATA (encoded_title),
1792 -1, NULL, 0);
1793
1794 if (tlen > 0)
1795 {
1796 /* Windows truncates the title text beyond what fits on
1797 a single line, so we can limit the length to some
1798 reasonably large value, and use alloca. */
1799 if (tlen > 10000)
1800 tlen = 10000;
1801 title_w = alloca ((tlen + 1) * sizeof (wchar_t));
1802 pMultiByteToWideChar (CP_UTF8, 0, SSDATA (encoded_title), -1,
1803 title_w, tlen);
1804 title_w[tlen] = L'\0';
1805 SetWindowTextW (FRAME_W32_WINDOW (f), title_w);
1806 }
1807 else /* Conversion to UTF-16 failed, so we punt. */
1808 SetWindowTextA (FRAME_W32_WINDOW (f),
1809 SSDATA (ENCODE_SYSTEM (name)));
1810 }
1811 else
1812 SetWindowTextA (FRAME_W32_WINDOW (f), SSDATA (ENCODE_SYSTEM (name)));
1813 #endif
1814 unblock_input ();
1815 }
1816 }
1817
1818 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
1819 w32_id_name.
1820
1821 If EXPLICIT is non-zero, that indicates that lisp code is setting the
1822 name; if NAME is a string, set F's name to NAME and set
1823 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
1824
1825 If EXPLICIT is zero, that indicates that Emacs redisplay code is
1826 suggesting a new name, which lisp code should override; if
1827 F->explicit_name is set, ignore the new name; otherwise, set it. */
1828
1829 void
1830 x_set_name (struct frame *f, Lisp_Object name, bool explicit)
1831 {
1832 /* Make sure that requests from lisp code override requests from
1833 Emacs redisplay code. */
1834 if (explicit)
1835 {
1836 /* If we're switching from explicit to implicit, we had better
1837 update the mode lines and thereby update the title. */
1838 if (f->explicit_name && NILP (name))
1839 update_mode_lines = 25;
1840
1841 f->explicit_name = ! NILP (name);
1842 }
1843 else if (f->explicit_name)
1844 return;
1845
1846 /* If NAME is nil, set the name to the w32_id_name. */
1847 if (NILP (name))
1848 {
1849 /* Check for no change needed in this very common case
1850 before we do any consing. */
1851 if (!strcmp (FRAME_DISPLAY_INFO (f)->w32_id_name,
1852 SSDATA (f->name)))
1853 return;
1854 name = build_string (FRAME_DISPLAY_INFO (f)->w32_id_name);
1855 }
1856 else
1857 CHECK_STRING (name);
1858
1859 /* Don't change the name if it's already NAME. */
1860 if (! NILP (Fstring_equal (name, f->name)))
1861 return;
1862
1863 fset_name (f, name);
1864
1865 /* For setting the frame title, the title parameter should override
1866 the name parameter. */
1867 if (! NILP (f->title))
1868 name = f->title;
1869
1870 w32_set_title_bar_text (f, name);
1871 }
1872
1873 /* This function should be called when the user's lisp code has
1874 specified a name for the frame; the name will override any set by the
1875 redisplay code. */
1876 void
1877 x_explicitly_set_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
1878 {
1879 x_set_name (f, arg, true);
1880 }
1881
1882 /* This function should be called by Emacs redisplay code to set the
1883 name; names set this way will never override names set by the user's
1884 lisp code. */
1885 void
1886 x_implicitly_set_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
1887 {
1888 x_set_name (f, arg, false);
1889 }
1890 \f
1891 /* Change the title of frame F to NAME.
1892 If NAME is nil, use the frame name as the title. */
1893
1894 void
1895 x_set_title (struct frame *f, Lisp_Object name, Lisp_Object old_name)
1896 {
1897 /* Don't change the title if it's already NAME. */
1898 if (EQ (name, f->title))
1899 return;
1900
1901 update_mode_lines = 26;
1902
1903 fset_title (f, name);
1904
1905 if (NILP (name))
1906 name = f->name;
1907
1908 w32_set_title_bar_text (f, name);
1909 }
1910
1911 void
1912 x_set_scroll_bar_default_width (struct frame *f)
1913 {
1914 int unit = FRAME_COLUMN_WIDTH (f);
1915
1916 FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = GetSystemMetrics (SM_CXVSCROLL);
1917 FRAME_CONFIG_SCROLL_BAR_COLS (f)
1918 = (FRAME_CONFIG_SCROLL_BAR_WIDTH (f) + unit - 1) / unit;
1919 }
1920
1921
1922 void
1923 x_set_scroll_bar_default_height (struct frame *f)
1924 {
1925 int unit = FRAME_LINE_HEIGHT (f);
1926
1927 FRAME_CONFIG_SCROLL_BAR_HEIGHT (f) = GetSystemMetrics (SM_CXHSCROLL);
1928 FRAME_CONFIG_SCROLL_BAR_LINES (f)
1929 = (FRAME_CONFIG_SCROLL_BAR_HEIGHT (f) + unit - 1) / unit;
1930 }
1931 \f
1932 /* Subroutines for creating a frame. */
1933
1934 Cursor
1935 w32_load_cursor (LPCTSTR name)
1936 {
1937 /* Try first to load cursor from application resource. */
1938 Cursor cursor = LoadImage ((HINSTANCE) GetModuleHandle (NULL),
1939 name, IMAGE_CURSOR, 0, 0,
1940 LR_DEFAULTCOLOR | LR_DEFAULTSIZE | LR_SHARED);
1941 if (!cursor)
1942 {
1943 /* Then try to load a shared predefined cursor. */
1944 cursor = LoadImage (NULL, name, IMAGE_CURSOR, 0, 0,
1945 LR_DEFAULTCOLOR | LR_DEFAULTSIZE | LR_SHARED);
1946 }
1947 return cursor;
1948 }
1949
1950 static LRESULT CALLBACK w32_wnd_proc (HWND, UINT, WPARAM, LPARAM);
1951
1952 #define INIT_WINDOW_CLASS(WC) \
1953 (WC).style = CS_HREDRAW | CS_VREDRAW; \
1954 (WC).lpfnWndProc = (WNDPROC) w32_wnd_proc; \
1955 (WC).cbClsExtra = 0; \
1956 (WC).cbWndExtra = WND_EXTRA_BYTES; \
1957 (WC).hInstance = hinst; \
1958 (WC).hIcon = LoadIcon (hinst, EMACS_CLASS); \
1959 (WC).hCursor = w32_load_cursor (IDC_ARROW); \
1960 (WC).hbrBackground = NULL; \
1961 (WC).lpszMenuName = NULL; \
1962
1963 static BOOL
1964 w32_init_class (HINSTANCE hinst)
1965 {
1966 if (w32_unicode_gui)
1967 {
1968 WNDCLASSW uwc;
1969 INIT_WINDOW_CLASS(uwc);
1970 uwc.lpszClassName = L"Emacs";
1971
1972 return RegisterClassW (&uwc);
1973 }
1974 else
1975 {
1976 WNDCLASS wc;
1977 INIT_WINDOW_CLASS(wc);
1978 wc.lpszClassName = EMACS_CLASS;
1979
1980 return RegisterClassA (&wc);
1981 }
1982 }
1983
1984 static HWND
1985 w32_createvscrollbar (struct frame *f, struct scroll_bar * bar)
1986 {
1987 return CreateWindow ("SCROLLBAR", "", SBS_VERT | WS_CHILD | WS_VISIBLE,
1988 /* Position and size of scroll bar. */
1989 bar->left, bar->top, bar->width, bar->height,
1990 FRAME_W32_WINDOW (f), NULL, hinst, NULL);
1991 }
1992
1993 static HWND
1994 w32_createhscrollbar (struct frame *f, struct scroll_bar * bar)
1995 {
1996 return CreateWindow ("SCROLLBAR", "", SBS_HORZ | WS_CHILD | WS_VISIBLE,
1997 /* Position and size of scroll bar. */
1998 bar->left, bar->top, bar->width, bar->height,
1999 FRAME_W32_WINDOW (f), NULL, hinst, NULL);
2000 }
2001
2002 static void
2003 w32_createwindow (struct frame *f, int *coords)
2004 {
2005 HWND hwnd;
2006 RECT rect;
2007 int top;
2008 int left;
2009
2010 rect.left = rect.top = 0;
2011 rect.right = FRAME_PIXEL_WIDTH (f);
2012 rect.bottom = FRAME_PIXEL_HEIGHT (f);
2013
2014 AdjustWindowRect (&rect, f->output_data.w32->dwStyle,
2015 FRAME_EXTERNAL_MENU_BAR (f));
2016
2017 /* Do first time app init */
2018
2019 w32_init_class (hinst);
2020
2021 if (f->size_hint_flags & USPosition || f->size_hint_flags & PPosition)
2022 {
2023 left = f->left_pos;
2024 top = f->top_pos;
2025 }
2026 else
2027 {
2028 left = coords[0];
2029 top = coords[1];
2030 }
2031
2032 FRAME_W32_WINDOW (f) = hwnd
2033 = CreateWindow (EMACS_CLASS,
2034 f->namebuf,
2035 f->output_data.w32->dwStyle | WS_CLIPCHILDREN,
2036 left, top,
2037 rect.right - rect.left, rect.bottom - rect.top,
2038 NULL,
2039 NULL,
2040 hinst,
2041 NULL);
2042
2043 if (hwnd)
2044 {
2045 SetWindowLong (hwnd, WND_FONTWIDTH_INDEX, FRAME_COLUMN_WIDTH (f));
2046 SetWindowLong (hwnd, WND_LINEHEIGHT_INDEX, FRAME_LINE_HEIGHT (f));
2047 SetWindowLong (hwnd, WND_BORDER_INDEX, FRAME_INTERNAL_BORDER_WIDTH (f));
2048 SetWindowLong (hwnd, WND_VSCROLLBAR_INDEX, FRAME_SCROLL_BAR_AREA_WIDTH (f));
2049 SetWindowLong (hwnd, WND_HSCROLLBAR_INDEX, FRAME_SCROLL_BAR_AREA_HEIGHT (f));
2050 SetWindowLong (hwnd, WND_BACKGROUND_INDEX, FRAME_BACKGROUND_PIXEL (f));
2051
2052 /* Enable drag-n-drop. */
2053 DragAcceptFiles (hwnd, TRUE);
2054
2055 /* Do this to discard the default setting specified by our parent. */
2056 ShowWindow (hwnd, SW_HIDE);
2057
2058 /* Update frame positions. */
2059 GetWindowRect (hwnd, &rect);
2060 f->left_pos = rect.left;
2061 f->top_pos = rect.top;
2062 }
2063 }
2064
2065 static void
2066 my_post_msg (W32Msg * wmsg, HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam)
2067 {
2068 wmsg->msg.hwnd = hwnd;
2069 wmsg->msg.message = msg;
2070 wmsg->msg.wParam = wParam;
2071 wmsg->msg.lParam = lParam;
2072 wmsg->msg.time = GetMessageTime ();
2073
2074 post_msg (wmsg);
2075 }
2076
2077 /* GetKeyState and MapVirtualKey on Windows 95 do not actually distinguish
2078 between left and right keys as advertised. We test for this
2079 support dynamically, and set a flag when the support is absent. If
2080 absent, we keep track of the left and right control and alt keys
2081 ourselves. This is particularly necessary on keyboards that rely
2082 upon the AltGr key, which is represented as having the left control
2083 and right alt keys pressed. For these keyboards, we need to know
2084 when the left alt key has been pressed in addition to the AltGr key
2085 so that we can properly support M-AltGr-key sequences (such as M-@
2086 on Swedish keyboards). */
2087
2088 #define EMACS_LCONTROL 0
2089 #define EMACS_RCONTROL 1
2090 #define EMACS_LMENU 2
2091 #define EMACS_RMENU 3
2092
2093 static int modifiers[4];
2094 static int modifiers_recorded;
2095 static int modifier_key_support_tested;
2096
2097 static void
2098 test_modifier_support (unsigned int wparam)
2099 {
2100 unsigned int l, r;
2101
2102 if (wparam != VK_CONTROL && wparam != VK_MENU)
2103 return;
2104 if (wparam == VK_CONTROL)
2105 {
2106 l = VK_LCONTROL;
2107 r = VK_RCONTROL;
2108 }
2109 else
2110 {
2111 l = VK_LMENU;
2112 r = VK_RMENU;
2113 }
2114 if (!(GetKeyState (l) & 0x8000) && !(GetKeyState (r) & 0x8000))
2115 modifiers_recorded = 1;
2116 else
2117 modifiers_recorded = 0;
2118 modifier_key_support_tested = 1;
2119 }
2120
2121 static void
2122 record_keydown (unsigned int wparam, unsigned int lparam)
2123 {
2124 int i;
2125
2126 if (!modifier_key_support_tested)
2127 test_modifier_support (wparam);
2128
2129 if ((wparam != VK_CONTROL && wparam != VK_MENU) || !modifiers_recorded)
2130 return;
2131
2132 if (wparam == VK_CONTROL)
2133 i = (lparam & 0x1000000) ? EMACS_RCONTROL : EMACS_LCONTROL;
2134 else
2135 i = (lparam & 0x1000000) ? EMACS_RMENU : EMACS_LMENU;
2136
2137 modifiers[i] = 1;
2138 }
2139
2140 static void
2141 record_keyup (unsigned int wparam, unsigned int lparam)
2142 {
2143 int i;
2144
2145 if ((wparam != VK_CONTROL && wparam != VK_MENU) || !modifiers_recorded)
2146 return;
2147
2148 if (wparam == VK_CONTROL)
2149 i = (lparam & 0x1000000) ? EMACS_RCONTROL : EMACS_LCONTROL;
2150 else
2151 i = (lparam & 0x1000000) ? EMACS_RMENU : EMACS_LMENU;
2152
2153 modifiers[i] = 0;
2154 }
2155
2156 /* Emacs can lose focus while a modifier key has been pressed. When
2157 it regains focus, be conservative and clear all modifiers since
2158 we cannot reconstruct the left and right modifier state. */
2159 static void
2160 reset_modifiers (void)
2161 {
2162 SHORT ctrl, alt;
2163
2164 if (GetFocus () == NULL)
2165 /* Emacs doesn't have keyboard focus. Do nothing. */
2166 return;
2167
2168 ctrl = GetAsyncKeyState (VK_CONTROL);
2169 alt = GetAsyncKeyState (VK_MENU);
2170
2171 if (!(ctrl & 0x08000))
2172 /* Clear any recorded control modifier state. */
2173 modifiers[EMACS_RCONTROL] = modifiers[EMACS_LCONTROL] = 0;
2174
2175 if (!(alt & 0x08000))
2176 /* Clear any recorded alt modifier state. */
2177 modifiers[EMACS_RMENU] = modifiers[EMACS_LMENU] = 0;
2178
2179 /* Update the state of all modifier keys, because modifiers used in
2180 hot-key combinations can get stuck on if Emacs loses focus as a
2181 result of a hot-key being pressed. */
2182 {
2183 BYTE keystate[256];
2184
2185 #define CURRENT_STATE(key) ((GetAsyncKeyState (key) & 0x8000) >> 8)
2186
2187 memset (keystate, 0, sizeof (keystate));
2188 GetKeyboardState (keystate);
2189 keystate[VK_SHIFT] = CURRENT_STATE (VK_SHIFT);
2190 keystate[VK_CONTROL] = CURRENT_STATE (VK_CONTROL);
2191 keystate[VK_LCONTROL] = CURRENT_STATE (VK_LCONTROL);
2192 keystate[VK_RCONTROL] = CURRENT_STATE (VK_RCONTROL);
2193 keystate[VK_MENU] = CURRENT_STATE (VK_MENU);
2194 keystate[VK_LMENU] = CURRENT_STATE (VK_LMENU);
2195 keystate[VK_RMENU] = CURRENT_STATE (VK_RMENU);
2196 keystate[VK_LWIN] = CURRENT_STATE (VK_LWIN);
2197 keystate[VK_RWIN] = CURRENT_STATE (VK_RWIN);
2198 keystate[VK_APPS] = CURRENT_STATE (VK_APPS);
2199 SetKeyboardState (keystate);
2200 }
2201 }
2202
2203 /* Synchronize modifier state with what is reported with the current
2204 keystroke. Even if we cannot distinguish between left and right
2205 modifier keys, we know that, if no modifiers are set, then neither
2206 the left or right modifier should be set. */
2207 static void
2208 sync_modifiers (void)
2209 {
2210 if (!modifiers_recorded)
2211 return;
2212
2213 if (!(GetKeyState (VK_CONTROL) & 0x8000))
2214 modifiers[EMACS_RCONTROL] = modifiers[EMACS_LCONTROL] = 0;
2215
2216 if (!(GetKeyState (VK_MENU) & 0x8000))
2217 modifiers[EMACS_RMENU] = modifiers[EMACS_LMENU] = 0;
2218 }
2219
2220 static int
2221 modifier_set (int vkey)
2222 {
2223 /* Warning: The fact that VK_NUMLOCK is not treated as the other 2
2224 toggle keys is not an omission! If you want to add it, you will
2225 have to make changes in the default sub-case of the WM_KEYDOWN
2226 switch, because if the NUMLOCK modifier is set, the code there
2227 will directly convert any key that looks like an ASCII letter,
2228 and also downcase those that look like upper-case ASCII. */
2229 if (vkey == VK_CAPITAL)
2230 {
2231 if (NILP (Vw32_enable_caps_lock))
2232 return 0;
2233 else
2234 return (GetKeyState (vkey) & 0x1);
2235 }
2236 if (vkey == VK_SCROLL)
2237 {
2238 if (NILP (Vw32_scroll_lock_modifier)
2239 /* w32-scroll-lock-modifier can be any non-nil value that is
2240 not one of the modifiers, in which case it shall be ignored. */
2241 || !( EQ (Vw32_scroll_lock_modifier, Qhyper)
2242 || EQ (Vw32_scroll_lock_modifier, Qsuper)
2243 || EQ (Vw32_scroll_lock_modifier, Qmeta)
2244 || EQ (Vw32_scroll_lock_modifier, Qalt)
2245 || EQ (Vw32_scroll_lock_modifier, Qcontrol)
2246 || EQ (Vw32_scroll_lock_modifier, Qshift)))
2247 return 0;
2248 else
2249 return (GetKeyState (vkey) & 0x1);
2250 }
2251
2252 if (!modifiers_recorded)
2253 return (GetKeyState (vkey) & 0x8000);
2254
2255 switch (vkey)
2256 {
2257 case VK_LCONTROL:
2258 return modifiers[EMACS_LCONTROL];
2259 case VK_RCONTROL:
2260 return modifiers[EMACS_RCONTROL];
2261 case VK_LMENU:
2262 return modifiers[EMACS_LMENU];
2263 case VK_RMENU:
2264 return modifiers[EMACS_RMENU];
2265 }
2266 return (GetKeyState (vkey) & 0x8000);
2267 }
2268
2269 /* Convert between the modifier bits W32 uses and the modifier bits
2270 Emacs uses. */
2271
2272 unsigned int
2273 w32_key_to_modifier (int key)
2274 {
2275 Lisp_Object key_mapping;
2276
2277 switch (key)
2278 {
2279 case VK_LWIN:
2280 key_mapping = Vw32_lwindow_modifier;
2281 break;
2282 case VK_RWIN:
2283 key_mapping = Vw32_rwindow_modifier;
2284 break;
2285 case VK_APPS:
2286 key_mapping = Vw32_apps_modifier;
2287 break;
2288 case VK_SCROLL:
2289 key_mapping = Vw32_scroll_lock_modifier;
2290 break;
2291 default:
2292 key_mapping = Qnil;
2293 }
2294
2295 /* NB. This code runs in the input thread, asynchronously to the lisp
2296 thread, so we must be careful to ensure access to lisp data is
2297 thread-safe. The following code is safe because the modifier
2298 variable values are updated atomically from lisp and symbols are
2299 not relocated by GC. Also, we don't have to worry about seeing GC
2300 markbits here. */
2301 if (EQ (key_mapping, Qhyper))
2302 return hyper_modifier;
2303 if (EQ (key_mapping, Qsuper))
2304 return super_modifier;
2305 if (EQ (key_mapping, Qmeta))
2306 return meta_modifier;
2307 if (EQ (key_mapping, Qalt))
2308 return alt_modifier;
2309 if (EQ (key_mapping, Qctrl))
2310 return ctrl_modifier;
2311 if (EQ (key_mapping, Qcontrol)) /* synonym for ctrl */
2312 return ctrl_modifier;
2313 if (EQ (key_mapping, Qshift))
2314 return shift_modifier;
2315
2316 /* Don't generate any modifier if not explicitly requested. */
2317 return 0;
2318 }
2319
2320 static unsigned int
2321 w32_get_modifiers (void)
2322 {
2323 return ((modifier_set (VK_SHIFT) ? shift_modifier : 0) |
2324 (modifier_set (VK_CONTROL) ? ctrl_modifier : 0) |
2325 (modifier_set (VK_LWIN) ? w32_key_to_modifier (VK_LWIN) : 0) |
2326 (modifier_set (VK_RWIN) ? w32_key_to_modifier (VK_RWIN) : 0) |
2327 (modifier_set (VK_APPS) ? w32_key_to_modifier (VK_APPS) : 0) |
2328 (modifier_set (VK_SCROLL) ? w32_key_to_modifier (VK_SCROLL) : 0) |
2329 (modifier_set (VK_MENU) ?
2330 ((NILP (Vw32_alt_is_meta)) ? alt_modifier : meta_modifier) : 0));
2331 }
2332
2333 /* We map the VK_* modifiers into console modifier constants
2334 so that we can use the same routines to handle both console
2335 and window input. */
2336
2337 static int
2338 construct_console_modifiers (void)
2339 {
2340 int mods;
2341
2342 mods = 0;
2343 mods |= (modifier_set (VK_SHIFT)) ? SHIFT_PRESSED : 0;
2344 mods |= (modifier_set (VK_CAPITAL)) ? CAPSLOCK_ON : 0;
2345 mods |= (modifier_set (VK_SCROLL)) ? SCROLLLOCK_ON : 0;
2346 mods |= (modifier_set (VK_NUMLOCK)) ? NUMLOCK_ON : 0;
2347 mods |= (modifier_set (VK_LCONTROL)) ? LEFT_CTRL_PRESSED : 0;
2348 mods |= (modifier_set (VK_RCONTROL)) ? RIGHT_CTRL_PRESSED : 0;
2349 mods |= (modifier_set (VK_LMENU)) ? LEFT_ALT_PRESSED : 0;
2350 mods |= (modifier_set (VK_RMENU)) ? RIGHT_ALT_PRESSED : 0;
2351 mods |= (modifier_set (VK_LWIN)) ? LEFT_WIN_PRESSED : 0;
2352 mods |= (modifier_set (VK_RWIN)) ? RIGHT_WIN_PRESSED : 0;
2353 mods |= (modifier_set (VK_APPS)) ? APPS_PRESSED : 0;
2354
2355 return mods;
2356 }
2357
2358 static int
2359 w32_get_key_modifiers (unsigned int wparam, unsigned int lparam)
2360 {
2361 int mods;
2362
2363 /* Convert to emacs modifiers. */
2364 mods = w32_kbd_mods_to_emacs (construct_console_modifiers (), wparam);
2365
2366 return mods;
2367 }
2368
2369 unsigned int
2370 map_keypad_keys (unsigned int virt_key, unsigned int extended)
2371 {
2372 if (virt_key < VK_CLEAR || virt_key > VK_DELETE)
2373 return virt_key;
2374
2375 if (virt_key == VK_RETURN)
2376 return (extended ? VK_NUMPAD_ENTER : VK_RETURN);
2377
2378 if (virt_key >= VK_PRIOR && virt_key <= VK_DOWN)
2379 return (!extended ? (VK_NUMPAD_PRIOR + (virt_key - VK_PRIOR)) : virt_key);
2380
2381 if (virt_key == VK_INSERT || virt_key == VK_DELETE)
2382 return (!extended ? (VK_NUMPAD_INSERT + (virt_key - VK_INSERT)) : virt_key);
2383
2384 if (virt_key == VK_CLEAR)
2385 return (!extended ? VK_NUMPAD_CLEAR : virt_key);
2386
2387 return virt_key;
2388 }
2389
2390 /* List of special key combinations which w32 would normally capture,
2391 but Emacs should grab instead. Not directly visible to lisp, to
2392 simplify synchronization. Each item is an integer encoding a virtual
2393 key code and modifier combination to capture. */
2394 static Lisp_Object w32_grabbed_keys;
2395
2396 #define HOTKEY(vk, mods) make_number (((vk) & 255) | ((mods) << 8))
2397 #define HOTKEY_ID(k) (XFASTINT (k) & 0xbfff)
2398 #define HOTKEY_VK_CODE(k) (XFASTINT (k) & 255)
2399 #define HOTKEY_MODIFIERS(k) (XFASTINT (k) >> 8)
2400
2401 #define RAW_HOTKEY_ID(k) ((k) & 0xbfff)
2402 #define RAW_HOTKEY_VK_CODE(k) ((k) & 255)
2403 #define RAW_HOTKEY_MODIFIERS(k) ((k) >> 8)
2404
2405 /* Register hot-keys for reserved key combinations when Emacs has
2406 keyboard focus, since this is the only way Emacs can receive key
2407 combinations like Alt-Tab which are used by the system. */
2408
2409 static void
2410 register_hot_keys (HWND hwnd)
2411 {
2412 Lisp_Object keylist;
2413
2414 /* Use CONSP, since we are called asynchronously. */
2415 for (keylist = w32_grabbed_keys; CONSP (keylist); keylist = XCDR (keylist))
2416 {
2417 Lisp_Object key = XCAR (keylist);
2418
2419 /* Deleted entries get set to nil. */
2420 if (!INTEGERP (key))
2421 continue;
2422
2423 RegisterHotKey (hwnd, HOTKEY_ID (key),
2424 HOTKEY_MODIFIERS (key), HOTKEY_VK_CODE (key));
2425 }
2426 }
2427
2428 static void
2429 unregister_hot_keys (HWND hwnd)
2430 {
2431 Lisp_Object keylist;
2432
2433 for (keylist = w32_grabbed_keys; CONSP (keylist); keylist = XCDR (keylist))
2434 {
2435 Lisp_Object key = XCAR (keylist);
2436
2437 if (!INTEGERP (key))
2438 continue;
2439
2440 UnregisterHotKey (hwnd, HOTKEY_ID (key));
2441 }
2442 }
2443
2444 #if EMACSDEBUG
2445 const char*
2446 w32_name_of_message (UINT msg)
2447 {
2448 unsigned i;
2449 static char buf[64];
2450 static const struct {
2451 UINT msg;
2452 const char* name;
2453 } msgnames[] = {
2454 #define M(msg) { msg, # msg }
2455 M (WM_PAINT),
2456 M (WM_TIMER),
2457 M (WM_USER),
2458 M (WM_MOUSEMOVE),
2459 M (WM_LBUTTONUP),
2460 M (WM_KEYDOWN),
2461 M (WM_EMACS_KILL),
2462 M (WM_EMACS_CREATEWINDOW),
2463 M (WM_EMACS_DONE),
2464 M (WM_EMACS_CREATEVSCROLLBAR),
2465 M (WM_EMACS_CREATEHSCROLLBAR),
2466 M (WM_EMACS_SHOWWINDOW),
2467 M (WM_EMACS_SETWINDOWPOS),
2468 M (WM_EMACS_DESTROYWINDOW),
2469 M (WM_EMACS_TRACKPOPUPMENU),
2470 M (WM_EMACS_SETFOCUS),
2471 M (WM_EMACS_SETFOREGROUND),
2472 M (WM_EMACS_SETLOCALE),
2473 M (WM_EMACS_SETKEYBOARDLAYOUT),
2474 M (WM_EMACS_REGISTER_HOT_KEY),
2475 M (WM_EMACS_UNREGISTER_HOT_KEY),
2476 M (WM_EMACS_TOGGLE_LOCK_KEY),
2477 M (WM_EMACS_TRACK_CARET),
2478 M (WM_EMACS_DESTROY_CARET),
2479 M (WM_EMACS_SHOW_CARET),
2480 M (WM_EMACS_HIDE_CARET),
2481 M (WM_EMACS_SETCURSOR),
2482 M (WM_EMACS_SHOWCURSOR),
2483 M (WM_EMACS_PAINT),
2484 M (WM_CHAR),
2485 #undef M
2486 { 0, 0 }
2487 };
2488
2489 for (i = 0; msgnames[i].name; ++i)
2490 if (msgnames[i].msg == msg)
2491 return msgnames[i].name;
2492
2493 sprintf (buf, "message 0x%04x", (unsigned)msg);
2494 return buf;
2495 }
2496 #endif /* EMACSDEBUG */
2497
2498 /* Here's an overview of how Emacs input works in GUI sessions on
2499 MS-Windows. (For description of non-GUI input, see the commentary
2500 before w32_console_read_socket in w32inevt.c.)
2501
2502 System messages are read and processed by w32_msg_pump below. This
2503 function runs in a separate thread. It handles a small number of
2504 custom WM_EMACS_* messages (posted by the main thread, look for
2505 PostMessage calls), and dispatches the rest to w32_wnd_proc, which
2506 is the main window procedure for the entire Emacs application.
2507
2508 w32_wnd_proc also runs in the same separate input thread. It
2509 handles some messages, mostly those that need GDI calls, by itself.
2510 For the others, it calls my_post_msg, which inserts the messages
2511 into the input queue serviced by w32_read_socket.
2512
2513 w32_read_socket runs in the main (a.k.a. "Lisp") thread, and is
2514 called synchronously from keyboard.c when it is known or suspected
2515 that some input is available. w32_read_socket either handles
2516 messages immediately, or converts them into Emacs input events and
2517 stuffs them into kbd_buffer, where kbd_buffer_get_event can get at
2518 them and process them when read_char and its callers require
2519 input.
2520
2521 Under Cygwin with the W32 toolkit, the use of /dev/windows with
2522 select(2) takes the place of w32_read_socket.
2523
2524 */
2525
2526 /* Main message dispatch loop. */
2527
2528 static void
2529 w32_msg_pump (deferred_msg * msg_buf)
2530 {
2531 MSG msg;
2532 WPARAM result;
2533 HWND focus_window;
2534
2535 msh_mousewheel = RegisterWindowMessage (MSH_MOUSEWHEEL);
2536
2537 while ((w32_unicode_gui ? GetMessageW : GetMessageA) (&msg, NULL, 0, 0))
2538 {
2539
2540 /* DebPrint (("w32_msg_pump: %s time:%u\n", */
2541 /* w32_name_of_message (msg.message), msg.time)); */
2542
2543 if (msg.hwnd == NULL)
2544 {
2545 switch (msg.message)
2546 {
2547 case WM_NULL:
2548 /* Produced by complete_deferred_msg; just ignore. */
2549 break;
2550 case WM_EMACS_CREATEWINDOW:
2551 /* Initialize COM for this window. Even though we don't use it,
2552 some third party shell extensions can cause it to be used in
2553 system dialogs, which causes a crash if it is not initialized.
2554 This is a known bug in Windows, which was fixed long ago, but
2555 the patch for XP is not publicly available until XP SP3,
2556 and older versions will never be patched. */
2557 CoInitialize (NULL);
2558 w32_createwindow ((struct frame *) msg.wParam,
2559 (int *) msg.lParam);
2560 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE, 0, 0))
2561 emacs_abort ();
2562 break;
2563 case WM_EMACS_SETLOCALE:
2564 SetThreadLocale (msg.wParam);
2565 /* Reply is not expected. */
2566 break;
2567 case WM_EMACS_SETKEYBOARDLAYOUT:
2568 result = (WPARAM) ActivateKeyboardLayout ((HKL) msg.wParam, 0);
2569 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE,
2570 result, 0))
2571 emacs_abort ();
2572 break;
2573 case WM_EMACS_REGISTER_HOT_KEY:
2574 focus_window = GetFocus ();
2575 if (focus_window != NULL)
2576 RegisterHotKey (focus_window,
2577 RAW_HOTKEY_ID (msg.wParam),
2578 RAW_HOTKEY_MODIFIERS (msg.wParam),
2579 RAW_HOTKEY_VK_CODE (msg.wParam));
2580 /* Reply is not expected. */
2581 break;
2582 case WM_EMACS_UNREGISTER_HOT_KEY:
2583 focus_window = GetFocus ();
2584 if (focus_window != NULL)
2585 UnregisterHotKey (focus_window, RAW_HOTKEY_ID (msg.wParam));
2586 /* Mark item as erased. NB: this code must be
2587 thread-safe. The next line is okay because the cons
2588 cell is never made into garbage and is not relocated by
2589 GC. */
2590 XSETCAR (make_lisp_ptr ((void *)msg.lParam, Lisp_Cons), Qnil);
2591 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE, 0, 0))
2592 emacs_abort ();
2593 break;
2594 case WM_EMACS_TOGGLE_LOCK_KEY:
2595 {
2596 int vk_code = (int) msg.wParam;
2597 int cur_state = (GetKeyState (vk_code) & 1);
2598 int new_state = msg.lParam;
2599
2600 if (new_state == -1
2601 || ((new_state & 1) != cur_state))
2602 {
2603 one_w32_display_info.faked_key = vk_code;
2604
2605 keybd_event ((BYTE) vk_code,
2606 (BYTE) MapVirtualKey (vk_code, 0),
2607 KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
2608 keybd_event ((BYTE) vk_code,
2609 (BYTE) MapVirtualKey (vk_code, 0),
2610 KEYEVENTF_EXTENDEDKEY | 0, 0);
2611 keybd_event ((BYTE) vk_code,
2612 (BYTE) MapVirtualKey (vk_code, 0),
2613 KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
2614 cur_state = !cur_state;
2615 }
2616 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE,
2617 cur_state, 0))
2618 emacs_abort ();
2619 }
2620 break;
2621 #ifdef MSG_DEBUG
2622 /* Broadcast messages make it here, so you need to be looking
2623 for something in particular for this to be useful. */
2624 default:
2625 DebPrint (("msg %x not expected by w32_msg_pump\n", msg.message));
2626 #endif
2627 }
2628 }
2629 else
2630 {
2631 if (w32_unicode_gui)
2632 DispatchMessageW (&msg);
2633 else
2634 DispatchMessageA (&msg);
2635 }
2636
2637 /* Exit nested loop when our deferred message has completed. */
2638 if (msg_buf->completed)
2639 break;
2640 }
2641 }
2642
2643 deferred_msg * deferred_msg_head;
2644
2645 static deferred_msg *
2646 find_deferred_msg (HWND hwnd, UINT msg)
2647 {
2648 deferred_msg * item;
2649
2650 /* Don't actually need synchronization for read access, since
2651 modification of single pointer is always atomic. */
2652 /* enter_crit (); */
2653
2654 for (item = deferred_msg_head; item != NULL; item = item->next)
2655 if (item->w32msg.msg.hwnd == hwnd
2656 && item->w32msg.msg.message == msg)
2657 break;
2658
2659 /* leave_crit (); */
2660
2661 return item;
2662 }
2663
2664 static LRESULT
2665 send_deferred_msg (deferred_msg * msg_buf,
2666 HWND hwnd,
2667 UINT msg,
2668 WPARAM wParam,
2669 LPARAM lParam)
2670 {
2671 /* Only input thread can send deferred messages. */
2672 if (GetCurrentThreadId () != dwWindowsThreadId)
2673 emacs_abort ();
2674
2675 /* It is an error to send a message that is already deferred. */
2676 if (find_deferred_msg (hwnd, msg) != NULL)
2677 emacs_abort ();
2678
2679 /* Enforced synchronization is not needed because this is the only
2680 function that alters deferred_msg_head, and the following critical
2681 section is guaranteed to only be serially reentered (since only the
2682 input thread can call us). */
2683
2684 /* enter_crit (); */
2685
2686 msg_buf->completed = 0;
2687 msg_buf->next = deferred_msg_head;
2688 deferred_msg_head = msg_buf;
2689 my_post_msg (&msg_buf->w32msg, hwnd, msg, wParam, lParam);
2690
2691 /* leave_crit (); */
2692
2693 /* Start a new nested message loop to process other messages until
2694 this one is completed. */
2695 w32_msg_pump (msg_buf);
2696
2697 deferred_msg_head = msg_buf->next;
2698
2699 return msg_buf->result;
2700 }
2701
2702 void
2703 complete_deferred_msg (HWND hwnd, UINT msg, LRESULT result)
2704 {
2705 deferred_msg * msg_buf = find_deferred_msg (hwnd, msg);
2706
2707 if (msg_buf == NULL)
2708 /* Message may have been canceled, so don't abort. */
2709 return;
2710
2711 msg_buf->result = result;
2712 msg_buf->completed = 1;
2713
2714 /* Ensure input thread is woken so it notices the completion. */
2715 PostThreadMessage (dwWindowsThreadId, WM_NULL, 0, 0);
2716 }
2717
2718 static void
2719 cancel_all_deferred_msgs (void)
2720 {
2721 deferred_msg * item;
2722
2723 /* Don't actually need synchronization for read access, since
2724 modification of single pointer is always atomic. */
2725 /* enter_crit (); */
2726
2727 for (item = deferred_msg_head; item != NULL; item = item->next)
2728 {
2729 item->result = 0;
2730 item->completed = 1;
2731 }
2732
2733 /* leave_crit (); */
2734
2735 /* Ensure input thread is woken so it notices the completion. */
2736 PostThreadMessage (dwWindowsThreadId, WM_NULL, 0, 0);
2737 }
2738
2739 DWORD WINAPI
2740 w32_msg_worker (void *arg)
2741 {
2742 MSG msg;
2743 deferred_msg dummy_buf;
2744
2745 /* Ensure our message queue is created */
2746
2747 PeekMessage (&msg, NULL, 0, 0, PM_NOREMOVE);
2748
2749 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE, 0, 0))
2750 emacs_abort ();
2751
2752 memset (&dummy_buf, 0, sizeof (dummy_buf));
2753 dummy_buf.w32msg.msg.hwnd = NULL;
2754 dummy_buf.w32msg.msg.message = WM_NULL;
2755
2756 /* This is the initial message loop which should only exit when the
2757 application quits. */
2758 w32_msg_pump (&dummy_buf);
2759
2760 return 0;
2761 }
2762
2763 static void
2764 signal_user_input (void)
2765 {
2766 /* Interrupt any lisp that wants to be interrupted by input. */
2767 if (!NILP (Vthrow_on_input))
2768 {
2769 Vquit_flag = Vthrow_on_input;
2770 /* Doing a QUIT from this thread is a bad idea, since this
2771 unwinds the stack of the Lisp thread, and the Windows runtime
2772 rightfully barfs. Disabled. */
2773 #if 0
2774 /* If we're inside a function that wants immediate quits,
2775 do it now. */
2776 if (immediate_quit && NILP (Vinhibit_quit))
2777 {
2778 immediate_quit = 0;
2779 QUIT;
2780 }
2781 #endif
2782 }
2783 }
2784
2785
2786 static void
2787 post_character_message (HWND hwnd, UINT msg,
2788 WPARAM wParam, LPARAM lParam,
2789 DWORD modifiers)
2790 {
2791 W32Msg wmsg;
2792
2793 wmsg.dwModifiers = modifiers;
2794
2795 /* Detect quit_char and set quit-flag directly. Note that we
2796 still need to post a message to ensure the main thread will be
2797 woken up if blocked in sys_select, but we do NOT want to post
2798 the quit_char message itself (because it will usually be as if
2799 the user had typed quit_char twice). Instead, we post a dummy
2800 message that has no particular effect. */
2801 {
2802 int c = wParam;
2803 if (isalpha (c) && wmsg.dwModifiers == ctrl_modifier)
2804 c = make_ctrl_char (c) & 0377;
2805 if (c == quit_char
2806 || (wmsg.dwModifiers == 0
2807 && w32_quit_key && wParam == w32_quit_key))
2808 {
2809 Vquit_flag = Qt;
2810
2811 /* The choice of message is somewhat arbitrary, as long as
2812 the main thread handler just ignores it. */
2813 msg = WM_NULL;
2814
2815 /* Interrupt any blocking system calls. */
2816 signal_quit ();
2817
2818 /* As a safety precaution, forcibly complete any deferred
2819 messages. This is a kludge, but I don't see any particularly
2820 clean way to handle the situation where a deferred message is
2821 "dropped" in the lisp thread, and will thus never be
2822 completed, eg. by the user trying to activate the menubar
2823 when the lisp thread is busy, and then typing C-g when the
2824 menubar doesn't open promptly (with the result that the
2825 menubar never responds at all because the deferred
2826 WM_INITMENU message is never completed). Another problem
2827 situation is when the lisp thread calls SendMessage (to send
2828 a window manager command) when a message has been deferred;
2829 the lisp thread gets blocked indefinitely waiting for the
2830 deferred message to be completed, which itself is waiting for
2831 the lisp thread to respond.
2832
2833 Note that we don't want to block the input thread waiting for
2834 a response from the lisp thread (although that would at least
2835 solve the deadlock problem above), because we want to be able
2836 to receive C-g to interrupt the lisp thread. */
2837 cancel_all_deferred_msgs ();
2838 }
2839 else
2840 signal_user_input ();
2841 }
2842
2843 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
2844 }
2845
2846 static int
2847 get_wm_chars (HWND aWnd, int *buf, int buflen, int ignore_ctrl, int ctrl,
2848 int *ctrl_cnt, int *is_dead, int vk, int exp)
2849 {
2850 MSG msg;
2851 /* If doubled is at the end, ignore it. */
2852 int i = buflen, doubled = 0, code_unit;
2853
2854 if (ctrl_cnt)
2855 *ctrl_cnt = 0;
2856 if (is_dead)
2857 *is_dead = -1;
2858 eassert (w32_unicode_gui);
2859 while (buflen
2860 /* Should be called only when w32_unicode_gui: */
2861 && PeekMessageW (&msg, aWnd, WM_KEYFIRST, WM_KEYLAST,
2862 PM_NOREMOVE | PM_NOYIELD)
2863 && (msg.message == WM_CHAR || msg.message == WM_SYSCHAR
2864 || msg.message == WM_DEADCHAR || msg.message == WM_SYSDEADCHAR
2865 || msg.message == WM_UNICHAR))
2866 {
2867 /* We extract character payload, but in this call we handle only the
2868 characters which come BEFORE the next keyup/keydown message. */
2869 int dead;
2870
2871 GetMessageW (&msg, aWnd, msg.message, msg.message);
2872 dead = (msg.message == WM_DEADCHAR || msg.message == WM_SYSDEADCHAR);
2873 if (is_dead)
2874 *is_dead = (dead ? msg.wParam : -1);
2875 if (dead)
2876 continue;
2877 code_unit = msg.wParam;
2878 if (doubled)
2879 {
2880 /* Had surrogate. */
2881 if (msg.message == WM_UNICHAR
2882 || code_unit < 0xDC00 || code_unit > 0xDFFF)
2883 { /* Mismatched first surrogate.
2884 Pass both code units as if they were two characters. */
2885 *buf++ = doubled;
2886 if (!--buflen)
2887 return i; /* Drop the 2nd char if at the end of the buffer. */
2888 }
2889 else /* see https://en.wikipedia.org/wiki/UTF-16 */
2890 code_unit = (doubled << 10) + code_unit - 0x35FDC00;
2891 doubled = 0;
2892 }
2893 else if (code_unit >= 0xD800 && code_unit <= 0xDBFF)
2894 {
2895 /* Handle mismatched 2nd surrogate the same as a normal character. */
2896 doubled = code_unit;
2897 continue;
2898 }
2899
2900 /* The only "fake" characters delivered by ToUnicode() or
2901 TranslateMessage() are:
2902 0x01 .. 0x1a for Ctrl-letter, Enter, Tab, Ctrl-Break, Esc, Backspace
2903 0x00 and 0x1b .. 0x1f for Control- []\@^_
2904 0x7f for Control-BackSpace
2905 0x20 for Control-Space */
2906 if (ignore_ctrl
2907 && (code_unit < 0x20 || code_unit == 0x7f
2908 || (code_unit == 0x20 && ctrl)))
2909 {
2910 /* Non-character payload in a WM_CHAR
2911 (Ctrl-something pressed, see above). Ignore, and report. */
2912 if (ctrl_cnt)
2913 (*ctrl_cnt)++;
2914 continue;
2915 }
2916 /* Traditionally, Emacs would ignore the character payload of VK_NUMPAD*
2917 keys, and would treat them later via `function-key-map'. In addition
2918 to usual 102-key NUMPAD keys, this map also treats `kp-'-variants of
2919 space, tab, enter, separator, equal. TAB and EQUAL, apparently,
2920 cannot be generated on Win-GUI branch. ENTER is already handled
2921 by the code above. According to `lispy_function_keys', kp_space is
2922 generated by not-extended VK_CLEAR. (kp-tab != VK_OEM_NEC_EQUAL!).
2923
2924 We do similarly for backward-compatibility, but ignore only the
2925 characters restorable later by `function-key-map'. */
2926 if (code_unit < 0x7f
2927 && ((vk >= VK_NUMPAD0 && vk <= VK_DIVIDE)
2928 || (exp && ((vk >= VK_PRIOR && vk <= VK_DOWN) ||
2929 vk == VK_INSERT || vk == VK_DELETE || vk == VK_CLEAR)))
2930 && strchr ("0123456789/*-+.,", code_unit))
2931 continue;
2932 *buf++ = code_unit;
2933 buflen--;
2934 }
2935 return i - buflen;
2936 }
2937
2938 #ifdef DBG_WM_CHARS
2939 # define FPRINTF_WM_CHARS(ARG) fprintf ARG
2940 #else
2941 # define FPRINTF_WM_CHARS(ARG) (void)0
2942 #endif
2943
2944 /* This is a heuristic only. This is supposed to track the state of the
2945 finite automaton in the language environment of Windows.
2946
2947 However, separate windows (if with the same different language
2948 environments!) should have different values. Moreover, switching to a
2949 non-Emacs window with the same language environment, and using (dead)keys
2950 there would change the value stored in the kernel, but not this value. */
2951 /* A layout may emit deadkey=0. It looks like this would reset the state
2952 of the kernel's finite automaton (equivalent to emiting 0-length string,
2953 which is otherwise impossible in the dead-key map of a layout).
2954 Be ready to treat the case when this delivers WM_(SYS)DEADCHAR. */
2955 static int after_deadkey = -1;
2956
2957 int
2958 deliver_wm_chars (int do_translate, HWND hwnd, UINT msg, UINT wParam,
2959 UINT lParam, int legacy_alt_meta)
2960 {
2961 /* An "old style" keyboard description may assign up to 125 UTF-16 code
2962 points to a keypress.
2963 (However, the "old style" TranslateMessage() would deliver at most 16 of
2964 them.) Be on a safe side, and prepare to treat many more. */
2965 int ctrl_cnt, buf[1024], count, is_dead, after_dead = (after_deadkey > 0);
2966
2967 /* Since the keypress processing logic of Windows has a lot of state, it
2968 is important to call TranslateMessage() for every keyup/keydown, AND
2969 do it exactly once. (The actual change of state is done by
2970 ToUnicode[Ex](), which is called by TranslateMessage(). So one can
2971 call ToUnicode[Ex]() instead.)
2972
2973 The "usual" message pump calls TranslateMessage() for EVERY event.
2974 Emacs calls TranslateMessage() very selectively (is it needed for doing
2975 some tricky stuff with Win95??? With newer Windows, selectiveness is,
2976 most probably, not needed -- and harms a lot).
2977
2978 So, with the usual message pump, the following call to TranslateMessage()
2979 is not needed (and is going to be VERY harmful). With Emacs' message
2980 pump, the call is needed. */
2981 if (do_translate)
2982 {
2983 MSG windows_msg = { hwnd, msg, wParam, lParam, 0, {0,0} };
2984
2985 windows_msg.time = GetMessageTime ();
2986 TranslateMessage (&windows_msg);
2987 }
2988 count = get_wm_chars (hwnd, buf, sizeof (buf)/sizeof (*buf), 1,
2989 /* The message may have been synthesized by
2990 who knows what; be conservative. */
2991 modifier_set (VK_LCONTROL)
2992 || modifier_set (VK_RCONTROL)
2993 || modifier_set (VK_CONTROL),
2994 &ctrl_cnt, &is_dead, wParam,
2995 (lParam & 0x1000000L) != 0);
2996 if (count)
2997 {
2998 W32Msg wmsg;
2999 DWORD console_modifiers = construct_console_modifiers ();
3000 int *b = buf, strip_ExtraMods = 1, hairy = 0;
3001 char *type_CtrlAlt = NULL;
3002
3003 /* XXXX In fact, there may be another case when we need to do the same:
3004 What happens if the string defined in the LIGATURES has length
3005 0? Probably, we will get count==0, but the state of the finite
3006 automaton would reset to 0??? */
3007 after_deadkey = -1;
3008
3009 /* wParam is checked when converting CapsLock to Shift; this is a clone
3010 of w32_get_key_modifiers (). */
3011 wmsg.dwModifiers = w32_kbd_mods_to_emacs (console_modifiers, wParam);
3012
3013 /* What follows is just heuristics; the correct treatement requires
3014 non-destructive ToUnicode():
3015 http://search.cpan.org/~ilyaz/UI-KeyboardLayout/lib/UI/KeyboardLayout.pm#Can_an_application_on_Windows_accept_keyboard_events?_Part_IV:_application-specific_modifiers
3016
3017 What one needs to find is:
3018 * which of the present modifiers AFFECT the resulting char(s)
3019 (so should be stripped, since their EFFECT is "already
3020 taken into account" in the string in buf), and
3021 * which modifiers are not affecting buf, so should be reported to
3022 the application for further treatment.
3023
3024 Example: assume that we know:
3025 (A) lCtrl+rCtrl+rAlt modifiers with VK_A key produce a Latin "f"
3026 ("may be logical" in JCUKEN-flavored Russian keyboard flavors);
3027 (B) removing any of lCtrl, rCtrl, rAlt changes the produced char;
3028 (C) Win-modifier is not affecting the produced character
3029 (this is the common case: happens with all "standard" layouts).
3030
3031 Suppose the user presses Win+lCtrl+rCtrl+rAlt modifiers with VK_A.
3032 What is the intent of the user? We need to guess the intent to decide
3033 which event to deliver to the application.
3034
3035 This looks like a reasonable logic: since Win- modifier doesn't affect
3036 the output string, the user was pressing Win for SOME OTHER purpose.
3037 So the user wanted to generate Win-SOMETHING event. Now, what is
3038 something? If one takes the mantra that "character payload is more
3039 important than the combination of keypresses which resulted in this
3040 payload", then one should ignore lCtrl+rCtrl+rAlt, ignore VK_A, and
3041 assume that the user wanted to generate Win-f.
3042
3043 Unfortunately, without non-destructive ToUnicode(), checking (B),(C)
3044 is out of question. So we use heuristics (hopefully, covering
3045 99.9999% of cases). */
3046
3047 /* Another thing to watch for is a possibility to use AltGr-* and
3048 Ctrl-Alt-* with different semantic.
3049
3050 Background: the layout defining the KLLF_ALTGR bit are treated
3051 specially by the kernel: when VK_RMENU (=rightAlt, =AltGr) is pressed
3052 (released), a press (release) of VK_LCONTROL is emulated (unless Ctrl
3053 is already down). As a result, any press/release of AltGr is seen
3054 by applications as a press/release of lCtrl AND rAlt. This is
3055 applicable, in particular, to ToUnicode[Ex](). (Keyrepeat is covered
3056 the same way!)
3057
3058 NOTE: it IS possible to see bare rAlt even with KLLF_ALTGR; but this
3059 requires a good finger coordination: doing (physically)
3060 Down-lCtrl Down-rAlt Up-lCtrl Down-a
3061 (doing quick enough, so that key repeat of rAlt [which would
3062 generate new "fake" Down-lCtrl events] does not happens before 'a'
3063 is down) results in no "fake" events, so the application will see
3064 only rAlt down when 'a' is pressed. (However, fake Up-lCtrl WILL
3065 be generated when rAlt goes UP.)
3066
3067 In fact, note also that KLLF_ALTGR does not prohibit construction of
3068 rCtrl-rAlt (just press them in this order!).
3069
3070 Moreover: "traditional" layouts do not define distinct modifier-masks
3071 for VK_LMENU and VK_RMENU (same for VK_L/RCONTROL). Instead, they
3072 rely on the KLLF_ALTGR bit to make the behavior of VK_LMENU and
3073 VK_RMENU distinct. As a corollary, for such layouts, the produced
3074 character is the same for AltGr-* (=rAlt-*) and Ctrl-Alt-* (in any
3075 combination of handedness). For description of masks, see
3076
3077 http://search.cpan.org/~ilyaz/UI-KeyboardLayout/lib/UI/KeyboardLayout.pm#Keyboard_input_on_Windows,_Part_I:_what_is_the_kernel_doing?
3078
3079 By default, Emacs was using these coincidences via the following
3080 heuristics: it was treating:
3081 (*) keypresses with lCtrl-rAlt modifiers as if they are carrying
3082 ONLY the character payload (no matter what the actual keyboard
3083 was defining: if lCtrl-lAlt-b was delivering U+05df=beta, then
3084 Emacs saw [beta]; if lCtrl-lAlt-b was undefined in the layout,
3085 the keypress was completely ignored), and
3086 (*) keypresses with the other combinations of handedness of Ctrl-Alt
3087 modifiers (e.g., lCtrl-lAlt) as if they NEVER carry a character
3088 payload (so they were reported "raw": if lCtrl-lAlt-b was
3089 delivering beta, then Emacs saw event [C-A-b], and not [beta]).
3090 This worked good for "traditional" layouts: users could type both
3091 AltGr-x and Ctrl-Alt-x, and one was a character, another a bindable
3092 event.
3093
3094 However, for layouts which deliver different characters for AltGr-x
3095 and lCtrl-lAlt-x, this scheme makes the latter character unaccessible
3096 in Emacs. While it is easy to access functionality of [C-M-x] in
3097 Emacs by other means (for example, by the `controlify' prefix, or
3098 using lCtrl-rCtrl-x, or rCtrl-rAlt-x [in this order]), missing
3099 characters cannot be reconstructed without a tedious manual work. */
3100
3101 /* These two cases are often going to be distinguishable, since at most
3102 one of these character is defined with KBDCTRL | KBDMENU modifier
3103 bitmap. (This heuristic breaks if both lCtrl-lAlt- AND lCtrl-rAlt-
3104 are translated to modifier bitmaps distinct from KBDCTRL | KBDMENU,
3105 or in the cases when lCtrl-lAlt-* and lCtrl-rAlt-* are generally
3106 different, but lCtrl-lAlt-x and lCtrl-rAlt-x happen to deliver the
3107 same character.)
3108
3109 So we have 2 chunks of info:
3110 (A) is it lCtrl-rAlt-, or lCtrl-lAlt, or some other combination?
3111 (B) is the delivered character defined with KBDCTRL | KBDMENU bits?
3112 Basing on (A) and (B), we should decide whether to ignore the
3113 delivered character. (Before, Emacs was completely ignoring (B), and
3114 was treating the 3-state of (A) as a bit.) This means that we have 6
3115 bits of customization.
3116
3117 Additionally, a presence of two Ctrl down may be AltGr-rCtrl-. */
3118
3119 /* Strip all non-Shift modifiers if:
3120 - more than one UTF-16 code point delivered (can't call VkKeyScanW ())
3121 - or the character is a result of combining with a prefix key. */
3122 if (!after_dead && count == 1 && *b < 0x10000)
3123 {
3124 if (console_modifiers & (RIGHT_ALT_PRESSED | LEFT_ALT_PRESSED)
3125 && console_modifiers & (RIGHT_CTRL_PRESSED | LEFT_CTRL_PRESSED))
3126 {
3127 type_CtrlAlt = "bB"; /* generic bindable Ctrl-Alt- modifiers */
3128 if ((console_modifiers & (LEFT_CTRL_PRESSED | RIGHT_CTRL_PRESSED))
3129 == (LEFT_CTRL_PRESSED | RIGHT_CTRL_PRESSED))
3130 /* double-Ctrl:
3131 e.g. AltGr-rCtrl on some layouts (in this order!) */
3132 type_CtrlAlt = "dD";
3133 else if ((console_modifiers
3134 & (LEFT_CTRL_PRESSED | LEFT_ALT_PRESSED))
3135 == (LEFT_CTRL_PRESSED | LEFT_ALT_PRESSED))
3136 type_CtrlAlt = "lL"; /* Ctrl-Alt- modifiers on the left */
3137 else if (!NILP (Vw32_recognize_altgr)
3138 && ((console_modifiers
3139 & (RIGHT_ALT_PRESSED | LEFT_CTRL_PRESSED)))
3140 == (RIGHT_ALT_PRESSED | LEFT_CTRL_PRESSED))
3141 type_CtrlAlt = "gG"; /* modifiers as in AltGr */
3142 }
3143 else if (wmsg.dwModifiers & (alt_modifier | meta_modifier)
3144 || ((console_modifiers
3145 & (LEFT_WIN_PRESSED | RIGHT_WIN_PRESSED
3146 | APPS_PRESSED | SCROLLLOCK_ON))))
3147 {
3148 /* Pure Alt (or combination of Alt, Win, APPS, scrolllock. */
3149 type_CtrlAlt = "aA";
3150 }
3151 if (type_CtrlAlt)
3152 {
3153 /* Out of bound bitmap: */
3154 SHORT r = VkKeyScanW (*b), bitmap = 0x1FF;
3155
3156 FPRINTF_WM_CHARS((stderr, "VkKeyScanW %#06x %#04x\n", (int)r,
3157 wParam));
3158 if ((r & 0xFF) == wParam)
3159 bitmap = r>>8; /* *b is reachable via simple interface */
3160 else
3161 {
3162 /* VkKeyScanW() (essentially) returns the FIRST key with
3163 the specified character; so here the pressed key is the
3164 SECONDARY key producing the character.
3165
3166 Essentially, we have no information about the "role" of
3167 modifiers on this key: which contribute into the
3168 produced character (so "are consumed"), and which are
3169 "extra" (must attache to bindable events).
3170
3171 The default above would consume ALL modifiers, so the
3172 character is reported "as is". However, on many layouts
3173 the ordering of the keys (in the layout table) is not
3174 thought out well, so the "secondary" keys are often those
3175 which the users would prefer to use with Alt-CHAR.
3176 (Moreover - with e.g. Czech-QWERTY - the ASCII
3177 punctuation is accessible from two equally [nu]preferable
3178 AltGr-keys.)
3179
3180 SO: Heuristic: if the reported char is ASCII, AND Meta
3181 modifier is a candidate, behave as if Meta is present
3182 (fallback to the legacy branch; bug#23251).
3183
3184 (This would break layouts
3185 - delivering ASCII characters
3186 - on SECONDARY keys
3187 - with not Shift/AltGr-like modifier combinations.
3188 All 3 conditions together must be pretty exotic
3189 cases - and a workaround exists: use "primary" keys!) */
3190 if (*b < 0x80
3191 && (wmsg.dwModifiers
3192 & (alt_modifier | meta_modifier
3193 | super_modifier | hyper_modifier)))
3194 return 0;
3195 }
3196 if (*type_CtrlAlt == 'a') /* Simple Alt seen */
3197 {
3198 if ((bitmap & ~1) == 0) /* 1: KBDSHIFT */
3199 {
3200 /* In "traditional" layouts, Alt without Ctrl does not
3201 change the delivered character. This detects this
3202 situation; it is safe to report this as Alt-something
3203 -- as opposed to delivering the reported character
3204 without modifiers. */
3205 if (legacy_alt_meta
3206 && *b > 0x7f && ('A' <= wParam && wParam <= 'Z'))
3207 /* For backward-compatibility with older Emacsen, let
3208 this be processed by another branch below (which
3209 would convert it to Alt-Latin char via wParam). */
3210 return 0;
3211 }
3212 else
3213 hairy = 1;
3214 }
3215 /* Check whether the delivered character(s) is accessible via
3216 KBDCTRL | KBDALT ( | KBDSHIFT ) modifier mask (which is 7). */
3217 else if ((bitmap & ~1) != 6)
3218 {
3219 /* The character is not accessible via plain Ctrl-Alt(-Shift)
3220 (which is, probably, same as AltGr) modifiers.
3221 Either it was after a prefix key, or is combined with
3222 modifier keys which we don't see, or there is an asymmetry
3223 between left-hand and right-hand modifiers, or other hairy
3224 stuff. */
3225 hairy = 1;
3226 }
3227 /* The best solution is to delegate these tough (but rarely
3228 needed) choices to the user. Temporarily (???), it is
3229 implemented as C macros.
3230
3231 Essentially, there are 3 things to do: return 0 (handle to the
3232 legacy processing code [ignoring the character payload]; keep
3233 some modifiers (so that they will be processed by the binding
3234 system [on top of the character payload]; strip modifiers [so
3235 that `self-insert' is going to be triggered with the character
3236 payload]).
3237
3238 The default below should cover 99.9999% of cases:
3239 (a) strip Alt- in the hairy case only;
3240 (stripping = not ignoring)
3241 (l) for lAlt-lCtrl, ignore the char in simple cases only;
3242 (g) for what looks like AltGr, ignore the modifiers;
3243 (d) for what looks like lCtrl-rCtrl-Alt (probably
3244 AltGr-rCtrl), ignore the character in simple cases only;
3245 (b) for other cases of Ctrl-Alt, ignore the character in
3246 simple cases only.
3247
3248 Essentially, in all hairy cases, and in looks-like-AltGr case,
3249 we keep the character, ignoring the modifiers. In all the
3250 other cases, we ignore the delivered character. */
3251 #define S_TYPES_TO_IGNORE_CHARACTER_PAYLOAD "aldb"
3252 #define S_TYPES_TO_REPORT_CHARACTER_PAYLOAD_WITH_MODIFIERS ""
3253 if (strchr (S_TYPES_TO_IGNORE_CHARACTER_PAYLOAD,
3254 type_CtrlAlt[hairy]))
3255 return 0;
3256 /* If in neither list, report all the modifiers we see COMBINED
3257 WITH the reported character. */
3258 if (strchr (S_TYPES_TO_REPORT_CHARACTER_PAYLOAD_WITH_MODIFIERS,
3259 type_CtrlAlt[hairy]))
3260 strip_ExtraMods = 0;
3261 }
3262 }
3263 if (strip_ExtraMods)
3264 wmsg.dwModifiers = wmsg.dwModifiers & shift_modifier;
3265
3266 signal_user_input ();
3267 while (count--)
3268 {
3269 FPRINTF_WM_CHARS((stderr, "unichar %#06x\n", *b));
3270 my_post_msg (&wmsg, hwnd, WM_UNICHAR, *b++, lParam);
3271 }
3272 if (!ctrl_cnt) /* Process ALSO as ctrl */
3273 return 1;
3274 else
3275 FPRINTF_WM_CHARS((stderr, "extra ctrl char\n"));
3276 return -1;
3277 }
3278 else if (is_dead >= 0)
3279 {
3280 FPRINTF_WM_CHARS((stderr, "dead %#06x\n", is_dead));
3281 after_deadkey = is_dead;
3282 return 1;
3283 }
3284 return 0;
3285 }
3286
3287 /* Main window procedure */
3288
3289 static LRESULT CALLBACK
3290 w32_wnd_proc (HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam)
3291 {
3292 struct frame *f;
3293 struct w32_display_info *dpyinfo = &one_w32_display_info;
3294 W32Msg wmsg;
3295 int windows_translate;
3296 int key;
3297
3298 /* Note that it is okay to call x_window_to_frame, even though we are
3299 not running in the main lisp thread, because frame deletion
3300 requires the lisp thread to synchronize with this thread. Thus, if
3301 a frame struct is returned, it can be used without concern that the
3302 lisp thread might make it disappear while we are using it.
3303
3304 NB. Walking the frame list in this thread is safe (as long as
3305 writes of Lisp_Object slots are atomic, which they are on Windows).
3306 Although delete-frame can destructively modify the frame list while
3307 we are walking it, a garbage collection cannot occur until after
3308 delete-frame has synchronized with this thread.
3309
3310 It is also safe to use functions that make GDI calls, such as
3311 w32_clear_rect, because these functions must obtain a DC handle
3312 from the frame struct using get_frame_dc which is thread-aware. */
3313
3314 switch (msg)
3315 {
3316 case WM_ERASEBKGND:
3317 f = x_window_to_frame (dpyinfo, hwnd);
3318 if (f)
3319 {
3320 HDC hdc = get_frame_dc (f);
3321 GetUpdateRect (hwnd, &wmsg.rect, FALSE);
3322 w32_clear_rect (f, hdc, &wmsg.rect);
3323 release_frame_dc (f, hdc);
3324
3325 #if defined (W32_DEBUG_DISPLAY)
3326 DebPrint (("WM_ERASEBKGND (frame %p): erasing %d,%d-%d,%d\n",
3327 f,
3328 wmsg.rect.left, wmsg.rect.top,
3329 wmsg.rect.right, wmsg.rect.bottom));
3330 #endif /* W32_DEBUG_DISPLAY */
3331 }
3332 return 1;
3333 case WM_PALETTECHANGED:
3334 /* ignore our own changes */
3335 if ((HWND)wParam != hwnd)
3336 {
3337 f = x_window_to_frame (dpyinfo, hwnd);
3338 if (f)
3339 /* get_frame_dc will realize our palette and force all
3340 frames to be redrawn if needed. */
3341 release_frame_dc (f, get_frame_dc (f));
3342 }
3343 return 0;
3344 case WM_PAINT:
3345 {
3346 PAINTSTRUCT paintStruct;
3347 RECT update_rect;
3348 memset (&update_rect, 0, sizeof (update_rect));
3349
3350 f = x_window_to_frame (dpyinfo, hwnd);
3351 if (f == 0)
3352 {
3353 DebPrint (("WM_PAINT received for unknown window %p\n", hwnd));
3354 return 0;
3355 }
3356
3357 /* MSDN Docs say not to call BeginPaint if GetUpdateRect
3358 fails. Apparently this can happen under some
3359 circumstances. */
3360 if (GetUpdateRect (hwnd, &update_rect, FALSE) || !w32_strict_painting)
3361 {
3362 enter_crit ();
3363 BeginPaint (hwnd, &paintStruct);
3364
3365 /* The rectangles returned by GetUpdateRect and BeginPaint
3366 do not always match. Play it safe by assuming both areas
3367 are invalid. */
3368 UnionRect (&(wmsg.rect), &update_rect, &(paintStruct.rcPaint));
3369
3370 #if defined (W32_DEBUG_DISPLAY)
3371 DebPrint (("WM_PAINT (frame %p): painting %d,%d-%d,%d\n",
3372 f,
3373 wmsg.rect.left, wmsg.rect.top,
3374 wmsg.rect.right, wmsg.rect.bottom));
3375 DebPrint ((" [update region is %d,%d-%d,%d]\n",
3376 update_rect.left, update_rect.top,
3377 update_rect.right, update_rect.bottom));
3378 #endif
3379 EndPaint (hwnd, &paintStruct);
3380 leave_crit ();
3381
3382 /* Change the message type to prevent Windows from
3383 combining WM_PAINT messages in the Lisp thread's queue,
3384 since Windows assumes that each message queue is
3385 dedicated to one frame and does not bother checking
3386 that hwnd matches before combining them. */
3387 my_post_msg (&wmsg, hwnd, WM_EMACS_PAINT, wParam, lParam);
3388
3389 return 0;
3390 }
3391
3392 /* If GetUpdateRect returns 0 (meaning there is no update
3393 region), assume the whole window needs to be repainted. */
3394 GetClientRect (hwnd, &wmsg.rect);
3395 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3396 return 0;
3397 }
3398
3399 case WM_INPUTLANGCHANGE:
3400 /* Inform lisp thread of keyboard layout changes. */
3401 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3402
3403 /* The state of the finite automaton is separate per every input
3404 language environment (so it does not change when one switches
3405 to a different window with the same environment). Moreover,
3406 the experiments show that the state is not remembered when
3407 one switches back to the pre-previous environment. */
3408 after_deadkey = -1;
3409
3410 /* XXXX??? What follows is a COMPLETE misunderstanding of Windows! */
3411
3412 /* Clear dead keys in the keyboard state; for simplicity only
3413 preserve modifier key states. */
3414 {
3415 int i;
3416 BYTE keystate[256];
3417
3418 GetKeyboardState (keystate);
3419 for (i = 0; i < 256; i++)
3420 if (1
3421 && i != VK_SHIFT
3422 && i != VK_LSHIFT
3423 && i != VK_RSHIFT
3424 && i != VK_CAPITAL
3425 && i != VK_NUMLOCK
3426 && i != VK_SCROLL
3427 && i != VK_CONTROL
3428 && i != VK_LCONTROL
3429 && i != VK_RCONTROL
3430 && i != VK_MENU
3431 && i != VK_LMENU
3432 && i != VK_RMENU
3433 && i != VK_LWIN
3434 && i != VK_RWIN)
3435 keystate[i] = 0;
3436 SetKeyboardState (keystate);
3437 }
3438 goto dflt;
3439
3440 case WM_HOTKEY:
3441 /* Synchronize hot keys with normal input. */
3442 PostMessage (hwnd, WM_KEYDOWN, HIWORD (lParam), 0);
3443 return (0);
3444
3445 case WM_KEYUP:
3446 case WM_SYSKEYUP:
3447 record_keyup (wParam, lParam);
3448 goto dflt;
3449
3450 case WM_KEYDOWN:
3451 case WM_SYSKEYDOWN:
3452 /* Ignore keystrokes we fake ourself; see below. */
3453 if (dpyinfo->faked_key == wParam)
3454 {
3455 dpyinfo->faked_key = 0;
3456 /* Make sure TranslateMessage sees them though (as long as
3457 they don't produce WM_CHAR messages). This ensures that
3458 indicator lights are toggled promptly on Windows 9x, for
3459 example. */
3460 if (wParam < 256 && lispy_function_keys[wParam])
3461 {
3462 windows_translate = 1;
3463 goto translate;
3464 }
3465 return 0;
3466 }
3467
3468 /* Synchronize modifiers with current keystroke. */
3469 sync_modifiers ();
3470 record_keydown (wParam, lParam);
3471 if (w32_use_fallback_wm_chars_method)
3472 wParam = map_keypad_keys (wParam, (lParam & 0x1000000L) != 0);
3473
3474 windows_translate = 0;
3475
3476 switch (wParam)
3477 {
3478 case VK_LWIN:
3479 if (NILP (Vw32_pass_lwindow_to_system))
3480 {
3481 /* Prevent system from acting on keyup (which opens the
3482 Start menu if no other key was pressed) by simulating a
3483 press of Space which we will ignore. */
3484 if (GetAsyncKeyState (wParam) & 1)
3485 {
3486 if (NUMBERP (Vw32_phantom_key_code))
3487 key = XUINT (Vw32_phantom_key_code) & 255;
3488 else
3489 key = VK_SPACE;
3490 dpyinfo->faked_key = key;
3491 keybd_event (key, (BYTE) MapVirtualKey (key, 0), 0, 0);
3492 }
3493 }
3494 if (!NILP (Vw32_lwindow_modifier))
3495 return 0;
3496 break;
3497 case VK_RWIN:
3498 if (NILP (Vw32_pass_rwindow_to_system))
3499 {
3500 if (GetAsyncKeyState (wParam) & 1)
3501 {
3502 if (NUMBERP (Vw32_phantom_key_code))
3503 key = XUINT (Vw32_phantom_key_code) & 255;
3504 else
3505 key = VK_SPACE;
3506 dpyinfo->faked_key = key;
3507 keybd_event (key, (BYTE) MapVirtualKey (key, 0), 0, 0);
3508 }
3509 }
3510 if (!NILP (Vw32_rwindow_modifier))
3511 return 0;
3512 break;
3513 case VK_APPS:
3514 if (!NILP (Vw32_apps_modifier))
3515 return 0;
3516 break;
3517 case VK_MENU:
3518 if (NILP (Vw32_pass_alt_to_system))
3519 /* Prevent DefWindowProc from activating the menu bar if an
3520 Alt key is pressed and released by itself. */
3521 return 0;
3522 windows_translate = 1;
3523 break;
3524 case VK_CAPITAL:
3525 /* Decide whether to treat as modifier or function key. */
3526 if (NILP (Vw32_enable_caps_lock))
3527 goto disable_lock_key;
3528 windows_translate = 1;
3529 break;
3530 case VK_NUMLOCK:
3531 /* Decide whether to treat as modifier or function key. */
3532 if (NILP (Vw32_enable_num_lock))
3533 goto disable_lock_key;
3534 windows_translate = 1;
3535 break;
3536 case VK_SCROLL:
3537 /* Decide whether to treat as modifier or function key. */
3538 if (NILP (Vw32_scroll_lock_modifier))
3539 goto disable_lock_key;
3540 windows_translate = 1;
3541 break;
3542 disable_lock_key:
3543 /* Ensure the appropriate lock key state (and indicator light)
3544 remains in the same state. We do this by faking another
3545 press of the relevant key. Apparently, this really is the
3546 only way to toggle the state of the indicator lights. */
3547 dpyinfo->faked_key = wParam;
3548 keybd_event ((BYTE) wParam, (BYTE) MapVirtualKey (wParam, 0),
3549 KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
3550 keybd_event ((BYTE) wParam, (BYTE) MapVirtualKey (wParam, 0),
3551 KEYEVENTF_EXTENDEDKEY | 0, 0);
3552 keybd_event ((BYTE) wParam, (BYTE) MapVirtualKey (wParam, 0),
3553 KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
3554 /* Ensure indicator lights are updated promptly on Windows 9x
3555 (TranslateMessage apparently does this), after forwarding
3556 input event. */
3557 post_character_message (hwnd, msg, wParam, lParam,
3558 w32_get_key_modifiers (wParam, lParam));
3559 windows_translate = 1;
3560 break;
3561 case VK_CONTROL:
3562 case VK_SHIFT:
3563 case VK_PROCESSKEY: /* Generated by IME. */
3564 windows_translate = 1;
3565 break;
3566 case VK_CANCEL:
3567 /* Windows maps Ctrl-Pause (aka Ctrl-Break) into VK_CANCEL,
3568 which is confusing for purposes of key binding; convert
3569 VK_CANCEL events into VK_PAUSE events. */
3570 wParam = VK_PAUSE;
3571 break;
3572 case VK_PAUSE:
3573 /* Windows maps Ctrl-NumLock into VK_PAUSE, which is confusing
3574 for purposes of key binding; convert these back into
3575 VK_NUMLOCK events, at least when we want to see NumLock key
3576 presses. (Note that there is never any possibility that
3577 VK_PAUSE with Ctrl really is C-Pause as per above.) */
3578 if (NILP (Vw32_enable_num_lock) && modifier_set (VK_CONTROL))
3579 wParam = VK_NUMLOCK;
3580 break;
3581 default:
3582 if (w32_unicode_gui && !w32_use_fallback_wm_chars_method)
3583 {
3584 /* If this event generates characters or deadkeys, do
3585 not interpret it as a "raw combination of modifiers
3586 and keysym". Hide deadkeys, and use the generated
3587 character(s) instead of the keysym. (Backward
3588 compatibility: exceptions for numpad keys generating
3589 0-9 . , / * - +, and for extra-Alt combined with a
3590 non-Latin char.)
3591
3592 Try to not report modifiers which have effect on
3593 which character or deadkey is generated.
3594
3595 Example (contrived): if rightAlt-? generates f (on a
3596 Cyrillic keyboard layout), and Ctrl, leftAlt do not
3597 affect the generated character, one wants to report
3598 Ctrl-leftAlt-f if the user presses
3599 Ctrl-leftAlt-rightAlt-?. */
3600 int res;
3601 #if 0
3602 /* Some of WM_CHAR may be fed to us directly, some are
3603 results of TranslateMessage(). Using 0 as the first
3604 argument (in a separate call) might help us
3605 distinguish these two cases.
3606
3607 However, the keypress feeders would most probably
3608 expect the "standard" message pump, when
3609 TranslateMessage() is called on EVERY KeyDown/KeyUp
3610 event. So they may feed us Down-Ctrl Down-FAKE
3611 Char-o and expect us to recognize it as Ctrl-o.
3612 Using 0 as the first argument would interfere with
3613 this. */
3614 deliver_wm_chars (0, hwnd, msg, wParam, lParam, 1);
3615 #endif
3616 /* Processing the generated WM_CHAR messages *WHILE* we
3617 handle KEYDOWN/UP event is the best choice, since
3618 without any fuss, we know all 3 of: scancode, virtual
3619 keycode, and expansion. (Additionally, one knows
3620 boundaries of expansion of different keypresses.) */
3621 res = deliver_wm_chars (1, hwnd, msg, wParam, lParam, 1);
3622 windows_translate = -(res != 0);
3623 if (res > 0) /* Bound to character(s) or a deadkey */
3624 break;
3625 /* deliver_wm_chars may make some branches after this vestigal. */
3626 }
3627 wParam = map_keypad_keys (wParam, (lParam & 0x1000000L) != 0);
3628 /* If not defined as a function key, change it to a WM_CHAR message. */
3629 if (wParam > 255 || !lispy_function_keys[wParam])
3630 {
3631 DWORD modifiers = construct_console_modifiers ();
3632
3633 if (!NILP (Vw32_recognize_altgr)
3634 && modifier_set (VK_LCONTROL) && modifier_set (VK_RMENU))
3635 {
3636 /* Always let TranslateMessage handle AltGr key chords;
3637 for some reason, ToAscii doesn't always process AltGr
3638 chords correctly. */
3639 windows_translate = 1;
3640 }
3641 else if ((modifiers & (~SHIFT_PRESSED & ~CAPSLOCK_ON)) != 0)
3642 {
3643 /* Handle key chords including any modifiers other
3644 than shift directly, in order to preserve as much
3645 modifier information as possible. */
3646 if ('A' <= wParam && wParam <= 'Z')
3647 {
3648 /* Don't translate modified alphabetic keystrokes,
3649 so the user doesn't need to constantly switch
3650 layout to type control or meta keystrokes when
3651 the normal layout translates alphabetic
3652 characters to non-ascii characters. */
3653 if (!modifier_set (VK_SHIFT))
3654 wParam += ('a' - 'A');
3655 msg = WM_CHAR;
3656 }
3657 else
3658 {
3659 /* Try to handle other keystrokes by determining the
3660 base character (ie. translating the base key plus
3661 shift modifier). */
3662 int add;
3663 KEY_EVENT_RECORD key;
3664
3665 key.bKeyDown = TRUE;
3666 key.wRepeatCount = 1;
3667 key.wVirtualKeyCode = wParam;
3668 key.wVirtualScanCode = (lParam & 0xFF0000) >> 16;
3669 key.uChar.AsciiChar = 0;
3670 key.dwControlKeyState = modifiers;
3671
3672 add = w32_kbd_patch_key (&key, w32_keyboard_codepage);
3673 /* 0 means an unrecognized keycode, negative means
3674 dead key. Ignore both. */
3675 while (--add >= 0)
3676 {
3677 /* Forward asciified character sequence. */
3678 post_character_message
3679 (hwnd, WM_CHAR,
3680 (unsigned char) key.uChar.AsciiChar, lParam,
3681 w32_get_key_modifiers (wParam, lParam));
3682 w32_kbd_patch_key (&key, w32_keyboard_codepage);
3683 }
3684 return 0;
3685 }
3686 }
3687 else
3688 {
3689 /* Let TranslateMessage handle everything else. */
3690 windows_translate = 1;
3691 }
3692 }
3693 }
3694
3695 if (windows_translate == -1)
3696 break;
3697 translate:
3698 if (windows_translate)
3699 {
3700 MSG windows_msg = { hwnd, msg, wParam, lParam, 0, {0,0} };
3701 windows_msg.time = GetMessageTime ();
3702 TranslateMessage (&windows_msg);
3703 goto dflt;
3704 }
3705
3706 /* Fall through */
3707
3708 case WM_SYSCHAR:
3709 case WM_CHAR:
3710 if (wParam > 255 )
3711 {
3712 W32Msg wmsg;
3713
3714 wmsg.dwModifiers = w32_get_key_modifiers (wParam, lParam);
3715 signal_user_input ();
3716 my_post_msg (&wmsg, hwnd, WM_UNICHAR, wParam, lParam);
3717
3718 }
3719 else
3720 post_character_message (hwnd, msg, wParam, lParam,
3721 w32_get_key_modifiers (wParam, lParam));
3722 break;
3723
3724 case WM_UNICHAR:
3725 /* WM_UNICHAR looks promising from the docs, but the exact
3726 circumstances in which TranslateMessage sends it is one of those
3727 Microsoft secret API things that EU and US courts are supposed
3728 to have put a stop to already. Spy++ shows it being sent to Notepad
3729 and other MS apps, but never to Emacs.
3730
3731 Some third party IMEs send it in accordance with the official
3732 documentation though, so handle it here.
3733
3734 UNICODE_NOCHAR is used to test for support for this message.
3735 TRUE indicates that the message is supported. */
3736 if (wParam == UNICODE_NOCHAR)
3737 return TRUE;
3738
3739 {
3740 W32Msg wmsg;
3741 wmsg.dwModifiers = w32_get_key_modifiers (wParam, lParam);
3742 signal_user_input ();
3743 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3744 }
3745 break;
3746
3747 case WM_IME_CHAR:
3748 /* If we can't get the IME result as Unicode, use default processing,
3749 which will at least allow characters decodable in the system locale
3750 get through. */
3751 if (!get_composition_string_fn)
3752 goto dflt;
3753
3754 else if (!ignore_ime_char)
3755 {
3756 wchar_t * buffer;
3757 int size, i;
3758 W32Msg wmsg;
3759 HIMC context = get_ime_context_fn (hwnd);
3760 wmsg.dwModifiers = w32_get_key_modifiers (wParam, lParam);
3761 /* Get buffer size. */
3762 size = get_composition_string_fn (context, GCS_RESULTSTR, NULL, 0);
3763 buffer = alloca (size);
3764 size = get_composition_string_fn (context, GCS_RESULTSTR,
3765 buffer, size);
3766 release_ime_context_fn (hwnd, context);
3767
3768 signal_user_input ();
3769 for (i = 0; i < size / sizeof (wchar_t); i++)
3770 {
3771 my_post_msg (&wmsg, hwnd, WM_UNICHAR, (WPARAM) buffer[i],
3772 lParam);
3773 }
3774 /* Ignore the messages for the rest of the
3775 characters in the string that was output above. */
3776 ignore_ime_char = (size / sizeof (wchar_t)) - 1;
3777 }
3778 else
3779 ignore_ime_char--;
3780
3781 break;
3782
3783 case WM_IME_STARTCOMPOSITION:
3784 if (!set_ime_composition_window_fn)
3785 goto dflt;
3786 else
3787 {
3788 COMPOSITIONFORM form;
3789 HIMC context;
3790 struct window *w;
3791
3792 /* Implementation note: The code below does something that
3793 one shouldn't do: it accesses the window object from a
3794 separate thread, while the main (a.k.a. "Lisp") thread
3795 runs and can legitimately delete and even GC it. That is
3796 why we are extra careful not to futz with a window that
3797 is different from the one recorded when the system caret
3798 coordinates were last modified. That is also why we are
3799 careful not to move the IME window if the window
3800 described by W was deleted, as indicated by its buffer
3801 field being reset to nil. */
3802 f = x_window_to_frame (dpyinfo, hwnd);
3803 if (!(f && FRAME_LIVE_P (f)))
3804 goto dflt;
3805 w = XWINDOW (FRAME_SELECTED_WINDOW (f));
3806 /* Punt if someone changed the frame's selected window
3807 behind our back. */
3808 if (w != w32_system_caret_window)
3809 goto dflt;
3810
3811 form.dwStyle = CFS_RECT;
3812 form.ptCurrentPos.x = w32_system_caret_x;
3813 form.ptCurrentPos.y = w32_system_caret_y;
3814
3815 form.rcArea.left = WINDOW_TEXT_TO_FRAME_PIXEL_X (w, 0);
3816 form.rcArea.top = (WINDOW_TOP_EDGE_Y (w)
3817 + w32_system_caret_hdr_height);
3818 form.rcArea.right = (WINDOW_BOX_RIGHT_EDGE_X (w)
3819 - WINDOW_RIGHT_MARGIN_WIDTH (w)
3820 - WINDOW_RIGHT_FRINGE_WIDTH (w));
3821 form.rcArea.bottom = (WINDOW_BOTTOM_EDGE_Y (w)
3822 - WINDOW_BOTTOM_DIVIDER_WIDTH (w)
3823 - w32_system_caret_mode_height);
3824
3825 /* Punt if the window was deleted behind our back. */
3826 if (!BUFFERP (w->contents))
3827 goto dflt;
3828
3829 context = get_ime_context_fn (hwnd);
3830
3831 if (!context)
3832 goto dflt;
3833
3834 set_ime_composition_window_fn (context, &form);
3835 release_ime_context_fn (hwnd, context);
3836 }
3837 /* We should "goto dflt" here to pass WM_IME_STARTCOMPOSITION to
3838 DefWindowProc, so that the composition window will actually
3839 be displayed. But doing so causes trouble with displaying
3840 dialog boxes, such as the file selection dialog or font
3841 selection dialog. So something else is needed to fix the
3842 former without breaking the latter. See bug#11732. */
3843 break;
3844
3845 case WM_IME_ENDCOMPOSITION:
3846 ignore_ime_char = 0;
3847 goto dflt;
3848
3849 /* Simulate middle mouse button events when left and right buttons
3850 are used together, but only if user has two button mouse. */
3851 case WM_LBUTTONDOWN:
3852 case WM_RBUTTONDOWN:
3853 if (w32_num_mouse_buttons > 2)
3854 goto handle_plain_button;
3855
3856 {
3857 int this = (msg == WM_LBUTTONDOWN) ? LMOUSE : RMOUSE;
3858 int other = (msg == WM_LBUTTONDOWN) ? RMOUSE : LMOUSE;
3859
3860 if (button_state & this)
3861 return 0;
3862
3863 if (button_state == 0)
3864 SetCapture (hwnd);
3865
3866 button_state |= this;
3867
3868 if (button_state & other)
3869 {
3870 if (mouse_button_timer)
3871 {
3872 KillTimer (hwnd, mouse_button_timer);
3873 mouse_button_timer = 0;
3874
3875 /* Generate middle mouse event instead. */
3876 msg = WM_MBUTTONDOWN;
3877 button_state |= MMOUSE;
3878 }
3879 else if (button_state & MMOUSE)
3880 {
3881 /* Ignore button event if we've already generated a
3882 middle mouse down event. This happens if the
3883 user releases and press one of the two buttons
3884 after we've faked a middle mouse event. */
3885 return 0;
3886 }
3887 else
3888 {
3889 /* Flush out saved message. */
3890 post_msg (&saved_mouse_button_msg);
3891 }
3892 wmsg.dwModifiers = w32_get_modifiers ();
3893 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3894 signal_user_input ();
3895
3896 /* Clear message buffer. */
3897 saved_mouse_button_msg.msg.hwnd = 0;
3898 }
3899 else
3900 {
3901 /* Hold onto message for now. */
3902 mouse_button_timer =
3903 SetTimer (hwnd, MOUSE_BUTTON_ID,
3904 w32_mouse_button_tolerance, NULL);
3905 saved_mouse_button_msg.msg.hwnd = hwnd;
3906 saved_mouse_button_msg.msg.message = msg;
3907 saved_mouse_button_msg.msg.wParam = wParam;
3908 saved_mouse_button_msg.msg.lParam = lParam;
3909 saved_mouse_button_msg.msg.time = GetMessageTime ();
3910 saved_mouse_button_msg.dwModifiers = w32_get_modifiers ();
3911 }
3912 }
3913 return 0;
3914
3915 case WM_LBUTTONUP:
3916 case WM_RBUTTONUP:
3917 if (w32_num_mouse_buttons > 2)
3918 goto handle_plain_button;
3919
3920 {
3921 int this = (msg == WM_LBUTTONUP) ? LMOUSE : RMOUSE;
3922 int other = (msg == WM_LBUTTONUP) ? RMOUSE : LMOUSE;
3923
3924 if ((button_state & this) == 0)
3925 return 0;
3926
3927 button_state &= ~this;
3928
3929 if (button_state & MMOUSE)
3930 {
3931 /* Only generate event when second button is released. */
3932 if ((button_state & other) == 0)
3933 {
3934 msg = WM_MBUTTONUP;
3935 button_state &= ~MMOUSE;
3936
3937 if (button_state) emacs_abort ();
3938 }
3939 else
3940 return 0;
3941 }
3942 else
3943 {
3944 /* Flush out saved message if necessary. */
3945 if (saved_mouse_button_msg.msg.hwnd)
3946 {
3947 post_msg (&saved_mouse_button_msg);
3948 }
3949 }
3950 wmsg.dwModifiers = w32_get_modifiers ();
3951 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3952 signal_user_input ();
3953
3954 /* Always clear message buffer and cancel timer. */
3955 saved_mouse_button_msg.msg.hwnd = 0;
3956 KillTimer (hwnd, mouse_button_timer);
3957 mouse_button_timer = 0;
3958
3959 if (button_state == 0)
3960 ReleaseCapture ();
3961 }
3962 return 0;
3963
3964 case WM_XBUTTONDOWN:
3965 case WM_XBUTTONUP:
3966 if (w32_pass_extra_mouse_buttons_to_system)
3967 goto dflt;
3968 /* else fall through and process them. */
3969 case WM_MBUTTONDOWN:
3970 case WM_MBUTTONUP:
3971 handle_plain_button:
3972 {
3973 BOOL up;
3974 int button;
3975
3976 /* Ignore middle and extra buttons as long as the menu is active. */
3977 f = x_window_to_frame (dpyinfo, hwnd);
3978 if (f && f->output_data.w32->menubar_active)
3979 return 0;
3980
3981 if (parse_button (msg, HIWORD (wParam), &button, &up))
3982 {
3983 if (up) ReleaseCapture ();
3984 else SetCapture (hwnd);
3985 button = (button == 0) ? LMOUSE :
3986 ((button == 1) ? MMOUSE : RMOUSE);
3987 if (up)
3988 button_state &= ~button;
3989 else
3990 button_state |= button;
3991 }
3992 }
3993
3994 wmsg.dwModifiers = w32_get_modifiers ();
3995 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3996 signal_user_input ();
3997
3998 /* Need to return true for XBUTTON messages, false for others,
3999 to indicate that we processed the message. */
4000 return (msg == WM_XBUTTONDOWN || msg == WM_XBUTTONUP);
4001
4002 case WM_MOUSEMOVE:
4003 f = x_window_to_frame (dpyinfo, hwnd);
4004 if (f)
4005 {
4006 /* Ignore mouse movements as long as the menu is active.
4007 These movements are processed by the window manager
4008 anyway, and it's wrong to handle them as if they happened
4009 on the underlying frame. */
4010 if (f->output_data.w32->menubar_active)
4011 return 0;
4012
4013 /* If the mouse moved, and the mouse pointer is invisible,
4014 make it visible again. We do this here so as to be able
4015 to show the mouse pointer even when the main
4016 (a.k.a. "Lisp") thread is busy doing something. */
4017 static int last_x, last_y;
4018 int x = GET_X_LPARAM (lParam);
4019 int y = GET_Y_LPARAM (lParam);
4020
4021 if (f->pointer_invisible
4022 && (x != last_x || y != last_y))
4023 f->pointer_invisible = false;
4024
4025 last_x = x;
4026 last_y = y;
4027 }
4028
4029 /* If the mouse has just moved into the frame, start tracking
4030 it, so we will be notified when it leaves the frame. Mouse
4031 tracking only works under W98 and NT4 and later. On earlier
4032 versions, there is no way of telling when the mouse leaves the
4033 frame, so we just have to put up with help-echo and mouse
4034 highlighting remaining while the frame is not active. */
4035 if (track_mouse_event_fn && !track_mouse_window
4036 /* If the menu bar is active, turning on tracking of mouse
4037 movement events might send these events to the tooltip
4038 frame, if the user happens to move the mouse pointer over
4039 the tooltip. But since we don't process events for
4040 tooltip frames, this causes Windows to present a
4041 hourglass cursor, which is ugly and unexpected. So don't
4042 enable tracking mouse events in this case; they will be
4043 restarted when the menu pops down. (Confusingly, the
4044 menubar_active member of f->output_data.w32, tested
4045 above, is only set when a menu was popped up _not_ from
4046 the frame's menu bar, but via x-popup-menu.) */
4047 && !menubar_in_use)
4048 {
4049 TRACKMOUSEEVENT tme;
4050 tme.cbSize = sizeof (tme);
4051 tme.dwFlags = TME_LEAVE;
4052 tme.hwndTrack = hwnd;
4053 tme.dwHoverTime = HOVER_DEFAULT;
4054
4055 track_mouse_event_fn (&tme);
4056 track_mouse_window = hwnd;
4057 }
4058 case WM_HSCROLL:
4059 case WM_VSCROLL:
4060 if (w32_mouse_move_interval <= 0
4061 || (msg == WM_MOUSEMOVE && button_state == 0))
4062 {
4063 wmsg.dwModifiers = w32_get_modifiers ();
4064 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4065 return 0;
4066 }
4067
4068 /* Hang onto mouse move and scroll messages for a bit, to avoid
4069 sending such events to Emacs faster than it can process them.
4070 If we get more events before the timer from the first message
4071 expires, we just replace the first message. */
4072
4073 if (saved_mouse_move_msg.msg.hwnd == 0)
4074 mouse_move_timer =
4075 SetTimer (hwnd, MOUSE_MOVE_ID,
4076 w32_mouse_move_interval, NULL);
4077
4078 /* Hold onto message for now. */
4079 saved_mouse_move_msg.msg.hwnd = hwnd;
4080 saved_mouse_move_msg.msg.message = msg;
4081 saved_mouse_move_msg.msg.wParam = wParam;
4082 saved_mouse_move_msg.msg.lParam = lParam;
4083 saved_mouse_move_msg.msg.time = GetMessageTime ();
4084 saved_mouse_move_msg.dwModifiers = w32_get_modifiers ();
4085
4086 return 0;
4087
4088 case WM_MOUSEWHEEL:
4089 case WM_DROPFILES:
4090 wmsg.dwModifiers = w32_get_modifiers ();
4091 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4092 signal_user_input ();
4093 return 0;
4094
4095 case WM_APPCOMMAND:
4096 if (w32_pass_multimedia_buttons_to_system)
4097 goto dflt;
4098 /* Otherwise, pass to lisp, the same way we do with mousehwheel. */
4099 case WM_MOUSEHWHEEL:
4100 wmsg.dwModifiers = w32_get_modifiers ();
4101 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4102 signal_user_input ();
4103 /* Non-zero must be returned when WM_MOUSEHWHEEL messages are
4104 handled, to prevent the system trying to handle it by faking
4105 scroll bar events. */
4106 return 1;
4107
4108 case WM_TIMER:
4109 /* Flush out saved messages if necessary. */
4110 if (wParam == mouse_button_timer)
4111 {
4112 if (saved_mouse_button_msg.msg.hwnd)
4113 {
4114 post_msg (&saved_mouse_button_msg);
4115 signal_user_input ();
4116 saved_mouse_button_msg.msg.hwnd = 0;
4117 }
4118 KillTimer (hwnd, mouse_button_timer);
4119 mouse_button_timer = 0;
4120 }
4121 else if (wParam == mouse_move_timer)
4122 {
4123 if (saved_mouse_move_msg.msg.hwnd)
4124 {
4125 post_msg (&saved_mouse_move_msg);
4126 saved_mouse_move_msg.msg.hwnd = 0;
4127 }
4128 KillTimer (hwnd, mouse_move_timer);
4129 mouse_move_timer = 0;
4130 }
4131 else if (wParam == menu_free_timer)
4132 {
4133 KillTimer (hwnd, menu_free_timer);
4134 menu_free_timer = 0;
4135 f = x_window_to_frame (dpyinfo, hwnd);
4136 /* If a popup menu is active, don't wipe its strings. */
4137 if (menubar_in_use
4138 && current_popup_menu == NULL)
4139 {
4140 /* Free memory used by owner-drawn and help-echo strings. */
4141 w32_free_menu_strings (hwnd);
4142 if (f)
4143 f->output_data.w32->menubar_active = 0;
4144 menubar_in_use = 0;
4145 }
4146 }
4147 return 0;
4148
4149 case WM_NCACTIVATE:
4150 /* Windows doesn't send us focus messages when putting up and
4151 taking down a system popup dialog as for Ctrl-Alt-Del on Windows 95.
4152 The only indication we get that something happened is receiving
4153 this message afterwards. So this is a good time to reset our
4154 keyboard modifiers' state. */
4155 reset_modifiers ();
4156 goto dflt;
4157
4158 case WM_INITMENU:
4159 button_state = 0;
4160 ReleaseCapture ();
4161 /* We must ensure menu bar is fully constructed and up to date
4162 before allowing user interaction with it. To achieve this
4163 we send this message to the lisp thread and wait for a
4164 reply (whose value is not actually needed) to indicate that
4165 the menu bar is now ready for use, so we can now return.
4166
4167 To remain responsive in the meantime, we enter a nested message
4168 loop that can process all other messages.
4169
4170 However, we skip all this if the message results from calling
4171 TrackPopupMenu - in fact, we must NOT attempt to send the lisp
4172 thread a message because it is blocked on us at this point. We
4173 set menubar_active before calling TrackPopupMenu to indicate
4174 this (there is no possibility of confusion with real menubar
4175 being active). */
4176
4177 f = x_window_to_frame (dpyinfo, hwnd);
4178 if (f
4179 && (f->output_data.w32->menubar_active
4180 /* We can receive this message even in the absence of a
4181 menubar (ie. when the system menu is activated) - in this
4182 case we do NOT want to forward the message, otherwise it
4183 will cause the menubar to suddenly appear when the user
4184 had requested it to be turned off! */
4185 || f->output_data.w32->menubar_widget == NULL))
4186 return 0;
4187
4188 {
4189 deferred_msg msg_buf;
4190
4191 /* Detect if message has already been deferred; in this case
4192 we cannot return any sensible value to ignore this. */
4193 if (find_deferred_msg (hwnd, msg) != NULL)
4194 emacs_abort ();
4195
4196 menubar_in_use = 1;
4197
4198 return send_deferred_msg (&msg_buf, hwnd, msg, wParam, lParam);
4199 }
4200
4201 case WM_EXITMENULOOP:
4202 f = x_window_to_frame (dpyinfo, hwnd);
4203
4204 /* If a menu is still active, check again after a short delay,
4205 since Windows often (always?) sends the WM_EXITMENULOOP
4206 before the corresponding WM_COMMAND message.
4207 Don't do this if a popup menu is active, since it is only
4208 menubar menus that require cleaning up in this way.
4209 */
4210 if (f && menubar_in_use && current_popup_menu == NULL)
4211 menu_free_timer = SetTimer (hwnd, MENU_FREE_ID, MENU_FREE_DELAY, NULL);
4212
4213 /* If hourglass cursor should be displayed, display it now. */
4214 if (f && f->output_data.w32->hourglass_p)
4215 SetCursor (f->output_data.w32->hourglass_cursor);
4216
4217 goto dflt;
4218
4219 case WM_MENUSELECT:
4220 /* Direct handling of help_echo in menus. Should be safe now
4221 that we generate the help_echo by placing a help event in the
4222 keyboard buffer. */
4223 {
4224 HMENU menu = (HMENU) lParam;
4225 UINT menu_item = (UINT) LOWORD (wParam);
4226 UINT flags = (UINT) HIWORD (wParam);
4227
4228 w32_menu_display_help (hwnd, menu, menu_item, flags);
4229 }
4230 return 0;
4231
4232 case WM_MEASUREITEM:
4233 f = x_window_to_frame (dpyinfo, hwnd);
4234 if (f)
4235 {
4236 MEASUREITEMSTRUCT * pMis = (MEASUREITEMSTRUCT *) lParam;
4237
4238 if (pMis->CtlType == ODT_MENU)
4239 {
4240 /* Work out dimensions for popup menu titles. */
4241 char * title = (char *) pMis->itemData;
4242 HDC hdc = GetDC (hwnd);
4243 HFONT menu_font = GetCurrentObject (hdc, OBJ_FONT);
4244 LOGFONT menu_logfont;
4245 HFONT old_font;
4246 SIZE size;
4247
4248 GetObject (menu_font, sizeof (menu_logfont), &menu_logfont);
4249 menu_logfont.lfWeight = FW_BOLD;
4250 menu_font = CreateFontIndirect (&menu_logfont);
4251 old_font = SelectObject (hdc, menu_font);
4252
4253 pMis->itemHeight = GetSystemMetrics (SM_CYMENUSIZE);
4254 if (title)
4255 {
4256 if (unicode_append_menu)
4257 GetTextExtentPoint32W (hdc, (WCHAR *) title,
4258 wcslen ((WCHAR *) title),
4259 &size);
4260 else
4261 GetTextExtentPoint32 (hdc, title, strlen (title), &size);
4262
4263 pMis->itemWidth = size.cx;
4264 if (pMis->itemHeight < size.cy)
4265 pMis->itemHeight = size.cy;
4266 }
4267 else
4268 pMis->itemWidth = 0;
4269
4270 SelectObject (hdc, old_font);
4271 DeleteObject (menu_font);
4272 ReleaseDC (hwnd, hdc);
4273 return TRUE;
4274 }
4275 }
4276 return 0;
4277
4278 case WM_DRAWITEM:
4279 f = x_window_to_frame (dpyinfo, hwnd);
4280 if (f)
4281 {
4282 DRAWITEMSTRUCT * pDis = (DRAWITEMSTRUCT *) lParam;
4283
4284 if (pDis->CtlType == ODT_MENU)
4285 {
4286 /* Draw popup menu title. */
4287 char * title = (char *) pDis->itemData;
4288 if (title)
4289 {
4290 HDC hdc = pDis->hDC;
4291 HFONT menu_font = GetCurrentObject (hdc, OBJ_FONT);
4292 LOGFONT menu_logfont;
4293 HFONT old_font;
4294
4295 GetObject (menu_font, sizeof (menu_logfont), &menu_logfont);
4296 menu_logfont.lfWeight = FW_BOLD;
4297 menu_font = CreateFontIndirect (&menu_logfont);
4298 old_font = SelectObject (hdc, menu_font);
4299
4300 /* Always draw title as if not selected. */
4301 if (unicode_append_menu)
4302 ExtTextOutW (hdc,
4303 pDis->rcItem.left
4304 + GetSystemMetrics (SM_CXMENUCHECK),
4305 pDis->rcItem.top,
4306 ETO_OPAQUE, &pDis->rcItem,
4307 (WCHAR *) title,
4308 wcslen ((WCHAR *) title), NULL);
4309 else
4310 ExtTextOut (hdc,
4311 pDis->rcItem.left
4312 + GetSystemMetrics (SM_CXMENUCHECK),
4313 pDis->rcItem.top,
4314 ETO_OPAQUE, &pDis->rcItem,
4315 title, strlen (title), NULL);
4316
4317 SelectObject (hdc, old_font);
4318 DeleteObject (menu_font);
4319 }
4320 return TRUE;
4321 }
4322 }
4323 return 0;
4324
4325 #if 0
4326 /* Still not right - can't distinguish between clicks in the
4327 client area of the frame from clicks forwarded from the scroll
4328 bars - may have to hook WM_NCHITTEST to remember the mouse
4329 position and then check if it is in the client area ourselves. */
4330 case WM_MOUSEACTIVATE:
4331 /* Discard the mouse click that activates a frame, allowing the
4332 user to click anywhere without changing point (or worse!).
4333 Don't eat mouse clicks on scrollbars though!! */
4334 if (LOWORD (lParam) == HTCLIENT )
4335 return MA_ACTIVATEANDEAT;
4336 goto dflt;
4337 #endif
4338
4339 case WM_MOUSELEAVE:
4340 /* No longer tracking mouse. */
4341 track_mouse_window = NULL;
4342
4343 case WM_ACTIVATEAPP:
4344 case WM_ACTIVATE:
4345 case WM_WINDOWPOSCHANGED:
4346 case WM_SHOWWINDOW:
4347 /* Inform lisp thread that a frame might have just been obscured
4348 or exposed, so should recheck visibility of all frames. */
4349 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4350 goto dflt;
4351
4352 case WM_SETFOCUS:
4353 dpyinfo->faked_key = 0;
4354 reset_modifiers ();
4355 register_hot_keys (hwnd);
4356 goto command;
4357 case WM_KILLFOCUS:
4358 unregister_hot_keys (hwnd);
4359 button_state = 0;
4360 ReleaseCapture ();
4361 /* Relinquish the system caret. */
4362 if (w32_system_caret_hwnd)
4363 {
4364 w32_visible_system_caret_hwnd = NULL;
4365 w32_system_caret_hwnd = NULL;
4366 DestroyCaret ();
4367 }
4368 goto command;
4369 case WM_COMMAND:
4370 menubar_in_use = 0;
4371 f = x_window_to_frame (dpyinfo, hwnd);
4372 if (f && HIWORD (wParam) == 0)
4373 {
4374 if (menu_free_timer)
4375 {
4376 KillTimer (hwnd, menu_free_timer);
4377 menu_free_timer = 0;
4378 }
4379 }
4380 case WM_MOVE:
4381 case WM_SIZE:
4382 command:
4383 wmsg.dwModifiers = w32_get_modifiers ();
4384 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4385 goto dflt;
4386
4387 case WM_DESTROY:
4388 CoUninitialize ();
4389 return 0;
4390
4391 case WM_CLOSE:
4392 wmsg.dwModifiers = w32_get_modifiers ();
4393 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4394 return 0;
4395
4396 case WM_WINDOWPOSCHANGING:
4397 /* Don't restrict the sizing of any kind of frames. If the window
4398 manager doesn't, there's no reason to do it ourselves. */
4399 return 0;
4400
4401 case WM_GETMINMAXINFO:
4402 /* Hack to allow resizing the Emacs frame above the screen size.
4403 Note that Windows 9x limits coordinates to 16-bits. */
4404 ((LPMINMAXINFO) lParam)->ptMaxTrackSize.x = 32767;
4405 ((LPMINMAXINFO) lParam)->ptMaxTrackSize.y = 32767;
4406 return 0;
4407
4408 case WM_SETCURSOR:
4409 if (LOWORD (lParam) == HTCLIENT)
4410 {
4411 f = x_window_to_frame (dpyinfo, hwnd);
4412 if (f)
4413 {
4414 if (f->output_data.w32->hourglass_p
4415 && !menubar_in_use && !current_popup_menu)
4416 SetCursor (f->output_data.w32->hourglass_cursor);
4417 else if (f->pointer_invisible)
4418 SetCursor (NULL);
4419 else
4420 SetCursor (f->output_data.w32->current_cursor);
4421 }
4422
4423 return 0;
4424 }
4425 goto dflt;
4426
4427 case WM_EMACS_SETCURSOR:
4428 {
4429 Cursor cursor = (Cursor) wParam;
4430 f = x_window_to_frame (dpyinfo, hwnd);
4431 if (f && cursor)
4432 {
4433 f->output_data.w32->current_cursor = cursor;
4434 /* Don't change the cursor while menu-bar menu is in use. */
4435 if (!f->output_data.w32->menubar_active
4436 && !f->output_data.w32->hourglass_p)
4437 {
4438 if (f->pointer_invisible)
4439 SetCursor (NULL);
4440 else
4441 SetCursor (cursor);
4442 }
4443 }
4444 return 0;
4445 }
4446
4447 case WM_EMACS_SHOWCURSOR:
4448 {
4449 ShowCursor ((BOOL) wParam);
4450
4451 return 0;
4452 }
4453
4454 case WM_EMACS_CREATEVSCROLLBAR:
4455 return (LRESULT) w32_createvscrollbar ((struct frame *) wParam,
4456 (struct scroll_bar *) lParam);
4457
4458 case WM_EMACS_CREATEHSCROLLBAR:
4459 return (LRESULT) w32_createhscrollbar ((struct frame *) wParam,
4460 (struct scroll_bar *) lParam);
4461
4462 case WM_EMACS_SHOWWINDOW:
4463 return ShowWindow ((HWND) wParam, (WPARAM) lParam);
4464
4465 case WM_EMACS_BRINGTOTOP:
4466 case WM_EMACS_SETFOREGROUND:
4467 {
4468 HWND foreground_window;
4469 DWORD foreground_thread, retval;
4470
4471 /* On NT 5.0, and apparently Windows 98, it is necessary to
4472 attach to the thread that currently has focus in order to
4473 pull the focus away from it. */
4474 foreground_window = GetForegroundWindow ();
4475 foreground_thread = GetWindowThreadProcessId (foreground_window, NULL);
4476 if (!foreground_window
4477 || foreground_thread == GetCurrentThreadId ()
4478 || !AttachThreadInput (GetCurrentThreadId (),
4479 foreground_thread, TRUE))
4480 foreground_thread = 0;
4481
4482 retval = SetForegroundWindow ((HWND) wParam);
4483 if (msg == WM_EMACS_BRINGTOTOP)
4484 retval = BringWindowToTop ((HWND) wParam);
4485
4486 /* Detach from the previous foreground thread. */
4487 if (foreground_thread)
4488 AttachThreadInput (GetCurrentThreadId (),
4489 foreground_thread, FALSE);
4490
4491 return retval;
4492 }
4493
4494 case WM_EMACS_SETWINDOWPOS:
4495 {
4496 WINDOWPOS * pos = (WINDOWPOS *) wParam;
4497 return SetWindowPos (hwnd, pos->hwndInsertAfter,
4498 pos->x, pos->y, pos->cx, pos->cy, pos->flags);
4499 }
4500
4501 case WM_EMACS_DESTROYWINDOW:
4502 DragAcceptFiles ((HWND) wParam, FALSE);
4503 return DestroyWindow ((HWND) wParam);
4504
4505 case WM_EMACS_HIDE_CARET:
4506 return HideCaret (hwnd);
4507
4508 case WM_EMACS_SHOW_CARET:
4509 return ShowCaret (hwnd);
4510
4511 case WM_EMACS_DESTROY_CARET:
4512 w32_system_caret_hwnd = NULL;
4513 w32_visible_system_caret_hwnd = NULL;
4514 return DestroyCaret ();
4515
4516 case WM_EMACS_TRACK_CARET:
4517 /* If there is currently no system caret, create one. */
4518 if (w32_system_caret_hwnd == NULL)
4519 {
4520 /* Use the default caret width, and avoid changing it
4521 unnecessarily, as it confuses screen reader software. */
4522 w32_system_caret_hwnd = hwnd;
4523 CreateCaret (hwnd, NULL, 0,
4524 w32_system_caret_height);
4525 }
4526
4527 if (!SetCaretPos (w32_system_caret_x, w32_system_caret_y))
4528 return 0;
4529 /* Ensure visible caret gets turned on when requested. */
4530 else if (w32_use_visible_system_caret
4531 && w32_visible_system_caret_hwnd != hwnd)
4532 {
4533 w32_visible_system_caret_hwnd = hwnd;
4534 return ShowCaret (hwnd);
4535 }
4536 /* Ensure visible caret gets turned off when requested. */
4537 else if (!w32_use_visible_system_caret
4538 && w32_visible_system_caret_hwnd)
4539 {
4540 w32_visible_system_caret_hwnd = NULL;
4541 return HideCaret (hwnd);
4542 }
4543 else
4544 return 1;
4545
4546 case WM_EMACS_TRACKPOPUPMENU:
4547 {
4548 UINT flags;
4549 POINT *pos;
4550 int retval;
4551 pos = (POINT *)lParam;
4552 flags = TPM_CENTERALIGN;
4553 if (button_state & LMOUSE)
4554 flags |= TPM_LEFTBUTTON;
4555 else if (button_state & RMOUSE)
4556 flags |= TPM_RIGHTBUTTON;
4557
4558 /* Remember we did a SetCapture on the initial mouse down event,
4559 so for safety, we make sure the capture is canceled now. */
4560 ReleaseCapture ();
4561 button_state = 0;
4562
4563 /* Use menubar_active to indicate that WM_INITMENU is from
4564 TrackPopupMenu below, and should be ignored. */
4565 f = x_window_to_frame (dpyinfo, hwnd);
4566 if (f)
4567 f->output_data.w32->menubar_active = 1;
4568
4569 if (TrackPopupMenu ((HMENU)wParam, flags, pos->x, pos->y,
4570 0, hwnd, NULL))
4571 {
4572 MSG amsg;
4573 /* Eat any mouse messages during popupmenu */
4574 while (PeekMessage (&amsg, hwnd, WM_MOUSEFIRST, WM_MOUSELAST,
4575 PM_REMOVE));
4576 /* Get the menu selection, if any */
4577 if (PeekMessage (&amsg, hwnd, WM_COMMAND, WM_COMMAND, PM_REMOVE))
4578 {
4579 retval = LOWORD (amsg.wParam);
4580 }
4581 else
4582 {
4583 retval = 0;
4584 }
4585 }
4586 else
4587 {
4588 retval = -1;
4589 }
4590
4591 return retval;
4592 }
4593 case WM_EMACS_FILENOTIFY:
4594 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4595 return 1;
4596
4597 default:
4598 /* Check for messages registered at runtime. */
4599 if (msg == msh_mousewheel)
4600 {
4601 wmsg.dwModifiers = w32_get_modifiers ();
4602 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4603 signal_user_input ();
4604 return 0;
4605 }
4606
4607 dflt:
4608 return (w32_unicode_gui ? DefWindowProcW : DefWindowProcA) (hwnd, msg, wParam, lParam);
4609 }
4610
4611 /* The most common default return code for handled messages is 0. */
4612 return 0;
4613 }
4614
4615 static void
4616 my_create_window (struct frame * f)
4617 {
4618 MSG msg;
4619 static int coords[2];
4620 Lisp_Object left, top;
4621 struct w32_display_info *dpyinfo = &one_w32_display_info;
4622
4623 /* When called with RES_TYPE_NUMBER, x_get_arg will return zero for
4624 anything that is not a number and is not Qunbound. */
4625 left = x_get_arg (dpyinfo, Qnil, Qleft, "left", "Left", RES_TYPE_NUMBER);
4626 top = x_get_arg (dpyinfo, Qnil, Qtop, "top", "Top", RES_TYPE_NUMBER);
4627 if (EQ (left, Qunbound))
4628 coords[0] = CW_USEDEFAULT;
4629 else
4630 coords[0] = XINT (left);
4631 if (EQ (top, Qunbound))
4632 coords[1] = CW_USEDEFAULT;
4633 else
4634 coords[1] = XINT (top);
4635
4636 if (!PostThreadMessage (dwWindowsThreadId, WM_EMACS_CREATEWINDOW,
4637 (WPARAM)f, (LPARAM)coords))
4638 emacs_abort ();
4639 GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE);
4640 }
4641
4642
4643 /* Create a tooltip window. Unlike my_create_window, we do not do this
4644 indirectly via the Window thread, as we do not need to process Window
4645 messages for the tooltip. Creating tooltips indirectly also creates
4646 deadlocks when tooltips are created for menu items. */
4647 static void
4648 my_create_tip_window (struct frame *f)
4649 {
4650 RECT rect;
4651
4652 rect.left = rect.top = 0;
4653 rect.right = FRAME_PIXEL_WIDTH (f);
4654 rect.bottom = FRAME_PIXEL_HEIGHT (f);
4655
4656 AdjustWindowRect (&rect, f->output_data.w32->dwStyle, false);
4657
4658 tip_window = FRAME_W32_WINDOW (f)
4659 = CreateWindow (EMACS_CLASS,
4660 f->namebuf,
4661 f->output_data.w32->dwStyle,
4662 f->left_pos,
4663 f->top_pos,
4664 rect.right - rect.left,
4665 rect.bottom - rect.top,
4666 FRAME_W32_WINDOW (SELECTED_FRAME ()), /* owner */
4667 NULL,
4668 hinst,
4669 NULL);
4670
4671 if (tip_window)
4672 {
4673 SetWindowLong (tip_window, WND_FONTWIDTH_INDEX, FRAME_COLUMN_WIDTH (f));
4674 SetWindowLong (tip_window, WND_LINEHEIGHT_INDEX, FRAME_LINE_HEIGHT (f));
4675 SetWindowLong (tip_window, WND_BORDER_INDEX, FRAME_INTERNAL_BORDER_WIDTH (f));
4676 SetWindowLong (tip_window, WND_BACKGROUND_INDEX, FRAME_BACKGROUND_PIXEL (f));
4677
4678 /* Tip frames have no scrollbars. */
4679 SetWindowLong (tip_window, WND_VSCROLLBAR_INDEX, 0);
4680 SetWindowLong (tip_window, WND_HSCROLLBAR_INDEX, 0);
4681
4682 /* Do this to discard the default setting specified by our parent. */
4683 ShowWindow (tip_window, SW_HIDE);
4684 }
4685 }
4686
4687
4688 /* Create and set up the w32 window for frame F. */
4689
4690 static void
4691 w32_window (struct frame *f, long window_prompting, bool minibuffer_only)
4692 {
4693 block_input ();
4694
4695 /* Use the resource name as the top-level window name
4696 for looking up resources. Make a non-Lisp copy
4697 for the window manager, so GC relocation won't bother it.
4698
4699 Elsewhere we specify the window name for the window manager. */
4700 f->namebuf = xlispstrdup (Vx_resource_name);
4701
4702 my_create_window (f);
4703
4704 validate_x_resource_name ();
4705
4706 /* x_set_name normally ignores requests to set the name if the
4707 requested name is the same as the current name. This is the one
4708 place where that assumption isn't correct; f->name is set, but
4709 the server hasn't been told. */
4710 {
4711 Lisp_Object name;
4712 int explicit = f->explicit_name;
4713
4714 f->explicit_name = 0;
4715 name = f->name;
4716 fset_name (f, Qnil);
4717 x_set_name (f, name, explicit);
4718 }
4719
4720 unblock_input ();
4721
4722 if (!minibuffer_only && FRAME_EXTERNAL_MENU_BAR (f))
4723 initialize_frame_menubar (f);
4724
4725 if (FRAME_W32_WINDOW (f) == 0)
4726 error ("Unable to create window");
4727 }
4728
4729 /* Handle the icon stuff for this window. Perhaps later we might
4730 want an x_set_icon_position which can be called interactively as
4731 well. */
4732
4733 static void
4734 x_icon (struct frame *f, Lisp_Object parms)
4735 {
4736 Lisp_Object icon_x, icon_y;
4737 struct w32_display_info *dpyinfo = &one_w32_display_info;
4738
4739 /* Set the position of the icon. Note that Windows 95 groups all
4740 icons in the tray. */
4741 icon_x = x_get_arg (dpyinfo, parms, Qicon_left, 0, 0, RES_TYPE_NUMBER);
4742 icon_y = x_get_arg (dpyinfo, parms, Qicon_top, 0, 0, RES_TYPE_NUMBER);
4743 if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
4744 {
4745 CHECK_NUMBER (icon_x);
4746 CHECK_NUMBER (icon_y);
4747 }
4748 else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
4749 error ("Both left and top icon corners of icon must be specified");
4750
4751 block_input ();
4752
4753 #if 0 /* TODO */
4754 /* Start up iconic or window? */
4755 x_wm_set_window_state
4756 (f, (EQ (x_get_arg (dpyinfo, parms, Qvisibility, 0, 0, RES_TYPE_SYMBOL), Qicon)
4757 ? IconicState
4758 : NormalState));
4759
4760 x_text_icon (f, SSDATA ((!NILP (f->icon_name)
4761 ? f->icon_name
4762 : f->name)));
4763 #endif
4764
4765 unblock_input ();
4766 }
4767
4768
4769 static void
4770 x_make_gc (struct frame *f)
4771 {
4772 XGCValues gc_values;
4773
4774 block_input ();
4775
4776 /* Create the GC's of this frame.
4777 Note that many default values are used. */
4778
4779 /* Normal video */
4780 gc_values.font = FRAME_FONT (f);
4781
4782 /* Cursor has cursor-color background, background-color foreground. */
4783 gc_values.foreground = FRAME_BACKGROUND_PIXEL (f);
4784 gc_values.background = f->output_data.w32->cursor_pixel;
4785 f->output_data.w32->cursor_gc
4786 = XCreateGC (NULL, FRAME_W32_WINDOW (f),
4787 (GCFont | GCForeground | GCBackground),
4788 &gc_values);
4789
4790 /* Reliefs. */
4791 f->output_data.w32->white_relief.gc = 0;
4792 f->output_data.w32->black_relief.gc = 0;
4793
4794 unblock_input ();
4795 }
4796
4797
4798 /* Handler for signals raised during x_create_frame and
4799 x_create_tip_frame. FRAME is the frame which is partially
4800 constructed. */
4801
4802 static Lisp_Object
4803 unwind_create_frame (Lisp_Object frame)
4804 {
4805 struct frame *f = XFRAME (frame);
4806
4807 /* If frame is ``official'', nothing to do. */
4808 if (NILP (Fmemq (frame, Vframe_list)))
4809 {
4810 #ifdef GLYPH_DEBUG
4811 struct w32_display_info *dpyinfo = FRAME_DISPLAY_INFO (f);
4812
4813 /* If the frame's image cache refcount is still the same as our
4814 private shadow variable, it means we are unwinding a frame
4815 for which we didn't yet call init_frame_faces, where the
4816 refcount is incremented. Therefore, we increment it here, so
4817 that free_frame_faces, called in x_free_frame_resources
4818 below, will not mistakenly decrement the counter that was not
4819 incremented yet to account for this new frame. */
4820 if (FRAME_IMAGE_CACHE (f) != NULL
4821 && FRAME_IMAGE_CACHE (f)->refcount == image_cache_refcount)
4822 FRAME_IMAGE_CACHE (f)->refcount++;
4823 #endif
4824
4825 x_free_frame_resources (f);
4826 free_glyphs (f);
4827
4828 #ifdef GLYPH_DEBUG
4829 /* Check that reference counts are indeed correct. */
4830 eassert (dpyinfo->reference_count == dpyinfo_refcount);
4831 eassert ((dpyinfo->terminal->image_cache == NULL
4832 && image_cache_refcount == 0)
4833 || (dpyinfo->terminal->image_cache != NULL
4834 && dpyinfo->terminal->image_cache->refcount == image_cache_refcount));
4835 #endif
4836 return Qt;
4837 }
4838
4839 return Qnil;
4840 }
4841
4842 static void
4843 do_unwind_create_frame (Lisp_Object frame)
4844 {
4845 unwind_create_frame (frame);
4846 }
4847
4848 static void
4849 x_default_font_parameter (struct frame *f, Lisp_Object parms)
4850 {
4851 struct w32_display_info *dpyinfo = FRAME_DISPLAY_INFO (f);
4852 Lisp_Object font_param = x_get_arg (dpyinfo, parms, Qfont, NULL, NULL,
4853 RES_TYPE_STRING);
4854 Lisp_Object font;
4855 if (EQ (font_param, Qunbound))
4856 font_param = Qnil;
4857 font = !NILP (font_param) ? font_param
4858 : x_get_arg (dpyinfo, parms, Qfont, "font", "Font", RES_TYPE_STRING);
4859
4860 if (!STRINGP (font))
4861 {
4862 int i;
4863 static char *names[]
4864 = { "Courier New-10",
4865 "-*-Courier-normal-r-*-*-13-*-*-*-c-*-iso8859-1",
4866 "-*-Fixedsys-normal-r-*-*-12-*-*-*-c-*-iso8859-1",
4867 "Fixedsys",
4868 NULL };
4869
4870 for (i = 0; names[i]; i++)
4871 {
4872 font = font_open_by_name (f, build_unibyte_string (names[i]));
4873 if (! NILP (font))
4874 break;
4875 }
4876 if (NILP (font))
4877 error ("No suitable font was found");
4878 }
4879 else if (!NILP (font_param))
4880 {
4881 /* Remember the explicit font parameter, so we can re-apply it after
4882 we've applied the `default' face settings. */
4883 x_set_frame_parameters (f, Fcons (Fcons (Qfont_param, font_param), Qnil));
4884 }
4885 x_default_parameter (f, parms, Qfont, font, "font", "Font", RES_TYPE_STRING);
4886 }
4887
4888 DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
4889 1, 1, 0,
4890 doc: /* Make a new window, which is called a \"frame\" in Emacs terms.
4891 Return an Emacs frame object.
4892 PARAMETERS is an alist of frame parameters.
4893 If the parameters specify that the frame should not have a minibuffer,
4894 and do not specify a specific minibuffer window to use,
4895 then `default-minibuffer-frame' must be a frame whose minibuffer can
4896 be shared by the new frame.
4897
4898 This function is an internal primitive--use `make-frame' instead. */)
4899 (Lisp_Object parameters)
4900 {
4901 struct frame *f;
4902 Lisp_Object frame, tem;
4903 Lisp_Object name;
4904 bool minibuffer_only = false;
4905 long window_prompting = 0;
4906 ptrdiff_t count = SPECPDL_INDEX ();
4907 Lisp_Object display;
4908 struct w32_display_info *dpyinfo = NULL;
4909 Lisp_Object parent;
4910 struct kboard *kb;
4911 int x_width = 0, x_height = 0;
4912
4913 if (!FRAME_W32_P (SELECTED_FRAME ())
4914 && !FRAME_INITIAL_P (SELECTED_FRAME ()))
4915 error ("Cannot create a GUI frame in a -nw session");
4916
4917 /* Make copy of frame parameters because the original is in pure
4918 storage now. */
4919 parameters = Fcopy_alist (parameters);
4920
4921 /* Use this general default value to start with
4922 until we know if this frame has a specified name. */
4923 Vx_resource_name = Vinvocation_name;
4924
4925 display = x_get_arg (dpyinfo, parameters, Qterminal, 0, 0, RES_TYPE_NUMBER);
4926 if (EQ (display, Qunbound))
4927 display = x_get_arg (dpyinfo, parameters, Qdisplay, 0, 0, RES_TYPE_STRING);
4928 if (EQ (display, Qunbound))
4929 display = Qnil;
4930 dpyinfo = check_x_display_info (display);
4931 kb = dpyinfo->terminal->kboard;
4932
4933 if (!dpyinfo->terminal->name)
4934 error ("Terminal is not live, can't create new frames on it");
4935
4936 name = x_get_arg (dpyinfo, parameters, Qname, "name", "Name", RES_TYPE_STRING);
4937 if (!STRINGP (name)
4938 && ! EQ (name, Qunbound)
4939 && ! NILP (name))
4940 error ("Invalid frame name--not a string or nil");
4941
4942 if (STRINGP (name))
4943 Vx_resource_name = name;
4944
4945 /* See if parent window is specified. */
4946 parent = x_get_arg (dpyinfo, parameters, Qparent_id, NULL, NULL, RES_TYPE_NUMBER);
4947 if (EQ (parent, Qunbound))
4948 parent = Qnil;
4949 if (! NILP (parent))
4950 CHECK_NUMBER (parent);
4951
4952 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
4953 /* No need to protect DISPLAY because that's not used after passing
4954 it to make_frame_without_minibuffer. */
4955 frame = Qnil;
4956 tem = x_get_arg (dpyinfo, parameters, Qminibuffer, "minibuffer", "Minibuffer",
4957 RES_TYPE_SYMBOL);
4958 if (EQ (tem, Qnone) || NILP (tem))
4959 f = make_frame_without_minibuffer (Qnil, kb, display);
4960 else if (EQ (tem, Qonly))
4961 {
4962 f = make_minibuffer_frame ();
4963 minibuffer_only = true;
4964 }
4965 else if (WINDOWP (tem))
4966 f = make_frame_without_minibuffer (tem, kb, display);
4967 else
4968 f = make_frame (true);
4969
4970 XSETFRAME (frame, f);
4971
4972 /* By default, make scrollbars the system standard width and height. */
4973 FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = GetSystemMetrics (SM_CXVSCROLL);
4974 FRAME_CONFIG_SCROLL_BAR_HEIGHT (f) = GetSystemMetrics (SM_CXHSCROLL);
4975
4976 f->terminal = dpyinfo->terminal;
4977
4978 f->output_method = output_w32;
4979 f->output_data.w32 = xzalloc (sizeof (struct w32_output));
4980 FRAME_FONTSET (f) = -1;
4981
4982 fset_icon_name
4983 (f, x_get_arg (dpyinfo, parameters, Qicon_name, "iconName", "Title",
4984 RES_TYPE_STRING));
4985 if (! STRINGP (f->icon_name))
4986 fset_icon_name (f, Qnil);
4987
4988 /* FRAME_DISPLAY_INFO (f) = dpyinfo; */
4989
4990 /* With FRAME_DISPLAY_INFO set up, this unwind-protect is safe. */
4991 record_unwind_protect (do_unwind_create_frame, frame);
4992
4993 #ifdef GLYPH_DEBUG
4994 image_cache_refcount =
4995 FRAME_IMAGE_CACHE (f) ? FRAME_IMAGE_CACHE (f)->refcount : 0;
4996 dpyinfo_refcount = dpyinfo->reference_count;
4997 #endif /* GLYPH_DEBUG */
4998
4999 /* Specify the parent under which to make this window. */
5000 if (!NILP (parent))
5001 {
5002 /* Cast to UINT_PTR shuts up compiler warnings about cast to
5003 pointer from integer of different size. */
5004 f->output_data.w32->parent_desc = (Window) (UINT_PTR) XFASTINT (parent);
5005 f->output_data.w32->explicit_parent = true;
5006 }
5007 else
5008 {
5009 f->output_data.w32->parent_desc = FRAME_DISPLAY_INFO (f)->root_window;
5010 f->output_data.w32->explicit_parent = false;
5011 }
5012
5013 /* Set the name; the functions to which we pass f expect the name to
5014 be set. */
5015 if (EQ (name, Qunbound) || NILP (name))
5016 {
5017 fset_name (f, build_string (dpyinfo->w32_id_name));
5018 f->explicit_name = false;
5019 }
5020 else
5021 {
5022 fset_name (f, name);
5023 f->explicit_name = true;
5024 /* Use the frame's title when getting resources for this frame. */
5025 specbind (Qx_resource_name, name);
5026 }
5027
5028 if (uniscribe_available)
5029 register_font_driver (&uniscribe_font_driver, f);
5030 register_font_driver (&w32font_driver, f);
5031
5032 x_default_parameter (f, parameters, Qfont_backend, Qnil,
5033 "fontBackend", "FontBackend", RES_TYPE_STRING);
5034
5035 /* Extract the window parameters from the supplied values
5036 that are needed to determine window geometry. */
5037 x_default_font_parameter (f, parameters);
5038
5039 x_default_parameter (f, parameters, Qborder_width, make_number (2),
5040 "borderWidth", "BorderWidth", RES_TYPE_NUMBER);
5041
5042 /* We recognize either internalBorderWidth or internalBorder
5043 (which is what xterm calls it). */
5044 if (NILP (Fassq (Qinternal_border_width, parameters)))
5045 {
5046 Lisp_Object value;
5047
5048 value = x_get_arg (dpyinfo, parameters, Qinternal_border_width,
5049 "internalBorder", "InternalBorder", RES_TYPE_NUMBER);
5050 if (! EQ (value, Qunbound))
5051 parameters = Fcons (Fcons (Qinternal_border_width, value),
5052 parameters);
5053 }
5054 /* Default internalBorderWidth to 0 on Windows to match other programs. */
5055 x_default_parameter (f, parameters, Qinternal_border_width, make_number (0),
5056 "internalBorderWidth", "InternalBorder", RES_TYPE_NUMBER);
5057 x_default_parameter (f, parameters, Qright_divider_width, make_number (0),
5058 NULL, NULL, RES_TYPE_NUMBER);
5059 x_default_parameter (f, parameters, Qbottom_divider_width, make_number (0),
5060 NULL, NULL, RES_TYPE_NUMBER);
5061 x_default_parameter (f, parameters, Qvertical_scroll_bars, Qright,
5062 "verticalScrollBars", "ScrollBars", RES_TYPE_SYMBOL);
5063 x_default_parameter (f, parameters, Qhorizontal_scroll_bars, Qnil,
5064 "horizontalScrollBars", "ScrollBars", RES_TYPE_SYMBOL);
5065
5066 /* Also do the stuff which must be set before the window exists. */
5067 x_default_parameter (f, parameters, Qforeground_color, build_string ("black"),
5068 "foreground", "Foreground", RES_TYPE_STRING);
5069 x_default_parameter (f, parameters, Qbackground_color, build_string ("white"),
5070 "background", "Background", RES_TYPE_STRING);
5071 x_default_parameter (f, parameters, Qmouse_color, build_string ("black"),
5072 "pointerColor", "Foreground", RES_TYPE_STRING);
5073 x_default_parameter (f, parameters, Qborder_color, build_string ("black"),
5074 "borderColor", "BorderColor", RES_TYPE_STRING);
5075 x_default_parameter (f, parameters, Qscreen_gamma, Qnil,
5076 "screenGamma", "ScreenGamma", RES_TYPE_FLOAT);
5077 x_default_parameter (f, parameters, Qline_spacing, Qnil,
5078 "lineSpacing", "LineSpacing", RES_TYPE_NUMBER);
5079 x_default_parameter (f, parameters, Qleft_fringe, Qnil,
5080 "leftFringe", "LeftFringe", RES_TYPE_NUMBER);
5081 x_default_parameter (f, parameters, Qright_fringe, Qnil,
5082 "rightFringe", "RightFringe", RES_TYPE_NUMBER);
5083 /* Process alpha here (Bug#16619). */
5084 x_default_parameter (f, parameters, Qalpha, Qnil,
5085 "alpha", "Alpha", RES_TYPE_NUMBER);
5086
5087 /* Init faces first since we need the frame's column width/line
5088 height in various occasions. */
5089 init_frame_faces (f);
5090
5091 /* The following call of change_frame_size is needed since otherwise
5092 x_set_tool_bar_lines will already work with the character sizes
5093 installed by init_frame_faces while the frame's pixel size is
5094 still calculated from a character size of 1 and we subsequently
5095 hit the (height >= 0) assertion in window_box_height.
5096
5097 The non-pixelwise code apparently worked around this because it
5098 had one frame line vs one toolbar line which left us with a zero
5099 root window height which was obviously wrong as well ... */
5100 adjust_frame_size (f, FRAME_COLS (f) * FRAME_COLUMN_WIDTH (f),
5101 FRAME_LINES (f) * FRAME_LINE_HEIGHT (f), 5, true,
5102 Qx_create_frame_1);
5103
5104 /* The X resources controlling the menu-bar and tool-bar are
5105 processed specially at startup, and reflected in the mode
5106 variables; ignore them here. */
5107 x_default_parameter (f, parameters, Qmenu_bar_lines,
5108 NILP (Vmenu_bar_mode)
5109 ? make_number (0) : make_number (1),
5110 NULL, NULL, RES_TYPE_NUMBER);
5111 x_default_parameter (f, parameters, Qtool_bar_lines,
5112 NILP (Vtool_bar_mode)
5113 ? make_number (0) : make_number (1),
5114 NULL, NULL, RES_TYPE_NUMBER);
5115
5116 x_default_parameter (f, parameters, Qbuffer_predicate, Qnil,
5117 "bufferPredicate", "BufferPredicate", RES_TYPE_SYMBOL);
5118 x_default_parameter (f, parameters, Qtitle, Qnil,
5119 "title", "Title", RES_TYPE_STRING);
5120
5121 f->output_data.w32->dwStyle = WS_OVERLAPPEDWINDOW;
5122 f->output_data.w32->parent_desc = FRAME_DISPLAY_INFO (f)->root_window;
5123
5124 f->output_data.w32->text_cursor = w32_load_cursor (IDC_IBEAM);
5125 f->output_data.w32->nontext_cursor = w32_load_cursor (IDC_ARROW);
5126 f->output_data.w32->modeline_cursor = w32_load_cursor (IDC_ARROW);
5127 f->output_data.w32->hand_cursor = w32_load_cursor (IDC_HAND);
5128 f->output_data.w32->hourglass_cursor = w32_load_cursor (IDC_WAIT);
5129 f->output_data.w32->horizontal_drag_cursor = w32_load_cursor (IDC_SIZEWE);
5130 f->output_data.w32->vertical_drag_cursor = w32_load_cursor (IDC_SIZENS);
5131
5132 f->output_data.w32->current_cursor = f->output_data.w32->nontext_cursor;
5133
5134 window_prompting = x_figure_window_size (f, parameters, true, &x_width, &x_height);
5135
5136 tem = x_get_arg (dpyinfo, parameters, Qunsplittable, 0, 0, RES_TYPE_BOOLEAN);
5137 f->no_split = minibuffer_only || EQ (tem, Qt);
5138
5139 w32_window (f, window_prompting, minibuffer_only);
5140 x_icon (f, parameters);
5141
5142 x_make_gc (f);
5143
5144 /* Now consider the frame official. */
5145 f->terminal->reference_count++;
5146 FRAME_DISPLAY_INFO (f)->reference_count++;
5147 Vframe_list = Fcons (frame, Vframe_list);
5148
5149 /* We need to do this after creating the window, so that the
5150 icon-creation functions can say whose icon they're describing. */
5151 x_default_parameter (f, parameters, Qicon_type, Qnil,
5152 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL);
5153
5154 x_default_parameter (f, parameters, Qauto_raise, Qnil,
5155 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN);
5156 x_default_parameter (f, parameters, Qauto_lower, Qnil,
5157 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN);
5158 x_default_parameter (f, parameters, Qcursor_type, Qbox,
5159 "cursorType", "CursorType", RES_TYPE_SYMBOL);
5160 x_default_parameter (f, parameters, Qscroll_bar_width, Qnil,
5161 "scrollBarWidth", "ScrollBarWidth", RES_TYPE_NUMBER);
5162 x_default_parameter (f, parameters, Qscroll_bar_height, Qnil,
5163 "scrollBarHeight", "ScrollBarHeight", RES_TYPE_NUMBER);
5164
5165 /* Allow x_set_window_size, now. */
5166 f->can_x_set_window_size = true;
5167
5168 if (x_width > 0)
5169 SET_FRAME_WIDTH (f, x_width);
5170 if (x_height > 0)
5171 SET_FRAME_HEIGHT (f, x_height);
5172
5173 /* Tell the server what size and position, etc, we want, and how
5174 badly we want them. This should be done after we have the menu
5175 bar so that its size can be taken into account. */
5176 block_input ();
5177 x_wm_set_size_hint (f, window_prompting, false);
5178 unblock_input ();
5179
5180 adjust_frame_size (f, FRAME_TEXT_WIDTH (f), FRAME_TEXT_HEIGHT (f), 0, true,
5181 Qx_create_frame_2);
5182
5183 /* Process fullscreen parameter here in the hope that normalizing a
5184 fullheight/fullwidth frame will produce the size set by the last
5185 adjust_frame_size call. */
5186 x_default_parameter (f, parameters, Qfullscreen, Qnil,
5187 "fullscreen", "Fullscreen", RES_TYPE_SYMBOL);
5188
5189 /* Make the window appear on the frame and enable display, unless
5190 the caller says not to. However, with explicit parent, Emacs
5191 cannot control visibility, so don't try. */
5192 if (! f->output_data.w32->explicit_parent)
5193 {
5194 Lisp_Object visibility;
5195
5196 visibility = x_get_arg (dpyinfo, parameters, Qvisibility, 0, 0, RES_TYPE_SYMBOL);
5197 if (EQ (visibility, Qunbound))
5198 visibility = Qt;
5199
5200 if (EQ (visibility, Qicon))
5201 x_iconify_frame (f);
5202 else if (! NILP (visibility))
5203 x_make_frame_visible (f);
5204 else
5205 /* Must have been Qnil. */
5206 ;
5207 }
5208
5209 /* Initialize `default-minibuffer-frame' in case this is the first
5210 frame on this terminal. */
5211 if (FRAME_HAS_MINIBUF_P (f)
5212 && (!FRAMEP (KVAR (kb, Vdefault_minibuffer_frame))
5213 || !FRAME_LIVE_P (XFRAME (KVAR (kb, Vdefault_minibuffer_frame)))))
5214 kset_default_minibuffer_frame (kb, frame);
5215
5216 /* All remaining specified parameters, which have not been "used"
5217 by x_get_arg and friends, now go in the misc. alist of the frame. */
5218 for (tem = parameters; CONSP (tem); tem = XCDR (tem))
5219 if (CONSP (XCAR (tem)) && !NILP (XCAR (XCAR (tem))))
5220 fset_param_alist (f, Fcons (XCAR (tem), f->param_alist));
5221
5222 /* Make sure windows on this frame appear in calls to next-window
5223 and similar functions. */
5224 Vwindow_list = Qnil;
5225
5226 return unbind_to (count, frame);
5227 }
5228
5229 /* FRAME is used only to get a handle on the X display. We don't pass the
5230 display info directly because we're called from frame.c, which doesn't
5231 know about that structure. */
5232 Lisp_Object
5233 x_get_focus_frame (struct frame *frame)
5234 {
5235 struct w32_display_info *dpyinfo = FRAME_DISPLAY_INFO (frame);
5236 Lisp_Object xfocus;
5237 if (! dpyinfo->w32_focus_frame)
5238 return Qnil;
5239
5240 XSETFRAME (xfocus, dpyinfo->w32_focus_frame);
5241 return xfocus;
5242 }
5243
5244 DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1, 2, 0,
5245 doc: /* Internal function called by `color-defined-p', which see.
5246 \(Note that the Nextstep version of this function ignores FRAME.) */)
5247 (Lisp_Object color, Lisp_Object frame)
5248 {
5249 XColor foo;
5250 struct frame *f = decode_window_system_frame (frame);
5251
5252 CHECK_STRING (color);
5253
5254 if (w32_defined_color (f, SSDATA (color), &foo, false))
5255 return Qt;
5256 else
5257 return Qnil;
5258 }
5259
5260 DEFUN ("xw-color-values", Fxw_color_values, Sxw_color_values, 1, 2, 0,
5261 doc: /* Internal function called by `color-values', which see. */)
5262 (Lisp_Object color, Lisp_Object frame)
5263 {
5264 XColor foo;
5265 struct frame *f = decode_window_system_frame (frame);
5266
5267 CHECK_STRING (color);
5268
5269 if (w32_defined_color (f, SSDATA (color), &foo, false))
5270 return list3i ((GetRValue (foo.pixel) << 8) | GetRValue (foo.pixel),
5271 (GetGValue (foo.pixel) << 8) | GetGValue (foo.pixel),
5272 (GetBValue (foo.pixel) << 8) | GetBValue (foo.pixel));
5273 else
5274 return Qnil;
5275 }
5276
5277 DEFUN ("xw-display-color-p", Fxw_display_color_p, Sxw_display_color_p, 0, 1, 0,
5278 doc: /* Internal function called by `display-color-p', which see. */)
5279 (Lisp_Object display)
5280 {
5281 struct w32_display_info *dpyinfo = check_x_display_info (display);
5282
5283 if ((dpyinfo->n_planes * dpyinfo->n_cbits) <= 2)
5284 return Qnil;
5285
5286 return Qt;
5287 }
5288
5289 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p,
5290 Sx_display_grayscale_p, 0, 1, 0,
5291 doc: /* Return t if DISPLAY supports shades of gray.
5292 Note that color displays do support shades of gray.
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. */)
5296 (Lisp_Object display)
5297 {
5298 struct w32_display_info *dpyinfo = check_x_display_info (display);
5299
5300 if ((dpyinfo->n_planes * dpyinfo->n_cbits) <= 1)
5301 return Qnil;
5302
5303 return Qt;
5304 }
5305
5306 DEFUN ("x-display-pixel-width", Fx_display_pixel_width,
5307 Sx_display_pixel_width, 0, 1, 0,
5308 doc: /* Return the width in pixels of DISPLAY.
5309 The optional argument DISPLAY specifies which display to ask about.
5310 DISPLAY should be either a frame or a display name (a string).
5311 If omitted or nil, that stands for the selected frame's display.
5312
5313 On \"multi-monitor\" setups this refers to the pixel width for all
5314 physical monitors associated with DISPLAY. To get information for
5315 each physical monitor, use `display-monitor-attributes-list'. */)
5316 (Lisp_Object display)
5317 {
5318 struct w32_display_info *dpyinfo = check_x_display_info (display);
5319
5320 return make_number (x_display_pixel_width (dpyinfo));
5321 }
5322
5323 DEFUN ("x-display-pixel-height", Fx_display_pixel_height,
5324 Sx_display_pixel_height, 0, 1, 0,
5325 doc: /* Return the height in pixels of DISPLAY.
5326 The optional argument DISPLAY specifies which display to ask about.
5327 DISPLAY should be either a frame or a display name (a string).
5328 If omitted or nil, that stands for the selected frame's display.
5329
5330 On \"multi-monitor\" setups this refers to the pixel height for all
5331 physical monitors associated with DISPLAY. To get information for
5332 each physical monitor, use `display-monitor-attributes-list'. */)
5333 (Lisp_Object display)
5334 {
5335 struct w32_display_info *dpyinfo = check_x_display_info (display);
5336
5337 return make_number (x_display_pixel_height (dpyinfo));
5338 }
5339
5340 DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes,
5341 0, 1, 0,
5342 doc: /* Return the number of bitplanes of DISPLAY.
5343 The optional argument DISPLAY specifies which display to ask about.
5344 DISPLAY should be either a frame or a display name (a string).
5345 If omitted or nil, that stands for the selected frame's display. */)
5346 (Lisp_Object display)
5347 {
5348 struct w32_display_info *dpyinfo = check_x_display_info (display);
5349
5350 return make_number (dpyinfo->n_planes * dpyinfo->n_cbits);
5351 }
5352
5353 DEFUN ("x-display-color-cells", Fx_display_color_cells, Sx_display_color_cells,
5354 0, 1, 0,
5355 doc: /* Return the number of color cells of DISPLAY.
5356 The optional argument DISPLAY specifies which display to ask about.
5357 DISPLAY should be either a frame or a display name (a string).
5358 If omitted or nil, that stands for the selected frame's display. */)
5359 (Lisp_Object display)
5360 {
5361 struct w32_display_info *dpyinfo = check_x_display_info (display);
5362 int cap;
5363
5364 /* Don't use NCOLORS: it returns incorrect results under remote
5365 * desktop. We force 24+ bit depths to 24-bit, both to prevent an
5366 * overflow and because probably is more meaningful on Windows
5367 * anyway. */
5368
5369 cap = 1 << min (dpyinfo->n_planes * dpyinfo->n_cbits, 24);
5370 return make_number (cap);
5371 }
5372
5373 DEFUN ("x-server-max-request-size", Fx_server_max_request_size,
5374 Sx_server_max_request_size,
5375 0, 1, 0,
5376 doc: /* Return the maximum request size of the server of DISPLAY.
5377 The optional argument DISPLAY specifies which display to ask about.
5378 DISPLAY should be either a frame or a display name (a string).
5379 If omitted or nil, that stands for the selected frame's display. */)
5380 (Lisp_Object display)
5381 {
5382 return make_number (1);
5383 }
5384
5385 DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0,
5386 doc: /* Return the "vendor ID" string of the GUI software on TERMINAL.
5387
5388 \(Labeling every distributor as a "vendor" embodies the false assumption
5389 that operating systems cannot be developed and distributed noncommercially.)
5390
5391 For GNU and Unix systems, this queries the X server software; for
5392 MS-Windows, this queries the OS.
5393
5394 The optional argument TERMINAL specifies which display to ask about.
5395 TERMINAL should be a terminal object, a frame or a display name (a string).
5396 If omitted or nil, that stands for the selected frame's display. */)
5397 (Lisp_Object terminal)
5398 {
5399 return build_string ("Microsoft Corp.");
5400 }
5401
5402 DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0,
5403 doc: /* Return the version numbers of the GUI software on TERMINAL.
5404 The value is a list of three integers specifying the version of the GUI
5405 software in use.
5406
5407 For GNU and Unix system, the first 2 numbers are the version of the X
5408 Protocol used on TERMINAL and the 3rd number is the distributor-specific
5409 release number. For MS-Windows, the 3 numbers report the version and
5410 the build number of the OS.
5411
5412 See also the function `x-server-vendor'.
5413
5414 The optional argument TERMINAL specifies which display to ask about.
5415 TERMINAL should be a terminal object, a frame or a display name (a string).
5416 If omitted or nil, that stands for the selected frame's display. */)
5417 (Lisp_Object terminal)
5418 {
5419 return list3i (w32_major_version, w32_minor_version, w32_build_number);
5420 }
5421
5422 DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0,
5423 doc: /* Return the number of screens on the server of DISPLAY.
5424 The optional argument DISPLAY specifies which display to ask about.
5425 DISPLAY should be either a frame or a display name (a string).
5426 If omitted or nil, that stands for the selected frame's display. */)
5427 (Lisp_Object display)
5428 {
5429 return make_number (1);
5430 }
5431
5432 DEFUN ("x-display-mm-height", Fx_display_mm_height,
5433 Sx_display_mm_height, 0, 1, 0,
5434 doc: /* Return the height in millimeters of DISPLAY.
5435 The optional argument DISPLAY specifies which display to ask about.
5436 DISPLAY should be either a frame or a display name (a string).
5437 If omitted or nil, that stands for the selected frame's display.
5438
5439 On \"multi-monitor\" setups this refers to the height in millimeters for
5440 all physical monitors associated with DISPLAY. To get information
5441 for each physical monitor, use `display-monitor-attributes-list'. */)
5442 (Lisp_Object display)
5443 {
5444 struct w32_display_info *dpyinfo = check_x_display_info (display);
5445 HDC hdc;
5446 double mm_per_pixel;
5447
5448 hdc = GetDC (NULL);
5449 mm_per_pixel = ((double) GetDeviceCaps (hdc, VERTSIZE)
5450 / GetDeviceCaps (hdc, VERTRES));
5451 ReleaseDC (NULL, hdc);
5452
5453 return make_number (x_display_pixel_height (dpyinfo) * mm_per_pixel + 0.5);
5454 }
5455
5456 DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0,
5457 doc: /* Return the width in millimeters of DISPLAY.
5458 The optional argument DISPLAY specifies which display to ask about.
5459 DISPLAY should be either a frame or a display name (a string).
5460 If omitted or nil, that stands for the selected frame's display.
5461
5462 On \"multi-monitor\" setups this refers to the width in millimeters for
5463 all physical monitors associated with TERMINAL. To get information
5464 for each physical monitor, use `display-monitor-attributes-list'. */)
5465 (Lisp_Object display)
5466 {
5467 struct w32_display_info *dpyinfo = check_x_display_info (display);
5468 HDC hdc;
5469 double mm_per_pixel;
5470
5471 hdc = GetDC (NULL);
5472 mm_per_pixel = ((double) GetDeviceCaps (hdc, HORZSIZE)
5473 / GetDeviceCaps (hdc, HORZRES));
5474 ReleaseDC (NULL, hdc);
5475
5476 return make_number (x_display_pixel_width (dpyinfo) * mm_per_pixel + 0.5);
5477 }
5478
5479 DEFUN ("x-display-backing-store", Fx_display_backing_store,
5480 Sx_display_backing_store, 0, 1, 0,
5481 doc: /* Return an indication of whether DISPLAY does backing store.
5482 The value may be `always', `when-mapped', or `not-useful'.
5483 The optional argument DISPLAY specifies which display to ask about.
5484 DISPLAY should be either a frame or a display name (a string).
5485 If omitted or nil, that stands for the selected frame's display. */)
5486 (Lisp_Object display)
5487 {
5488 return intern ("not-useful");
5489 }
5490
5491 DEFUN ("x-display-visual-class", Fx_display_visual_class,
5492 Sx_display_visual_class, 0, 1, 0,
5493 doc: /* Return the visual class of DISPLAY.
5494 The value is one of the symbols `static-gray', `gray-scale',
5495 `static-color', `pseudo-color', `true-color', or `direct-color'.
5496
5497 The optional argument DISPLAY specifies which display to ask about.
5498 DISPLAY should be either a frame or a display name (a string).
5499 If omitted or nil, that stands for the selected frame's display. */)
5500 (Lisp_Object display)
5501 {
5502 struct w32_display_info *dpyinfo = check_x_display_info (display);
5503 Lisp_Object result = Qnil;
5504
5505 if (dpyinfo->has_palette)
5506 result = intern ("pseudo-color");
5507 else if (dpyinfo->n_planes * dpyinfo->n_cbits == 1)
5508 result = intern ("static-grey");
5509 else if (dpyinfo->n_planes * dpyinfo->n_cbits == 4)
5510 result = intern ("static-color");
5511 else if (dpyinfo->n_planes * dpyinfo->n_cbits > 8)
5512 result = intern ("true-color");
5513
5514 return result;
5515 }
5516
5517 DEFUN ("x-display-save-under", Fx_display_save_under,
5518 Sx_display_save_under, 0, 1, 0,
5519 doc: /* Return t if DISPLAY supports the save-under feature.
5520 The optional argument DISPLAY specifies which display to ask about.
5521 DISPLAY should be either a frame or a display name (a string).
5522 If omitted or nil, that stands for the selected frame's display. */)
5523 (Lisp_Object display)
5524 {
5525 return Qnil;
5526 }
5527
5528 static BOOL CALLBACK ALIGN_STACK
5529 w32_monitor_enum (HMONITOR monitor, HDC hdc, RECT *rcMonitor, LPARAM dwData)
5530 {
5531 Lisp_Object *monitor_list = (Lisp_Object *) dwData;
5532
5533 *monitor_list = Fcons (make_save_ptr (monitor), *monitor_list);
5534
5535 return TRUE;
5536 }
5537
5538 static Lisp_Object
5539 w32_display_monitor_attributes_list (void)
5540 {
5541 Lisp_Object attributes_list = Qnil, primary_monitor_attributes = Qnil;
5542 Lisp_Object monitor_list = Qnil, monitor_frames, rest, frame;
5543 int i, n_monitors;
5544 HMONITOR *monitors;
5545
5546 if (!(enum_display_monitors_fn && get_monitor_info_fn
5547 && monitor_from_window_fn))
5548 return Qnil;
5549
5550 if (!enum_display_monitors_fn (NULL, NULL, w32_monitor_enum,
5551 (LPARAM) &monitor_list)
5552 || NILP (monitor_list))
5553 return Qnil;
5554
5555 n_monitors = 0;
5556 for (rest = monitor_list; CONSP (rest); rest = XCDR (rest))
5557 n_monitors++;
5558
5559 monitors = xmalloc (n_monitors * sizeof (*monitors));
5560 for (i = 0; i < n_monitors; i++)
5561 {
5562 monitors[i] = XSAVE_POINTER (XCAR (monitor_list), 0);
5563 monitor_list = XCDR (monitor_list);
5564 }
5565
5566 monitor_frames = Fmake_vector (make_number (n_monitors), Qnil);
5567 FOR_EACH_FRAME (rest, frame)
5568 {
5569 struct frame *f = XFRAME (frame);
5570
5571 if (FRAME_W32_P (f) && !EQ (frame, tip_frame))
5572 {
5573 HMONITOR monitor =
5574 monitor_from_window_fn (FRAME_W32_WINDOW (f),
5575 MONITOR_DEFAULT_TO_NEAREST);
5576
5577 for (i = 0; i < n_monitors; i++)
5578 if (monitors[i] == monitor)
5579 break;
5580
5581 if (i < n_monitors)
5582 ASET (monitor_frames, i, Fcons (frame, AREF (monitor_frames, i)));
5583 }
5584 }
5585
5586 for (i = 0; i < n_monitors; i++)
5587 {
5588 Lisp_Object geometry, workarea, name, attributes = Qnil;
5589 HDC hdc;
5590 int width_mm, height_mm;
5591 struct MONITOR_INFO_EX mi;
5592
5593 mi.cbSize = sizeof (mi);
5594 if (!get_monitor_info_fn (monitors[i], (struct MONITOR_INFO *) &mi))
5595 continue;
5596
5597 hdc = CreateDCA ("DISPLAY", mi.szDevice, NULL, NULL);
5598 if (hdc == NULL)
5599 continue;
5600 width_mm = GetDeviceCaps (hdc, HORZSIZE);
5601 height_mm = GetDeviceCaps (hdc, VERTSIZE);
5602 DeleteDC (hdc);
5603
5604 attributes = Fcons (Fcons (Qframes, AREF (monitor_frames, i)),
5605 attributes);
5606
5607 name = DECODE_SYSTEM (build_unibyte_string (mi.szDevice));
5608
5609 attributes = Fcons (Fcons (Qname, name), attributes);
5610
5611 attributes = Fcons (Fcons (Qmm_size, list2i (width_mm, height_mm)),
5612 attributes);
5613
5614 workarea = list4i (mi.rcWork.left, mi.rcWork.top,
5615 mi.rcWork.right - mi.rcWork.left,
5616 mi.rcWork.bottom - mi.rcWork.top);
5617 attributes = Fcons (Fcons (Qworkarea, workarea), attributes);
5618
5619 geometry = list4i (mi.rcMonitor.left, mi.rcMonitor.top,
5620 mi.rcMonitor.right - mi.rcMonitor.left,
5621 mi.rcMonitor.bottom - mi.rcMonitor.top);
5622 attributes = Fcons (Fcons (Qgeometry, geometry), attributes);
5623
5624 if (mi.dwFlags & MONITORINFOF_PRIMARY)
5625 primary_monitor_attributes = attributes;
5626 else
5627 attributes_list = Fcons (attributes, attributes_list);
5628 }
5629
5630 if (!NILP (primary_monitor_attributes))
5631 attributes_list = Fcons (primary_monitor_attributes, attributes_list);
5632
5633 xfree (monitors);
5634
5635 return attributes_list;
5636 }
5637
5638 static Lisp_Object
5639 w32_display_monitor_attributes_list_fallback (struct w32_display_info *dpyinfo)
5640 {
5641 Lisp_Object geometry, workarea, frames, rest, frame, attributes = Qnil;
5642 HDC hdc;
5643 double mm_per_pixel;
5644 int pixel_width, pixel_height, width_mm, height_mm;
5645 RECT workarea_rect;
5646
5647 /* Fallback: treat (possibly) multiple physical monitors as if they
5648 formed a single monitor as a whole. This should provide a
5649 consistent result at least on single monitor environments. */
5650 attributes = Fcons (Fcons (Qname, build_string ("combined screen")),
5651 attributes);
5652
5653 frames = Qnil;
5654 FOR_EACH_FRAME (rest, frame)
5655 {
5656 struct frame *f = XFRAME (frame);
5657
5658 if (FRAME_W32_P (f) && !EQ (frame, tip_frame))
5659 frames = Fcons (frame, frames);
5660 }
5661 attributes = Fcons (Fcons (Qframes, frames), attributes);
5662
5663 pixel_width = x_display_pixel_width (dpyinfo);
5664 pixel_height = x_display_pixel_height (dpyinfo);
5665
5666 hdc = GetDC (NULL);
5667 mm_per_pixel = ((double) GetDeviceCaps (hdc, HORZSIZE)
5668 / GetDeviceCaps (hdc, HORZRES));
5669 width_mm = pixel_width * mm_per_pixel + 0.5;
5670 mm_per_pixel = ((double) GetDeviceCaps (hdc, VERTSIZE)
5671 / GetDeviceCaps (hdc, VERTRES));
5672 height_mm = pixel_height * mm_per_pixel + 0.5;
5673 ReleaseDC (NULL, hdc);
5674 attributes = Fcons (Fcons (Qmm_size, list2i (width_mm, height_mm)),
5675 attributes);
5676
5677 /* GetSystemMetrics below may return 0 for Windows 95 or NT 4.0, but
5678 we don't care. */
5679 geometry = list4i (GetSystemMetrics (SM_XVIRTUALSCREEN),
5680 GetSystemMetrics (SM_YVIRTUALSCREEN),
5681 pixel_width, pixel_height);
5682 if (SystemParametersInfo (SPI_GETWORKAREA, 0, &workarea_rect, 0))
5683 workarea = list4i (workarea_rect.left, workarea_rect.top,
5684 workarea_rect.right - workarea_rect.left,
5685 workarea_rect.bottom - workarea_rect.top);
5686 else
5687 workarea = geometry;
5688 attributes = Fcons (Fcons (Qworkarea, workarea), attributes);
5689
5690 attributes = Fcons (Fcons (Qgeometry, geometry), attributes);
5691
5692 return list1 (attributes);
5693 }
5694
5695 DEFUN ("w32-display-monitor-attributes-list", Fw32_display_monitor_attributes_list,
5696 Sw32_display_monitor_attributes_list,
5697 0, 1, 0,
5698 doc: /* Return a list of physical monitor attributes on the W32 display DISPLAY.
5699
5700 The optional argument DISPLAY specifies which display to ask about.
5701 DISPLAY should be either a frame or a display name (a string).
5702 If omitted or nil, that stands for the selected frame's display.
5703
5704 Internal use only, use `display-monitor-attributes-list' instead. */)
5705 (Lisp_Object display)
5706 {
5707 struct w32_display_info *dpyinfo = check_x_display_info (display);
5708 Lisp_Object attributes_list;
5709
5710 block_input ();
5711 attributes_list = w32_display_monitor_attributes_list ();
5712 if (NILP (attributes_list))
5713 attributes_list = w32_display_monitor_attributes_list_fallback (dpyinfo);
5714 unblock_input ();
5715
5716 return attributes_list;
5717 }
5718
5719 DEFUN ("set-message-beep", Fset_message_beep, Sset_message_beep, 1, 1, 0,
5720 doc: /* Set the sound generated when the bell is rung.
5721 SOUND is `asterisk', `exclamation', `hand', `question', `ok', or `silent'
5722 to use the corresponding system sound for the bell. The `silent' sound
5723 prevents Emacs from making any sound at all.
5724 SOUND is nil to use the normal beep. */)
5725 (Lisp_Object sound)
5726 {
5727 CHECK_SYMBOL (sound);
5728
5729 if (NILP (sound))
5730 sound_type = 0xFFFFFFFF;
5731 else if (EQ (sound, intern ("asterisk")))
5732 sound_type = MB_ICONASTERISK;
5733 else if (EQ (sound, intern ("exclamation")))
5734 sound_type = MB_ICONEXCLAMATION;
5735 else if (EQ (sound, intern ("hand")))
5736 sound_type = MB_ICONHAND;
5737 else if (EQ (sound, intern ("question")))
5738 sound_type = MB_ICONQUESTION;
5739 else if (EQ (sound, intern ("ok")))
5740 sound_type = MB_OK;
5741 else if (EQ (sound, intern ("silent")))
5742 sound_type = MB_EMACS_SILENT;
5743 else
5744 sound_type = 0xFFFFFFFF;
5745
5746 return sound;
5747 }
5748
5749 int
5750 x_screen_planes (register struct frame *f)
5751 {
5752 return FRAME_DISPLAY_INFO (f)->n_planes;
5753 }
5754 \f
5755 /* Return the display structure for the display named NAME.
5756 Open a new connection if necessary. */
5757
5758 struct w32_display_info *
5759 x_display_info_for_name (Lisp_Object name)
5760 {
5761 struct w32_display_info *dpyinfo;
5762
5763 CHECK_STRING (name);
5764
5765 for (dpyinfo = &one_w32_display_info; dpyinfo; dpyinfo = dpyinfo->next)
5766 if (!NILP (Fstring_equal (XCAR (dpyinfo->name_list_element), name)))
5767 return dpyinfo;
5768
5769 /* Use this general default value to start with. */
5770 Vx_resource_name = Vinvocation_name;
5771
5772 validate_x_resource_name ();
5773
5774 dpyinfo = w32_term_init (name, NULL, SSDATA (Vx_resource_name));
5775
5776 if (dpyinfo == 0)
5777 error ("Cannot connect to server %s", SDATA (name));
5778
5779 XSETFASTINT (Vwindow_system_version, w32_major_version);
5780
5781 return dpyinfo;
5782 }
5783
5784 DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
5785 1, 3, 0, doc: /* Open a connection to a display server.
5786 DISPLAY is the name of the display to connect to.
5787 Optional second arg XRM-STRING is a string of resources in xrdb format.
5788 If the optional third arg MUST-SUCCEED is non-nil,
5789 terminate Emacs if we can't open the connection.
5790 \(In the Nextstep version, the last two arguments are currently ignored.) */)
5791 (Lisp_Object display, Lisp_Object xrm_string, Lisp_Object must_succeed)
5792 {
5793 char *xrm_option;
5794 struct w32_display_info *dpyinfo;
5795
5796 CHECK_STRING (display);
5797
5798 /* Signal an error in order to encourage correct use from callers.
5799 * If we ever support multiple window systems in the same Emacs,
5800 * we'll need callers to be precise about what window system they
5801 * want. */
5802
5803 if (strcmp (SSDATA (display), "w32") != 0)
5804 error ("The name of the display in this Emacs must be \"w32\"");
5805
5806 /* If initialization has already been done, return now to avoid
5807 overwriting critical parts of one_w32_display_info. */
5808 if (window_system_available (NULL))
5809 return Qnil;
5810
5811 if (! NILP (xrm_string))
5812 CHECK_STRING (xrm_string);
5813
5814 /* Allow color mapping to be defined externally; first look in user's
5815 HOME directory, then in Emacs etc dir for a file called rgb.txt. */
5816 {
5817 Lisp_Object color_file;
5818
5819 color_file = build_string ("~/rgb.txt");
5820
5821 if (NILP (Ffile_readable_p (color_file)))
5822 color_file =
5823 Fexpand_file_name (build_string ("rgb.txt"),
5824 Fsymbol_value (intern ("data-directory")));
5825
5826 Vw32_color_map = Fx_load_color_file (color_file);
5827 }
5828 if (NILP (Vw32_color_map))
5829 Vw32_color_map = w32_default_color_map ();
5830
5831 /* Merge in system logical colors. */
5832 add_system_logical_colors_to_map (&Vw32_color_map);
5833
5834 if (! NILP (xrm_string))
5835 xrm_option = SSDATA (xrm_string);
5836 else
5837 xrm_option = NULL;
5838
5839 /* Use this general default value to start with. */
5840 /* First remove .exe suffix from invocation-name - it looks ugly. */
5841 {
5842 char basename[ MAX_PATH ], *str;
5843
5844 lispstpcpy (basename, Vinvocation_name);
5845 str = strrchr (basename, '.');
5846 if (str) *str = 0;
5847 Vinvocation_name = build_string (basename);
5848 }
5849 Vx_resource_name = Vinvocation_name;
5850
5851 validate_x_resource_name ();
5852
5853 /* This is what opens the connection and sets x_current_display.
5854 This also initializes many symbols, such as those used for input. */
5855 dpyinfo = w32_term_init (display, xrm_option, SSDATA (Vx_resource_name));
5856
5857 if (dpyinfo == 0)
5858 {
5859 if (!NILP (must_succeed))
5860 fatal ("Cannot connect to server %s.\n",
5861 SDATA (display));
5862 else
5863 error ("Cannot connect to server %s", SDATA (display));
5864 }
5865
5866 XSETFASTINT (Vwindow_system_version, w32_major_version);
5867 return Qnil;
5868 }
5869
5870 DEFUN ("x-close-connection", Fx_close_connection,
5871 Sx_close_connection, 1, 1, 0,
5872 doc: /* Close the connection to DISPLAY's server.
5873 For DISPLAY, specify either a frame or a display name (a string).
5874 If DISPLAY is nil, that stands for the selected frame's display. */)
5875 (Lisp_Object display)
5876 {
5877 struct w32_display_info *dpyinfo = check_x_display_info (display);
5878
5879 if (dpyinfo->reference_count > 0)
5880 error ("Display still has frames on it");
5881
5882 block_input ();
5883 x_destroy_all_bitmaps (dpyinfo);
5884
5885 x_delete_display (dpyinfo);
5886 unblock_input ();
5887
5888 return Qnil;
5889 }
5890
5891 DEFUN ("x-display-list", Fx_display_list, Sx_display_list, 0, 0, 0,
5892 doc: /* Return the list of display names that Emacs has connections to. */)
5893 (void)
5894 {
5895 Lisp_Object result = Qnil;
5896 struct w32_display_info *wdi;
5897
5898 for (wdi = x_display_list; wdi; wdi = wdi->next)
5899 result = Fcons (XCAR (wdi->name_list_element), result);
5900
5901 return result;
5902 }
5903
5904 DEFUN ("x-synchronize", Fx_synchronize, Sx_synchronize, 1, 2, 0,
5905 doc: /* If ON is non-nil, report X errors as soon as the erring request is made.
5906 This function only has an effect on X Windows. With MS Windows, it is
5907 defined but does nothing.
5908
5909 If ON is nil, allow buffering of requests.
5910 Turning on synchronization prohibits the Xlib routines from buffering
5911 requests and seriously degrades performance, but makes debugging much
5912 easier.
5913 The optional second argument TERMINAL specifies which display to act on.
5914 TERMINAL should be a terminal object, a frame or a display name (a string).
5915 If TERMINAL is omitted or nil, that stands for the selected frame's display. */)
5916 (Lisp_Object on, Lisp_Object display)
5917 {
5918 return Qnil;
5919 }
5920
5921
5922 \f
5923 /***********************************************************************
5924 Window properties
5925 ***********************************************************************/
5926
5927 #if 0 /* TODO : port window properties to W32 */
5928
5929 DEFUN ("x-change-window-property", Fx_change_window_property,
5930 Sx_change_window_property, 2, 6, 0,
5931 doc: /* Change window property PROP to VALUE on the X window of FRAME.
5932 PROP must be a string. VALUE may be a string or a list of conses,
5933 numbers and/or strings. If an element in the list is a string, it is
5934 converted to an atom and the value of the Atom is used. If an element
5935 is a cons, it is converted to a 32 bit number where the car is the 16
5936 top bits and the cdr is the lower 16 bits.
5937
5938 FRAME nil or omitted means use the selected frame.
5939 If TYPE is given and non-nil, it is the name of the type of VALUE.
5940 If TYPE is not given or nil, the type is STRING.
5941 FORMAT gives the size in bits of each element if VALUE is a list.
5942 It must be one of 8, 16 or 32.
5943 If VALUE is a string or FORMAT is nil or not given, FORMAT defaults to 8.
5944 If OUTER-P is non-nil, the property is changed for the outer X window of
5945 FRAME. Default is to change on the edit X window. */)
5946 (Lisp_Object prop, Lisp_Object value, Lisp_Object frame,
5947 Lisp_Object type, Lisp_Object format, Lisp_Object outer_p)
5948 {
5949 struct frame *f = decode_window_system_frame (frame);
5950 Atom prop_atom;
5951
5952 CHECK_STRING (prop);
5953 CHECK_STRING (value);
5954
5955 block_input ();
5956 prop_atom = XInternAtom (FRAME_W32_DISPLAY (f), SDATA (prop), False);
5957 XChangeProperty (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f),
5958 prop_atom, XA_STRING, 8, PropModeReplace,
5959 SDATA (value), SCHARS (value));
5960
5961 /* Make sure the property is set when we return. */
5962 XFlush (FRAME_W32_DISPLAY (f));
5963 unblock_input ();
5964
5965 return value;
5966 }
5967
5968
5969 DEFUN ("x-delete-window-property", Fx_delete_window_property,
5970 Sx_delete_window_property, 1, 2, 0,
5971 doc: /* Remove window property PROP from X window of FRAME.
5972 FRAME nil or omitted means use the selected frame. Value is PROP. */)
5973 (Lisp_Object prop, Lisp_Object frame)
5974 {
5975 struct frame *f = decode_window_system_frame (frame);
5976 Atom prop_atom;
5977
5978 CHECK_STRING (prop);
5979 block_input ();
5980 prop_atom = XInternAtom (FRAME_W32_DISPLAY (f), SDATA (prop), False);
5981 XDeleteProperty (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f), prop_atom);
5982
5983 /* Make sure the property is removed when we return. */
5984 XFlush (FRAME_W32_DISPLAY (f));
5985 unblock_input ();
5986
5987 return prop;
5988 }
5989
5990
5991 DEFUN ("x-window-property", Fx_window_property, Sx_window_property,
5992 1, 6, 0,
5993 doc: /* Value is the value of window property PROP on FRAME.
5994 If FRAME is nil or omitted, use the selected frame.
5995
5996 On X Windows, the following optional arguments are also accepted:
5997 If TYPE is nil or omitted, get the property as a string.
5998 Otherwise TYPE is the name of the atom that denotes the type expected.
5999 If SOURCE is non-nil, get the property on that window instead of from
6000 FRAME. The number 0 denotes the root window.
6001 If DELETE-P is non-nil, delete the property after retrieving it.
6002 If VECTOR-RET-P is non-nil, don't return a string but a vector of values.
6003
6004 On MS Windows, this function accepts but ignores those optional arguments.
6005
6006 Value is nil if FRAME hasn't a property with name PROP or if PROP has
6007 no value of TYPE (always string in the MS Windows case). */)
6008 (Lisp_Object prop, Lisp_Object frame, Lisp_Object type,
6009 Lisp_Object source, Lisp_Object delete_p, Lisp_Object vector_ret_p)
6010 {
6011 struct frame *f = decode_window_system_frame (frame);
6012 Atom prop_atom;
6013 int rc;
6014 Lisp_Object prop_value = Qnil;
6015 char *tmp_data = NULL;
6016 Atom actual_type;
6017 int actual_format;
6018 unsigned long actual_size, bytes_remaining;
6019
6020 CHECK_STRING (prop);
6021 block_input ();
6022 prop_atom = XInternAtom (FRAME_W32_DISPLAY (f), SDATA (prop), False);
6023 rc = XGetWindowProperty (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f),
6024 prop_atom, 0, 0, False, XA_STRING,
6025 &actual_type, &actual_format, &actual_size,
6026 &bytes_remaining, (unsigned char **) &tmp_data);
6027 if (rc == Success)
6028 {
6029 int size = bytes_remaining;
6030
6031 XFree (tmp_data);
6032 tmp_data = NULL;
6033
6034 rc = XGetWindowProperty (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f),
6035 prop_atom, 0, bytes_remaining,
6036 False, XA_STRING,
6037 &actual_type, &actual_format,
6038 &actual_size, &bytes_remaining,
6039 (unsigned char **) &tmp_data);
6040 if (rc == Success)
6041 prop_value = make_string (tmp_data, size);
6042
6043 XFree (tmp_data);
6044 }
6045
6046 unblock_input ();
6047
6048 return prop_value;
6049
6050 return Qnil;
6051 }
6052
6053 #endif /* TODO */
6054
6055 /***********************************************************************
6056 Tool tips
6057 ***********************************************************************/
6058
6059 static Lisp_Object x_create_tip_frame (struct w32_display_info *,
6060 Lisp_Object, Lisp_Object);
6061 static void compute_tip_xy (struct frame *, Lisp_Object, Lisp_Object,
6062 Lisp_Object, int, int, int *, int *);
6063
6064 /* The frame of a currently visible tooltip. */
6065
6066 Lisp_Object tip_frame;
6067
6068 /* If non-nil, a timer started that hides the last tooltip when it
6069 fires. */
6070
6071 Lisp_Object tip_timer;
6072 Window tip_window;
6073
6074 /* If non-nil, a vector of 3 elements containing the last args
6075 with which x-show-tip was called. See there. */
6076
6077 Lisp_Object last_show_tip_args;
6078
6079
6080 static void
6081 unwind_create_tip_frame (Lisp_Object frame)
6082 {
6083 Lisp_Object deleted;
6084
6085 deleted = unwind_create_frame (frame);
6086 if (EQ (deleted, Qt))
6087 {
6088 tip_window = NULL;
6089 tip_frame = Qnil;
6090 }
6091 }
6092
6093
6094 /* Create a frame for a tooltip on the display described by DPYINFO.
6095 PARMS is a list of frame parameters. TEXT is the string to
6096 display in the tip frame. Value is the frame.
6097
6098 Note that functions called here, esp. x_default_parameter can
6099 signal errors, for instance when a specified color name is
6100 undefined. We have to make sure that we're in a consistent state
6101 when this happens. */
6102
6103 static Lisp_Object
6104 x_create_tip_frame (struct w32_display_info *dpyinfo,
6105 Lisp_Object parms, Lisp_Object text)
6106 {
6107 struct frame *f;
6108 Lisp_Object frame;
6109 Lisp_Object name;
6110 int width, height;
6111 ptrdiff_t count = SPECPDL_INDEX ();
6112 struct kboard *kb;
6113 bool face_change_before = face_change;
6114 Lisp_Object buffer;
6115 struct buffer *old_buffer;
6116 int x_width = 0, x_height = 0;
6117
6118 /* Use this general default value to start with until we know if
6119 this frame has a specified name. */
6120 Vx_resource_name = Vinvocation_name;
6121
6122 kb = dpyinfo->terminal->kboard;
6123
6124 /* The calls to x_get_arg remove elements from PARMS, so copy it to
6125 avoid destructive changes behind our caller's back. */
6126 parms = Fcopy_alist (parms);
6127
6128 /* Get the name of the frame to use for resource lookup. */
6129 name = x_get_arg (dpyinfo, parms, Qname, "name", "Name", RES_TYPE_STRING);
6130 if (!STRINGP (name)
6131 && !EQ (name, Qunbound)
6132 && !NILP (name))
6133 error ("Invalid frame name--not a string or nil");
6134 Vx_resource_name = name;
6135
6136 frame = Qnil;
6137 /* Make a frame without minibuffer nor mode-line. */
6138 f = make_frame (false);
6139 f->wants_modeline = 0;
6140 XSETFRAME (frame, f);
6141
6142 AUTO_STRING (tip, " *tip*");
6143 buffer = Fget_buffer_create (tip);
6144 /* Use set_window_buffer instead of Fset_window_buffer (see
6145 discussion of bug#11984, bug#12025, bug#12026). */
6146 set_window_buffer (FRAME_ROOT_WINDOW (f), buffer, false, false);
6147 old_buffer = current_buffer;
6148 set_buffer_internal_1 (XBUFFER (buffer));
6149 bset_truncate_lines (current_buffer, Qnil);
6150 specbind (Qinhibit_read_only, Qt);
6151 specbind (Qinhibit_modification_hooks, Qt);
6152 Ferase_buffer ();
6153 Finsert (1, &text);
6154 set_buffer_internal_1 (old_buffer);
6155
6156 record_unwind_protect (unwind_create_tip_frame, frame);
6157
6158 /* By setting the output method, we're essentially saying that
6159 the frame is live, as per FRAME_LIVE_P. If we get a signal
6160 from this point on, x_destroy_window might screw up reference
6161 counts etc. */
6162 f->terminal = dpyinfo->terminal;
6163 f->output_method = output_w32;
6164 f->output_data.w32 = xzalloc (sizeof (struct w32_output));
6165
6166 FRAME_FONTSET (f) = -1;
6167 fset_icon_name (f, Qnil);
6168
6169 #ifdef GLYPH_DEBUG
6170 image_cache_refcount =
6171 FRAME_IMAGE_CACHE (f) ? FRAME_IMAGE_CACHE (f)->refcount : 0;
6172 dpyinfo_refcount = dpyinfo->reference_count;
6173 #endif /* GLYPH_DEBUG */
6174 FRAME_KBOARD (f) = kb;
6175 f->output_data.w32->parent_desc = FRAME_DISPLAY_INFO (f)->root_window;
6176 f->output_data.w32->explicit_parent = false;
6177
6178 /* Set the name; the functions to which we pass f expect the name to
6179 be set. */
6180 if (EQ (name, Qunbound) || NILP (name))
6181 {
6182 fset_name (f, build_string (dpyinfo->w32_id_name));
6183 f->explicit_name = false;
6184 }
6185 else
6186 {
6187 fset_name (f, name);
6188 f->explicit_name = true;
6189 /* use the frame's title when getting resources for this frame. */
6190 specbind (Qx_resource_name, name);
6191 }
6192
6193 if (uniscribe_available)
6194 register_font_driver (&uniscribe_font_driver, f);
6195 register_font_driver (&w32font_driver, f);
6196
6197 x_default_parameter (f, parms, Qfont_backend, Qnil,
6198 "fontBackend", "FontBackend", RES_TYPE_STRING);
6199
6200 /* Extract the window parameters from the supplied values
6201 that are needed to determine window geometry. */
6202 x_default_font_parameter (f, parms);
6203
6204 x_default_parameter (f, parms, Qborder_width, make_number (2),
6205 "borderWidth", "BorderWidth", RES_TYPE_NUMBER);
6206 /* This defaults to 2 in order to match xterm. We recognize either
6207 internalBorderWidth or internalBorder (which is what xterm calls
6208 it). */
6209 if (NILP (Fassq (Qinternal_border_width, parms)))
6210 {
6211 Lisp_Object value;
6212
6213 value = x_get_arg (dpyinfo, parms, Qinternal_border_width,
6214 "internalBorder", "internalBorder", RES_TYPE_NUMBER);
6215 if (! EQ (value, Qunbound))
6216 parms = Fcons (Fcons (Qinternal_border_width, value),
6217 parms);
6218 }
6219 x_default_parameter (f, parms, Qinternal_border_width, make_number (1),
6220 "internalBorderWidth", "internalBorderWidth",
6221 RES_TYPE_NUMBER);
6222 x_default_parameter (f, parms, Qright_divider_width, make_number (0),
6223 NULL, NULL, RES_TYPE_NUMBER);
6224 x_default_parameter (f, parms, Qbottom_divider_width, make_number (0),
6225 NULL, NULL, RES_TYPE_NUMBER);
6226
6227 /* Also do the stuff which must be set before the window exists. */
6228 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
6229 "foreground", "Foreground", RES_TYPE_STRING);
6230 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
6231 "background", "Background", RES_TYPE_STRING);
6232 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
6233 "pointerColor", "Foreground", RES_TYPE_STRING);
6234 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
6235 "cursorColor", "Foreground", RES_TYPE_STRING);
6236 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
6237 "borderColor", "BorderColor", RES_TYPE_STRING);
6238
6239 /* Init faces before x_default_parameter is called for the
6240 scroll-bar-width parameter because otherwise we end up in
6241 init_iterator with a null face cache, which should not happen. */
6242 init_frame_faces (f);
6243
6244 f->output_data.w32->dwStyle = WS_BORDER | WS_POPUP | WS_DISABLED;
6245 f->output_data.w32->parent_desc = FRAME_DISPLAY_INFO (f)->root_window;
6246
6247 x_figure_window_size (f, parms, true, &x_width, &x_height);
6248
6249 /* No fringes on tip frame. */
6250 f->fringe_cols = 0;
6251 f->left_fringe_width = 0;
6252 f->right_fringe_width = 0;
6253
6254 block_input ();
6255 my_create_tip_window (f);
6256 unblock_input ();
6257
6258 x_make_gc (f);
6259
6260 x_default_parameter (f, parms, Qauto_raise, Qnil,
6261 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN);
6262 x_default_parameter (f, parms, Qauto_lower, Qnil,
6263 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN);
6264 x_default_parameter (f, parms, Qcursor_type, Qbox,
6265 "cursorType", "CursorType", RES_TYPE_SYMBOL);
6266 /* Process alpha here (Bug#17344). */
6267 x_default_parameter (f, parms, Qalpha, Qnil,
6268 "alpha", "Alpha", RES_TYPE_NUMBER);
6269
6270 /* Dimensions, especially FRAME_LINES (f), must be done via
6271 change_frame_size. Change will not be effected unless different
6272 from the current FRAME_LINES (f). */
6273 width = FRAME_COLS (f);
6274 height = FRAME_LINES (f);
6275 SET_FRAME_COLS (f, 0);
6276 SET_FRAME_LINES (f, 0);
6277 adjust_frame_size (f, width * FRAME_COLUMN_WIDTH (f),
6278 height * FRAME_LINE_HEIGHT (f), 0, true, Qtip_frame);
6279
6280 /* Add `tooltip' frame parameter's default value. */
6281 if (NILP (Fframe_parameter (frame, Qtooltip)))
6282 Fmodify_frame_parameters (frame, Fcons (Fcons (Qtooltip, Qt), Qnil));
6283
6284 /* Set up faces after all frame parameters are known. This call
6285 also merges in face attributes specified for new frames.
6286
6287 Frame parameters may be changed if .Xdefaults contains
6288 specifications for the default font. For example, if there is an
6289 `Emacs.default.attributeBackground: pink', the `background-color'
6290 attribute of the frame get's set, which let's the internal border
6291 of the tooltip frame appear in pink. Prevent this. */
6292 {
6293 Lisp_Object bg = Fframe_parameter (frame, Qbackground_color);
6294 Lisp_Object fg = Fframe_parameter (frame, Qforeground_color);
6295 Lisp_Object colors = Qnil;
6296
6297 /* Set tip_frame here, so that */
6298 tip_frame = frame;
6299 call2 (Qface_set_after_frame_default, frame, Qnil);
6300
6301 if (!EQ (bg, Fframe_parameter (frame, Qbackground_color)))
6302 colors = Fcons (Fcons (Qbackground_color, bg), colors);
6303 if (!EQ (fg, Fframe_parameter (frame, Qforeground_color)))
6304 colors = Fcons (Fcons (Qforeground_color, fg), colors);
6305
6306 if (!NILP (colors))
6307 Fmodify_frame_parameters (frame, colors);
6308 }
6309
6310 f->no_split = true;
6311
6312 /* Now that the frame is official, it counts as a reference to
6313 its display. */
6314 FRAME_DISPLAY_INFO (f)->reference_count++;
6315 f->terminal->reference_count++;
6316
6317 /* It is now ok to make the frame official even if we get an error
6318 below. And the frame needs to be on Vframe_list or making it
6319 visible won't work. */
6320 Vframe_list = Fcons (frame, Vframe_list);
6321 f->can_x_set_window_size = true;
6322
6323 /* Setting attributes of faces of the tooltip frame from resources
6324 and similar will set face_change, which leads to the
6325 clearing of all current matrices. Since this isn't necessary
6326 here, avoid it by resetting face_change to the value it
6327 had before we created the tip frame. */
6328 face_change = face_change_before;
6329
6330 /* Discard the unwind_protect. */
6331 return unbind_to (count, frame);
6332 }
6333
6334
6335 /* Compute where to display tip frame F. PARMS is the list of frame
6336 parameters for F. DX and DY are specified offsets from the current
6337 location of the mouse. WIDTH and HEIGHT are the width and height
6338 of the tooltip. Return coordinates relative to the root window of
6339 the display in *ROOT_X and *ROOT_Y. */
6340
6341 static void
6342 compute_tip_xy (struct frame *f,
6343 Lisp_Object parms, Lisp_Object dx, Lisp_Object dy,
6344 int width, int height, int *root_x, int *root_y)
6345 {
6346 Lisp_Object left, top, right, bottom;
6347 int min_x, min_y, max_x, max_y;
6348
6349 /* User-specified position? */
6350 left = Fcdr (Fassq (Qleft, parms));
6351 top = Fcdr (Fassq (Qtop, parms));
6352 right = Fcdr (Fassq (Qright, parms));
6353 bottom = Fcdr (Fassq (Qbottom, parms));
6354
6355 /* Move the tooltip window where the mouse pointer is. Resize and
6356 show it. */
6357 if ((!INTEGERP (left) && !INTEGERP (right))
6358 || (!INTEGERP (top) && !INTEGERP (bottom)))
6359 {
6360 POINT pt;
6361
6362 /* Default min and max values. */
6363 min_x = 0;
6364 min_y = 0;
6365 max_x = x_display_pixel_width (FRAME_DISPLAY_INFO (f));
6366 max_y = x_display_pixel_height (FRAME_DISPLAY_INFO (f));
6367
6368 block_input ();
6369 GetCursorPos (&pt);
6370 *root_x = pt.x;
6371 *root_y = pt.y;
6372 unblock_input ();
6373
6374 /* If multiple monitor support is available, constrain the tip onto
6375 the current monitor. This improves the above by allowing negative
6376 co-ordinates if monitor positions are such that they are valid, and
6377 snaps a tooltip onto a single monitor if we are close to the edge
6378 where it would otherwise flow onto the other monitor (or into
6379 nothingness if there is a gap in the overlap). */
6380 if (monitor_from_point_fn && get_monitor_info_fn)
6381 {
6382 struct MONITOR_INFO info;
6383 HMONITOR monitor
6384 = monitor_from_point_fn (pt, MONITOR_DEFAULT_TO_NEAREST);
6385 info.cbSize = sizeof (info);
6386
6387 if (get_monitor_info_fn (monitor, &info))
6388 {
6389 min_x = info.rcWork.left;
6390 min_y = info.rcWork.top;
6391 max_x = info.rcWork.right;
6392 max_y = info.rcWork.bottom;
6393 }
6394 }
6395 }
6396
6397 if (INTEGERP (top))
6398 *root_y = XINT (top);
6399 else if (INTEGERP (bottom))
6400 *root_y = XINT (bottom) - height;
6401 else if (*root_y + XINT (dy) <= min_y)
6402 *root_y = min_y; /* Can happen for negative dy */
6403 else if (*root_y + XINT (dy) + height <= max_y)
6404 /* It fits below the pointer */
6405 *root_y += XINT (dy);
6406 else if (height + XINT (dy) + min_y <= *root_y)
6407 /* It fits above the pointer. */
6408 *root_y -= height + XINT (dy);
6409 else
6410 /* Put it on the top. */
6411 *root_y = min_y;
6412
6413 if (INTEGERP (left))
6414 *root_x = XINT (left);
6415 else if (INTEGERP (right))
6416 *root_x = XINT (right) - width;
6417 else if (*root_x + XINT (dx) <= min_x)
6418 *root_x = 0; /* Can happen for negative dx */
6419 else if (*root_x + XINT (dx) + width <= max_x)
6420 /* It fits to the right of the pointer. */
6421 *root_x += XINT (dx);
6422 else if (width + XINT (dx) + min_x <= *root_x)
6423 /* It fits to the left of the pointer. */
6424 *root_x -= width + XINT (dx);
6425 else
6426 /* Put it left justified on the screen -- it ought to fit that way. */
6427 *root_x = min_x;
6428 }
6429
6430
6431 DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0,
6432 doc: /* Show STRING in a \"tooltip\" window on frame FRAME.
6433 A tooltip window is a small window displaying a string.
6434
6435 This is an internal function; Lisp code should call `tooltip-show'.
6436
6437 FRAME nil or omitted means use the selected frame.
6438
6439 PARMS is an optional list of frame parameters which can be
6440 used to change the tooltip's appearance.
6441
6442 Automatically hide the tooltip after TIMEOUT seconds. TIMEOUT nil
6443 means use the default timeout of 5 seconds.
6444
6445 If the list of frame parameters PARMS contains a `left' parameter,
6446 display the tooltip at that x-position. If the list of frame parameters
6447 PARMS contains no `left' but a `right' parameter, display the tooltip
6448 right-adjusted at that x-position. Otherwise display it at the
6449 x-position of the mouse, with offset DX added (default is 5 if DX isn't
6450 specified).
6451
6452 Likewise for the y-position: If a `top' frame parameter is specified, it
6453 determines the position of the upper edge of the tooltip window. If a
6454 `bottom' parameter but no `top' frame parameter is specified, it
6455 determines the position of the lower edge of the tooltip window.
6456 Otherwise display the tooltip window at the y-position of the mouse,
6457 with offset DY added (default is -10).
6458
6459 A tooltip's maximum size is specified by `x-max-tooltip-size'.
6460 Text larger than the specified size is clipped. */)
6461 (Lisp_Object string, Lisp_Object frame, Lisp_Object parms, Lisp_Object timeout, Lisp_Object dx, Lisp_Object dy)
6462 {
6463 struct frame *f;
6464 struct window *w;
6465 int root_x, root_y;
6466 struct buffer *old_buffer;
6467 struct text_pos pos;
6468 int i, width, height;
6469 bool seen_reversed_p;
6470 int old_windows_or_buffers_changed = windows_or_buffers_changed;
6471 ptrdiff_t count = SPECPDL_INDEX ();
6472
6473 specbind (Qinhibit_redisplay, Qt);
6474
6475 CHECK_STRING (string);
6476 f = decode_window_system_frame (frame);
6477 if (NILP (timeout))
6478 timeout = make_number (5);
6479 else
6480 CHECK_NATNUM (timeout);
6481
6482 if (NILP (dx))
6483 dx = make_number (5);
6484 else
6485 CHECK_NUMBER (dx);
6486
6487 if (NILP (dy))
6488 dy = make_number (-10);
6489 else
6490 CHECK_NUMBER (dy);
6491
6492 if (NILP (last_show_tip_args))
6493 last_show_tip_args = Fmake_vector (make_number (3), Qnil);
6494
6495 if (!NILP (tip_frame))
6496 {
6497 Lisp_Object last_string = AREF (last_show_tip_args, 0);
6498 Lisp_Object last_frame = AREF (last_show_tip_args, 1);
6499 Lisp_Object last_parms = AREF (last_show_tip_args, 2);
6500
6501 if (EQ (frame, last_frame)
6502 && !NILP (Fequal (last_string, string))
6503 && !NILP (Fequal (last_parms, parms)))
6504 {
6505 struct frame *f = XFRAME (tip_frame);
6506
6507 /* Only DX and DY have changed. */
6508 if (!NILP (tip_timer))
6509 {
6510 Lisp_Object timer = tip_timer;
6511 tip_timer = Qnil;
6512 call1 (Qcancel_timer, timer);
6513 }
6514
6515 block_input ();
6516 compute_tip_xy (f, parms, dx, dy, FRAME_PIXEL_WIDTH (f),
6517 FRAME_PIXEL_HEIGHT (f), &root_x, &root_y);
6518
6519 /* Put tooltip in topmost group and in position. */
6520 SetWindowPos (FRAME_W32_WINDOW (f), HWND_TOPMOST,
6521 root_x, root_y, 0, 0,
6522 SWP_NOSIZE | SWP_NOACTIVATE | SWP_NOOWNERZORDER);
6523
6524 /* Ensure tooltip is on top of other topmost windows (eg menus). */
6525 SetWindowPos (FRAME_W32_WINDOW (f), HWND_TOP,
6526 0, 0, 0, 0,
6527 SWP_NOMOVE | SWP_NOSIZE
6528 | SWP_NOACTIVATE | SWP_NOOWNERZORDER);
6529
6530 unblock_input ();
6531 goto start_timer;
6532 }
6533 }
6534
6535 /* Hide a previous tip, if any. */
6536 Fx_hide_tip ();
6537
6538 ASET (last_show_tip_args, 0, string);
6539 ASET (last_show_tip_args, 1, frame);
6540 ASET (last_show_tip_args, 2, parms);
6541
6542 /* Add default values to frame parameters. */
6543 if (NILP (Fassq (Qname, parms)))
6544 parms = Fcons (Fcons (Qname, build_string ("tooltip")), parms);
6545 if (NILP (Fassq (Qinternal_border_width, parms)))
6546 parms = Fcons (Fcons (Qinternal_border_width, make_number (3)), parms);
6547 if (NILP (Fassq (Qright_divider_width, parms)))
6548 parms = Fcons (Fcons (Qright_divider_width, make_number (0)), parms);
6549 if (NILP (Fassq (Qbottom_divider_width, parms)))
6550 parms = Fcons (Fcons (Qbottom_divider_width, make_number (0)), parms);
6551 if (NILP (Fassq (Qborder_width, parms)))
6552 parms = Fcons (Fcons (Qborder_width, make_number (1)), parms);
6553 if (NILP (Fassq (Qborder_color, parms)))
6554 parms = Fcons (Fcons (Qborder_color, build_string ("lightyellow")), parms);
6555 if (NILP (Fassq (Qbackground_color, parms)))
6556 parms = Fcons (Fcons (Qbackground_color, build_string ("lightyellow")),
6557 parms);
6558
6559 /* Block input until the tip has been fully drawn, to avoid crashes
6560 when drawing tips in menus. */
6561 block_input ();
6562
6563 /* Create a frame for the tooltip, and record it in the global
6564 variable tip_frame. */
6565 frame = x_create_tip_frame (FRAME_DISPLAY_INFO (f), parms, string);
6566 f = XFRAME (frame);
6567
6568 /* Set up the frame's root window. */
6569 w = XWINDOW (FRAME_ROOT_WINDOW (f));
6570 w->left_col = 0;
6571 w->top_line = 0;
6572 w->pixel_left = 0;
6573 w->pixel_top = 0;
6574
6575 if (CONSP (Vx_max_tooltip_size)
6576 && INTEGERP (XCAR (Vx_max_tooltip_size))
6577 && XINT (XCAR (Vx_max_tooltip_size)) > 0
6578 && INTEGERP (XCDR (Vx_max_tooltip_size))
6579 && XINT (XCDR (Vx_max_tooltip_size)) > 0)
6580 {
6581 w->total_cols = XFASTINT (XCAR (Vx_max_tooltip_size));
6582 w->total_lines = XFASTINT (XCDR (Vx_max_tooltip_size));
6583 }
6584 else
6585 {
6586 w->total_cols = 80;
6587 w->total_lines = 40;
6588 }
6589
6590 w->pixel_width = w->total_cols * FRAME_COLUMN_WIDTH (f);
6591 w->pixel_height = w->total_lines * FRAME_LINE_HEIGHT (f);
6592
6593 FRAME_TOTAL_COLS (f) = WINDOW_TOTAL_COLS (w);
6594 adjust_frame_glyphs (f);
6595 w->pseudo_window_p = true;
6596
6597 /* Display the tooltip text in a temporary buffer. */
6598 old_buffer = current_buffer;
6599 set_buffer_internal_1 (XBUFFER (XWINDOW (FRAME_ROOT_WINDOW (f))->contents));
6600 bset_truncate_lines (current_buffer, Qnil);
6601 clear_glyph_matrix (w->desired_matrix);
6602 clear_glyph_matrix (w->current_matrix);
6603 SET_TEXT_POS (pos, BEGV, BEGV_BYTE);
6604 try_window (FRAME_ROOT_WINDOW (f), pos, TRY_WINDOW_IGNORE_FONTS_CHANGE);
6605
6606 /* Compute width and height of the tooltip. */
6607 width = height = 0;
6608 seen_reversed_p = false;
6609 for (i = 0; i < w->desired_matrix->nrows; ++i)
6610 {
6611 struct glyph_row *row = &w->desired_matrix->rows[i];
6612 struct glyph *last;
6613 int row_width;
6614
6615 /* Stop at the first empty row at the end. */
6616 if (!row->enabled_p || !MATRIX_ROW_DISPLAYS_TEXT_P (row))
6617 break;
6618
6619 /* Let the row go over the full width of the frame. */
6620 row->full_width_p = true;
6621
6622 row_width = row->pixel_width;
6623 if (row->used[TEXT_AREA])
6624 {
6625 if (!row->reversed_p)
6626 {
6627 /* There's a glyph at the end of rows that is used to
6628 place the cursor there. Don't include the width of
6629 this glyph. */
6630 last = &row->glyphs[TEXT_AREA][row->used[TEXT_AREA] - 1];
6631 if (NILP (last->object))
6632 row_width -= last->pixel_width;
6633 }
6634 else
6635 {
6636 /* There could be a stretch glyph at the beginning of R2L
6637 rows that is produced by extend_face_to_end_of_line.
6638 Don't count that glyph. */
6639 struct glyph *g = row->glyphs[TEXT_AREA];
6640
6641 if (g->type == STRETCH_GLYPH && NILP (g->object))
6642 {
6643 row_width -= g->pixel_width;
6644 seen_reversed_p = true;
6645 }
6646 }
6647 }
6648
6649 height += row->height;
6650 width = max (width, row_width);
6651 }
6652
6653 /* If we've seen partial-length R2L rows, we need to re-adjust the
6654 tool-tip frame width and redisplay it again, to avoid over-wide
6655 tips due to the stretch glyph that extends R2L lines to full
6656 width of the frame. */
6657 if (seen_reversed_p)
6658 {
6659 /* PXW: Why do we do the pixel-to-cols conversion only if
6660 seen_reversed_p holds? Don't we have to set other fields of
6661 the window/frame structure?
6662
6663 w->total_cols and FRAME_TOTAL_COLS want the width in columns,
6664 not in pixels. */
6665 w->pixel_width = width;
6666 width /= WINDOW_FRAME_COLUMN_WIDTH (w);
6667 w->total_cols = width;
6668 FRAME_TOTAL_COLS (f) = width;
6669 SET_FRAME_WIDTH (f, width);
6670 adjust_frame_glyphs (f);
6671 w->pseudo_window_p = 1;
6672 clear_glyph_matrix (w->desired_matrix);
6673 clear_glyph_matrix (w->current_matrix);
6674 try_window (FRAME_ROOT_WINDOW (f), pos, TRY_WINDOW_IGNORE_FONTS_CHANGE);
6675 width = height = 0;
6676 /* Recompute width and height of the tooltip. */
6677 for (i = 0; i < w->desired_matrix->nrows; ++i)
6678 {
6679 struct glyph_row *row = &w->desired_matrix->rows[i];
6680 struct glyph *last;
6681 int row_width;
6682
6683 if (!row->enabled_p || !MATRIX_ROW_DISPLAYS_TEXT_P (row))
6684 break;
6685 row->full_width_p = true;
6686 row_width = row->pixel_width;
6687 if (row->used[TEXT_AREA] && !row->reversed_p)
6688 {
6689 last = &row->glyphs[TEXT_AREA][row->used[TEXT_AREA] - 1];
6690 if (NILP (last->object))
6691 row_width -= last->pixel_width;
6692 }
6693
6694 height += row->height;
6695 width = max (width, row_width);
6696 }
6697 }
6698
6699 /* Add the frame's internal border to the width and height the w32
6700 window should have. */
6701 height += 2 * FRAME_INTERNAL_BORDER_WIDTH (f);
6702 width += 2 * FRAME_INTERNAL_BORDER_WIDTH (f);
6703
6704 /* Move the tooltip window where the mouse pointer is. Resize and
6705 show it.
6706
6707 PXW: This should use the frame's pixel coordinates. */
6708 compute_tip_xy (f, parms, dx, dy, width, height, &root_x, &root_y);
6709
6710 {
6711 /* Adjust Window size to take border into account. */
6712 RECT rect;
6713 rect.left = rect.top = 0;
6714 rect.right = width;
6715 rect.bottom = height;
6716 AdjustWindowRect (&rect, f->output_data.w32->dwStyle, false);
6717
6718 /* Position and size tooltip, and put it in the topmost group.
6719 The add-on of FRAME_COLUMN_WIDTH to the 5th argument is a
6720 peculiarity of w32 display: without it, some fonts cause the
6721 last character of the tip to be truncated or wrapped around to
6722 the next line. */
6723 SetWindowPos (FRAME_W32_WINDOW (f), HWND_TOPMOST,
6724 root_x, root_y,
6725 rect.right - rect.left + FRAME_COLUMN_WIDTH (f),
6726 rect.bottom - rect.top, SWP_NOACTIVATE | SWP_NOOWNERZORDER);
6727
6728 /* Ensure tooltip is on top of other topmost windows (eg menus). */
6729 SetWindowPos (FRAME_W32_WINDOW (f), HWND_TOP,
6730 0, 0, 0, 0,
6731 SWP_NOMOVE | SWP_NOSIZE
6732 | SWP_NOACTIVATE | SWP_NOOWNERZORDER);
6733
6734 /* Let redisplay know that we have made the frame visible already. */
6735 SET_FRAME_VISIBLE (f, 1);
6736
6737 ShowWindow (FRAME_W32_WINDOW (f), SW_SHOWNOACTIVATE);
6738 }
6739
6740 /* Draw into the window. */
6741 w->must_be_updated_p = true;
6742 update_single_window (w);
6743
6744 unblock_input ();
6745
6746 /* Restore original current buffer. */
6747 set_buffer_internal_1 (old_buffer);
6748 windows_or_buffers_changed = old_windows_or_buffers_changed;
6749
6750 start_timer:
6751 /* Let the tip disappear after timeout seconds. */
6752 tip_timer = call3 (intern ("run-at-time"), timeout, Qnil,
6753 intern ("x-hide-tip"));
6754
6755 return unbind_to (count, Qnil);
6756 }
6757
6758
6759 DEFUN ("x-hide-tip", Fx_hide_tip, Sx_hide_tip, 0, 0, 0,
6760 doc: /* Hide the current tooltip window, if there is any.
6761 Value is t if tooltip was open, nil otherwise. */)
6762 (void)
6763 {
6764 ptrdiff_t count;
6765 Lisp_Object deleted, frame, timer;
6766
6767 /* Return quickly if nothing to do. */
6768 if (NILP (tip_timer) && NILP (tip_frame))
6769 return Qnil;
6770
6771 frame = tip_frame;
6772 timer = tip_timer;
6773 tip_frame = tip_timer = deleted = Qnil;
6774
6775 count = SPECPDL_INDEX ();
6776 specbind (Qinhibit_redisplay, Qt);
6777 specbind (Qinhibit_quit, Qt);
6778
6779 if (!NILP (timer))
6780 call1 (Qcancel_timer, timer);
6781
6782 if (FRAMEP (frame))
6783 {
6784 delete_frame (frame, Qnil);
6785 deleted = Qt;
6786 }
6787
6788 return unbind_to (count, deleted);
6789 }
6790 \f
6791 /***********************************************************************
6792 File selection dialog
6793 ***********************************************************************/
6794
6795 #define FILE_NAME_TEXT_FIELD edt1
6796 #define FILE_NAME_COMBO_BOX cmb13
6797 #define FILE_NAME_LIST lst1
6798
6799 /* Callback for altering the behavior of the Open File dialog.
6800 Makes the Filename text field contain "Current Directory" and be
6801 read-only when "Directories" is selected in the filter. This
6802 allows us to work around the fact that the standard Open File
6803 dialog does not support directories. */
6804 static UINT_PTR CALLBACK
6805 file_dialog_callback (HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam)
6806 {
6807 if (msg == WM_NOTIFY)
6808 {
6809 OFNOTIFYW * notify_w = (OFNOTIFYW *)lParam;
6810 OFNOTIFYA * notify_a = (OFNOTIFYA *)lParam;
6811 int dropdown_changed;
6812 int dir_index;
6813 #ifdef NTGUI_UNICODE
6814 const int use_unicode = 1;
6815 #else /* !NTGUI_UNICODE */
6816 int use_unicode = w32_unicode_filenames;
6817 #endif /* NTGUI_UNICODE */
6818
6819 /* Detect when the Filter dropdown is changed. */
6820 if (use_unicode)
6821 dropdown_changed =
6822 notify_w->hdr.code == CDN_TYPECHANGE
6823 || notify_w->hdr.code == CDN_INITDONE;
6824 else
6825 dropdown_changed =
6826 notify_a->hdr.code == CDN_TYPECHANGE
6827 || notify_a->hdr.code == CDN_INITDONE;
6828 if (dropdown_changed)
6829 {
6830 HWND dialog = GetParent (hwnd);
6831 HWND edit_control = GetDlgItem (dialog, FILE_NAME_TEXT_FIELD);
6832 HWND list = GetDlgItem (dialog, FILE_NAME_LIST);
6833 int hdr_code;
6834
6835 /* At least on Windows 7, the above attempt to get the window handle
6836 to the File Name Text Field fails. The following code does the
6837 job though. Note that this code is based on my examination of the
6838 window hierarchy using Microsoft Spy++. bk */
6839 if (edit_control == NULL)
6840 {
6841 HWND tmp = GetDlgItem (dialog, FILE_NAME_COMBO_BOX);
6842 if (tmp)
6843 {
6844 tmp = GetWindow (tmp, GW_CHILD);
6845 if (tmp)
6846 edit_control = GetWindow (tmp, GW_CHILD);
6847 }
6848 }
6849
6850 /* Directories is in index 2. */
6851 if (use_unicode)
6852 {
6853 dir_index = notify_w->lpOFN->nFilterIndex;
6854 hdr_code = notify_w->hdr.code;
6855 }
6856 else
6857 {
6858 dir_index = notify_a->lpOFN->nFilterIndex;
6859 hdr_code = notify_a->hdr.code;
6860 }
6861 if (dir_index == 2)
6862 {
6863 if (use_unicode)
6864 SendMessageW (dialog, CDM_SETCONTROLTEXT, FILE_NAME_TEXT_FIELD,
6865 (LPARAM)L"Current Directory");
6866 else
6867 SendMessageA (dialog, CDM_SETCONTROLTEXT, FILE_NAME_TEXT_FIELD,
6868 (LPARAM)"Current Directory");
6869 EnableWindow (edit_control, FALSE);
6870 /* Note that at least on Windows 7, the above call to EnableWindow
6871 disables the window that would ordinarily have focus. If we
6872 do not set focus to some other window here, focus will land in
6873 no man's land and the user will be unable to tab through the
6874 dialog box (pressing tab will only result in a beep).
6875 Avoid that problem by setting focus to the list here. */
6876 if (hdr_code == CDN_INITDONE)
6877 SetFocus (list);
6878 }
6879 else
6880 {
6881 /* Don't override default filename on init done. */
6882 if (hdr_code == CDN_TYPECHANGE)
6883 {
6884 if (use_unicode)
6885 SendMessageW (dialog, CDM_SETCONTROLTEXT,
6886 FILE_NAME_TEXT_FIELD, (LPARAM)L"");
6887 else
6888 SendMessageA (dialog, CDM_SETCONTROLTEXT,
6889 FILE_NAME_TEXT_FIELD, (LPARAM)"");
6890 }
6891 EnableWindow (edit_control, TRUE);
6892 }
6893 }
6894 }
6895 return 0;
6896 }
6897
6898 DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 5, 0,
6899 doc: /* Read file name, prompting with PROMPT in directory DIR.
6900 Use a file selection dialog. Select DEFAULT-FILENAME in the dialog's file
6901 selection box, if specified. If MUSTMATCH is non-nil, the returned file
6902 or directory must exist.
6903
6904 This function is only defined on NS, MS Windows, and X Windows with the
6905 Motif or Gtk toolkits. With the Motif toolkit, ONLY-DIR-P is ignored.
6906 Otherwise, if ONLY-DIR-P is non-nil, the user can only select directories.
6907 On Windows 7 and later, the file selection dialog "remembers" the last
6908 directory where the user selected a file, and will open that directory
6909 instead of DIR on subsequent invocations of this function with the same
6910 value of DIR as in previous invocations; this is standard Windows behavior. */)
6911 (Lisp_Object prompt, Lisp_Object dir, Lisp_Object default_filename, Lisp_Object mustmatch, Lisp_Object only_dir_p)
6912 {
6913 /* Filter index: 1: All Files, 2: Directories only */
6914 static const wchar_t filter_w[] = L"All Files (*.*)\0*.*\0Directories\0*|*\0";
6915 static const char filter_a[] = "All Files (*.*)\0*.*\0Directories\0*|*\0";
6916
6917 Lisp_Object filename = default_filename;
6918 struct frame *f = SELECTED_FRAME ();
6919 BOOL file_opened = FALSE;
6920 Lisp_Object orig_dir = dir;
6921 Lisp_Object orig_prompt = prompt;
6922
6923 /* If we compile with _WIN32_WINNT set to 0x0400 (for NT4
6924 compatibility) we end up with the old file dialogs. Define a big
6925 enough struct for the new dialog to trick GetOpenFileName into
6926 giving us the new dialogs on newer versions of Windows. */
6927 struct {
6928 OPENFILENAMEW details;
6929 #if _WIN32_WINNT < 0x500 /* < win2k */
6930 PVOID pvReserved;
6931 DWORD dwReserved;
6932 DWORD FlagsEx;
6933 #endif /* < win2k */
6934 } new_file_details_w;
6935
6936 #ifdef NTGUI_UNICODE
6937 wchar_t filename_buf_w[32*1024 + 1]; // NT kernel maximum
6938 OPENFILENAMEW * file_details_w = &new_file_details_w.details;
6939 const int use_unicode = 1;
6940 #else /* not NTGUI_UNICODE */
6941 struct {
6942 OPENFILENAMEA details;
6943 #if _WIN32_WINNT < 0x500 /* < win2k */
6944 PVOID pvReserved;
6945 DWORD dwReserved;
6946 DWORD FlagsEx;
6947 #endif /* < win2k */
6948 } new_file_details_a;
6949 wchar_t filename_buf_w[MAX_PATH + 1], dir_w[MAX_PATH];
6950 char filename_buf_a[MAX_PATH + 1], dir_a[MAX_PATH];
6951 OPENFILENAMEW * file_details_w = &new_file_details_w.details;
6952 OPENFILENAMEA * file_details_a = &new_file_details_a.details;
6953 int use_unicode = w32_unicode_filenames;
6954 wchar_t *prompt_w;
6955 char *prompt_a;
6956 int len;
6957 char fname_ret[MAX_UTF8_PATH];
6958 #endif /* NTGUI_UNICODE */
6959
6960 {
6961 /* Note: under NTGUI_UNICODE, we do _NOT_ use ENCODE_FILE: the
6962 system file encoding expected by the platform APIs (e.g. Cygwin's
6963 POSIX implementation) may not be the same as the encoding expected
6964 by the Windows "ANSI" APIs! */
6965
6966 CHECK_STRING (prompt);
6967 CHECK_STRING (dir);
6968
6969 dir = Fexpand_file_name (dir, Qnil);
6970
6971 if (STRINGP (filename))
6972 filename = Ffile_name_nondirectory (filename);
6973 else
6974 filename = empty_unibyte_string;
6975
6976 #ifdef CYGWIN
6977 dir = Fcygwin_convert_file_name_to_windows (dir, Qt);
6978 if (SCHARS (filename) > 0)
6979 filename = Fcygwin_convert_file_name_to_windows (filename, Qnil);
6980 #endif
6981
6982 CHECK_STRING (dir);
6983 CHECK_STRING (filename);
6984
6985 /* The code in file_dialog_callback that attempts to set the text
6986 of the file name edit window when handling the CDN_INITDONE
6987 WM_NOTIFY message does not work. Setting filename to "Current
6988 Directory" in the only_dir_p case here does work however. */
6989 if (SCHARS (filename) == 0 && ! NILP (only_dir_p))
6990 filename = build_string ("Current Directory");
6991
6992 /* Convert the values we've computed so far to system form. */
6993 #ifdef NTGUI_UNICODE
6994 to_unicode (prompt, &prompt);
6995 to_unicode (dir, &dir);
6996 to_unicode (filename, &filename);
6997 if (SBYTES (filename) + 1 > sizeof (filename_buf_w))
6998 report_file_error ("filename too long", default_filename);
6999
7000 memcpy (filename_buf_w, SDATA (filename), SBYTES (filename) + 1);
7001 #else /* !NTGUI_UNICODE */
7002 prompt = ENCODE_FILE (prompt);
7003 dir = ENCODE_FILE (dir);
7004 filename = ENCODE_FILE (filename);
7005
7006 /* We modify these in-place, so make copies for safety. */
7007 dir = Fcopy_sequence (dir);
7008 unixtodos_filename (SSDATA (dir));
7009 filename = Fcopy_sequence (filename);
7010 unixtodos_filename (SSDATA (filename));
7011 if (SBYTES (filename) >= MAX_UTF8_PATH)
7012 report_file_error ("filename too long", default_filename);
7013 if (w32_unicode_filenames)
7014 {
7015 filename_to_utf16 (SSDATA (dir), dir_w);
7016 if (filename_to_utf16 (SSDATA (filename), filename_buf_w) != 0)
7017 {
7018 /* filename_to_utf16 sets errno to ENOENT when the file
7019 name is too long or cannot be converted to UTF-16. */
7020 if (errno == ENOENT && filename_buf_w[MAX_PATH - 1] != 0)
7021 report_file_error ("filename too long", default_filename);
7022 }
7023 len = pMultiByteToWideChar (CP_UTF8, multiByteToWideCharFlags,
7024 SSDATA (prompt), -1, NULL, 0);
7025 if (len > 32768)
7026 len = 32768;
7027 prompt_w = alloca (len * sizeof (wchar_t));
7028 pMultiByteToWideChar (CP_UTF8, multiByteToWideCharFlags,
7029 SSDATA (prompt), -1, prompt_w, len);
7030 }
7031 else
7032 {
7033 filename_to_ansi (SSDATA (dir), dir_a);
7034 if (filename_to_ansi (SSDATA (filename), filename_buf_a) != '\0')
7035 {
7036 /* filename_to_ansi sets errno to ENOENT when the file
7037 name is too long or cannot be converted to UTF-16. */
7038 if (errno == ENOENT && filename_buf_a[MAX_PATH - 1] != 0)
7039 report_file_error ("filename too long", default_filename);
7040 }
7041 len = pMultiByteToWideChar (CP_UTF8, multiByteToWideCharFlags,
7042 SSDATA (prompt), -1, NULL, 0);
7043 if (len > 32768)
7044 len = 32768;
7045 prompt_w = alloca (len * sizeof (wchar_t));
7046 pMultiByteToWideChar (CP_UTF8, multiByteToWideCharFlags,
7047 SSDATA (prompt), -1, prompt_w, len);
7048 len = pWideCharToMultiByte (CP_ACP, 0, prompt_w, -1, NULL, 0, NULL, NULL);
7049 if (len > 32768)
7050 len = 32768;
7051 prompt_a = alloca (len);
7052 pWideCharToMultiByte (CP_ACP, 0, prompt_w, -1, prompt_a, len, NULL, NULL);
7053 }
7054 #endif /* NTGUI_UNICODE */
7055
7056 /* Fill in the structure for the call to GetOpenFileName below.
7057 For NTGUI_UNICODE builds (which run only on NT), we just use
7058 the actual size of the structure. For non-NTGUI_UNICODE
7059 builds, we tell the OS we're using an old version of the
7060 structure if the OS isn't new enough to support the newer
7061 version. */
7062 if (use_unicode)
7063 {
7064 memset (&new_file_details_w, 0, sizeof (new_file_details_w));
7065 if (w32_major_version > 4 && w32_major_version < 95)
7066 file_details_w->lStructSize = sizeof (new_file_details_w);
7067 else
7068 file_details_w->lStructSize = sizeof (*file_details_w);
7069 /* Set up the inout parameter for the selected file name. */
7070 file_details_w->lpstrFile = filename_buf_w;
7071 file_details_w->nMaxFile =
7072 sizeof (filename_buf_w) / sizeof (*filename_buf_w);
7073 file_details_w->hwndOwner = FRAME_W32_WINDOW (f);
7074 /* Undocumented Bug in Common File Dialog:
7075 If a filter is not specified, shell links are not resolved. */
7076 file_details_w->lpstrFilter = filter_w;
7077 #ifdef NTGUI_UNICODE
7078 file_details_w->lpstrInitialDir = (wchar_t*) SDATA (dir);
7079 file_details_w->lpstrTitle = (guichar_t*) SDATA (prompt);
7080 #else
7081 file_details_w->lpstrInitialDir = dir_w;
7082 file_details_w->lpstrTitle = prompt_w;
7083 #endif
7084 file_details_w->nFilterIndex = NILP (only_dir_p) ? 1 : 2;
7085 file_details_w->Flags = (OFN_HIDEREADONLY | OFN_NOCHANGEDIR
7086 | OFN_EXPLORER | OFN_ENABLEHOOK);
7087 if (!NILP (mustmatch))
7088 {
7089 /* Require that the path to the parent directory exists. */
7090 file_details_w->Flags |= OFN_PATHMUSTEXIST;
7091 /* If we are looking for a file, require that it exists. */
7092 if (NILP (only_dir_p))
7093 file_details_w->Flags |= OFN_FILEMUSTEXIST;
7094 }
7095 }
7096 #ifndef NTGUI_UNICODE
7097 else
7098 {
7099 memset (&new_file_details_a, 0, sizeof (new_file_details_a));
7100 if (w32_major_version > 4 && w32_major_version < 95)
7101 file_details_a->lStructSize = sizeof (new_file_details_a);
7102 else
7103 file_details_a->lStructSize = sizeof (*file_details_a);
7104 file_details_a->lpstrFile = filename_buf_a;
7105 file_details_a->nMaxFile =
7106 sizeof (filename_buf_a) / sizeof (*filename_buf_a);
7107 file_details_a->hwndOwner = FRAME_W32_WINDOW (f);
7108 file_details_a->lpstrFilter = filter_a;
7109 file_details_a->lpstrInitialDir = dir_a;
7110 file_details_a->lpstrTitle = prompt_a;
7111 file_details_a->nFilterIndex = NILP (only_dir_p) ? 1 : 2;
7112 file_details_a->Flags = (OFN_HIDEREADONLY | OFN_NOCHANGEDIR
7113 | OFN_EXPLORER | OFN_ENABLEHOOK);
7114 if (!NILP (mustmatch))
7115 {
7116 /* Require that the path to the parent directory exists. */
7117 file_details_a->Flags |= OFN_PATHMUSTEXIST;
7118 /* If we are looking for a file, require that it exists. */
7119 if (NILP (only_dir_p))
7120 file_details_a->Flags |= OFN_FILEMUSTEXIST;
7121 }
7122 }
7123 #endif /* !NTGUI_UNICODE */
7124
7125 {
7126 int count = SPECPDL_INDEX ();
7127 /* Prevent redisplay. */
7128 specbind (Qinhibit_redisplay, Qt);
7129 block_input ();
7130 if (use_unicode)
7131 {
7132 file_details_w->lpfnHook = file_dialog_callback;
7133
7134 file_opened = GetOpenFileNameW (file_details_w);
7135 }
7136 #ifndef NTGUI_UNICODE
7137 else
7138 {
7139 file_details_a->lpfnHook = file_dialog_callback;
7140
7141 file_opened = GetOpenFileNameA (file_details_a);
7142 }
7143 #endif /* !NTGUI_UNICODE */
7144 unblock_input ();
7145 unbind_to (count, Qnil);
7146 }
7147
7148 if (file_opened)
7149 {
7150 /* Get an Emacs string from the value Windows gave us. */
7151 #ifdef NTGUI_UNICODE
7152 filename = from_unicode_buffer (filename_buf_w);
7153 #else /* !NTGUI_UNICODE */
7154 if (use_unicode)
7155 filename_from_utf16 (filename_buf_w, fname_ret);
7156 else
7157 filename_from_ansi (filename_buf_a, fname_ret);
7158 dostounix_filename (fname_ret);
7159 filename = DECODE_FILE (build_unibyte_string (fname_ret));
7160 #endif /* NTGUI_UNICODE */
7161
7162 #ifdef CYGWIN
7163 filename = Fcygwin_convert_file_name_from_windows (filename, Qt);
7164 #endif /* CYGWIN */
7165
7166 /* Strip the dummy filename off the end of the string if we
7167 added it to select a directory. */
7168 if ((use_unicode && file_details_w->nFilterIndex == 2)
7169 #ifndef NTGUI_UNICODE
7170 || (!use_unicode && file_details_a->nFilterIndex == 2)
7171 #endif
7172 )
7173 filename = Ffile_name_directory (filename);
7174 }
7175 /* User canceled the dialog without making a selection. */
7176 else if (!CommDlgExtendedError ())
7177 filename = Qnil;
7178 /* An error occurred, fallback on reading from the mini-buffer. */
7179 else
7180 filename = Fcompleting_read (
7181 orig_prompt,
7182 intern ("read-file-name-internal"),
7183 orig_dir,
7184 mustmatch,
7185 orig_dir,
7186 Qfile_name_history,
7187 default_filename,
7188 Qnil);
7189 }
7190
7191 /* Make "Cancel" equivalent to C-g. */
7192 if (NILP (filename))
7193 Fsignal (Qquit, Qnil);
7194
7195 return filename;
7196 }
7197
7198 \f
7199 #ifdef WINDOWSNT
7200 /* Moving files to the system recycle bin.
7201 Used by `move-file-to-trash' instead of the default moving to ~/.Trash */
7202 DEFUN ("system-move-file-to-trash", Fsystem_move_file_to_trash,
7203 Ssystem_move_file_to_trash, 1, 1, 0,
7204 doc: /* Move file or directory named FILENAME to the recycle bin. */)
7205 (Lisp_Object filename)
7206 {
7207 Lisp_Object handler;
7208 Lisp_Object encoded_file;
7209 Lisp_Object operation;
7210
7211 operation = Qdelete_file;
7212 if (!NILP (Ffile_directory_p (filename))
7213 && NILP (Ffile_symlink_p (filename)))
7214 {
7215 operation = intern ("delete-directory");
7216 filename = Fdirectory_file_name (filename);
7217 }
7218
7219 /* Must have fully qualified file names for moving files to Recycle
7220 Bin. */
7221 filename = Fexpand_file_name (filename, Qnil);
7222
7223 handler = Ffind_file_name_handler (filename, operation);
7224 if (!NILP (handler))
7225 return call2 (handler, operation, filename);
7226 else
7227 {
7228 const char * path;
7229 int result;
7230
7231 encoded_file = ENCODE_FILE (filename);
7232
7233 path = map_w32_filename (SSDATA (encoded_file), NULL);
7234
7235 /* The Unicode version of SHFileOperation is not supported on
7236 Windows 9X. */
7237 if (w32_unicode_filenames && os_subtype != OS_9X)
7238 {
7239 SHFILEOPSTRUCTW file_op_w;
7240 /* We need one more element beyond MAX_PATH because this is
7241 a list of file names, with the last element double-null
7242 terminated. */
7243 wchar_t tmp_path_w[MAX_PATH + 1];
7244
7245 memset (tmp_path_w, 0, sizeof (tmp_path_w));
7246 filename_to_utf16 (path, tmp_path_w);
7247
7248 /* On Windows, write permission is required to delete/move files. */
7249 _wchmod (tmp_path_w, 0666);
7250
7251 memset (&file_op_w, 0, sizeof (file_op_w));
7252 file_op_w.hwnd = HWND_DESKTOP;
7253 file_op_w.wFunc = FO_DELETE;
7254 file_op_w.pFrom = tmp_path_w;
7255 file_op_w.fFlags = FOF_SILENT | FOF_NOCONFIRMATION | FOF_ALLOWUNDO
7256 | FOF_NOERRORUI | FOF_NO_CONNECTED_ELEMENTS;
7257 file_op_w.fAnyOperationsAborted = FALSE;
7258
7259 result = SHFileOperationW (&file_op_w);
7260 }
7261 else
7262 {
7263 SHFILEOPSTRUCTA file_op_a;
7264 char tmp_path_a[MAX_PATH + 1];
7265
7266 memset (tmp_path_a, 0, sizeof (tmp_path_a));
7267 filename_to_ansi (path, tmp_path_a);
7268
7269 /* If a file cannot be represented in ANSI codepage, don't
7270 let them inadvertently delete other files because some
7271 characters are interpreted as a wildcards. */
7272 if (_mbspbrk ((unsigned char *)tmp_path_a,
7273 (const unsigned char *)"?*"))
7274 result = ERROR_FILE_NOT_FOUND;
7275 else
7276 {
7277 _chmod (tmp_path_a, 0666);
7278
7279 memset (&file_op_a, 0, sizeof (file_op_a));
7280 file_op_a.hwnd = HWND_DESKTOP;
7281 file_op_a.wFunc = FO_DELETE;
7282 file_op_a.pFrom = tmp_path_a;
7283 file_op_a.fFlags = FOF_SILENT | FOF_NOCONFIRMATION | FOF_ALLOWUNDO
7284 | FOF_NOERRORUI | FOF_NO_CONNECTED_ELEMENTS;
7285 file_op_a.fAnyOperationsAborted = FALSE;
7286
7287 result = SHFileOperationA (&file_op_a);
7288 }
7289 }
7290 if (result != 0)
7291 report_file_error ("Removing old name", list1 (filename));
7292 }
7293 return Qnil;
7294 }
7295
7296 #endif /* WINDOWSNT */
7297
7298 \f
7299 /***********************************************************************
7300 w32 specialized functions
7301 ***********************************************************************/
7302
7303 DEFUN ("w32-send-sys-command", Fw32_send_sys_command,
7304 Sw32_send_sys_command, 1, 2, 0,
7305 doc: /* Send frame a Windows WM_SYSCOMMAND message of type COMMAND.
7306 Some useful values for COMMAND are #xf030 to maximize frame (#xf020
7307 to minimize), #xf120 to restore frame to original size, and #xf100
7308 to activate the menubar for keyboard access. #xf140 activates the
7309 screen saver if defined.
7310
7311 If optional parameter FRAME is not specified, use selected frame. */)
7312 (Lisp_Object command, Lisp_Object frame)
7313 {
7314 struct frame *f = decode_window_system_frame (frame);
7315
7316 CHECK_NUMBER (command);
7317
7318 if (FRAME_W32_P (f))
7319 PostMessage (FRAME_W32_WINDOW (f), WM_SYSCOMMAND, XINT (command), 0);
7320
7321 return Qnil;
7322 }
7323
7324 DEFUN ("w32-shell-execute", Fw32_shell_execute, Sw32_shell_execute, 2, 4, 0,
7325 doc: /* Get Windows to perform OPERATION on DOCUMENT.
7326 This is a wrapper around the ShellExecute system function, which
7327 invokes the application registered to handle OPERATION for DOCUMENT.
7328
7329 OPERATION is either nil or a string that names a supported operation.
7330 What operations can be used depends on the particular DOCUMENT and its
7331 handler application, but typically it is one of the following common
7332 operations:
7333
7334 \"open\" - open DOCUMENT, which could be a file, a directory, or an
7335 executable program (application). If it is an application,
7336 that application is launched in the current buffer's default
7337 directory. Otherwise, the application associated with
7338 DOCUMENT is launched in the buffer's default directory.
7339 \"opennew\" - like \"open\", but instruct the application to open
7340 DOCUMENT in a new window.
7341 \"openas\" - open the \"Open With\" dialog for DOCUMENT.
7342 \"print\" - print DOCUMENT, which must be a file.
7343 \"printto\" - print DOCUMENT, which must be a file, to a specified printer.
7344 The printer should be provided in PARAMETERS, see below.
7345 \"explore\" - start the Windows Explorer on DOCUMENT.
7346 \"edit\" - launch an editor and open DOCUMENT for editing; which
7347 editor is launched depends on the association for the
7348 specified DOCUMENT.
7349 \"find\" - initiate search starting from DOCUMENT, which must specify
7350 a directory.
7351 \"delete\" - move DOCUMENT, a file or a directory, to Recycle Bin.
7352 \"copy\" - copy DOCUMENT, which must be a file or a directory, into
7353 the clipboard.
7354 \"cut\" - move DOCUMENT, a file or a directory, into the clipboard.
7355 \"paste\" - paste the file whose name is in the clipboard into DOCUMENT,
7356 which must be a directory.
7357 \"pastelink\"
7358 - create a shortcut in DOCUMENT (which must be a directory)
7359 the file or directory whose name is in the clipboard.
7360 \"runas\" - run DOCUMENT, which must be an excutable file, with
7361 elevated privileges (a.k.a. \"as Administrator\").
7362 \"properties\"
7363 - open the property sheet dialog for DOCUMENT.
7364 nil - invoke the default OPERATION, or \"open\" if default is
7365 not defined or unavailable.
7366
7367 DOCUMENT is typically the name of a document file or a URL, but can
7368 also be an executable program to run, or a directory to open in the
7369 Windows Explorer. If it is a file or a directory, it must be a local
7370 one; this function does not support remote file names.
7371
7372 If DOCUMENT is an executable program, the optional third arg PARAMETERS
7373 can be a string containing command line parameters, separated by blanks,
7374 that will be passed to the program. Some values of OPERATION also require
7375 parameters (e.g., \"printto\" requires the printer address). Otherwise,
7376 PARAMETERS should be nil or unspecified. Note that double quote characters
7377 in PARAMETERS must each be enclosed in 2 additional quotes, as in \"\"\".
7378
7379 Optional fourth argument SHOW-FLAG can be used to control how the
7380 application will be displayed when it is invoked. If SHOW-FLAG is nil
7381 or unspecified, the application is displayed as if SHOW-FLAG of 10 was
7382 specified, otherwise it is an integer between 0 and 11 representing
7383 a ShowWindow flag:
7384
7385 0 - start hidden
7386 1 - start as normal-size window
7387 3 - start in a maximized window
7388 6 - start in a minimized window
7389 10 - start as the application itself specifies; this is the default. */)
7390 (Lisp_Object operation, Lisp_Object document, Lisp_Object parameters, Lisp_Object show_flag)
7391 {
7392 char *errstr;
7393 Lisp_Object current_dir = BVAR (current_buffer, directory);;
7394 wchar_t *doc_w = NULL, *params_w = NULL, *ops_w = NULL;
7395 #ifdef CYGWIN
7396 intptr_t result;
7397 #else
7398 int use_unicode = w32_unicode_filenames;
7399 char *doc_a = NULL, *params_a = NULL, *ops_a = NULL;
7400 Lisp_Object absdoc, handler;
7401 BOOL success;
7402 #endif
7403
7404 CHECK_STRING (document);
7405
7406 #ifdef CYGWIN
7407 current_dir = Fcygwin_convert_file_name_to_windows (current_dir, Qt);
7408 document = Fcygwin_convert_file_name_to_windows (document, Qt);
7409
7410 /* Encode filename, current directory and parameters. */
7411 current_dir = GUI_ENCODE_FILE (current_dir);
7412 document = GUI_ENCODE_FILE (document);
7413 doc_w = GUI_SDATA (document);
7414 if (STRINGP (parameters))
7415 {
7416 parameters = GUI_ENCODE_SYSTEM (parameters);
7417 params_w = GUI_SDATA (parameters);
7418 }
7419 if (STRINGP (operation))
7420 {
7421 operation = GUI_ENCODE_SYSTEM (operation);
7422 ops_w = GUI_SDATA (operation);
7423 }
7424 result = (intptr_t) ShellExecuteW (NULL, ops_w, doc_w, params_w,
7425 GUI_SDATA (current_dir),
7426 (INTEGERP (show_flag)
7427 ? XINT (show_flag) : SW_SHOWDEFAULT));
7428
7429 if (result > 32)
7430 return Qt;
7431
7432 switch (result)
7433 {
7434 case SE_ERR_ACCESSDENIED:
7435 errstr = w32_strerror (ERROR_ACCESS_DENIED);
7436 break;
7437 case SE_ERR_ASSOCINCOMPLETE:
7438 case SE_ERR_NOASSOC:
7439 errstr = w32_strerror (ERROR_NO_ASSOCIATION);
7440 break;
7441 case SE_ERR_DDEBUSY:
7442 case SE_ERR_DDEFAIL:
7443 errstr = w32_strerror (ERROR_DDE_FAIL);
7444 break;
7445 case SE_ERR_DDETIMEOUT:
7446 errstr = w32_strerror (ERROR_TIMEOUT);
7447 break;
7448 case SE_ERR_DLLNOTFOUND:
7449 errstr = w32_strerror (ERROR_DLL_NOT_FOUND);
7450 break;
7451 case SE_ERR_FNF:
7452 errstr = w32_strerror (ERROR_FILE_NOT_FOUND);
7453 break;
7454 case SE_ERR_OOM:
7455 errstr = w32_strerror (ERROR_NOT_ENOUGH_MEMORY);
7456 break;
7457 case SE_ERR_PNF:
7458 errstr = w32_strerror (ERROR_PATH_NOT_FOUND);
7459 break;
7460 case SE_ERR_SHARE:
7461 errstr = w32_strerror (ERROR_SHARING_VIOLATION);
7462 break;
7463 default:
7464 errstr = w32_strerror (0);
7465 break;
7466 }
7467
7468 #else /* !CYGWIN */
7469
7470 const char file_url_str[] = "file:///";
7471 const int file_url_len = sizeof (file_url_str) - 1;
7472 int doclen;
7473
7474 if (strncmp (SSDATA (document), file_url_str, file_url_len) == 0)
7475 {
7476 /* Passing "file:///" URLs to ShellExecute causes shlwapi.dll to
7477 start a thread in some rare system configurations, for
7478 unknown reasons. That thread is started in the context of
7479 the Emacs process, but out of control of our code, and seems
7480 to never exit afterwards. Each such thread reserves 8MB of
7481 stack space (because that's the value recorded in the Emacs
7482 executable at link time: Emacs needs a large stack). So a
7483 large enough number of invocations of w32-shell-execute can
7484 potentially cause the Emacs process to run out of available
7485 address space, which is nasty. To work around this, we
7486 convert such URLs to local file names, which seems to prevent
7487 those threads from starting. See bug #20220. */
7488 char *p = SSDATA (document) + file_url_len;
7489
7490 if (c_isalpha (*p) && p[1] == ':' && IS_DIRECTORY_SEP (p[2]))
7491 document = Fsubstring_no_properties (document,
7492 make_number (file_url_len), Qnil);
7493 }
7494 /* We have a situation here. If DOCUMENT is a relative file name,
7495 but its name includes leading directories, i.e. it lives not in
7496 CURRENT_DIR, but in its subdirectory, then ShellExecute below
7497 will fail to find it. So we need to make the file name is
7498 absolute. But DOCUMENT does not have to be a file, it can be a
7499 URL, for example. So we make it absolute only if it is an
7500 existing file; if it is a file that does not exist, tough. */
7501 absdoc = Fexpand_file_name (document, Qnil);
7502 /* Don't call file handlers for file-exists-p, since they might
7503 attempt to access the file, which could fail or produce undesired
7504 consequences, see bug#16558 for an example. */
7505 handler = Ffind_file_name_handler (absdoc, Qfile_exists_p);
7506 if (NILP (handler))
7507 {
7508 Lisp_Object absdoc_encoded = ENCODE_FILE (absdoc);
7509
7510 if (faccessat (AT_FDCWD, SSDATA (absdoc_encoded), F_OK, AT_EACCESS) == 0)
7511 {
7512 /* ShellExecute fails if DOCUMENT is a UNC with forward
7513 slashes (expand-file-name above converts all backslashes
7514 to forward slashes). Now that we know DOCUMENT is a
7515 file, we can mirror all forward slashes into backslashes. */
7516 unixtodos_filename (SSDATA (absdoc_encoded));
7517 document = absdoc_encoded;
7518 }
7519 else
7520 document = ENCODE_FILE (document);
7521 }
7522 else
7523 document = ENCODE_FILE (document);
7524
7525 current_dir = ENCODE_FILE (current_dir);
7526 /* Cannot use filename_to_utf16/ansi with DOCUMENT, since it could
7527 be a URL that is not limited to MAX_PATH chararcters. */
7528 doclen = pMultiByteToWideChar (CP_UTF8, multiByteToWideCharFlags,
7529 SSDATA (document), -1, NULL, 0);
7530 doc_w = xmalloc (doclen * sizeof (wchar_t));
7531 pMultiByteToWideChar (CP_UTF8, multiByteToWideCharFlags,
7532 SSDATA (document), -1, doc_w, doclen);
7533 if (use_unicode)
7534 {
7535 wchar_t current_dir_w[MAX_PATH];
7536 SHELLEXECUTEINFOW shexinfo_w;
7537
7538 /* Encode the current directory and parameters, and convert
7539 operation to UTF-16. */
7540 filename_to_utf16 (SSDATA (current_dir), current_dir_w);
7541 if (STRINGP (parameters))
7542 {
7543 int len;
7544
7545 parameters = ENCODE_SYSTEM (parameters);
7546 len = pMultiByteToWideChar (CP_ACP, multiByteToWideCharFlags,
7547 SSDATA (parameters), -1, NULL, 0);
7548 if (len > 32768)
7549 len = 32768;
7550 params_w = alloca (len * sizeof (wchar_t));
7551 pMultiByteToWideChar (CP_ACP, multiByteToWideCharFlags,
7552 SSDATA (parameters), -1, params_w, len);
7553 params_w[len - 1] = 0;
7554 }
7555 if (STRINGP (operation))
7556 {
7557 /* Assume OPERATION is pure ASCII. */
7558 const char *s = SSDATA (operation);
7559 wchar_t *d;
7560 int len = SBYTES (operation) + 1;
7561
7562 if (len > 32768)
7563 len = 32768;
7564 d = ops_w = alloca (len * sizeof (wchar_t));
7565 while (d < ops_w + len - 1)
7566 *d++ = *s++;
7567 *d = 0;
7568 }
7569
7570 /* Using ShellExecuteEx and setting the SEE_MASK_INVOKEIDLIST
7571 flag succeeds with more OPERATIONs (a.k.a. "verbs"), as it is
7572 able to invoke verbs from shortcut menu extensions, not just
7573 static verbs listed in the Registry. */
7574 memset (&shexinfo_w, 0, sizeof (shexinfo_w));
7575 shexinfo_w.cbSize = sizeof (shexinfo_w);
7576 shexinfo_w.fMask =
7577 SEE_MASK_INVOKEIDLIST | SEE_MASK_FLAG_DDEWAIT | SEE_MASK_FLAG_NO_UI;
7578 shexinfo_w.hwnd = NULL;
7579 shexinfo_w.lpVerb = ops_w;
7580 shexinfo_w.lpFile = doc_w;
7581 shexinfo_w.lpParameters = params_w;
7582 shexinfo_w.lpDirectory = current_dir_w;
7583 shexinfo_w.nShow =
7584 (INTEGERP (show_flag) ? XINT (show_flag) : SW_SHOWDEFAULT);
7585 success = ShellExecuteExW (&shexinfo_w);
7586 xfree (doc_w);
7587 }
7588 else
7589 {
7590 char current_dir_a[MAX_PATH];
7591 SHELLEXECUTEINFOA shexinfo_a;
7592 int codepage = codepage_for_filenames (NULL);
7593 int ldoc_a = pWideCharToMultiByte (codepage, 0, doc_w, -1, NULL, 0,
7594 NULL, NULL);
7595
7596 doc_a = xmalloc (ldoc_a);
7597 pWideCharToMultiByte (codepage, 0, doc_w, -1, doc_a, ldoc_a, NULL, NULL);
7598 filename_to_ansi (SSDATA (current_dir), current_dir_a);
7599 if (STRINGP (parameters))
7600 {
7601 parameters = ENCODE_SYSTEM (parameters);
7602 params_a = SSDATA (parameters);
7603 }
7604 if (STRINGP (operation))
7605 {
7606 /* Assume OPERATION is pure ASCII. */
7607 ops_a = SSDATA (operation);
7608 }
7609 memset (&shexinfo_a, 0, sizeof (shexinfo_a));
7610 shexinfo_a.cbSize = sizeof (shexinfo_a);
7611 shexinfo_a.fMask =
7612 SEE_MASK_INVOKEIDLIST | SEE_MASK_FLAG_DDEWAIT | SEE_MASK_FLAG_NO_UI;
7613 shexinfo_a.hwnd = NULL;
7614 shexinfo_a.lpVerb = ops_a;
7615 shexinfo_a.lpFile = doc_a;
7616 shexinfo_a.lpParameters = params_a;
7617 shexinfo_a.lpDirectory = current_dir_a;
7618 shexinfo_a.nShow =
7619 (INTEGERP (show_flag) ? XINT (show_flag) : SW_SHOWDEFAULT);
7620 success = ShellExecuteExA (&shexinfo_a);
7621 xfree (doc_w);
7622 xfree (doc_a);
7623 }
7624
7625 if (success)
7626 return Qt;
7627
7628 errstr = w32_strerror (0);
7629
7630 #endif /* !CYGWIN */
7631
7632 /* The error string might be encoded in the locale's encoding. */
7633 if (!NILP (Vlocale_coding_system))
7634 {
7635 Lisp_Object decoded =
7636 code_convert_string_norecord (build_unibyte_string (errstr),
7637 Vlocale_coding_system, 0);
7638 errstr = SSDATA (decoded);
7639 }
7640 error ("ShellExecute failed: %s", errstr);
7641 }
7642
7643 /* Lookup virtual keycode from string representing the name of a
7644 non-ascii keystroke into the corresponding virtual key, using
7645 lispy_function_keys. */
7646 static int
7647 lookup_vk_code (char *key)
7648 {
7649 int i;
7650
7651 for (i = 0; i < 256; i++)
7652 if (lispy_function_keys[i]
7653 && strcmp (lispy_function_keys[i], key) == 0)
7654 return i;
7655
7656 return -1;
7657 }
7658
7659 /* Convert a one-element vector style key sequence to a hot key
7660 definition. */
7661 static Lisp_Object
7662 w32_parse_hot_key (Lisp_Object key)
7663 {
7664 /* Copied from Fdefine_key and store_in_keymap. */
7665 register Lisp_Object c;
7666 int vk_code;
7667 int lisp_modifiers;
7668 int w32_modifiers;
7669
7670 CHECK_VECTOR (key);
7671
7672 if (ASIZE (key) != 1)
7673 return Qnil;
7674
7675 c = AREF (key, 0);
7676
7677 if (CONSP (c) && lucid_event_type_list_p (c))
7678 c = Fevent_convert_list (c);
7679
7680 if (! INTEGERP (c) && ! SYMBOLP (c))
7681 error ("Key definition is invalid");
7682
7683 /* Work out the base key and the modifiers. */
7684 if (SYMBOLP (c))
7685 {
7686 c = parse_modifiers (c);
7687 lisp_modifiers = XINT (Fcar (Fcdr (c)));
7688 c = Fcar (c);
7689 if (!SYMBOLP (c))
7690 emacs_abort ();
7691 vk_code = lookup_vk_code (SSDATA (SYMBOL_NAME (c)));
7692 }
7693 else if (INTEGERP (c))
7694 {
7695 lisp_modifiers = XINT (c) & ~CHARACTERBITS;
7696 /* Many ascii characters are their own virtual key code. */
7697 vk_code = XINT (c) & CHARACTERBITS;
7698 }
7699
7700 if (vk_code < 0 || vk_code > 255)
7701 return Qnil;
7702
7703 if ((lisp_modifiers & meta_modifier) != 0
7704 && !NILP (Vw32_alt_is_meta))
7705 lisp_modifiers |= alt_modifier;
7706
7707 /* Supply defs missing from mingw32. */
7708 #ifndef MOD_ALT
7709 #define MOD_ALT 0x0001
7710 #define MOD_CONTROL 0x0002
7711 #define MOD_SHIFT 0x0004
7712 #define MOD_WIN 0x0008
7713 #endif
7714
7715 /* Convert lisp modifiers to Windows hot-key form. */
7716 w32_modifiers = (lisp_modifiers & hyper_modifier) ? MOD_WIN : 0;
7717 w32_modifiers |= (lisp_modifiers & alt_modifier) ? MOD_ALT : 0;
7718 w32_modifiers |= (lisp_modifiers & ctrl_modifier) ? MOD_CONTROL : 0;
7719 w32_modifiers |= (lisp_modifiers & shift_modifier) ? MOD_SHIFT : 0;
7720
7721 return HOTKEY (vk_code, w32_modifiers);
7722 }
7723
7724 DEFUN ("w32-register-hot-key", Fw32_register_hot_key,
7725 Sw32_register_hot_key, 1, 1, 0,
7726 doc: /* Register KEY as a hot-key combination.
7727 Certain key combinations like Alt-Tab are reserved for system use on
7728 Windows, and therefore are normally intercepted by the system. However,
7729 most of these key combinations can be received by registering them as
7730 hot-keys, overriding their special meaning.
7731
7732 KEY must be a one element key definition in vector form that would be
7733 acceptable to `define-key' (e.g. [A-tab] for Alt-Tab). The meta
7734 modifier is interpreted as Alt if `w32-alt-is-meta' is t, and hyper
7735 is always interpreted as the Windows modifier keys.
7736
7737 The return value is the hotkey-id if registered, otherwise nil. */)
7738 (Lisp_Object key)
7739 {
7740 key = w32_parse_hot_key (key);
7741
7742 if (!NILP (key) && NILP (Fmemq (key, w32_grabbed_keys)))
7743 {
7744 /* Reuse an empty slot if possible. */
7745 Lisp_Object item = Fmemq (Qnil, w32_grabbed_keys);
7746
7747 /* Safe to add new key to list, even if we have focus. */
7748 if (NILP (item))
7749 w32_grabbed_keys = Fcons (key, w32_grabbed_keys);
7750 else
7751 XSETCAR (item, key);
7752
7753 /* Notify input thread about new hot-key definition, so that it
7754 takes effect without needing to switch focus. */
7755 PostThreadMessage (dwWindowsThreadId, WM_EMACS_REGISTER_HOT_KEY,
7756 (WPARAM) XINT (key), 0);
7757 }
7758
7759 return key;
7760 }
7761
7762 DEFUN ("w32-unregister-hot-key", Fw32_unregister_hot_key,
7763 Sw32_unregister_hot_key, 1, 1, 0,
7764 doc: /* Unregister KEY as a hot-key combination. */)
7765 (Lisp_Object key)
7766 {
7767 Lisp_Object item;
7768
7769 if (!INTEGERP (key))
7770 key = w32_parse_hot_key (key);
7771
7772 item = Fmemq (key, w32_grabbed_keys);
7773
7774 if (!NILP (item))
7775 {
7776 LPARAM lparam;
7777
7778 eassert (CONSP (item));
7779 /* Pass the tail of the list as a pointer to a Lisp_Cons cell,
7780 so that it works in a --with-wide-int build as well. */
7781 lparam = (LPARAM) XUNTAG (item, Lisp_Cons);
7782
7783 /* Notify input thread about hot-key definition being removed, so
7784 that it takes effect without needing focus switch. */
7785 if (PostThreadMessage (dwWindowsThreadId, WM_EMACS_UNREGISTER_HOT_KEY,
7786 (WPARAM) XINT (XCAR (item)), lparam))
7787 {
7788 MSG msg;
7789 GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE);
7790 }
7791 return Qt;
7792 }
7793 return Qnil;
7794 }
7795
7796 DEFUN ("w32-registered-hot-keys", Fw32_registered_hot_keys,
7797 Sw32_registered_hot_keys, 0, 0, 0,
7798 doc: /* Return list of registered hot-key IDs. */)
7799 (void)
7800 {
7801 return Fdelq (Qnil, Fcopy_sequence (w32_grabbed_keys));
7802 }
7803
7804 DEFUN ("w32-reconstruct-hot-key", Fw32_reconstruct_hot_key,
7805 Sw32_reconstruct_hot_key, 1, 1, 0,
7806 doc: /* Convert hot-key ID to a lisp key combination.
7807 usage: (w32-reconstruct-hot-key ID) */)
7808 (Lisp_Object hotkeyid)
7809 {
7810 int vk_code, w32_modifiers;
7811 Lisp_Object key;
7812
7813 CHECK_NUMBER (hotkeyid);
7814
7815 vk_code = HOTKEY_VK_CODE (hotkeyid);
7816 w32_modifiers = HOTKEY_MODIFIERS (hotkeyid);
7817
7818 if (vk_code < 256 && lispy_function_keys[vk_code])
7819 key = intern (lispy_function_keys[vk_code]);
7820 else
7821 key = make_number (vk_code);
7822
7823 key = Fcons (key, Qnil);
7824 if (w32_modifiers & MOD_SHIFT)
7825 key = Fcons (Qshift, key);
7826 if (w32_modifiers & MOD_CONTROL)
7827 key = Fcons (Qctrl, key);
7828 if (w32_modifiers & MOD_ALT)
7829 key = Fcons (NILP (Vw32_alt_is_meta) ? Qalt : Qmeta, key);
7830 if (w32_modifiers & MOD_WIN)
7831 key = Fcons (Qhyper, key);
7832
7833 return key;
7834 }
7835
7836 DEFUN ("w32-toggle-lock-key", Fw32_toggle_lock_key,
7837 Sw32_toggle_lock_key, 1, 2, 0,
7838 doc: /* Toggle the state of the lock key KEY.
7839 KEY can be `capslock', `kp-numlock', or `scroll'.
7840 If the optional parameter NEW-STATE is a number, then the state of KEY
7841 is set to off if the low bit of NEW-STATE is zero, otherwise on.
7842 If NEW-STATE is omitted or nil, the function toggles the state,
7843
7844 Value is the new state of the key, or nil if the function failed
7845 to change the state. */)
7846 (Lisp_Object key, Lisp_Object new_state)
7847 {
7848 int vk_code;
7849 LPARAM lparam;
7850
7851 if (EQ (key, intern ("capslock")))
7852 vk_code = VK_CAPITAL;
7853 else if (EQ (key, intern ("kp-numlock")))
7854 vk_code = VK_NUMLOCK;
7855 else if (EQ (key, intern ("scroll")))
7856 vk_code = VK_SCROLL;
7857 else
7858 return Qnil;
7859
7860 if (!dwWindowsThreadId)
7861 return make_number (w32_console_toggle_lock_key (vk_code, new_state));
7862
7863 if (NILP (new_state))
7864 lparam = -1;
7865 else
7866 lparam = (XUINT (new_state)) & 1;
7867 if (PostThreadMessage (dwWindowsThreadId, WM_EMACS_TOGGLE_LOCK_KEY,
7868 (WPARAM) vk_code, lparam))
7869 {
7870 MSG msg;
7871 GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE);
7872 return make_number (msg.wParam);
7873 }
7874 return Qnil;
7875 }
7876
7877 DEFUN ("w32-window-exists-p", Fw32_window_exists_p, Sw32_window_exists_p,
7878 2, 2, 0,
7879 doc: /* Return non-nil if a window exists with the specified CLASS and NAME.
7880
7881 This is a direct interface to the Windows API FindWindow function. */)
7882 (Lisp_Object class, Lisp_Object name)
7883 {
7884 HWND hnd;
7885
7886 if (!NILP (class))
7887 CHECK_STRING (class);
7888 if (!NILP (name))
7889 CHECK_STRING (name);
7890
7891 hnd = FindWindow (STRINGP (class) ? ((LPCTSTR) SDATA (class)) : NULL,
7892 STRINGP (name) ? ((LPCTSTR) SDATA (name)) : NULL);
7893 if (!hnd)
7894 return Qnil;
7895 return Qt;
7896 }
7897
7898 DEFUN ("w32-frame-geometry", Fw32_frame_geometry, Sw32_frame_geometry, 0, 1, 0,
7899 doc: /* Return geometric attributes of FRAME.
7900 FRAME must be a live frame and defaults to the selected one. The return
7901 value is an association list of the attributes listed below. All height
7902 and width values are in pixels.
7903
7904 `outer-position' is a cons of the outer left and top edges of FRAME
7905 relative to the origin - the position (0, 0) - of FRAME's display.
7906
7907 `outer-size' is a cons of the outer width and height of FRAME. The
7908 outer size includes the title bar and the external borders as well as
7909 any menu and/or tool bar of frame.
7910
7911 `external-border-size' is a cons of the horizontal and vertical width of
7912 FRAME's external borders as supplied by the window manager.
7913
7914 `title-bar-size' is a cons of the width and height of the title bar of
7915 FRAME as supplied by the window manager. If both of them are zero,
7916 FRAME has no title bar. If only the width is zero, Emacs was not
7917 able to retrieve the width information.
7918
7919 `menu-bar-external', if non-nil, means the menu bar is external (never
7920 included in the inner edges of FRAME).
7921
7922 `menu-bar-size' is a cons of the width and height of the menu bar of
7923 FRAME.
7924
7925 `tool-bar-external', if non-nil, means the tool bar is external (never
7926 included in the inner edges of FRAME).
7927
7928 `tool-bar-position' tells on which side the tool bar on FRAME is and can
7929 be one of `left', `top', `right' or `bottom'. If this is nil, FRAME
7930 has no tool bar.
7931
7932 `tool-bar-size' is a cons of the width and height of the tool bar of
7933 FRAME.
7934
7935 `internal-border-width' is the width of the internal border of
7936 FRAME. */)
7937 (Lisp_Object frame)
7938 {
7939 struct frame *f = decode_live_frame (frame);
7940
7941 MENUBARINFO menu_bar;
7942 WINDOWINFO window;
7943 int left, top, right, bottom;
7944 unsigned int external_border_width, external_border_height;
7945 int title_bar_width = 0, title_bar_height = 0;
7946 int single_menu_bar_height, wrapped_menu_bar_height, menu_bar_height;
7947 int tool_bar_height = FRAME_TOOL_BAR_HEIGHT (f);
7948 int internal_border_width = FRAME_INTERNAL_BORDER_WIDTH (f);
7949
7950 if (FRAME_INITIAL_P (f) || !FRAME_W32_P (f))
7951 return Qnil;
7952
7953 block_input ();
7954 /* Outer rectangle and borders. */
7955 window.cbSize = sizeof (window);
7956 GetWindowInfo (FRAME_W32_WINDOW (f), &window);
7957 external_border_width = window.cxWindowBorders;
7958 external_border_height = window.cyWindowBorders;
7959 /* Title bar. */
7960 if (get_title_bar_info_fn)
7961 {
7962 TITLEBAR_INFO title_bar;
7963
7964 title_bar.cbSize = sizeof (title_bar);
7965 title_bar.rcTitleBar.left = title_bar.rcTitleBar.right = 0;
7966 title_bar.rcTitleBar.top = title_bar.rcTitleBar.bottom = 0;
7967 for (int i = 0; i < 6; i++)
7968 title_bar.rgstate[i] = 0;
7969 if (get_title_bar_info_fn (FRAME_W32_WINDOW (f), &title_bar)
7970 && !(title_bar.rgstate[0] & 0x00008001))
7971 {
7972 title_bar_width
7973 = title_bar.rcTitleBar.right - title_bar.rcTitleBar.left;
7974 title_bar_height
7975 = title_bar.rcTitleBar.bottom - title_bar.rcTitleBar.top;
7976 }
7977 }
7978 else if ((window.dwStyle & WS_CAPTION) == WS_CAPTION)
7979 title_bar_height = GetSystemMetrics (SM_CYCAPTION);
7980 /* Menu bar. */
7981 menu_bar.cbSize = sizeof (menu_bar);
7982 menu_bar.rcBar.right = menu_bar.rcBar.left = 0;
7983 menu_bar.rcBar.top = menu_bar.rcBar.bottom = 0;
7984 GetMenuBarInfo (FRAME_W32_WINDOW (f), 0xFFFFFFFD, 0, &menu_bar);
7985 single_menu_bar_height = GetSystemMetrics (SM_CYMENU);
7986 wrapped_menu_bar_height = GetSystemMetrics (SM_CYMENUSIZE);
7987 unblock_input ();
7988
7989 left = window.rcWindow.left;
7990 top = window.rcWindow.top;
7991 right = window.rcWindow.right;
7992 bottom = window.rcWindow.bottom;
7993
7994 /* Menu bar. */
7995 menu_bar_height = menu_bar.rcBar.bottom - menu_bar.rcBar.top;
7996 /* Fix menu bar height reported by GetMenuBarInfo. */
7997 if (menu_bar_height > single_menu_bar_height)
7998 /* A wrapped menu bar. */
7999 menu_bar_height += single_menu_bar_height - wrapped_menu_bar_height;
8000 else if (menu_bar_height > 0)
8001 /* A single line menu bar. */
8002 menu_bar_height = single_menu_bar_height;
8003
8004 return listn (CONSTYPE_HEAP, 10,
8005 Fcons (Qouter_position,
8006 Fcons (make_number (left), make_number (top))),
8007 Fcons (Qouter_size,
8008 Fcons (make_number (right - left),
8009 make_number (bottom - top))),
8010 Fcons (Qexternal_border_size,
8011 Fcons (make_number (external_border_width),
8012 make_number (external_border_height))),
8013 Fcons (Qtitle_bar_size,
8014 Fcons (make_number (title_bar_width),
8015 make_number (title_bar_height))),
8016 Fcons (Qmenu_bar_external, Qt),
8017 Fcons (Qmenu_bar_size,
8018 Fcons (make_number
8019 (menu_bar.rcBar.right - menu_bar.rcBar.left),
8020 make_number (menu_bar_height))),
8021 Fcons (Qtool_bar_external, Qnil),
8022 Fcons (Qtool_bar_position, tool_bar_height ? Qtop : Qnil),
8023 Fcons (Qtool_bar_size,
8024 Fcons (make_number
8025 (tool_bar_height
8026 ? right - left - 2 * internal_border_width
8027 : 0),
8028 make_number (tool_bar_height))),
8029 Fcons (Qinternal_border_width,
8030 make_number (internal_border_width)));
8031 }
8032
8033 DEFUN ("w32-frame-edges", Fw32_frame_edges, Sw32_frame_edges, 0, 2, 0,
8034 doc: /* Return edge coordinates of FRAME.
8035 FRAME must be a live frame and defaults to the selected one. The return
8036 value is a list of the form (LEFT, TOP, RIGHT, BOTTOM). All values are
8037 in pixels relative to the origin - the position (0, 0) - of FRAME's
8038 display.
8039
8040 If optional argument TYPE is the symbol `outer-edges', return the outer
8041 edges of FRAME. The outer edges comprise the decorations of the window
8042 manager (like the title bar or external borders) as well as any external
8043 menu or tool bar of FRAME. If optional argument TYPE is the symbol
8044 `native-edges' or nil, return the native edges of FRAME. The native
8045 edges exclude the decorations of the window manager and any external
8046 menu or tool bar of FRAME. If TYPE is the symbol `inner-edges', return
8047 the inner edges of FRAME. These edges exclude title bar, any borders,
8048 menu bar or tool bar of FRAME. */)
8049 (Lisp_Object frame, Lisp_Object type)
8050 {
8051 struct frame *f = decode_live_frame (frame);
8052
8053 if (FRAME_INITIAL_P (f) || !FRAME_W32_P (f))
8054 return Qnil;
8055
8056 if (EQ (type, Qouter_edges))
8057 {
8058 RECT rectangle;
8059
8060 block_input ();
8061 /* Outer frame rectangle, including outer borders and title bar. */
8062 GetWindowRect (FRAME_W32_WINDOW (f), &rectangle);
8063 unblock_input ();
8064
8065 return list4 (make_number (rectangle.left),
8066 make_number (rectangle.top),
8067 make_number (rectangle.right),
8068 make_number (rectangle.bottom));
8069 }
8070 else
8071 {
8072 RECT rectangle;
8073 POINT pt;
8074 int left, top, right, bottom;
8075
8076 block_input ();
8077 /* Inner frame rectangle, excluding borders and title bar. */
8078 GetClientRect (FRAME_W32_WINDOW (f), &rectangle);
8079 /* Get top-left corner of native rectangle in screen
8080 coordinates. */
8081 pt.x = 0;
8082 pt.y = 0;
8083 ClientToScreen (FRAME_W32_WINDOW (f), &pt);
8084 unblock_input ();
8085
8086 left = pt.x;
8087 top = pt.y;
8088 right = left + rectangle.right;
8089 bottom = top + rectangle.bottom;
8090
8091 if (EQ (type, Qinner_edges))
8092 {
8093 int internal_border_width = FRAME_INTERNAL_BORDER_WIDTH (f);
8094
8095 return list4 (make_number (left + internal_border_width),
8096 make_number (top
8097 + FRAME_TOOL_BAR_HEIGHT (f)
8098 + internal_border_width),
8099 make_number (right - internal_border_width),
8100 make_number (bottom - internal_border_width));
8101 }
8102 else
8103 return list4 (make_number (left), make_number (top),
8104 make_number (right), make_number (bottom));
8105 }
8106 }
8107
8108 DEFUN ("w32-mouse-absolute-pixel-position", Fw32_mouse_absolute_pixel_position,
8109 Sw32_mouse_absolute_pixel_position, 0, 0, 0,
8110 doc: /* Return absolute position of mouse cursor in pixels.
8111 The position is returned as a cons cell (X . Y) of the coordinates of
8112 the mouse cursor position in pixels relative to a position (0, 0) of the
8113 selected frame's display. */)
8114 (void)
8115 {
8116 POINT pt;
8117
8118 block_input ();
8119 GetCursorPos (&pt);
8120 unblock_input ();
8121
8122 return Fcons (make_number (pt.x), make_number (pt.y));
8123 }
8124
8125 DEFUN ("w32-set-mouse-absolute-pixel-position", Fw32_set_mouse_absolute_pixel_position,
8126 Sw32_set_mouse_absolute_pixel_position, 2, 2, 0,
8127 doc: /* Move mouse pointer to absolute pixel position (X, Y).
8128 The coordinates X and Y are interpreted in pixels relative to a position
8129 \(0, 0) of the selected frame's display. */)
8130 (Lisp_Object x, Lisp_Object y)
8131 {
8132 UINT trail_num = 0;
8133 BOOL ret = false;
8134
8135 CHECK_TYPE_RANGED_INTEGER (int, x);
8136 CHECK_TYPE_RANGED_INTEGER (int, y);
8137
8138 block_input ();
8139 /* When "mouse trails" are in effect, moving the mouse cursor
8140 sometimes leaves behind an annoying "ghost" of the pointer.
8141 Avoid that by momentarily switching off mouse trails. */
8142 if (os_subtype == OS_NT
8143 && w32_major_version + w32_minor_version >= 6)
8144 ret = SystemParametersInfo (SPI_GETMOUSETRAILS, 0, &trail_num, 0);
8145 SetCursorPos (XINT (x), XINT (y));
8146 if (ret)
8147 SystemParametersInfo (SPI_SETMOUSETRAILS, trail_num, NULL, 0);
8148 unblock_input ();
8149
8150 return Qnil;
8151 }
8152
8153 DEFUN ("w32-battery-status", Fw32_battery_status, Sw32_battery_status, 0, 0, 0,
8154 doc: /* Get power status information from Windows system.
8155
8156 The following %-sequences are provided:
8157 %L AC line status (verbose)
8158 %B Battery status (verbose)
8159 %b Battery status, empty means high, `-' means low,
8160 `!' means critical, and `+' means charging
8161 %p Battery load percentage
8162 %s Remaining time (to charge or discharge) in seconds
8163 %m Remaining time (to charge or discharge) in minutes
8164 %h Remaining time (to charge or discharge) in hours
8165 %t Remaining time (to charge or discharge) in the form `h:min' */)
8166 (void)
8167 {
8168 Lisp_Object status = Qnil;
8169
8170 SYSTEM_POWER_STATUS system_status;
8171 if (GetSystemPowerStatus (&system_status))
8172 {
8173 Lisp_Object line_status, battery_status, battery_status_symbol;
8174 Lisp_Object load_percentage, seconds, minutes, hours, remain;
8175
8176 long seconds_left = (long) system_status.BatteryLifeTime;
8177
8178 if (system_status.ACLineStatus == 0)
8179 line_status = build_string ("off-line");
8180 else if (system_status.ACLineStatus == 1)
8181 line_status = build_string ("on-line");
8182 else
8183 line_status = build_string ("N/A");
8184
8185 if (system_status.BatteryFlag & 128)
8186 {
8187 battery_status = build_string ("N/A");
8188 battery_status_symbol = empty_unibyte_string;
8189 }
8190 else if (system_status.BatteryFlag & 8)
8191 {
8192 battery_status = build_string ("charging");
8193 battery_status_symbol = build_string ("+");
8194 if (system_status.BatteryFullLifeTime != -1L)
8195 seconds_left = system_status.BatteryFullLifeTime - seconds_left;
8196 }
8197 else if (system_status.BatteryFlag & 4)
8198 {
8199 battery_status = build_string ("critical");
8200 battery_status_symbol = build_string ("!");
8201 }
8202 else if (system_status.BatteryFlag & 2)
8203 {
8204 battery_status = build_string ("low");
8205 battery_status_symbol = build_string ("-");
8206 }
8207 else if (system_status.BatteryFlag & 1)
8208 {
8209 battery_status = build_string ("high");
8210 battery_status_symbol = empty_unibyte_string;
8211 }
8212 else
8213 {
8214 battery_status = build_string ("medium");
8215 battery_status_symbol = empty_unibyte_string;
8216 }
8217
8218 if (system_status.BatteryLifePercent > 100)
8219 load_percentage = build_string ("N/A");
8220 else
8221 {
8222 char buffer[16];
8223 snprintf (buffer, 16, "%d", system_status.BatteryLifePercent);
8224 load_percentage = build_string (buffer);
8225 }
8226
8227 if (seconds_left < 0)
8228 seconds = minutes = hours = remain = build_string ("N/A");
8229 else
8230 {
8231 long m;
8232 float h;
8233 char buffer[16];
8234 snprintf (buffer, 16, "%ld", seconds_left);
8235 seconds = build_string (buffer);
8236
8237 m = seconds_left / 60;
8238 snprintf (buffer, 16, "%ld", m);
8239 minutes = build_string (buffer);
8240
8241 h = seconds_left / 3600.0;
8242 snprintf (buffer, 16, "%3.1f", h);
8243 hours = build_string (buffer);
8244
8245 snprintf (buffer, 16, "%ld:%02ld", m / 60, m % 60);
8246 remain = build_string (buffer);
8247 }
8248
8249 status = listn (CONSTYPE_HEAP, 8,
8250 Fcons (make_number ('L'), line_status),
8251 Fcons (make_number ('B'), battery_status),
8252 Fcons (make_number ('b'), battery_status_symbol),
8253 Fcons (make_number ('p'), load_percentage),
8254 Fcons (make_number ('s'), seconds),
8255 Fcons (make_number ('m'), minutes),
8256 Fcons (make_number ('h'), hours),
8257 Fcons (make_number ('t'), remain));
8258 }
8259 return status;
8260 }
8261
8262 \f
8263 #ifdef WINDOWSNT
8264 typedef BOOL (WINAPI *GetDiskFreeSpaceExW_Proc)
8265 (LPCWSTR, PULARGE_INTEGER, PULARGE_INTEGER, PULARGE_INTEGER);
8266 typedef BOOL (WINAPI *GetDiskFreeSpaceExA_Proc)
8267 (LPCSTR, PULARGE_INTEGER, PULARGE_INTEGER, PULARGE_INTEGER);
8268
8269 DEFUN ("file-system-info", Ffile_system_info, Sfile_system_info, 1, 1, 0,
8270 doc: /* Return storage information about the file system FILENAME is on.
8271 Value is a list of floats (TOTAL FREE AVAIL), where TOTAL is the total
8272 storage of the file system, FREE is the free storage, and AVAIL is the
8273 storage available to a non-superuser. All 3 numbers are in bytes.
8274 If the underlying system call fails, value is nil. */)
8275 (Lisp_Object filename)
8276 {
8277 Lisp_Object encoded, value;
8278
8279 CHECK_STRING (filename);
8280 filename = Fexpand_file_name (filename, Qnil);
8281 encoded = ENCODE_FILE (filename);
8282
8283 value = Qnil;
8284
8285 /* Determining the required information on Windows turns out, sadly,
8286 to be more involved than one would hope. The original Windows API
8287 call for this will return bogus information on some systems, but we
8288 must dynamically probe for the replacement api, since that was
8289 added rather late on. */
8290 {
8291 HMODULE hKernel = GetModuleHandle ("kernel32");
8292 GetDiskFreeSpaceExW_Proc pfn_GetDiskFreeSpaceExW =
8293 (GetDiskFreeSpaceExW_Proc) GetProcAddress (hKernel, "GetDiskFreeSpaceExW");
8294 GetDiskFreeSpaceExA_Proc pfn_GetDiskFreeSpaceExA =
8295 (GetDiskFreeSpaceExA_Proc) GetProcAddress (hKernel, "GetDiskFreeSpaceExA");
8296 bool have_pfn_GetDiskFreeSpaceEx =
8297 ((w32_unicode_filenames && pfn_GetDiskFreeSpaceExW)
8298 || (!w32_unicode_filenames && pfn_GetDiskFreeSpaceExA));
8299
8300 /* On Windows, we may need to specify the root directory of the
8301 volume holding FILENAME. */
8302 char rootname[MAX_UTF8_PATH];
8303 wchar_t rootname_w[MAX_PATH];
8304 char rootname_a[MAX_PATH];
8305 char *name = SSDATA (encoded);
8306 BOOL result;
8307
8308 /* find the root name of the volume if given */
8309 if (isalpha (name[0]) && name[1] == ':')
8310 {
8311 rootname[0] = name[0];
8312 rootname[1] = name[1];
8313 rootname[2] = '\\';
8314 rootname[3] = 0;
8315 }
8316 else if (IS_DIRECTORY_SEP (name[0]) && IS_DIRECTORY_SEP (name[1]))
8317 {
8318 char *str = rootname;
8319 int slashes = 4;
8320 do
8321 {
8322 if (IS_DIRECTORY_SEP (*name) && --slashes == 0)
8323 break;
8324 *str++ = *name++;
8325 }
8326 while ( *name );
8327
8328 *str++ = '\\';
8329 *str = 0;
8330 }
8331
8332 if (w32_unicode_filenames)
8333 filename_to_utf16 (rootname, rootname_w);
8334 else
8335 filename_to_ansi (rootname, rootname_a);
8336
8337 if (have_pfn_GetDiskFreeSpaceEx)
8338 {
8339 /* Unsigned large integers cannot be cast to double, so
8340 use signed ones instead. */
8341 LARGE_INTEGER availbytes;
8342 LARGE_INTEGER freebytes;
8343 LARGE_INTEGER totalbytes;
8344
8345 if (w32_unicode_filenames)
8346 result = pfn_GetDiskFreeSpaceExW (rootname_w,
8347 (ULARGE_INTEGER *)&availbytes,
8348 (ULARGE_INTEGER *)&totalbytes,
8349 (ULARGE_INTEGER *)&freebytes);
8350 else
8351 result = pfn_GetDiskFreeSpaceExA (rootname_a,
8352 (ULARGE_INTEGER *)&availbytes,
8353 (ULARGE_INTEGER *)&totalbytes,
8354 (ULARGE_INTEGER *)&freebytes);
8355 if (result)
8356 value = list3 (make_float ((double) totalbytes.QuadPart),
8357 make_float ((double) freebytes.QuadPart),
8358 make_float ((double) availbytes.QuadPart));
8359 }
8360 else
8361 {
8362 DWORD sectors_per_cluster;
8363 DWORD bytes_per_sector;
8364 DWORD free_clusters;
8365 DWORD total_clusters;
8366
8367 if (w32_unicode_filenames)
8368 result = GetDiskFreeSpaceW (rootname_w,
8369 &sectors_per_cluster,
8370 &bytes_per_sector,
8371 &free_clusters,
8372 &total_clusters);
8373 else
8374 result = GetDiskFreeSpaceA (rootname_a,
8375 &sectors_per_cluster,
8376 &bytes_per_sector,
8377 &free_clusters,
8378 &total_clusters);
8379 if (result)
8380 value = list3 (make_float ((double) total_clusters
8381 * sectors_per_cluster * bytes_per_sector),
8382 make_float ((double) free_clusters
8383 * sectors_per_cluster * bytes_per_sector),
8384 make_float ((double) free_clusters
8385 * sectors_per_cluster * bytes_per_sector));
8386 }
8387 }
8388
8389 return value;
8390 }
8391 #endif /* WINDOWSNT */
8392
8393 \f
8394 #ifdef WINDOWSNT
8395 DEFUN ("default-printer-name", Fdefault_printer_name, Sdefault_printer_name,
8396 0, 0, 0, doc: /* Return the name of Windows default printer device. */)
8397 (void)
8398 {
8399 static char pname_buf[256];
8400 int err;
8401 HANDLE hPrn;
8402 PRINTER_INFO_2W *ppi2w = NULL;
8403 PRINTER_INFO_2A *ppi2a = NULL;
8404 DWORD dwNeeded = 0, dwReturned = 0;
8405 char server_name[MAX_UTF8_PATH], share_name[MAX_UTF8_PATH];
8406 char port_name[MAX_UTF8_PATH];
8407
8408 /* Retrieve the default string from Win.ini (the registry).
8409 * String will be in form "printername,drivername,portname".
8410 * This is the most portable way to get the default printer. */
8411 if (GetProfileString ("windows", "device", ",,", pname_buf, sizeof (pname_buf)) <= 0)
8412 return Qnil;
8413 /* printername precedes first "," character */
8414 strtok (pname_buf, ",");
8415 /* We want to know more than the printer name */
8416 if (!OpenPrinter (pname_buf, &hPrn, NULL))
8417 return Qnil;
8418 /* GetPrinterW is not supported by unicows.dll. */
8419 if (w32_unicode_filenames && os_subtype != OS_9X)
8420 GetPrinterW (hPrn, 2, NULL, 0, &dwNeeded);
8421 else
8422 GetPrinterA (hPrn, 2, NULL, 0, &dwNeeded);
8423 if (dwNeeded == 0)
8424 {
8425 ClosePrinter (hPrn);
8426 return Qnil;
8427 }
8428 /* Call GetPrinter again with big enough memory block. */
8429 if (w32_unicode_filenames && os_subtype != OS_9X)
8430 {
8431 /* Allocate memory for the PRINTER_INFO_2 struct. */
8432 ppi2w = xmalloc (dwNeeded);
8433 err = GetPrinterW (hPrn, 2, (LPBYTE)ppi2w, dwNeeded, &dwReturned);
8434 ClosePrinter (hPrn);
8435 if (!err)
8436 {
8437 xfree (ppi2w);
8438 return Qnil;
8439 }
8440
8441 if ((ppi2w->Attributes & PRINTER_ATTRIBUTE_SHARED)
8442 && ppi2w->pServerName)
8443 {
8444 filename_from_utf16 (ppi2w->pServerName, server_name);
8445 filename_from_utf16 (ppi2w->pShareName, share_name);
8446 }
8447 else
8448 {
8449 server_name[0] = '\0';
8450 filename_from_utf16 (ppi2w->pPortName, port_name);
8451 }
8452 }
8453 else
8454 {
8455 ppi2a = xmalloc (dwNeeded);
8456 err = GetPrinterA (hPrn, 2, (LPBYTE)ppi2a, dwNeeded, &dwReturned);
8457 ClosePrinter (hPrn);
8458 if (!err)
8459 {
8460 xfree (ppi2a);
8461 return Qnil;
8462 }
8463
8464 if ((ppi2a->Attributes & PRINTER_ATTRIBUTE_SHARED)
8465 && ppi2a->pServerName)
8466 {
8467 filename_from_ansi (ppi2a->pServerName, server_name);
8468 filename_from_ansi (ppi2a->pShareName, share_name);
8469 }
8470 else
8471 {
8472 server_name[0] = '\0';
8473 filename_from_ansi (ppi2a->pPortName, port_name);
8474 }
8475 }
8476
8477 if (server_name[0])
8478 {
8479 /* a remote printer */
8480 if (server_name[0] == '\\')
8481 snprintf (pname_buf, sizeof (pname_buf), "%s\\%s", server_name,
8482 share_name);
8483 else
8484 snprintf (pname_buf, sizeof (pname_buf), "\\\\%s\\%s", server_name,
8485 share_name);
8486 pname_buf[sizeof (pname_buf) - 1] = '\0';
8487 }
8488 else
8489 {
8490 /* a local printer */
8491 strncpy (pname_buf, port_name, sizeof (pname_buf));
8492 pname_buf[sizeof (pname_buf) - 1] = '\0';
8493 /* `pPortName' can include several ports, delimited by ','.
8494 * we only use the first one. */
8495 strtok (pname_buf, ",");
8496 }
8497
8498 return DECODE_FILE (build_unibyte_string (pname_buf));
8499 }
8500 #endif /* WINDOWSNT */
8501 \f
8502
8503 /* Equivalent of strerror for W32 error codes. */
8504 char *
8505 w32_strerror (int error_no)
8506 {
8507 static char buf[500];
8508 DWORD ret;
8509
8510 if (error_no == 0)
8511 error_no = GetLastError ();
8512
8513 ret = FormatMessage (FORMAT_MESSAGE_FROM_SYSTEM |
8514 FORMAT_MESSAGE_IGNORE_INSERTS,
8515 NULL,
8516 error_no,
8517 0, /* choose most suitable language */
8518 buf, sizeof (buf), NULL);
8519
8520 while (ret > 0 && (buf[ret - 1] == '\n' ||
8521 buf[ret - 1] == '\r' ))
8522 --ret;
8523 buf[ret] = '\0';
8524 if (!ret)
8525 sprintf (buf, "w32 error %u", error_no);
8526
8527 return buf;
8528 }
8529
8530 /* For convenience when debugging. (You cannot call GetLastError
8531 directly from GDB: it will crash, because it uses the __stdcall
8532 calling convention, not the _cdecl convention assumed by GDB.) */
8533 DWORD
8534 w32_last_error (void)
8535 {
8536 return GetLastError ();
8537 }
8538
8539 /* Cache information describing the NT system for later use. */
8540 void
8541 cache_system_info (void)
8542 {
8543 union
8544 {
8545 struct info
8546 {
8547 char major;
8548 char minor;
8549 short platform;
8550 } info;
8551 DWORD data;
8552 } version;
8553
8554 /* Cache the module handle of Emacs itself. */
8555 hinst = GetModuleHandle (NULL);
8556
8557 /* Cache the version of the operating system. */
8558 version.data = GetVersion ();
8559 w32_major_version = version.info.major;
8560 w32_minor_version = version.info.minor;
8561
8562 if (version.info.platform & 0x8000)
8563 os_subtype = OS_9X;
8564 else
8565 os_subtype = OS_NT;
8566
8567 /* Cache page size, allocation unit, processor type, etc. */
8568 GetSystemInfo (&sysinfo_cache);
8569 syspage_mask = (DWORD_PTR)sysinfo_cache.dwPageSize - 1;
8570
8571 /* Cache os info. */
8572 osinfo_cache.dwOSVersionInfoSize = sizeof (OSVERSIONINFO);
8573 GetVersionEx (&osinfo_cache);
8574
8575 w32_build_number = osinfo_cache.dwBuildNumber;
8576 if (os_subtype == OS_9X)
8577 w32_build_number &= 0xffff;
8578
8579 w32_num_mouse_buttons = GetSystemMetrics (SM_CMOUSEBUTTONS);
8580 }
8581
8582 #ifdef EMACSDEBUG
8583 void
8584 _DebPrint (const char *fmt, ...)
8585 {
8586 char buf[1024];
8587 va_list args;
8588
8589 va_start (args, fmt);
8590 vsprintf (buf, fmt, args);
8591 va_end (args);
8592 #if CYGWIN
8593 fprintf (stderr, "%s", buf);
8594 #endif
8595 OutputDebugString (buf);
8596 }
8597 #endif
8598
8599 int
8600 w32_console_toggle_lock_key (int vk_code, Lisp_Object new_state)
8601 {
8602 int cur_state = (GetKeyState (vk_code) & 1);
8603
8604 if (NILP (new_state)
8605 || (NUMBERP (new_state)
8606 && ((XUINT (new_state)) & 1) != cur_state))
8607 {
8608 #ifdef WINDOWSNT
8609 faked_key = vk_code;
8610 #endif /* WINDOWSNT */
8611
8612 keybd_event ((BYTE) vk_code,
8613 (BYTE) MapVirtualKey (vk_code, 0),
8614 KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
8615 keybd_event ((BYTE) vk_code,
8616 (BYTE) MapVirtualKey (vk_code, 0),
8617 KEYEVENTF_EXTENDEDKEY | 0, 0);
8618 keybd_event ((BYTE) vk_code,
8619 (BYTE) MapVirtualKey (vk_code, 0),
8620 KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
8621 cur_state = !cur_state;
8622 }
8623
8624 return cur_state;
8625 }
8626
8627 /* Translate console modifiers to emacs modifiers.
8628 German keyboard support (Kai Morgan Zeise 2/18/95). */
8629 int
8630 w32_kbd_mods_to_emacs (DWORD mods, WORD key)
8631 {
8632 int retval = 0;
8633
8634 /* If we recognize right-alt and left-ctrl as AltGr, and it has been
8635 pressed, first remove those modifiers. */
8636 if (!NILP (Vw32_recognize_altgr)
8637 && (mods & (RIGHT_ALT_PRESSED | LEFT_CTRL_PRESSED))
8638 == (RIGHT_ALT_PRESSED | LEFT_CTRL_PRESSED))
8639 mods &= ~ (RIGHT_ALT_PRESSED | LEFT_CTRL_PRESSED);
8640
8641 if (mods & (RIGHT_ALT_PRESSED | LEFT_ALT_PRESSED))
8642 retval = ((NILP (Vw32_alt_is_meta)) ? alt_modifier : meta_modifier);
8643
8644 if (mods & (RIGHT_CTRL_PRESSED | LEFT_CTRL_PRESSED))
8645 {
8646 retval |= ctrl_modifier;
8647 if ((mods & (RIGHT_CTRL_PRESSED | LEFT_CTRL_PRESSED))
8648 == (RIGHT_CTRL_PRESSED | LEFT_CTRL_PRESSED))
8649 retval |= meta_modifier;
8650 }
8651
8652 if (mods & LEFT_WIN_PRESSED)
8653 retval |= w32_key_to_modifier (VK_LWIN);
8654 if (mods & RIGHT_WIN_PRESSED)
8655 retval |= w32_key_to_modifier (VK_RWIN);
8656 if (mods & APPS_PRESSED)
8657 retval |= w32_key_to_modifier (VK_APPS);
8658 if (mods & SCROLLLOCK_ON)
8659 retval |= w32_key_to_modifier (VK_SCROLL);
8660
8661 /* Just in case someone wanted the original behavior, make it
8662 optional by setting w32-capslock-is-shiftlock to t. */
8663 if (NILP (Vw32_capslock_is_shiftlock)
8664 /* Keys that should _not_ be affected by CapsLock. */
8665 && ( (key == VK_BACK)
8666 || (key == VK_TAB)
8667 || (key == VK_CLEAR)
8668 || (key == VK_RETURN)
8669 || (key == VK_ESCAPE)
8670 || ((key >= VK_SPACE) && (key <= VK_HELP))
8671 || ((key >= VK_NUMPAD0) && (key <= VK_F24))
8672 || ((key >= VK_NUMPAD_CLEAR) && (key <= VK_NUMPAD_DELETE))
8673 ))
8674 {
8675 /* Only consider shift state. */
8676 if ((mods & SHIFT_PRESSED) != 0)
8677 retval |= shift_modifier;
8678 }
8679 else
8680 {
8681 /* Ignore CapsLock state if not enabled. */
8682 if (NILP (Vw32_enable_caps_lock))
8683 mods &= ~CAPSLOCK_ON;
8684 if ((mods & (SHIFT_PRESSED | CAPSLOCK_ON)) != 0)
8685 retval |= shift_modifier;
8686 }
8687
8688 return retval;
8689 }
8690
8691 /* The return code indicates key code size. cpID is the codepage to
8692 use for translation to Unicode; -1 means use the current console
8693 input codepage. */
8694 int
8695 w32_kbd_patch_key (KEY_EVENT_RECORD *event, int cpId)
8696 {
8697 unsigned int key_code = event->wVirtualKeyCode;
8698 unsigned int mods = event->dwControlKeyState;
8699 BYTE keystate[256];
8700 static BYTE ansi_code[4];
8701 static int isdead = 0;
8702
8703 if (isdead == 2)
8704 {
8705 event->uChar.AsciiChar = ansi_code[2];
8706 isdead = 0;
8707 return 1;
8708 }
8709 if (event->uChar.AsciiChar != 0)
8710 return 1;
8711
8712 memset (keystate, 0, sizeof (keystate));
8713 keystate[key_code] = 0x80;
8714 if (mods & SHIFT_PRESSED)
8715 keystate[VK_SHIFT] = 0x80;
8716 if (mods & CAPSLOCK_ON)
8717 keystate[VK_CAPITAL] = 1;
8718 /* If we recognize right-alt and left-ctrl as AltGr, set the key
8719 states accordingly before invoking ToAscii. */
8720 if (!NILP (Vw32_recognize_altgr)
8721 && (mods & LEFT_CTRL_PRESSED) && (mods & RIGHT_ALT_PRESSED))
8722 {
8723 keystate[VK_CONTROL] = 0x80;
8724 keystate[VK_LCONTROL] = 0x80;
8725 keystate[VK_MENU] = 0x80;
8726 keystate[VK_RMENU] = 0x80;
8727 }
8728
8729 #if 0
8730 /* Because of an OS bug, ToAscii corrupts the stack when called to
8731 convert a dead key in console mode on NT4. Unfortunately, trying
8732 to check for dead keys using MapVirtualKey doesn't work either -
8733 these functions apparently use internal information about keyboard
8734 layout which doesn't get properly updated in console programs when
8735 changing layout (though apparently it gets partly updated,
8736 otherwise ToAscii wouldn't crash). */
8737 if (is_dead_key (event->wVirtualKeyCode))
8738 return 0;
8739 #endif
8740
8741 /* On NT, call ToUnicode instead and then convert to the current
8742 console input codepage. */
8743 if (os_subtype == OS_NT)
8744 {
8745 WCHAR buf[128];
8746
8747 isdead = ToUnicode (event->wVirtualKeyCode, event->wVirtualScanCode,
8748 keystate, buf, 128, 0);
8749 if (isdead > 0)
8750 {
8751 /* When we are called from the GUI message processing code,
8752 we are passed the current keyboard codepage, a positive
8753 number, to use below. */
8754 if (cpId == -1)
8755 cpId = GetConsoleCP ();
8756
8757 event->uChar.UnicodeChar = buf[isdead - 1];
8758 isdead = WideCharToMultiByte (cpId, 0, buf, isdead,
8759 (LPSTR)ansi_code, 4, NULL, NULL);
8760 }
8761 else
8762 isdead = 0;
8763 }
8764 else
8765 {
8766 isdead = ToAscii (event->wVirtualKeyCode, event->wVirtualScanCode,
8767 keystate, (LPWORD) ansi_code, 0);
8768 }
8769
8770 if (isdead == 0)
8771 return 0;
8772 event->uChar.AsciiChar = ansi_code[0];
8773 return isdead;
8774 }
8775
8776
8777 void
8778 w32_sys_ring_bell (struct frame *f)
8779 {
8780 if (sound_type == 0xFFFFFFFF)
8781 {
8782 Beep (666, 100);
8783 }
8784 else if (sound_type == MB_EMACS_SILENT)
8785 {
8786 /* Do nothing. */
8787 }
8788 else
8789 MessageBeep (sound_type);
8790 }
8791
8792 DEFUN ("w32--menu-bar-in-use", Fw32__menu_bar_in_use, Sw32__menu_bar_in_use,
8793 0, 0, 0,
8794 doc: /* Return non-nil when a menu-bar menu is being used.
8795 Internal use only. */)
8796 (void)
8797 {
8798 return menubar_in_use ? Qt : Qnil;
8799 }
8800
8801 #if defined WINDOWSNT && !defined HAVE_DBUS
8802
8803 /***********************************************************************
8804 Tray notifications
8805 ***********************************************************************/
8806 /* A private struct declaration to avoid compile-time limits. */
8807 typedef struct MY_NOTIFYICONDATAW {
8808 DWORD cbSize;
8809 HWND hWnd;
8810 UINT uID;
8811 UINT uFlags;
8812 UINT uCallbackMessage;
8813 HICON hIcon;
8814 WCHAR szTip[128];
8815 DWORD dwState;
8816 DWORD dwStateMask;
8817 WCHAR szInfo[256];
8818 _ANONYMOUS_UNION union {
8819 UINT uTimeout;
8820 UINT uVersion;
8821 } DUMMYUNIONNAME;
8822 WCHAR szInfoTitle[64];
8823 DWORD dwInfoFlags;
8824 GUID guidItem;
8825 HICON hBalloonIcon;
8826 } MY_NOTIFYICONDATAW;
8827
8828 #define MYNOTIFYICONDATAW_V1_SIZE offsetof (MY_NOTIFYICONDATAW, szTip[64])
8829 #define MYNOTIFYICONDATAW_V2_SIZE offsetof (MY_NOTIFYICONDATAW, guidItem)
8830 #define MYNOTIFYICONDATAW_V3_SIZE offsetof (MY_NOTIFYICONDATAW, hBalloonIcon)
8831 #ifndef NIF_INFO
8832 # define NIF_INFO 0x00000010
8833 #endif
8834 #ifndef NIIF_NONE
8835 # define NIIF_NONE 0x00000000
8836 #endif
8837 #ifndef NIIF_INFO
8838 # define NIIF_INFO 0x00000001
8839 #endif
8840 #ifndef NIIF_WARNING
8841 # define NIIF_WARNING 0x00000002
8842 #endif
8843 #ifndef NIIF_ERROR
8844 # define NIIF_ERROR 0x00000003
8845 #endif
8846
8847
8848 #define EMACS_TRAY_NOTIFICATION_ID 42 /* arbitrary */
8849 #define EMACS_NOTIFICATION_MSG (WM_APP + 1)
8850
8851 enum NI_Severity {
8852 Ni_None,
8853 Ni_Info,
8854 Ni_Warn,
8855 Ni_Err
8856 };
8857
8858 /* Report the version of a DLL given by its name. The return value is
8859 constructed using MAKEDLLVERULL. */
8860 static ULONGLONG
8861 get_dll_version (const char *dll_name)
8862 {
8863 ULONGLONG version = 0;
8864 HINSTANCE hdll = LoadLibrary (dll_name);
8865
8866 if (hdll)
8867 {
8868 DLLGETVERSIONPROC pDllGetVersion
8869 = (DLLGETVERSIONPROC) GetProcAddress (hdll, "DllGetVersion");
8870
8871 if (pDllGetVersion)
8872 {
8873 DLLVERSIONINFO dvi;
8874 HRESULT result;
8875
8876 memset (&dvi, 0, sizeof(dvi));
8877 dvi.cbSize = sizeof(dvi);
8878 result = pDllGetVersion (&dvi);
8879 if (SUCCEEDED (result))
8880 version = MAKEDLLVERULL (dvi.dwMajorVersion, dvi.dwMinorVersion,
8881 0, 0);
8882 }
8883 FreeLibrary (hdll);
8884 }
8885
8886 return version;
8887 }
8888
8889 /* Return the number of bytes in UTF-8 encoded string STR that
8890 corresponds to at most LIM characters. If STR ends before LIM
8891 characters, return the number of bytes in STR including the
8892 terminating null byte. */
8893 static int
8894 utf8_mbslen_lim (const char *str, int lim)
8895 {
8896 const char *p = str;
8897 int mblen = 0, nchars = 0;
8898
8899 while (*p && nchars < lim)
8900 {
8901 int nbytes = CHAR_BYTES (*p);
8902
8903 mblen += nbytes;
8904 nchars++;
8905 p += nbytes;
8906 }
8907
8908 if (!*p && nchars < lim)
8909 mblen++;
8910
8911 return mblen;
8912 }
8913
8914 /* Low-level subroutine to show tray notifications. All strings are
8915 supposed to be unibyte UTF-8 encoded by the caller. */
8916 static EMACS_INT
8917 add_tray_notification (struct frame *f, const char *icon, const char *tip,
8918 enum NI_Severity severity, unsigned timeout,
8919 const char *title, const char *msg)
8920 {
8921 EMACS_INT retval = EMACS_TRAY_NOTIFICATION_ID;
8922
8923 if (FRAME_W32_P (f))
8924 {
8925 MY_NOTIFYICONDATAW nidw;
8926 ULONGLONG shell_dll_version = get_dll_version ("Shell32.dll");
8927 wchar_t tipw[128], msgw[256], titlew[64];
8928 int tiplen;
8929
8930 memset (&nidw, 0, sizeof(nidw));
8931
8932 /* MSDN says the full struct is supported since Vista, whose
8933 Shell32.dll version is said to be 6.0.6. But DllGetVersion
8934 cannot report the 3rd field value, it reports "build number"
8935 instead, which is something else. So we use the Windows 7's
8936 version 6.1 as cutoff, and Vista loses. (Actually, the loss
8937 is not a real one, since we don't expose the hBalloonIcon
8938 member of the struct to Lisp.) */
8939 if (shell_dll_version >= MAKEDLLVERULL (6, 1, 0, 0)) /* >= Windows 7 */
8940 nidw.cbSize = sizeof (nidw);
8941 else if (shell_dll_version >= MAKEDLLVERULL (6, 0, 0, 0)) /* XP */
8942 nidw.cbSize = MYNOTIFYICONDATAW_V3_SIZE;
8943 else if (shell_dll_version >= MAKEDLLVERULL (5, 0, 0, 0)) /* W2K */
8944 nidw.cbSize = MYNOTIFYICONDATAW_V2_SIZE;
8945 else
8946 nidw.cbSize = MYNOTIFYICONDATAW_V1_SIZE; /* < W2K */
8947 nidw.hWnd = FRAME_W32_WINDOW (f);
8948 nidw.uID = EMACS_TRAY_NOTIFICATION_ID;
8949 nidw.uFlags = NIF_MESSAGE | NIF_ICON | NIF_TIP | NIF_INFO;
8950 nidw.uCallbackMessage = EMACS_NOTIFICATION_MSG;
8951 if (!*icon)
8952 nidw.hIcon = LoadIcon (hinst, EMACS_CLASS);
8953 else
8954 {
8955 if (w32_unicode_filenames)
8956 {
8957 wchar_t icon_w[MAX_PATH];
8958
8959 if (filename_to_utf16 (icon, icon_w) != 0)
8960 {
8961 errno = ENOENT;
8962 return -1;
8963 }
8964 nidw.hIcon = LoadImageW (NULL, icon_w, IMAGE_ICON, 0, 0,
8965 LR_DEFAULTSIZE | LR_LOADFROMFILE);
8966 }
8967 else
8968 {
8969 char icon_a[MAX_PATH];
8970
8971 if (filename_to_ansi (icon, icon_a) != 0)
8972 {
8973 errno = ENOENT;
8974 return -1;
8975 }
8976 nidw.hIcon = LoadImageA (NULL, icon_a, IMAGE_ICON, 0, 0,
8977 LR_DEFAULTSIZE | LR_LOADFROMFILE);
8978 }
8979 }
8980 if (!nidw.hIcon)
8981 {
8982 switch (GetLastError ())
8983 {
8984 case ERROR_FILE_NOT_FOUND:
8985 errno = ENOENT;
8986 break;
8987 default:
8988 errno = ENOMEM;
8989 break;
8990 }
8991 return -1;
8992 }
8993
8994 /* Windows 9X and NT4 support only 64 characters in the Tip,
8995 later versions support up to 128. */
8996 if (nidw.cbSize == MYNOTIFYICONDATAW_V1_SIZE)
8997 {
8998 tiplen = pMultiByteToWideChar (CP_UTF8, multiByteToWideCharFlags,
8999 tip, utf8_mbslen_lim (tip, 63),
9000 tipw, 64);
9001 if (tiplen >= 63)
9002 tipw[63] = 0;
9003 }
9004 else
9005 {
9006 tiplen = pMultiByteToWideChar (CP_UTF8, multiByteToWideCharFlags,
9007 tip, utf8_mbslen_lim (tip, 127),
9008 tipw, 128);
9009 if (tiplen >= 127)
9010 tipw[127] = 0;
9011 }
9012 if (tiplen == 0)
9013 {
9014 errno = EINVAL;
9015 retval = -1;
9016 goto done;
9017 }
9018 wcscpy (nidw.szTip, tipw);
9019
9020 /* The rest of the structure is only supported since Windows 2000. */
9021 if (nidw.cbSize > MYNOTIFYICONDATAW_V1_SIZE)
9022 {
9023 int slen;
9024
9025 slen = pMultiByteToWideChar (CP_UTF8, multiByteToWideCharFlags,
9026 msg, utf8_mbslen_lim (msg, 255),
9027 msgw, 256);
9028 if (slen >= 255)
9029 msgw[255] = 0;
9030 else if (slen == 0)
9031 {
9032 errno = EINVAL;
9033 retval = -1;
9034 goto done;
9035 }
9036 wcscpy (nidw.szInfo, msgw);
9037 nidw.uTimeout = timeout;
9038 slen = pMultiByteToWideChar (CP_UTF8, multiByteToWideCharFlags,
9039 title, utf8_mbslen_lim (title, 63),
9040 titlew, 64);
9041 if (slen >= 63)
9042 titlew[63] = 0;
9043 else if (slen == 0)
9044 {
9045 errno = EINVAL;
9046 retval = -1;
9047 goto done;
9048 }
9049 wcscpy (nidw.szInfoTitle, titlew);
9050
9051 switch (severity)
9052 {
9053 case Ni_None:
9054 nidw.dwInfoFlags = NIIF_NONE;
9055 break;
9056 case Ni_Info:
9057 default:
9058 nidw.dwInfoFlags = NIIF_INFO;
9059 break;
9060 case Ni_Warn:
9061 nidw.dwInfoFlags = NIIF_WARNING;
9062 break;
9063 case Ni_Err:
9064 nidw.dwInfoFlags = NIIF_ERROR;
9065 break;
9066 }
9067 }
9068
9069 if (!Shell_NotifyIconW (NIM_ADD, (PNOTIFYICONDATAW)&nidw))
9070 {
9071 /* GetLastError returns meaningless results when
9072 Shell_NotifyIcon fails. */
9073 DebPrint (("Shell_NotifyIcon ADD failed (err=%d)\n",
9074 GetLastError ()));
9075 errno = EINVAL;
9076 retval = -1;
9077 }
9078 done:
9079 if (*icon && !DestroyIcon (nidw.hIcon))
9080 DebPrint (("DestroyIcon failed (err=%d)\n", GetLastError ()));
9081 }
9082 return retval;
9083 }
9084
9085 /* Low-level subroutine to remove a tray notification. Note: we only
9086 pass the minimum data about the notification: its ID and the handle
9087 of the window to which it sends messages. MSDN doesn't say this is
9088 enough, but it works in practice. This allows us to avoid keeping
9089 the notification data around after we show the notification. */
9090 static void
9091 delete_tray_notification (struct frame *f, int id)
9092 {
9093 if (FRAME_W32_P (f))
9094 {
9095 MY_NOTIFYICONDATAW nidw;
9096
9097 memset (&nidw, 0, sizeof(nidw));
9098 nidw.hWnd = FRAME_W32_WINDOW (f);
9099 nidw.uID = id;
9100
9101 if (!Shell_NotifyIconW (NIM_DELETE, (PNOTIFYICONDATAW)&nidw))
9102 {
9103 /* GetLastError returns meaningless results when
9104 Shell_NotifyIcon fails. */
9105 DebPrint (("Shell_NotifyIcon DELETE failed\n"));
9106 errno = EINVAL;
9107 return;
9108 }
9109 }
9110 return;
9111 }
9112
9113 DEFUN ("w32-notification-notify",
9114 Fw32_notification_notify, Sw32_notification_notify,
9115 0, MANY, 0,
9116 doc: /* Display an MS-Windows tray notification as specified by PARAMS.
9117
9118 Value is the integer unique ID of the notification that can be used
9119 to remove the notification using `w32-notification-close', which see.
9120 If the function fails, the return value is nil.
9121
9122 Tray notifications, a.k.a. \"taskbar messages\", are messages that
9123 inform the user about events unrelated to the current user activity,
9124 such as a significant system event, by briefly displaying informative
9125 text in a balloon from an icon in the notification area of the taskbar.
9126
9127 Parameters in PARAMS are specified as keyword/value pairs. All the
9128 parameters are optional, but if no parameters are specified, the
9129 function will do nothing and return nil.
9130
9131 The following parameters are supported:
9132
9133 :icon ICON -- Display ICON in the system tray. If ICON is a string,
9134 it should specify a file name from which to load the
9135 icon; the specified file should be a .ico Windows icon
9136 file. If ICON is not a string, or if this parameter
9137 is not specified, the standard Emacs icon will be used.
9138
9139 :tip TIP -- Use TIP as the tooltip for the notification. If TIP
9140 is a string, this is the text of a tooltip that will
9141 be shown when the mouse pointer hovers over the tray
9142 icon added by the notification. If TIP is not a
9143 string, or if this parameter is not specified, the
9144 default tooltip text is \"Emacs notification\". The
9145 tooltip text can be up to 127 characters long (63
9146 on Windows versions before W2K). Longer strings
9147 will be truncated.
9148
9149 :level LEVEL -- Notification severity level, one of `info',
9150 `warning', or `error'. If given, the value
9151 determines the icon displayed to the left of the
9152 notification title, but only if the `:title'
9153 parameter (see below) is also specified and is a
9154 string.
9155
9156 :title TITLE -- The title of the notification. If TITLE is a string,
9157 it is displayed in a larger font immediately above
9158 the body text. The title text can be up to 63
9159 characters long; longer text will be truncated.
9160
9161 :body BODY -- The body of the notification. If BODY is a string,
9162 it specifies the text of the notification message.
9163 Use embedded newlines to control how the text is
9164 broken into lines. The body text can be up to 255
9165 characters long, and will be truncated if it's longer.
9166
9167 Note that versions of Windows before W2K support only `:icon' and `:tip'.
9168 You can pass the other parameters, but they will be ignored on those
9169 old systems.
9170
9171 There can be at most one active notification at any given time. An
9172 active notification must be removed by calling `w32-notification-close'
9173 before a new one can be shown.
9174
9175 usage: (w32-notification-notify &rest PARAMS) */)
9176 (ptrdiff_t nargs, Lisp_Object *args)
9177 {
9178 struct frame *f = SELECTED_FRAME ();
9179 Lisp_Object arg_plist, lres;
9180 EMACS_INT retval;
9181 char *icon, *tip, *title, *msg;
9182 enum NI_Severity severity;
9183 unsigned timeout;
9184
9185 if (nargs == 0)
9186 return Qnil;
9187
9188 arg_plist = Flist (nargs, args);
9189
9190 /* Icon. */
9191 lres = Fplist_get (arg_plist, QCicon);
9192 if (STRINGP (lres))
9193 icon = SSDATA (ENCODE_FILE (Fexpand_file_name (lres, Qnil)));
9194 else
9195 icon = "";
9196
9197 /* Tip. */
9198 lres = Fplist_get (arg_plist, QCtip);
9199 if (STRINGP (lres))
9200 tip = SSDATA (code_convert_string_norecord (lres, Qutf_8, 1));
9201 else
9202 tip = "Emacs notification";
9203
9204 /* Severity. */
9205 lres = Fplist_get (arg_plist, QClevel);
9206 if (NILP (lres))
9207 severity = Ni_None;
9208 else if (EQ (lres, Qinfo))
9209 severity = Ni_Info;
9210 else if (EQ (lres, Qwarning))
9211 severity = Ni_Warn;
9212 else if (EQ (lres, Qerror))
9213 severity = Ni_Err;
9214 else
9215 severity = Ni_Info;
9216
9217 /* Title. */
9218 lres = Fplist_get (arg_plist, QCtitle);
9219 if (STRINGP (lres))
9220 title = SSDATA (code_convert_string_norecord (lres, Qutf_8, 1));
9221 else
9222 title = "";
9223
9224 /* Notification body text. */
9225 lres = Fplist_get (arg_plist, QCbody);
9226 if (STRINGP (lres))
9227 msg = SSDATA (code_convert_string_norecord (lres, Qutf_8, 1));
9228 else
9229 msg = "";
9230
9231 /* Do it! */
9232 retval = add_tray_notification (f, icon, tip, severity, timeout, title, msg);
9233 return (retval < 0 ? Qnil : make_number (retval));
9234 }
9235
9236 DEFUN ("w32-notification-close",
9237 Fw32_notification_close, Sw32_notification_close,
9238 1, 1, 0,
9239 doc: /* Remove the MS-Windows tray notification specified by its ID. */)
9240 (Lisp_Object id)
9241 {
9242 struct frame *f = SELECTED_FRAME ();
9243
9244 if (INTEGERP (id))
9245 delete_tray_notification (f, XINT (id));
9246
9247 return Qnil;
9248 }
9249
9250 #endif /* WINDOWSNT && !HAVE_DBUS */
9251
9252 \f
9253 /***********************************************************************
9254 Initialization
9255 ***********************************************************************/
9256
9257 /* Keep this list in the same order as frame_parms in frame.c.
9258 Use 0 for unsupported frame parameters. */
9259
9260 frame_parm_handler w32_frame_parm_handlers[] =
9261 {
9262 x_set_autoraise,
9263 x_set_autolower,
9264 x_set_background_color,
9265 x_set_border_color,
9266 x_set_border_width,
9267 x_set_cursor_color,
9268 x_set_cursor_type,
9269 x_set_font,
9270 x_set_foreground_color,
9271 x_set_icon_name,
9272 x_set_icon_type,
9273 x_set_internal_border_width,
9274 x_set_right_divider_width,
9275 x_set_bottom_divider_width,
9276 x_set_menu_bar_lines,
9277 x_set_mouse_color,
9278 x_explicitly_set_name,
9279 x_set_scroll_bar_width,
9280 x_set_scroll_bar_height,
9281 x_set_title,
9282 x_set_unsplittable,
9283 x_set_vertical_scroll_bars,
9284 x_set_horizontal_scroll_bars,
9285 x_set_visibility,
9286 x_set_tool_bar_lines,
9287 0, /* x_set_scroll_bar_foreground, */
9288 0, /* x_set_scroll_bar_background, */
9289 x_set_screen_gamma,
9290 x_set_line_spacing,
9291 x_set_left_fringe,
9292 x_set_right_fringe,
9293 0, /* x_set_wait_for_wm, */
9294 x_set_fullscreen,
9295 x_set_font_backend,
9296 x_set_alpha,
9297 0, /* x_set_sticky */
9298 0, /* x_set_tool_bar_position */
9299 };
9300
9301 void
9302 syms_of_w32fns (void)
9303 {
9304 globals_of_w32fns ();
9305 track_mouse_window = NULL;
9306
9307 w32_visible_system_caret_hwnd = NULL;
9308
9309 DEFSYM (Qundefined_color, "undefined-color");
9310 DEFSYM (Qcancel_timer, "cancel-timer");
9311 DEFSYM (Qhyper, "hyper");
9312 DEFSYM (Qsuper, "super");
9313 DEFSYM (Qmeta, "meta");
9314 DEFSYM (Qalt, "alt");
9315 DEFSYM (Qctrl, "ctrl");
9316 DEFSYM (Qcontrol, "control");
9317 DEFSYM (Qshift, "shift");
9318 DEFSYM (Qfont_param, "font-parameter");
9319 DEFSYM (Qgeometry, "geometry");
9320 DEFSYM (Qworkarea, "workarea");
9321 DEFSYM (Qmm_size, "mm-size");
9322 DEFSYM (Qframes, "frames");
9323 DEFSYM (Qtip_frame, "tip-frame");
9324 DEFSYM (Qunicode_sip, "unicode-sip");
9325 #if defined WINDOWSNT && !defined HAVE_DBUS
9326 DEFSYM (QCicon, ":icon");
9327 DEFSYM (QCtip, ":tip");
9328 DEFSYM (QClevel, ":level");
9329 DEFSYM (Qinfo, "info");
9330 DEFSYM (Qwarning, "warning");
9331 DEFSYM (QCtitle, ":title");
9332 DEFSYM (QCbody, ":body");
9333 #endif
9334
9335 /* Symbols used elsewhere, but only in MS-Windows-specific code. */
9336 DEFSYM (Qgnutls_dll, "gnutls");
9337 DEFSYM (Qlibxml2_dll, "libxml2");
9338 DEFSYM (Qserif, "serif");
9339 DEFSYM (Qzlib_dll, "zlib");
9340
9341 Fput (Qundefined_color, Qerror_conditions,
9342 listn (CONSTYPE_PURE, 2, Qundefined_color, Qerror));
9343 Fput (Qundefined_color, Qerror_message,
9344 build_pure_c_string ("Undefined color"));
9345
9346 staticpro (&w32_grabbed_keys);
9347 w32_grabbed_keys = Qnil;
9348
9349 DEFVAR_LISP ("w32-color-map", Vw32_color_map,
9350 doc: /* An array of color name mappings for Windows. */);
9351 Vw32_color_map = Qnil;
9352
9353 DEFVAR_LISP ("w32-pass-alt-to-system", Vw32_pass_alt_to_system,
9354 doc: /* Non-nil if Alt key presses are passed on to Windows.
9355 When non-nil, for example, Alt pressed and released and then space will
9356 open the System menu. When nil, Emacs processes the Alt key events, and
9357 then silently swallows them. */);
9358 Vw32_pass_alt_to_system = Qnil;
9359
9360 DEFVAR_LISP ("w32-alt-is-meta", Vw32_alt_is_meta,
9361 doc: /* Non-nil if the Alt key is to be considered the same as the META key.
9362 When nil, Emacs will translate the Alt key to the ALT modifier, not to META. */);
9363 Vw32_alt_is_meta = Qt;
9364
9365 DEFVAR_INT ("w32-quit-key", w32_quit_key,
9366 doc: /* If non-zero, the virtual key code for an alternative quit key. */);
9367 w32_quit_key = 0;
9368
9369 DEFVAR_LISP ("w32-pass-lwindow-to-system",
9370 Vw32_pass_lwindow_to_system,
9371 doc: /* If non-nil, the left \"Windows\" key is passed on to Windows.
9372
9373 When non-nil, the Start menu is opened by tapping the key.
9374 If you set this to nil, the left \"Windows\" key is processed by Emacs
9375 according to the value of `w32-lwindow-modifier', which see.
9376
9377 Note that some combinations of the left \"Windows\" key with other keys are
9378 caught by Windows at low level, and so binding them in Emacs will have no
9379 effect. For example, <lwindow>-r always pops up the Windows Run dialog,
9380 <lwindow>-<Pause> pops up the "System Properties" dialog, etc. However, see
9381 the doc string of `w32-phantom-key-code'. */);
9382 Vw32_pass_lwindow_to_system = Qt;
9383
9384 DEFVAR_LISP ("w32-pass-rwindow-to-system",
9385 Vw32_pass_rwindow_to_system,
9386 doc: /* If non-nil, the right \"Windows\" key is passed on to Windows.
9387
9388 When non-nil, the Start menu is opened by tapping the key.
9389 If you set this to nil, the right \"Windows\" key is processed by Emacs
9390 according to the value of `w32-rwindow-modifier', which see.
9391
9392 Note that some combinations of the right \"Windows\" key with other keys are
9393 caught by Windows at low level, and so binding them in Emacs will have no
9394 effect. For example, <rwindow>-r always pops up the Windows Run dialog,
9395 <rwindow>-<Pause> pops up the "System Properties" dialog, etc. However, see
9396 the doc string of `w32-phantom-key-code'. */);
9397 Vw32_pass_rwindow_to_system = Qt;
9398
9399 DEFVAR_LISP ("w32-phantom-key-code",
9400 Vw32_phantom_key_code,
9401 doc: /* Virtual key code used to generate \"phantom\" key presses.
9402 Value is a number between 0 and 255.
9403
9404 Phantom key presses are generated in order to stop the system from
9405 acting on \"Windows\" key events when `w32-pass-lwindow-to-system' or
9406 `w32-pass-rwindow-to-system' is nil. */);
9407 /* Although 255 is technically not a valid key code, it works and
9408 means that this hack won't interfere with any real key code. */
9409 XSETINT (Vw32_phantom_key_code, 255);
9410
9411 DEFVAR_LISP ("w32-enable-num-lock",
9412 Vw32_enable_num_lock,
9413 doc: /* If non-nil, the Num Lock key acts normally.
9414 Set to nil to handle Num Lock as the `kp-numlock' key. */);
9415 Vw32_enable_num_lock = Qt;
9416
9417 DEFVAR_LISP ("w32-enable-caps-lock",
9418 Vw32_enable_caps_lock,
9419 doc: /* If non-nil, the Caps Lock key acts normally.
9420 Set to nil to handle Caps Lock as the `capslock' key. */);
9421 Vw32_enable_caps_lock = Qt;
9422
9423 DEFVAR_LISP ("w32-scroll-lock-modifier",
9424 Vw32_scroll_lock_modifier,
9425 doc: /* Modifier to use for the Scroll Lock ON state.
9426 The value can be hyper, super, meta, alt, control or shift for the
9427 respective modifier, or nil to handle Scroll Lock as the `scroll' key.
9428 Any other value will cause the Scroll Lock key to be ignored. */);
9429 Vw32_scroll_lock_modifier = Qnil;
9430
9431 DEFVAR_LISP ("w32-lwindow-modifier",
9432 Vw32_lwindow_modifier,
9433 doc: /* Modifier to use for the left \"Windows\" key.
9434 The value can be hyper, super, meta, alt, control or shift for the
9435 respective modifier, or nil to appear as the `lwindow' key.
9436 Any other value will cause the key to be ignored. */);
9437 Vw32_lwindow_modifier = Qnil;
9438
9439 DEFVAR_LISP ("w32-rwindow-modifier",
9440 Vw32_rwindow_modifier,
9441 doc: /* Modifier to use for the right \"Windows\" key.
9442 The value can be hyper, super, meta, alt, control or shift for the
9443 respective modifier, or nil to appear as the `rwindow' key.
9444 Any other value will cause the key to be ignored. */);
9445 Vw32_rwindow_modifier = Qnil;
9446
9447 DEFVAR_LISP ("w32-apps-modifier",
9448 Vw32_apps_modifier,
9449 doc: /* Modifier to use for the \"Apps\" key.
9450 The value can be hyper, super, meta, alt, control or shift for the
9451 respective modifier, or nil to appear as the `apps' key.
9452 Any other value will cause the key to be ignored. */);
9453 Vw32_apps_modifier = Qnil;
9454
9455 DEFVAR_BOOL ("w32-enable-synthesized-fonts", w32_enable_synthesized_fonts,
9456 doc: /* Non-nil enables selection of artificially italicized and bold fonts. */);
9457 w32_enable_synthesized_fonts = 0;
9458
9459 DEFVAR_LISP ("w32-enable-palette", Vw32_enable_palette,
9460 doc: /* Non-nil enables Windows palette management to map colors exactly. */);
9461 Vw32_enable_palette = Qt;
9462
9463 DEFVAR_INT ("w32-mouse-button-tolerance",
9464 w32_mouse_button_tolerance,
9465 doc: /* Analogue of double click interval for faking middle mouse events.
9466 The value is the minimum time in milliseconds that must elapse between
9467 left and right button down events before they are considered distinct events.
9468 If both mouse buttons are depressed within this interval, a middle mouse
9469 button down event is generated instead. */);
9470 w32_mouse_button_tolerance = GetDoubleClickTime () / 2;
9471
9472 DEFVAR_INT ("w32-mouse-move-interval",
9473 w32_mouse_move_interval,
9474 doc: /* Minimum interval between mouse move events.
9475 The value is the minimum time in milliseconds that must elapse between
9476 successive mouse move (or scroll bar drag) events before they are
9477 reported as lisp events. */);
9478 w32_mouse_move_interval = 0;
9479
9480 DEFVAR_BOOL ("w32-pass-extra-mouse-buttons-to-system",
9481 w32_pass_extra_mouse_buttons_to_system,
9482 doc: /* If non-nil, the fourth and fifth mouse buttons are passed to Windows.
9483 Recent versions of Windows support mice with up to five buttons.
9484 Since most applications don't support these extra buttons, most mouse
9485 drivers will allow you to map them to functions at the system level.
9486 If this variable is non-nil, Emacs will pass them on, allowing the
9487 system to handle them. */);
9488 w32_pass_extra_mouse_buttons_to_system = 0;
9489
9490 DEFVAR_BOOL ("w32-pass-multimedia-buttons-to-system",
9491 w32_pass_multimedia_buttons_to_system,
9492 doc: /* If non-nil, media buttons are passed to Windows.
9493 Some modern keyboards contain buttons for controlling media players, web
9494 browsers and other applications. Generally these buttons are handled on a
9495 system wide basis, but by setting this to nil they are made available
9496 to Emacs for binding. Depending on your keyboard, additional keys that
9497 may be available are:
9498
9499 browser-back, browser-forward, browser-refresh, browser-stop,
9500 browser-search, browser-favorites, browser-home,
9501 mail, mail-reply, mail-forward, mail-send,
9502 app-1, app-2,
9503 help, find, new, open, close, save, print, undo, redo, copy, cut, paste,
9504 spell-check, correction-list, toggle-dictate-command,
9505 media-next, media-previous, media-stop, media-play-pause, media-select,
9506 media-play, media-pause, media-record, media-fast-forward, media-rewind,
9507 media-channel-up, media-channel-down,
9508 volume-mute, volume-up, volume-down,
9509 mic-volume-mute, mic-volume-down, mic-volume-up, mic-toggle,
9510 bass-down, bass-boost, bass-up, treble-down, treble-up */);
9511 w32_pass_multimedia_buttons_to_system = 1;
9512
9513 #if 0 /* TODO: Mouse cursor customization. */
9514 DEFVAR_LISP ("x-pointer-shape", Vx_pointer_shape,
9515 doc: /* The shape of the pointer when over text.
9516 Changing the value does not affect existing frames
9517 unless you set the mouse color. */);
9518 Vx_pointer_shape = Qnil;
9519
9520 Vx_nontext_pointer_shape = Qnil;
9521
9522 Vx_mode_pointer_shape = Qnil;
9523
9524 DEFVAR_LISP ("x-hourglass-pointer-shape", Vx_hourglass_pointer_shape,
9525 doc: /* The shape of the pointer when Emacs is busy.
9526 This variable takes effect when you create a new frame
9527 or when you set the mouse color. */);
9528 Vx_hourglass_pointer_shape = Qnil;
9529
9530 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
9531 Vx_sensitive_text_pointer_shape,
9532 doc: /* The shape of the pointer when over mouse-sensitive text.
9533 This variable takes effect when you create a new frame
9534 or when you set the mouse color. */);
9535 Vx_sensitive_text_pointer_shape = Qnil;
9536
9537 DEFVAR_LISP ("x-window-horizontal-drag-cursor",
9538 Vx_window_horizontal_drag_shape,
9539 doc: /* Pointer shape to use for indicating a window can be dragged horizontally.
9540 This variable takes effect when you create a new frame
9541 or when you set the mouse color. */);
9542 Vx_window_horizontal_drag_shape = Qnil;
9543
9544 DEFVAR_LISP ("x-window-vertical-drag-cursor",
9545 Vx_window_vertical_drag_shape,
9546 doc: /* Pointer shape to use for indicating a window can be dragged vertically.
9547 This variable takes effect when you create a new frame
9548 or when you set the mouse color. */);
9549 Vx_window_vertical_drag_shape = Qnil;
9550 #endif
9551
9552 DEFVAR_LISP ("x-cursor-fore-pixel", Vx_cursor_fore_pixel,
9553 doc: /* A string indicating the foreground color of the cursor box. */);
9554 Vx_cursor_fore_pixel = Qnil;
9555
9556 DEFVAR_LISP ("x-max-tooltip-size", Vx_max_tooltip_size,
9557 doc: /* Maximum size for tooltips.
9558 Value is a pair (COLUMNS . ROWS). Text larger than this is clipped. */);
9559 Vx_max_tooltip_size = Fcons (make_number (80), make_number (40));
9560
9561 DEFVAR_LISP ("x-no-window-manager", Vx_no_window_manager,
9562 doc: /* Non-nil if no window manager is in use.
9563 Emacs doesn't try to figure this out; this is always nil
9564 unless you set it to something else. */);
9565 /* We don't have any way to find this out, so set it to nil
9566 and maybe the user would like to set it to t. */
9567 Vx_no_window_manager = Qnil;
9568
9569 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
9570 Vx_pixel_size_width_font_regexp,
9571 doc: /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'.
9572
9573 Since Emacs gets width of a font matching with this regexp from
9574 PIXEL_SIZE field of the name, font finding mechanism gets faster for
9575 such a font. This is especially effective for such large fonts as
9576 Chinese, Japanese, and Korean. */);
9577 Vx_pixel_size_width_font_regexp = Qnil;
9578
9579 DEFVAR_LISP ("w32-bdf-filename-alist",
9580 Vw32_bdf_filename_alist,
9581 doc: /* List of bdf fonts and their corresponding filenames. */);
9582 Vw32_bdf_filename_alist = Qnil;
9583
9584 DEFVAR_BOOL ("w32-strict-fontnames",
9585 w32_strict_fontnames,
9586 doc: /* Non-nil means only use fonts that are exact matches for those requested.
9587 Default is nil, which allows old fontnames that are not XLFD compliant,
9588 and allows third-party CJK display to work by specifying false charset
9589 fields to trick Emacs into translating to Big5, SJIS etc.
9590 Setting this to t will prevent wrong fonts being selected when
9591 fontsets are automatically created. */);
9592 w32_strict_fontnames = 0;
9593
9594 DEFVAR_BOOL ("w32-strict-painting",
9595 w32_strict_painting,
9596 doc: /* Non-nil means use strict rules for repainting frames.
9597 Set this to nil to get the old behavior for repainting; this should
9598 only be necessary if the default setting causes problems. */);
9599 w32_strict_painting = 1;
9600
9601 DEFVAR_BOOL ("w32-use-fallback-wm-chars-method",
9602 w32_use_fallback_wm_chars_method,
9603 doc: /* Non-nil means use old method of processing character keys.
9604 This is intended only for debugging of the new processing method.
9605 Default is nil.
9606
9607 This variable has effect only on NT family of systems, not on Windows 9X. */);
9608 w32_use_fallback_wm_chars_method = 0;
9609
9610 DEFVAR_BOOL ("w32-disable-new-uniscribe-apis",
9611 w32_disable_new_uniscribe_apis,
9612 doc: /* Non-nil means don't use new Uniscribe APIs.
9613 The new APIs are used to access OTF features supported by fonts.
9614 This is intended only for debugging of the new Uniscribe-related code.
9615 Default is nil.
9616
9617 This variable has effect only on Windows Vista and later. */);
9618 w32_disable_new_uniscribe_apis = 0;
9619
9620 #if 0 /* TODO: Port to W32 */
9621 defsubr (&Sx_change_window_property);
9622 defsubr (&Sx_delete_window_property);
9623 defsubr (&Sx_window_property);
9624 #endif
9625 defsubr (&Sxw_display_color_p);
9626 defsubr (&Sx_display_grayscale_p);
9627 defsubr (&Sxw_color_defined_p);
9628 defsubr (&Sxw_color_values);
9629 defsubr (&Sx_server_max_request_size);
9630 defsubr (&Sx_server_vendor);
9631 defsubr (&Sx_server_version);
9632 defsubr (&Sx_display_pixel_width);
9633 defsubr (&Sx_display_pixel_height);
9634 defsubr (&Sx_display_mm_width);
9635 defsubr (&Sx_display_mm_height);
9636 defsubr (&Sx_display_screens);
9637 defsubr (&Sx_display_planes);
9638 defsubr (&Sx_display_color_cells);
9639 defsubr (&Sx_display_visual_class);
9640 defsubr (&Sx_display_backing_store);
9641 defsubr (&Sx_display_save_under);
9642 defsubr (&Sx_create_frame);
9643 defsubr (&Sx_open_connection);
9644 defsubr (&Sx_close_connection);
9645 defsubr (&Sx_display_list);
9646 defsubr (&Sw32_frame_geometry);
9647 defsubr (&Sw32_frame_edges);
9648 defsubr (&Sw32_mouse_absolute_pixel_position);
9649 defsubr (&Sw32_set_mouse_absolute_pixel_position);
9650 defsubr (&Sx_synchronize);
9651
9652 /* W32 specific functions */
9653
9654 defsubr (&Sw32_define_rgb_color);
9655 defsubr (&Sw32_default_color_map);
9656 defsubr (&Sw32_display_monitor_attributes_list);
9657 defsubr (&Sw32_send_sys_command);
9658 defsubr (&Sw32_shell_execute);
9659 defsubr (&Sw32_register_hot_key);
9660 defsubr (&Sw32_unregister_hot_key);
9661 defsubr (&Sw32_registered_hot_keys);
9662 defsubr (&Sw32_reconstruct_hot_key);
9663 defsubr (&Sw32_toggle_lock_key);
9664 defsubr (&Sw32_window_exists_p);
9665 defsubr (&Sw32_battery_status);
9666 defsubr (&Sw32__menu_bar_in_use);
9667 #if defined WINDOWSNT && !defined HAVE_DBUS
9668 defsubr (&Sw32_notification_notify);
9669 defsubr (&Sw32_notification_close);
9670 #endif
9671
9672 #ifdef WINDOWSNT
9673 defsubr (&Sfile_system_info);
9674 defsubr (&Sdefault_printer_name);
9675 #endif
9676
9677 defsubr (&Sset_message_beep);
9678 defsubr (&Sx_show_tip);
9679 defsubr (&Sx_hide_tip);
9680 tip_timer = Qnil;
9681 staticpro (&tip_timer);
9682 tip_frame = Qnil;
9683 staticpro (&tip_frame);
9684
9685 last_show_tip_args = Qnil;
9686 staticpro (&last_show_tip_args);
9687
9688 defsubr (&Sx_file_dialog);
9689 #ifdef WINDOWSNT
9690 defsubr (&Ssystem_move_file_to_trash);
9691 #endif
9692 }
9693
9694 \f
9695
9696 /* Crashing and reporting backtrace. */
9697
9698 #ifndef CYGWIN
9699 static LONG CALLBACK my_exception_handler (EXCEPTION_POINTERS *);
9700 static LPTOP_LEVEL_EXCEPTION_FILTER prev_exception_handler;
9701 #endif
9702 static DWORD except_code;
9703 static PVOID except_addr;
9704
9705 #ifndef CYGWIN
9706
9707 /* Stack overflow recovery. */
9708
9709 /* MinGW headers don't declare this (should be in malloc.h). Also,
9710 the function is not present pre-W2K, so make the call through
9711 a function pointer. */
9712 typedef int (__cdecl *_resetstkoflw_proc) (void);
9713 static _resetstkoflw_proc resetstkoflw;
9714
9715 /* Re-establish the guard page at stack limit. This is needed because
9716 when a stack overflow is detected, Windows removes the guard bit
9717 from the guard page, so if we don't re-establish that protection,
9718 the next stack overflow will cause a crash. */
9719 void
9720 w32_reset_stack_overflow_guard (void)
9721 {
9722 if (resetstkoflw == NULL)
9723 resetstkoflw =
9724 (_resetstkoflw_proc)GetProcAddress (GetModuleHandle ("msvcrt.dll"),
9725 "_resetstkoflw");
9726 /* We ignore the return value. If _resetstkoflw fails, the next
9727 stack overflow will crash the program. */
9728 if (resetstkoflw != NULL)
9729 (void)resetstkoflw ();
9730 }
9731
9732 static void
9733 stack_overflow_handler (void)
9734 {
9735 /* Hard GC error may lead to stack overflow caused by
9736 too nested calls to mark_object. No way to survive. */
9737 if (gc_in_progress)
9738 terminate_due_to_signal (SIGSEGV, 40);
9739 #ifdef _WIN64
9740 /* See ms-w32.h: MinGW64's longjmp crashes if invoked in this context. */
9741 __builtin_longjmp (return_to_command_loop, 1);
9742 #else
9743 sys_longjmp (return_to_command_loop, 1);
9744 #endif
9745 }
9746
9747 /* This handler records the exception code and the address where it
9748 was triggered so that this info could be included in the backtrace.
9749 Without that, the backtrace in some cases has no information
9750 whatsoever about the offending code, and looks as if the top-level
9751 exception handler in the MinGW startup code was the one that
9752 crashed. We also recover from stack overflow, by calling our stack
9753 overflow handler that jumps back to top level. */
9754 static LONG CALLBACK
9755 my_exception_handler (EXCEPTION_POINTERS * exception_data)
9756 {
9757 except_code = exception_data->ExceptionRecord->ExceptionCode;
9758 except_addr = exception_data->ExceptionRecord->ExceptionAddress;
9759
9760 /* If this is a stack overflow exception, attempt to recover. */
9761 if (exception_data->ExceptionRecord->ExceptionCode == EXCEPTION_STACK_OVERFLOW
9762 && exception_data->ExceptionRecord->NumberParameters == 2
9763 /* We can only longjmp to top level from the main thread. */
9764 && GetCurrentThreadId () == dwMainThreadId)
9765 {
9766 /* Call stack_overflow_handler (). */
9767 #ifdef _WIN64
9768 exception_data->ContextRecord->Rip = (DWORD_PTR) &stack_overflow_handler;
9769 #else
9770 exception_data->ContextRecord->Eip = (DWORD_PTR) &stack_overflow_handler;
9771 #endif
9772 /* Zero this out, so the stale address of the stack overflow
9773 exception we handled is not displayed in some future
9774 unrelated crash. */
9775 except_addr = 0;
9776 return EXCEPTION_CONTINUE_EXECUTION;
9777 }
9778
9779 if (prev_exception_handler)
9780 return prev_exception_handler (exception_data);
9781 return EXCEPTION_EXECUTE_HANDLER;
9782 }
9783 #endif
9784
9785 typedef USHORT (WINAPI * CaptureStackBackTrace_proc) (ULONG, ULONG, PVOID *,
9786 PULONG);
9787
9788 #define BACKTRACE_LIMIT_MAX 62
9789
9790 int
9791 w32_backtrace (void **buffer, int limit)
9792 {
9793 static CaptureStackBackTrace_proc s_pfn_CaptureStackBackTrace = NULL;
9794 HMODULE hm_kernel32 = NULL;
9795
9796 if (!s_pfn_CaptureStackBackTrace)
9797 {
9798 hm_kernel32 = LoadLibrary ("Kernel32.dll");
9799 s_pfn_CaptureStackBackTrace =
9800 (CaptureStackBackTrace_proc) GetProcAddress (hm_kernel32,
9801 "RtlCaptureStackBackTrace");
9802 }
9803 if (s_pfn_CaptureStackBackTrace)
9804 return s_pfn_CaptureStackBackTrace (0, min (BACKTRACE_LIMIT_MAX, limit),
9805 buffer, NULL);
9806 return 0;
9807 }
9808
9809 void
9810 emacs_abort (void)
9811 {
9812 int button;
9813 button = MessageBox (NULL,
9814 "A fatal error has occurred!\n\n"
9815 "Would you like to attach a debugger?\n\n"
9816 "Select:\n"
9817 "YES -- to debug Emacs, or\n"
9818 "NO -- to abort Emacs and produce a backtrace\n"
9819 " (emacs_backtrace.txt in current directory)."
9820 #if __GNUC__
9821 "\n\n(type \"gdb -p <emacs-PID>\" and\n"
9822 "\"continue\" inside GDB before clicking YES.)"
9823 #endif
9824 , "Emacs Abort Dialog",
9825 MB_ICONEXCLAMATION | MB_TASKMODAL
9826 | MB_SETFOREGROUND | MB_YESNO);
9827 switch (button)
9828 {
9829 case IDYES:
9830 DebugBreak ();
9831 exit (2); /* tell the compiler we will never return */
9832 case IDNO:
9833 default:
9834 {
9835 void *stack[BACKTRACE_LIMIT_MAX + 1];
9836 int i = w32_backtrace (stack, BACKTRACE_LIMIT_MAX + 1);
9837
9838 if (i)
9839 {
9840 int errfile_fd = -1;
9841 int j;
9842 char buf[sizeof ("\r\nException at this address:\r\n\r\n")
9843 /* The type below should really be 'void *', but
9844 INT_BUFSIZE_BOUND cannot handle that without
9845 triggering compiler warnings (under certain
9846 pedantic warning switches), it wants an
9847 integer type. */
9848 + 2 * INT_BUFSIZE_BOUND (intptr_t)];
9849 #ifdef CYGWIN
9850 int stderr_fd = 2;
9851 #else
9852 HANDLE errout = GetStdHandle (STD_ERROR_HANDLE);
9853 int stderr_fd = -1;
9854
9855 if (errout && errout != INVALID_HANDLE_VALUE)
9856 stderr_fd = _open_osfhandle ((intptr_t)errout, O_APPEND | O_BINARY);
9857 #endif
9858
9859 /* We use %p, not 0x%p, as %p produces a leading "0x" on XP,
9860 but not on Windows 7. addr2line doesn't mind a missing
9861 "0x", but will be confused by an extra one. */
9862 if (except_addr)
9863 sprintf (buf, "\r\nException 0x%lx at this address:\r\n%p\r\n",
9864 except_code, except_addr);
9865 if (stderr_fd >= 0)
9866 {
9867 if (except_addr)
9868 write (stderr_fd, buf, strlen (buf));
9869 write (stderr_fd, "\r\nBacktrace:\r\n", 14);
9870 }
9871 #ifdef CYGWIN
9872 #define _open open
9873 #endif
9874 errfile_fd = _open ("emacs_backtrace.txt", O_RDWR | O_CREAT | O_BINARY, S_IREAD | S_IWRITE);
9875 if (errfile_fd >= 0)
9876 {
9877 lseek (errfile_fd, 0L, SEEK_END);
9878 if (except_addr)
9879 write (errfile_fd, buf, strlen (buf));
9880 write (errfile_fd, "\r\nBacktrace:\r\n", 14);
9881 }
9882
9883 for (j = 0; j < i; j++)
9884 {
9885 /* stack[] gives the return addresses, whereas we want
9886 the address of the call, so decrease each address
9887 by approximate size of 1 CALL instruction. */
9888 sprintf (buf, "%p\r\n", (char *)stack[j] - sizeof(void *));
9889 if (stderr_fd >= 0)
9890 write (stderr_fd, buf, strlen (buf));
9891 if (errfile_fd >= 0)
9892 write (errfile_fd, buf, strlen (buf));
9893 }
9894 if (i == BACKTRACE_LIMIT_MAX)
9895 {
9896 if (stderr_fd >= 0)
9897 write (stderr_fd, "...\r\n", 5);
9898 if (errfile_fd >= 0)
9899 write (errfile_fd, "...\r\n", 5);
9900 }
9901 if (errfile_fd >= 0)
9902 close (errfile_fd);
9903 }
9904 abort ();
9905 break;
9906 }
9907 }
9908 }
9909
9910 \f
9911
9912 /* Initialization. */
9913
9914 /*
9915 globals_of_w32fns is used to initialize those global variables that
9916 must always be initialized on startup even when the global variable
9917 initialized is non zero (see the function main in emacs.c).
9918 globals_of_w32fns is called from syms_of_w32fns when the global
9919 variable initialized is 0 and directly from main when initialized
9920 is non zero.
9921 */
9922 void
9923 globals_of_w32fns (void)
9924 {
9925 HMODULE user32_lib = GetModuleHandle ("user32.dll");
9926 /*
9927 TrackMouseEvent not available in all versions of Windows, so must load
9928 it dynamically. Do it once, here, instead of every time it is used.
9929 */
9930 track_mouse_event_fn = (TrackMouseEvent_Proc)
9931 GetProcAddress (user32_lib, "TrackMouseEvent");
9932
9933 monitor_from_point_fn = (MonitorFromPoint_Proc)
9934 GetProcAddress (user32_lib, "MonitorFromPoint");
9935 get_monitor_info_fn = (GetMonitorInfo_Proc)
9936 GetProcAddress (user32_lib, "GetMonitorInfoA");
9937 monitor_from_window_fn = (MonitorFromWindow_Proc)
9938 GetProcAddress (user32_lib, "MonitorFromWindow");
9939 enum_display_monitors_fn = (EnumDisplayMonitors_Proc)
9940 GetProcAddress (user32_lib, "EnumDisplayMonitors");
9941 get_title_bar_info_fn = (GetTitleBarInfo_Proc)
9942 GetProcAddress (user32_lib, "GetTitleBarInfo");
9943
9944 {
9945 HMODULE imm32_lib = GetModuleHandle ("imm32.dll");
9946 get_composition_string_fn = (ImmGetCompositionString_Proc)
9947 GetProcAddress (imm32_lib, "ImmGetCompositionStringW");
9948 get_ime_context_fn = (ImmGetContext_Proc)
9949 GetProcAddress (imm32_lib, "ImmGetContext");
9950 release_ime_context_fn = (ImmReleaseContext_Proc)
9951 GetProcAddress (imm32_lib, "ImmReleaseContext");
9952 set_ime_composition_window_fn = (ImmSetCompositionWindow_Proc)
9953 GetProcAddress (imm32_lib, "ImmSetCompositionWindow");
9954 }
9955
9956 except_code = 0;
9957 except_addr = 0;
9958 #ifndef CYGWIN
9959 prev_exception_handler = SetUnhandledExceptionFilter (my_exception_handler);
9960 resetstkoflw = NULL;
9961 #endif
9962
9963 DEFVAR_INT ("w32-ansi-code-page",
9964 w32_ansi_code_page,
9965 doc: /* The ANSI code page used by the system. */);
9966 w32_ansi_code_page = GetACP ();
9967
9968 if (os_subtype == OS_NT)
9969 w32_unicode_gui = 1;
9970 else
9971 w32_unicode_gui = 0;
9972
9973 after_deadkey = -1;
9974
9975 /* MessageBox does not work without this when linked to comctl32.dll 6.0. */
9976 InitCommonControls ();
9977
9978 syms_of_w32uniscribe ();
9979 }
9980
9981 #ifdef NTGUI_UNICODE
9982
9983 Lisp_Object
9984 ntgui_encode_system (Lisp_Object str)
9985 {
9986 Lisp_Object encoded;
9987 to_unicode (str, &encoded);
9988 return encoded;
9989 }
9990
9991 #endif /* NTGUI_UNICODE */