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