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