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