* lisp/ielm.el (ielm-menu): New menu.
[emacs.git] / src / w32fns.c
blobd7ac0dd1a6c7af6d0167c5643cbcead32e8183ae
1 /* Graphical user interface functions for the Microsoft Windows API.
3 Copyright (C) 1989, 1992-2013 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software: you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation, either version 3 of the License, or
10 (at your option) any later version.
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
20 /* Added by Kevin Gallo */
22 #include <config.h>
24 #include <signal.h>
25 #include <stdio.h>
26 #include <limits.h>
27 #include <errno.h>
28 #include <math.h>
29 #include <fcntl.h>
30 #include <unistd.h>
32 #include "lisp.h"
33 #include "w32term.h"
34 #include "frame.h"
35 #include "window.h"
36 #include "character.h"
37 #include "buffer.h"
38 #include "intervals.h"
39 #include "dispextern.h"
40 #include "keyboard.h"
41 #include "blockinput.h"
42 #include "epaths.h"
43 #include "charset.h"
44 #include "coding.h"
45 #include "ccl.h"
46 #include "fontset.h"
47 #include "systime.h"
48 #include "termhooks.h"
50 #include "w32common.h"
52 #ifdef WINDOWSNT
53 #include "w32heap.h"
54 #endif /* WINDOWSNT */
56 #if CYGWIN
57 #include "cygw32.h"
58 #else
59 #include "w32.h"
60 #endif
62 #include "bitmaps/gray.xbm"
64 #include <commctrl.h>
65 #include <commdlg.h>
66 #include <shellapi.h>
67 #include <ctype.h>
68 #include <winspool.h>
69 #include <objbase.h>
71 #include <dlgs.h>
72 #include <imm.h>
74 #include "font.h"
75 #include "w32font.h"
77 #ifndef FOF_NO_CONNECTED_ELEMENTS
78 #define FOF_NO_CONNECTED_ELEMENTS 0x2000
79 #endif
81 void syms_of_w32fns (void);
82 void globals_of_w32fns (void);
84 extern void free_frame_menubar (struct frame *);
85 extern int w32_console_toggle_lock_key (int, Lisp_Object);
86 extern void w32_menu_display_help (HWND, HMENU, UINT, UINT);
87 extern void w32_free_menu_strings (HWND);
88 extern const char *map_w32_filename (const char *, const char **);
89 extern char * w32_strerror (int error_no);
91 /* If non-NULL, a handle to a frame where to display the hourglass cursor. */
92 static HWND hourglass_hwnd = NULL;
94 #ifndef IDC_HAND
95 #define IDC_HAND MAKEINTRESOURCE(32649)
96 #endif
98 Lisp_Object Qsuppress_icon;
99 Lisp_Object Qundefined_color;
100 Lisp_Object Qcancel_timer;
101 Lisp_Object Qfont_param;
102 Lisp_Object Qhyper;
103 Lisp_Object Qsuper;
104 Lisp_Object Qmeta;
105 Lisp_Object Qalt;
106 Lisp_Object Qctrl;
107 Lisp_Object Qcontrol;
108 Lisp_Object Qshift;
111 /* Prefix for system colors. */
112 #define SYSTEM_COLOR_PREFIX "System"
113 #define SYSTEM_COLOR_PREFIX_LEN (sizeof (SYSTEM_COLOR_PREFIX) - 1)
115 /* State variables for emulating a three button mouse. */
116 #define LMOUSE 1
117 #define MMOUSE 2
118 #define RMOUSE 4
120 static int button_state = 0;
121 static W32Msg saved_mouse_button_msg;
122 static unsigned mouse_button_timer = 0; /* non-zero when timer is active */
123 static W32Msg saved_mouse_move_msg;
124 static unsigned mouse_move_timer = 0;
126 /* Window that is tracking the mouse. */
127 static HWND track_mouse_window;
129 /* Multi-monitor API definitions that are not pulled from the headers
130 since we are compiling for NT 4. */
131 #ifndef MONITOR_DEFAULT_TO_NEAREST
132 #define MONITOR_DEFAULT_TO_NEAREST 2
133 #endif
134 /* MinGW headers define MONITORINFO unconditionally, but MSVC ones don't.
135 To avoid a compile error on one or the other, redefine with a new name. */
136 struct MONITOR_INFO
138 DWORD cbSize;
139 RECT rcMonitor;
140 RECT rcWork;
141 DWORD dwFlags;
144 /* Reportedly, MSVC does not have this in its headers. */
145 #if defined (_MSC_VER) && _WIN32_WINNT < 0x0500
146 DECLARE_HANDLE(HMONITOR);
147 #endif
149 typedef BOOL (WINAPI * TrackMouseEvent_Proc)
150 (IN OUT LPTRACKMOUSEEVENT lpEventTrack);
151 typedef LONG (WINAPI * ImmGetCompositionString_Proc)
152 (IN HIMC context, IN DWORD index, OUT LPVOID buffer, IN DWORD bufLen);
153 typedef HIMC (WINAPI * ImmGetContext_Proc) (IN HWND window);
154 typedef HWND (WINAPI * ImmReleaseContext_Proc) (IN HWND wnd, IN HIMC context);
155 typedef HWND (WINAPI * ImmSetCompositionWindow_Proc) (IN HIMC context,
156 IN COMPOSITIONFORM *form);
157 typedef HMONITOR (WINAPI * MonitorFromPoint_Proc) (IN POINT pt, IN DWORD flags);
158 typedef BOOL (WINAPI * GetMonitorInfo_Proc)
159 (IN HMONITOR monitor, OUT struct MONITOR_INFO* info);
160 typedef HMONITOR (WINAPI * MonitorFromWindow_Proc)
161 (IN HWND hwnd, IN DWORD dwFlags);
163 TrackMouseEvent_Proc track_mouse_event_fn = NULL;
164 ImmGetCompositionString_Proc get_composition_string_fn = NULL;
165 ImmGetContext_Proc get_ime_context_fn = NULL;
166 ImmReleaseContext_Proc release_ime_context_fn = NULL;
167 ImmSetCompositionWindow_Proc set_ime_composition_window_fn = NULL;
168 MonitorFromPoint_Proc monitor_from_point_fn = NULL;
169 GetMonitorInfo_Proc get_monitor_info_fn = NULL;
170 MonitorFromWindow_Proc monitor_from_window_fn = NULL;
172 #ifdef NTGUI_UNICODE
173 #define unicode_append_menu AppendMenuW
174 #else /* !NTGUI_UNICODE */
175 extern AppendMenuW_Proc unicode_append_menu;
176 #endif /* NTGUI_UNICODE */
178 /* Flag to selectively ignore WM_IME_CHAR messages. */
179 static int ignore_ime_char = 0;
181 /* W95 mousewheel handler */
182 unsigned int msh_mousewheel = 0;
184 /* Timers */
185 #define MOUSE_BUTTON_ID 1
186 #define MOUSE_MOVE_ID 2
187 #define MENU_FREE_ID 3
188 /* The delay (milliseconds) before a menu is freed after WM_EXITMENULOOP
189 is received. */
190 #define MENU_FREE_DELAY 1000
191 static unsigned menu_free_timer = 0;
193 #ifdef GLYPH_DEBUG
194 static int image_cache_refcount, dpyinfo_refcount;
195 #endif
197 static HWND w32_visible_system_caret_hwnd;
199 static int w32_unicode_gui;
201 /* From w32menu.c */
202 extern HMENU current_popup_menu;
203 static int menubar_in_use = 0;
205 /* From w32uniscribe.c */
206 extern void syms_of_w32uniscribe (void);
207 extern int uniscribe_available;
209 /* Function prototypes for hourglass support. */
210 static void w32_show_hourglass (struct frame *);
211 static void w32_hide_hourglass (void);
213 #ifdef WINDOWSNT
214 /* From w32inevt.c */
215 extern int faked_key;
216 #endif /* WINDOWSNT */
218 /* This gives us the page size and the size of the allocation unit on NT. */
219 SYSTEM_INFO sysinfo_cache;
221 /* This gives us version, build, and platform identification. */
222 OSVERSIONINFO osinfo_cache;
224 DWORD_PTR syspage_mask = 0;
226 /* The major and minor versions of NT. */
227 int w32_major_version;
228 int w32_minor_version;
229 int w32_build_number;
231 /* Distinguish between Windows NT and Windows 95. */
232 int os_subtype;
234 #ifdef HAVE_NTGUI
235 HINSTANCE hinst = NULL;
236 #endif
238 static unsigned int sound_type = 0xFFFFFFFF;
239 #define MB_EMACS_SILENT (0xFFFFFFFF - 1)
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. */
245 struct w32_display_info *
246 check_x_display_info (Lisp_Object frame)
248 if (NILP (frame))
250 struct frame *sf = XFRAME (selected_frame);
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;
257 else if (STRINGP (frame))
258 return x_display_info_for_name (frame);
259 else
261 FRAME_PTR f;
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);
271 /* Return the Emacs frame-object corresponding to an w32 window.
272 It could be the frame's main window or an icon window. */
274 struct frame *
275 x_window_to_frame (struct w32_display_info *dpyinfo, HWND wdesc)
277 Lisp_Object tail, frame;
278 struct frame *f;
280 FOR_EACH_FRAME (tail, frame)
282 f = XFRAME (frame);
283 if (!FRAME_W32_P (f) || FRAME_W32_DISPLAY_INFO (f) != dpyinfo)
284 continue;
286 if (FRAME_W32_WINDOW (f) == wdesc)
287 return f;
289 return 0;
293 static Lisp_Object unwind_create_frame (Lisp_Object);
294 static Lisp_Object unwind_create_tip_frame (Lisp_Object);
295 static void my_create_window (struct frame *);
296 static void my_create_tip_window (struct frame *);
298 /* TODO: Native Input Method support; see x_create_im. */
299 void x_set_foreground_color (struct frame *, Lisp_Object, Lisp_Object);
300 void x_set_background_color (struct frame *, Lisp_Object, Lisp_Object);
301 void x_set_mouse_color (struct frame *, Lisp_Object, Lisp_Object);
302 void x_set_cursor_color (struct frame *, Lisp_Object, Lisp_Object);
303 void x_set_border_color (struct frame *, Lisp_Object, Lisp_Object);
304 void x_set_cursor_type (struct frame *, Lisp_Object, Lisp_Object);
305 void x_set_icon_type (struct frame *, Lisp_Object, Lisp_Object);
306 void x_set_icon_name (struct frame *, Lisp_Object, Lisp_Object);
307 void x_explicitly_set_name (struct frame *, Lisp_Object, Lisp_Object);
308 void x_set_menu_bar_lines (struct frame *, Lisp_Object, Lisp_Object);
309 void x_set_title (struct frame *, Lisp_Object, Lisp_Object);
310 void x_set_tool_bar_lines (struct frame *, Lisp_Object, Lisp_Object);
315 /* Store the screen positions of frame F into XPTR and YPTR.
316 These are the positions of the containing window manager window,
317 not Emacs's own window. */
319 void
320 x_real_positions (FRAME_PTR f, int *xptr, int *yptr)
322 POINT pt;
323 RECT rect;
325 /* Get the bounds of the WM window. */
326 GetWindowRect (FRAME_W32_WINDOW (f), &rect);
328 pt.x = 0;
329 pt.y = 0;
331 /* Convert (0, 0) in the client area to screen co-ordinates. */
332 ClientToScreen (FRAME_W32_WINDOW (f), &pt);
334 /* Remember x_pixels_diff and y_pixels_diff. */
335 f->x_pixels_diff = pt.x - rect.left;
336 f->y_pixels_diff = pt.y - rect.top;
338 *xptr = rect.left;
339 *yptr = rect.top;
342 /* Returns the window rectangle appropriate for the given fullscreen mode.
343 The normal rect parameter was the window's rectangle prior to entering
344 fullscreen mode. If multiple monitor support is available, the nearest
345 monitor to the window is chosen. */
347 void
348 w32_fullscreen_rect (HWND hwnd, int fsmode, RECT normal, RECT *rect)
350 struct MONITOR_INFO mi = { sizeof(mi) };
351 if (monitor_from_window_fn && get_monitor_info_fn)
353 HMONITOR monitor =
354 monitor_from_window_fn (hwnd, MONITOR_DEFAULT_TO_NEAREST);
355 get_monitor_info_fn (monitor, &mi);
357 else
359 mi.rcMonitor.left = 0;
360 mi.rcMonitor.top = 0;
361 mi.rcMonitor.right = GetSystemMetrics (SM_CXSCREEN);
362 mi.rcMonitor.bottom = GetSystemMetrics (SM_CYSCREEN);
363 mi.rcWork.left = 0;
364 mi.rcWork.top = 0;
365 mi.rcWork.right = GetSystemMetrics (SM_CXMAXIMIZED);
366 mi.rcWork.bottom = GetSystemMetrics (SM_CYMAXIMIZED);
369 switch (fsmode)
371 case FULLSCREEN_BOTH:
372 rect->left = mi.rcMonitor.left;
373 rect->top = mi.rcMonitor.top;
374 rect->right = mi.rcMonitor.right;
375 rect->bottom = mi.rcMonitor.bottom;
376 break;
377 case FULLSCREEN_MAXIMIZED:
378 rect->left = mi.rcWork.left;
379 rect->top = mi.rcWork.top;
380 rect->right = mi.rcWork.right;
381 rect->bottom = mi.rcWork.bottom;
382 break;
383 case FULLSCREEN_WIDTH:
384 rect->left = mi.rcWork.left;
385 rect->top = normal.top;
386 rect->right = mi.rcWork.right;
387 rect->bottom = normal.bottom;
388 break;
389 case FULLSCREEN_HEIGHT:
390 rect->left = normal.left;
391 rect->top = mi.rcWork.top;
392 rect->right = normal.right;
393 rect->bottom = mi.rcWork.bottom;
394 break;
395 case FULLSCREEN_NONE:
396 default:
397 *rect = normal;
398 break;
404 DEFUN ("w32-define-rgb-color", Fw32_define_rgb_color,
405 Sw32_define_rgb_color, 4, 4, 0,
406 doc: /* Convert RGB numbers to a Windows color reference and associate with NAME.
407 This adds or updates a named color to `w32-color-map', making it
408 available for use. The original entry's RGB ref is returned, or nil
409 if the entry is new. */)
410 (Lisp_Object red, Lisp_Object green, Lisp_Object blue, Lisp_Object name)
412 Lisp_Object rgb;
413 Lisp_Object oldrgb = Qnil;
414 Lisp_Object entry;
416 CHECK_NUMBER (red);
417 CHECK_NUMBER (green);
418 CHECK_NUMBER (blue);
419 CHECK_STRING (name);
421 XSETINT (rgb, RGB (XUINT (red), XUINT (green), XUINT (blue)));
423 block_input ();
425 /* replace existing entry in w32-color-map or add new entry. */
426 entry = Fassoc (name, Vw32_color_map);
427 if (NILP (entry))
429 entry = Fcons (name, rgb);
430 Vw32_color_map = Fcons (entry, Vw32_color_map);
432 else
434 oldrgb = Fcdr (entry);
435 Fsetcdr (entry, rgb);
438 unblock_input ();
440 return (oldrgb);
443 /* The default colors for the w32 color map */
444 typedef struct colormap_t
446 char *name;
447 COLORREF colorref;
448 } colormap_t;
450 colormap_t w32_color_map[] =
452 {"snow" , PALETTERGB (255,250,250)},
453 {"ghost white" , PALETTERGB (248,248,255)},
454 {"GhostWhite" , PALETTERGB (248,248,255)},
455 {"white smoke" , PALETTERGB (245,245,245)},
456 {"WhiteSmoke" , PALETTERGB (245,245,245)},
457 {"gainsboro" , PALETTERGB (220,220,220)},
458 {"floral white" , PALETTERGB (255,250,240)},
459 {"FloralWhite" , PALETTERGB (255,250,240)},
460 {"old lace" , PALETTERGB (253,245,230)},
461 {"OldLace" , PALETTERGB (253,245,230)},
462 {"linen" , PALETTERGB (250,240,230)},
463 {"antique white" , PALETTERGB (250,235,215)},
464 {"AntiqueWhite" , PALETTERGB (250,235,215)},
465 {"papaya whip" , PALETTERGB (255,239,213)},
466 {"PapayaWhip" , PALETTERGB (255,239,213)},
467 {"blanched almond" , PALETTERGB (255,235,205)},
468 {"BlanchedAlmond" , PALETTERGB (255,235,205)},
469 {"bisque" , PALETTERGB (255,228,196)},
470 {"peach puff" , PALETTERGB (255,218,185)},
471 {"PeachPuff" , PALETTERGB (255,218,185)},
472 {"navajo white" , PALETTERGB (255,222,173)},
473 {"NavajoWhite" , PALETTERGB (255,222,173)},
474 {"moccasin" , PALETTERGB (255,228,181)},
475 {"cornsilk" , PALETTERGB (255,248,220)},
476 {"ivory" , PALETTERGB (255,255,240)},
477 {"lemon chiffon" , PALETTERGB (255,250,205)},
478 {"LemonChiffon" , PALETTERGB (255,250,205)},
479 {"seashell" , PALETTERGB (255,245,238)},
480 {"honeydew" , PALETTERGB (240,255,240)},
481 {"mint cream" , PALETTERGB (245,255,250)},
482 {"MintCream" , PALETTERGB (245,255,250)},
483 {"azure" , PALETTERGB (240,255,255)},
484 {"alice blue" , PALETTERGB (240,248,255)},
485 {"AliceBlue" , PALETTERGB (240,248,255)},
486 {"lavender" , PALETTERGB (230,230,250)},
487 {"lavender blush" , PALETTERGB (255,240,245)},
488 {"LavenderBlush" , PALETTERGB (255,240,245)},
489 {"misty rose" , PALETTERGB (255,228,225)},
490 {"MistyRose" , PALETTERGB (255,228,225)},
491 {"white" , PALETTERGB (255,255,255)},
492 {"black" , PALETTERGB ( 0, 0, 0)},
493 {"dark slate gray" , PALETTERGB ( 47, 79, 79)},
494 {"DarkSlateGray" , PALETTERGB ( 47, 79, 79)},
495 {"dark slate grey" , PALETTERGB ( 47, 79, 79)},
496 {"DarkSlateGrey" , PALETTERGB ( 47, 79, 79)},
497 {"dim gray" , PALETTERGB (105,105,105)},
498 {"DimGray" , PALETTERGB (105,105,105)},
499 {"dim grey" , PALETTERGB (105,105,105)},
500 {"DimGrey" , PALETTERGB (105,105,105)},
501 {"slate gray" , PALETTERGB (112,128,144)},
502 {"SlateGray" , PALETTERGB (112,128,144)},
503 {"slate grey" , PALETTERGB (112,128,144)},
504 {"SlateGrey" , PALETTERGB (112,128,144)},
505 {"light slate gray" , PALETTERGB (119,136,153)},
506 {"LightSlateGray" , PALETTERGB (119,136,153)},
507 {"light slate grey" , PALETTERGB (119,136,153)},
508 {"LightSlateGrey" , PALETTERGB (119,136,153)},
509 {"gray" , PALETTERGB (190,190,190)},
510 {"grey" , PALETTERGB (190,190,190)},
511 {"light grey" , PALETTERGB (211,211,211)},
512 {"LightGrey" , PALETTERGB (211,211,211)},
513 {"light gray" , PALETTERGB (211,211,211)},
514 {"LightGray" , PALETTERGB (211,211,211)},
515 {"midnight blue" , PALETTERGB ( 25, 25,112)},
516 {"MidnightBlue" , PALETTERGB ( 25, 25,112)},
517 {"navy" , PALETTERGB ( 0, 0,128)},
518 {"navy blue" , PALETTERGB ( 0, 0,128)},
519 {"NavyBlue" , PALETTERGB ( 0, 0,128)},
520 {"cornflower blue" , PALETTERGB (100,149,237)},
521 {"CornflowerBlue" , PALETTERGB (100,149,237)},
522 {"dark slate blue" , PALETTERGB ( 72, 61,139)},
523 {"DarkSlateBlue" , PALETTERGB ( 72, 61,139)},
524 {"slate blue" , PALETTERGB (106, 90,205)},
525 {"SlateBlue" , PALETTERGB (106, 90,205)},
526 {"medium slate blue" , PALETTERGB (123,104,238)},
527 {"MediumSlateBlue" , PALETTERGB (123,104,238)},
528 {"light slate blue" , PALETTERGB (132,112,255)},
529 {"LightSlateBlue" , PALETTERGB (132,112,255)},
530 {"medium blue" , PALETTERGB ( 0, 0,205)},
531 {"MediumBlue" , PALETTERGB ( 0, 0,205)},
532 {"royal blue" , PALETTERGB ( 65,105,225)},
533 {"RoyalBlue" , PALETTERGB ( 65,105,225)},
534 {"blue" , PALETTERGB ( 0, 0,255)},
535 {"dodger blue" , PALETTERGB ( 30,144,255)},
536 {"DodgerBlue" , PALETTERGB ( 30,144,255)},
537 {"deep sky blue" , PALETTERGB ( 0,191,255)},
538 {"DeepSkyBlue" , PALETTERGB ( 0,191,255)},
539 {"sky blue" , PALETTERGB (135,206,235)},
540 {"SkyBlue" , PALETTERGB (135,206,235)},
541 {"light sky blue" , PALETTERGB (135,206,250)},
542 {"LightSkyBlue" , PALETTERGB (135,206,250)},
543 {"steel blue" , PALETTERGB ( 70,130,180)},
544 {"SteelBlue" , PALETTERGB ( 70,130,180)},
545 {"light steel blue" , PALETTERGB (176,196,222)},
546 {"LightSteelBlue" , PALETTERGB (176,196,222)},
547 {"light blue" , PALETTERGB (173,216,230)},
548 {"LightBlue" , PALETTERGB (173,216,230)},
549 {"powder blue" , PALETTERGB (176,224,230)},
550 {"PowderBlue" , PALETTERGB (176,224,230)},
551 {"pale turquoise" , PALETTERGB (175,238,238)},
552 {"PaleTurquoise" , PALETTERGB (175,238,238)},
553 {"dark turquoise" , PALETTERGB ( 0,206,209)},
554 {"DarkTurquoise" , PALETTERGB ( 0,206,209)},
555 {"medium turquoise" , PALETTERGB ( 72,209,204)},
556 {"MediumTurquoise" , PALETTERGB ( 72,209,204)},
557 {"turquoise" , PALETTERGB ( 64,224,208)},
558 {"cyan" , PALETTERGB ( 0,255,255)},
559 {"light cyan" , PALETTERGB (224,255,255)},
560 {"LightCyan" , PALETTERGB (224,255,255)},
561 {"cadet blue" , PALETTERGB ( 95,158,160)},
562 {"CadetBlue" , PALETTERGB ( 95,158,160)},
563 {"medium aquamarine" , PALETTERGB (102,205,170)},
564 {"MediumAquamarine" , PALETTERGB (102,205,170)},
565 {"aquamarine" , PALETTERGB (127,255,212)},
566 {"dark green" , PALETTERGB ( 0,100, 0)},
567 {"DarkGreen" , PALETTERGB ( 0,100, 0)},
568 {"dark olive green" , PALETTERGB ( 85,107, 47)},
569 {"DarkOliveGreen" , PALETTERGB ( 85,107, 47)},
570 {"dark sea green" , PALETTERGB (143,188,143)},
571 {"DarkSeaGreen" , PALETTERGB (143,188,143)},
572 {"sea green" , PALETTERGB ( 46,139, 87)},
573 {"SeaGreen" , PALETTERGB ( 46,139, 87)},
574 {"medium sea green" , PALETTERGB ( 60,179,113)},
575 {"MediumSeaGreen" , PALETTERGB ( 60,179,113)},
576 {"light sea green" , PALETTERGB ( 32,178,170)},
577 {"LightSeaGreen" , PALETTERGB ( 32,178,170)},
578 {"pale green" , PALETTERGB (152,251,152)},
579 {"PaleGreen" , PALETTERGB (152,251,152)},
580 {"spring green" , PALETTERGB ( 0,255,127)},
581 {"SpringGreen" , PALETTERGB ( 0,255,127)},
582 {"lawn green" , PALETTERGB (124,252, 0)},
583 {"LawnGreen" , PALETTERGB (124,252, 0)},
584 {"green" , PALETTERGB ( 0,255, 0)},
585 {"chartreuse" , PALETTERGB (127,255, 0)},
586 {"medium spring green" , PALETTERGB ( 0,250,154)},
587 {"MediumSpringGreen" , PALETTERGB ( 0,250,154)},
588 {"green yellow" , PALETTERGB (173,255, 47)},
589 {"GreenYellow" , PALETTERGB (173,255, 47)},
590 {"lime green" , PALETTERGB ( 50,205, 50)},
591 {"LimeGreen" , PALETTERGB ( 50,205, 50)},
592 {"yellow green" , PALETTERGB (154,205, 50)},
593 {"YellowGreen" , PALETTERGB (154,205, 50)},
594 {"forest green" , PALETTERGB ( 34,139, 34)},
595 {"ForestGreen" , PALETTERGB ( 34,139, 34)},
596 {"olive drab" , PALETTERGB (107,142, 35)},
597 {"OliveDrab" , PALETTERGB (107,142, 35)},
598 {"dark khaki" , PALETTERGB (189,183,107)},
599 {"DarkKhaki" , PALETTERGB (189,183,107)},
600 {"khaki" , PALETTERGB (240,230,140)},
601 {"pale goldenrod" , PALETTERGB (238,232,170)},
602 {"PaleGoldenrod" , PALETTERGB (238,232,170)},
603 {"light goldenrod yellow" , PALETTERGB (250,250,210)},
604 {"LightGoldenrodYellow" , PALETTERGB (250,250,210)},
605 {"light yellow" , PALETTERGB (255,255,224)},
606 {"LightYellow" , PALETTERGB (255,255,224)},
607 {"yellow" , PALETTERGB (255,255, 0)},
608 {"gold" , PALETTERGB (255,215, 0)},
609 {"light goldenrod" , PALETTERGB (238,221,130)},
610 {"LightGoldenrod" , PALETTERGB (238,221,130)},
611 {"goldenrod" , PALETTERGB (218,165, 32)},
612 {"dark goldenrod" , PALETTERGB (184,134, 11)},
613 {"DarkGoldenrod" , PALETTERGB (184,134, 11)},
614 {"rosy brown" , PALETTERGB (188,143,143)},
615 {"RosyBrown" , PALETTERGB (188,143,143)},
616 {"indian red" , PALETTERGB (205, 92, 92)},
617 {"IndianRed" , PALETTERGB (205, 92, 92)},
618 {"saddle brown" , PALETTERGB (139, 69, 19)},
619 {"SaddleBrown" , PALETTERGB (139, 69, 19)},
620 {"sienna" , PALETTERGB (160, 82, 45)},
621 {"peru" , PALETTERGB (205,133, 63)},
622 {"burlywood" , PALETTERGB (222,184,135)},
623 {"beige" , PALETTERGB (245,245,220)},
624 {"wheat" , PALETTERGB (245,222,179)},
625 {"sandy brown" , PALETTERGB (244,164, 96)},
626 {"SandyBrown" , PALETTERGB (244,164, 96)},
627 {"tan" , PALETTERGB (210,180,140)},
628 {"chocolate" , PALETTERGB (210,105, 30)},
629 {"firebrick" , PALETTERGB (178,34, 34)},
630 {"brown" , PALETTERGB (165,42, 42)},
631 {"dark salmon" , PALETTERGB (233,150,122)},
632 {"DarkSalmon" , PALETTERGB (233,150,122)},
633 {"salmon" , PALETTERGB (250,128,114)},
634 {"light salmon" , PALETTERGB (255,160,122)},
635 {"LightSalmon" , PALETTERGB (255,160,122)},
636 {"orange" , PALETTERGB (255,165, 0)},
637 {"dark orange" , PALETTERGB (255,140, 0)},
638 {"DarkOrange" , PALETTERGB (255,140, 0)},
639 {"coral" , PALETTERGB (255,127, 80)},
640 {"light coral" , PALETTERGB (240,128,128)},
641 {"LightCoral" , PALETTERGB (240,128,128)},
642 {"tomato" , PALETTERGB (255, 99, 71)},
643 {"orange red" , PALETTERGB (255, 69, 0)},
644 {"OrangeRed" , PALETTERGB (255, 69, 0)},
645 {"red" , PALETTERGB (255, 0, 0)},
646 {"hot pink" , PALETTERGB (255,105,180)},
647 {"HotPink" , PALETTERGB (255,105,180)},
648 {"deep pink" , PALETTERGB (255, 20,147)},
649 {"DeepPink" , PALETTERGB (255, 20,147)},
650 {"pink" , PALETTERGB (255,192,203)},
651 {"light pink" , PALETTERGB (255,182,193)},
652 {"LightPink" , PALETTERGB (255,182,193)},
653 {"pale violet red" , PALETTERGB (219,112,147)},
654 {"PaleVioletRed" , PALETTERGB (219,112,147)},
655 {"maroon" , PALETTERGB (176, 48, 96)},
656 {"medium violet red" , PALETTERGB (199, 21,133)},
657 {"MediumVioletRed" , PALETTERGB (199, 21,133)},
658 {"violet red" , PALETTERGB (208, 32,144)},
659 {"VioletRed" , PALETTERGB (208, 32,144)},
660 {"magenta" , PALETTERGB (255, 0,255)},
661 {"violet" , PALETTERGB (238,130,238)},
662 {"plum" , PALETTERGB (221,160,221)},
663 {"orchid" , PALETTERGB (218,112,214)},
664 {"medium orchid" , PALETTERGB (186, 85,211)},
665 {"MediumOrchid" , PALETTERGB (186, 85,211)},
666 {"dark orchid" , PALETTERGB (153, 50,204)},
667 {"DarkOrchid" , PALETTERGB (153, 50,204)},
668 {"dark violet" , PALETTERGB (148, 0,211)},
669 {"DarkViolet" , PALETTERGB (148, 0,211)},
670 {"blue violet" , PALETTERGB (138, 43,226)},
671 {"BlueViolet" , PALETTERGB (138, 43,226)},
672 {"purple" , PALETTERGB (160, 32,240)},
673 {"medium purple" , PALETTERGB (147,112,219)},
674 {"MediumPurple" , PALETTERGB (147,112,219)},
675 {"thistle" , PALETTERGB (216,191,216)},
676 {"gray0" , PALETTERGB ( 0, 0, 0)},
677 {"grey0" , PALETTERGB ( 0, 0, 0)},
678 {"dark grey" , PALETTERGB (169,169,169)},
679 {"DarkGrey" , PALETTERGB (169,169,169)},
680 {"dark gray" , PALETTERGB (169,169,169)},
681 {"DarkGray" , PALETTERGB (169,169,169)},
682 {"dark blue" , PALETTERGB ( 0, 0,139)},
683 {"DarkBlue" , PALETTERGB ( 0, 0,139)},
684 {"dark cyan" , PALETTERGB ( 0,139,139)},
685 {"DarkCyan" , PALETTERGB ( 0,139,139)},
686 {"dark magenta" , PALETTERGB (139, 0,139)},
687 {"DarkMagenta" , PALETTERGB (139, 0,139)},
688 {"dark red" , PALETTERGB (139, 0, 0)},
689 {"DarkRed" , PALETTERGB (139, 0, 0)},
690 {"light green" , PALETTERGB (144,238,144)},
691 {"LightGreen" , PALETTERGB (144,238,144)},
694 static Lisp_Object
695 w32_default_color_map (void)
697 int i;
698 colormap_t *pc = w32_color_map;
699 Lisp_Object cmap;
701 block_input ();
703 cmap = Qnil;
705 for (i = 0; i < sizeof (w32_color_map) / sizeof (w32_color_map[0]);
706 pc++, i++)
707 cmap = Fcons (Fcons (build_string (pc->name),
708 make_number (pc->colorref)),
709 cmap);
711 unblock_input ();
713 return (cmap);
716 DEFUN ("w32-default-color-map", Fw32_default_color_map, Sw32_default_color_map,
717 0, 0, 0, doc: /* Return the default color map. */)
718 (void)
720 return w32_default_color_map ();
723 static Lisp_Object
724 w32_color_map_lookup (const char *colorname)
726 Lisp_Object tail, ret = Qnil;
728 block_input ();
730 for (tail = Vw32_color_map; CONSP (tail); tail = XCDR (tail))
732 register Lisp_Object elt, tem;
734 elt = XCAR (tail);
735 if (!CONSP (elt)) continue;
737 tem = XCAR (elt);
739 if (lstrcmpi (SDATA (tem), colorname) == 0)
741 ret = Fcdr (elt);
742 break;
745 QUIT;
748 unblock_input ();
750 return ret;
754 static void
755 add_system_logical_colors_to_map (Lisp_Object *system_colors)
757 HKEY colors_key;
759 /* Other registry operations are done with input blocked. */
760 block_input ();
762 /* Look for "Control Panel/Colors" under User and Machine registry
763 settings. */
764 if (RegOpenKeyEx (HKEY_CURRENT_USER, "Control Panel\\Colors", 0,
765 KEY_READ, &colors_key) == ERROR_SUCCESS
766 || RegOpenKeyEx (HKEY_LOCAL_MACHINE, "Control Panel\\Colors", 0,
767 KEY_READ, &colors_key) == ERROR_SUCCESS)
769 /* List all keys. */
770 char color_buffer[64];
771 char full_name_buffer[MAX_PATH + SYSTEM_COLOR_PREFIX_LEN];
772 int index = 0;
773 DWORD name_size, color_size;
774 char *name_buffer = full_name_buffer + SYSTEM_COLOR_PREFIX_LEN;
776 name_size = sizeof (full_name_buffer) - SYSTEM_COLOR_PREFIX_LEN;
777 color_size = sizeof (color_buffer);
779 strcpy (full_name_buffer, SYSTEM_COLOR_PREFIX);
781 while (RegEnumValueA (colors_key, index, name_buffer, &name_size,
782 NULL, NULL, color_buffer, &color_size)
783 == ERROR_SUCCESS)
785 int r, g, b;
786 if (sscanf (color_buffer, " %u %u %u", &r, &g, &b) == 3)
787 *system_colors = Fcons (Fcons (build_string (full_name_buffer),
788 make_number (RGB (r, g, b))),
789 *system_colors);
791 name_size = sizeof (full_name_buffer) - SYSTEM_COLOR_PREFIX_LEN;
792 color_size = sizeof (color_buffer);
793 index++;
795 RegCloseKey (colors_key);
798 unblock_input ();
802 static Lisp_Object
803 x_to_w32_color (const char * colorname)
805 register Lisp_Object ret = Qnil;
807 block_input ();
809 if (colorname[0] == '#')
811 /* Could be an old-style RGB Device specification. */
812 int size = strlen (colorname + 1);
813 char *color = alloca (size + 1);
815 strcpy (color, colorname + 1);
816 if (size == 3 || size == 6 || size == 9 || size == 12)
818 UINT colorval;
819 int i, pos;
820 pos = 0;
821 size /= 3;
822 colorval = 0;
824 for (i = 0; i < 3; i++)
826 char *end;
827 char t;
828 unsigned long value;
830 /* The check for 'x' in the following conditional takes into
831 account the fact that strtol allows a "0x" in front of
832 our numbers, and we don't. */
833 if (!isxdigit (color[0]) || color[1] == 'x')
834 break;
835 t = color[size];
836 color[size] = '\0';
837 value = strtoul (color, &end, 16);
838 color[size] = t;
839 if (errno == ERANGE || end - color != size)
840 break;
841 switch (size)
843 case 1:
844 value = value * 0x10;
845 break;
846 case 2:
847 break;
848 case 3:
849 value /= 0x10;
850 break;
851 case 4:
852 value /= 0x100;
853 break;
855 colorval |= (value << pos);
856 pos += 0x8;
857 if (i == 2)
859 unblock_input ();
860 XSETINT (ret, colorval);
861 return ret;
863 color = end;
867 else if (strnicmp (colorname, "rgb:", 4) == 0)
869 const char *color;
870 UINT colorval;
871 int i, pos;
872 pos = 0;
874 colorval = 0;
875 color = colorname + 4;
876 for (i = 0; i < 3; i++)
878 char *end;
879 unsigned long value;
881 /* The check for 'x' in the following conditional takes into
882 account the fact that strtol allows a "0x" in front of
883 our numbers, and we don't. */
884 if (!isxdigit (color[0]) || color[1] == 'x')
885 break;
886 value = strtoul (color, &end, 16);
887 if (errno == ERANGE)
888 break;
889 switch (end - color)
891 case 1:
892 value = value * 0x10 + value;
893 break;
894 case 2:
895 break;
896 case 3:
897 value /= 0x10;
898 break;
899 case 4:
900 value /= 0x100;
901 break;
902 default:
903 value = ULONG_MAX;
905 if (value == ULONG_MAX)
906 break;
907 colorval |= (value << pos);
908 pos += 0x8;
909 if (i == 2)
911 if (*end != '\0')
912 break;
913 unblock_input ();
914 XSETINT (ret, colorval);
915 return ret;
917 if (*end != '/')
918 break;
919 color = end + 1;
922 else if (strnicmp (colorname, "rgbi:", 5) == 0)
924 /* This is an RGB Intensity specification. */
925 const char *color;
926 UINT colorval;
927 int i, pos;
928 pos = 0;
930 colorval = 0;
931 color = colorname + 5;
932 for (i = 0; i < 3; i++)
934 char *end;
935 double value;
936 UINT val;
938 value = strtod (color, &end);
939 if (errno == ERANGE)
940 break;
941 if (value < 0.0 || value > 1.0)
942 break;
943 val = (UINT)(0x100 * value);
944 /* We used 0x100 instead of 0xFF to give a continuous
945 range between 0.0 and 1.0 inclusive. The next statement
946 fixes the 1.0 case. */
947 if (val == 0x100)
948 val = 0xFF;
949 colorval |= (val << pos);
950 pos += 0x8;
951 if (i == 2)
953 if (*end != '\0')
954 break;
955 unblock_input ();
956 XSETINT (ret, colorval);
957 return ret;
959 if (*end != '/')
960 break;
961 color = end + 1;
964 /* I am not going to attempt to handle any of the CIE color schemes
965 or TekHVC, since I don't know the algorithms for conversion to
966 RGB. */
968 /* If we fail to lookup the color name in w32_color_map, then check the
969 colorname to see if it can be crudely approximated: If the X color
970 ends in a number (e.g., "darkseagreen2"), strip the number and
971 return the result of looking up the base color name. */
972 ret = w32_color_map_lookup (colorname);
973 if (NILP (ret))
975 int len = strlen (colorname);
977 if (isdigit (colorname[len - 1]))
979 char *ptr, *approx = alloca (len + 1);
981 strcpy (approx, colorname);
982 ptr = &approx[len - 1];
983 while (ptr > approx && isdigit (*ptr))
984 *ptr-- = '\0';
986 ret = w32_color_map_lookup (approx);
990 unblock_input ();
991 return ret;
994 void
995 w32_regenerate_palette (FRAME_PTR f)
997 struct w32_palette_entry * list;
998 LOGPALETTE * log_palette;
999 HPALETTE new_palette;
1000 int i;
1002 /* don't bother trying to create palette if not supported */
1003 if (! FRAME_W32_DISPLAY_INFO (f)->has_palette)
1004 return;
1006 log_palette = (LOGPALETTE *)
1007 alloca (sizeof (LOGPALETTE) +
1008 FRAME_W32_DISPLAY_INFO (f)->num_colors * sizeof (PALETTEENTRY));
1009 log_palette->palVersion = 0x300;
1010 log_palette->palNumEntries = FRAME_W32_DISPLAY_INFO (f)->num_colors;
1012 list = FRAME_W32_DISPLAY_INFO (f)->color_list;
1013 for (i = 0;
1014 i < FRAME_W32_DISPLAY_INFO (f)->num_colors;
1015 i++, list = list->next)
1016 log_palette->palPalEntry[i] = list->entry;
1018 new_palette = CreatePalette (log_palette);
1020 enter_crit ();
1022 if (FRAME_W32_DISPLAY_INFO (f)->palette)
1023 DeleteObject (FRAME_W32_DISPLAY_INFO (f)->palette);
1024 FRAME_W32_DISPLAY_INFO (f)->palette = new_palette;
1026 /* Realize display palette and garbage all frames. */
1027 release_frame_dc (f, get_frame_dc (f));
1029 leave_crit ();
1032 #define W32_COLOR(pe) RGB (pe.peRed, pe.peGreen, pe.peBlue)
1033 #define SET_W32_COLOR(pe, color) \
1034 do \
1036 pe.peRed = GetRValue (color); \
1037 pe.peGreen = GetGValue (color); \
1038 pe.peBlue = GetBValue (color); \
1039 pe.peFlags = 0; \
1040 } while (0)
1042 #if 0
1043 /* Keep these around in case we ever want to track color usage. */
1044 void
1045 w32_map_color (FRAME_PTR f, COLORREF color)
1047 struct w32_palette_entry * list = FRAME_W32_DISPLAY_INFO (f)->color_list;
1049 if (NILP (Vw32_enable_palette))
1050 return;
1052 /* check if color is already mapped */
1053 while (list)
1055 if (W32_COLOR (list->entry) == color)
1057 ++list->refcount;
1058 return;
1060 list = list->next;
1063 /* not already mapped, so add to list and recreate Windows palette */
1064 list = xmalloc (sizeof (struct w32_palette_entry));
1065 SET_W32_COLOR (list->entry, color);
1066 list->refcount = 1;
1067 list->next = FRAME_W32_DISPLAY_INFO (f)->color_list;
1068 FRAME_W32_DISPLAY_INFO (f)->color_list = list;
1069 FRAME_W32_DISPLAY_INFO (f)->num_colors++;
1071 /* set flag that palette must be regenerated */
1072 FRAME_W32_DISPLAY_INFO (f)->regen_palette = TRUE;
1075 void
1076 w32_unmap_color (FRAME_PTR f, COLORREF color)
1078 struct w32_palette_entry * list = FRAME_W32_DISPLAY_INFO (f)->color_list;
1079 struct w32_palette_entry **prev = &FRAME_W32_DISPLAY_INFO (f)->color_list;
1081 if (NILP (Vw32_enable_palette))
1082 return;
1084 /* check if color is already mapped */
1085 while (list)
1087 if (W32_COLOR (list->entry) == color)
1089 if (--list->refcount == 0)
1091 *prev = list->next;
1092 xfree (list);
1093 FRAME_W32_DISPLAY_INFO (f)->num_colors--;
1094 break;
1096 else
1097 return;
1099 prev = &list->next;
1100 list = list->next;
1103 /* set flag that palette must be regenerated */
1104 FRAME_W32_DISPLAY_INFO (f)->regen_palette = TRUE;
1106 #endif
1109 /* Gamma-correct COLOR on frame F. */
1111 void
1112 gamma_correct (struct frame *f, COLORREF *color)
1114 if (f->gamma)
1116 *color = PALETTERGB (
1117 pow (GetRValue (*color) / 255.0, f->gamma) * 255.0 + 0.5,
1118 pow (GetGValue (*color) / 255.0, f->gamma) * 255.0 + 0.5,
1119 pow (GetBValue (*color) / 255.0, f->gamma) * 255.0 + 0.5);
1124 /* Decide if color named COLOR is valid for the display associated with
1125 the selected frame; if so, return the rgb values in COLOR_DEF.
1126 If ALLOC is nonzero, allocate a new colormap cell. */
1129 w32_defined_color (FRAME_PTR f, const char *color, XColor *color_def, int alloc)
1131 register Lisp_Object tem;
1132 COLORREF w32_color_ref;
1134 tem = x_to_w32_color (color);
1136 if (!NILP (tem))
1138 if (f)
1140 /* Apply gamma correction. */
1141 w32_color_ref = XUINT (tem);
1142 gamma_correct (f, &w32_color_ref);
1143 XSETINT (tem, w32_color_ref);
1146 /* Map this color to the palette if it is enabled. */
1147 if (!NILP (Vw32_enable_palette))
1149 struct w32_palette_entry * entry =
1150 one_w32_display_info.color_list;
1151 struct w32_palette_entry ** prev =
1152 &one_w32_display_info.color_list;
1154 /* check if color is already mapped */
1155 while (entry)
1157 if (W32_COLOR (entry->entry) == XUINT (tem))
1158 break;
1159 prev = &entry->next;
1160 entry = entry->next;
1163 if (entry == NULL && alloc)
1165 /* not already mapped, so add to list */
1166 entry = xmalloc (sizeof (struct w32_palette_entry));
1167 SET_W32_COLOR (entry->entry, XUINT (tem));
1168 entry->next = NULL;
1169 *prev = entry;
1170 one_w32_display_info.num_colors++;
1172 /* set flag that palette must be regenerated */
1173 one_w32_display_info.regen_palette = TRUE;
1176 /* Ensure COLORREF value is snapped to nearest color in (default)
1177 palette by simulating the PALETTERGB macro. This works whether
1178 or not the display device has a palette. */
1179 w32_color_ref = XUINT (tem) | 0x2000000;
1181 color_def->pixel = w32_color_ref;
1182 color_def->red = GetRValue (w32_color_ref) * 256;
1183 color_def->green = GetGValue (w32_color_ref) * 256;
1184 color_def->blue = GetBValue (w32_color_ref) * 256;
1186 return 1;
1188 else
1190 return 0;
1194 /* Given a string ARG naming a color, compute a pixel value from it
1195 suitable for screen F.
1196 If F is not a color screen, return DEF (default) regardless of what
1197 ARG says. */
1200 x_decode_color (FRAME_PTR f, Lisp_Object arg, int def)
1202 XColor cdef;
1204 CHECK_STRING (arg);
1206 if (strcmp (SDATA (arg), "black") == 0)
1207 return BLACK_PIX_DEFAULT (f);
1208 else if (strcmp (SDATA (arg), "white") == 0)
1209 return WHITE_PIX_DEFAULT (f);
1211 if ((FRAME_W32_DISPLAY_INFO (f)->n_planes * FRAME_W32_DISPLAY_INFO (f)->n_cbits) == 1)
1212 return def;
1214 /* w32_defined_color is responsible for coping with failures
1215 by looking for a near-miss. */
1216 if (w32_defined_color (f, SDATA (arg), &cdef, 1))
1217 return cdef.pixel;
1219 /* defined_color failed; return an ultimate default. */
1220 return def;
1225 /* Functions called only from `x_set_frame_param'
1226 to set individual parameters.
1228 If FRAME_W32_WINDOW (f) is 0,
1229 the frame is being created and its window does not exist yet.
1230 In that case, just record the parameter's new value
1231 in the standard place; do not attempt to change the window. */
1233 void
1234 x_set_foreground_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
1236 struct w32_output *x = f->output_data.w32;
1237 PIX_TYPE fg, old_fg;
1239 fg = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1240 old_fg = FRAME_FOREGROUND_PIXEL (f);
1241 FRAME_FOREGROUND_PIXEL (f) = fg;
1243 if (FRAME_W32_WINDOW (f) != 0)
1245 if (x->cursor_pixel == old_fg)
1247 x->cursor_pixel = fg;
1248 x->cursor_gc->background = fg;
1251 update_face_from_frame_parameter (f, Qforeground_color, arg);
1252 if (FRAME_VISIBLE_P (f))
1253 redraw_frame (f);
1257 void
1258 x_set_background_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
1260 FRAME_BACKGROUND_PIXEL (f)
1261 = x_decode_color (f, arg, WHITE_PIX_DEFAULT (f));
1263 if (FRAME_W32_WINDOW (f) != 0)
1265 SetWindowLong (FRAME_W32_WINDOW (f), WND_BACKGROUND_INDEX,
1266 FRAME_BACKGROUND_PIXEL (f));
1268 update_face_from_frame_parameter (f, Qbackground_color, arg);
1270 if (FRAME_VISIBLE_P (f))
1271 redraw_frame (f);
1275 void
1276 x_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
1278 Cursor cursor, nontext_cursor, mode_cursor, hand_cursor;
1279 int count;
1280 int mask_color;
1282 if (!EQ (Qnil, arg))
1283 f->output_data.w32->mouse_pixel
1284 = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1285 mask_color = FRAME_BACKGROUND_PIXEL (f);
1287 /* Don't let pointers be invisible. */
1288 if (mask_color == f->output_data.w32->mouse_pixel
1289 && mask_color == FRAME_BACKGROUND_PIXEL (f))
1290 f->output_data.w32->mouse_pixel = FRAME_FOREGROUND_PIXEL (f);
1292 #if 0 /* TODO : Mouse cursor customization. */
1293 block_input ();
1295 /* It's not okay to crash if the user selects a screwy cursor. */
1296 count = x_catch_errors (FRAME_W32_DISPLAY (f));
1298 if (!EQ (Qnil, Vx_pointer_shape))
1300 CHECK_NUMBER (Vx_pointer_shape);
1301 cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XINT (Vx_pointer_shape));
1303 else
1304 cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_xterm);
1305 x_check_errors (FRAME_W32_DISPLAY (f), "bad text pointer cursor: %s");
1307 if (!EQ (Qnil, Vx_nontext_pointer_shape))
1309 CHECK_NUMBER (Vx_nontext_pointer_shape);
1310 nontext_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f),
1311 XINT (Vx_nontext_pointer_shape));
1313 else
1314 nontext_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_left_ptr);
1315 x_check_errors (FRAME_W32_DISPLAY (f), "bad nontext pointer cursor: %s");
1317 if (!EQ (Qnil, Vx_hourglass_pointer_shape))
1319 CHECK_NUMBER (Vx_hourglass_pointer_shape);
1320 hourglass_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f),
1321 XINT (Vx_hourglass_pointer_shape));
1323 else
1324 hourglass_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_watch);
1325 x_check_errors (FRAME_W32_DISPLAY (f), "bad busy pointer cursor: %s");
1327 x_check_errors (FRAME_W32_DISPLAY (f), "bad nontext pointer cursor: %s");
1328 if (!EQ (Qnil, Vx_mode_pointer_shape))
1330 CHECK_NUMBER (Vx_mode_pointer_shape);
1331 mode_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f),
1332 XINT (Vx_mode_pointer_shape));
1334 else
1335 mode_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_xterm);
1336 x_check_errors (FRAME_W32_DISPLAY (f), "bad modeline pointer cursor: %s");
1338 if (!EQ (Qnil, Vx_sensitive_text_pointer_shape))
1340 CHECK_NUMBER (Vx_sensitive_text_pointer_shape);
1341 hand_cursor
1342 = XCreateFontCursor (FRAME_W32_DISPLAY (f),
1343 XINT (Vx_sensitive_text_pointer_shape));
1345 else
1346 hand_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_crosshair);
1348 if (!NILP (Vx_window_horizontal_drag_shape))
1350 CHECK_NUMBER (Vx_window_horizontal_drag_shape);
1351 horizontal_drag_cursor
1352 = XCreateFontCursor (FRAME_X_DISPLAY (f),
1353 XINT (Vx_window_horizontal_drag_shape));
1355 else
1356 horizontal_drag_cursor
1357 = XCreateFontCursor (FRAME_X_DISPLAY (f), XC_sb_h_double_arrow);
1359 /* Check and report errors with the above calls. */
1360 x_check_errors (FRAME_W32_DISPLAY (f), "can't set cursor shape: %s");
1361 x_uncatch_errors (FRAME_W32_DISPLAY (f), count);
1364 XColor fore_color, back_color;
1366 fore_color.pixel = f->output_data.w32->mouse_pixel;
1367 back_color.pixel = mask_color;
1368 XQueryColor (FRAME_W32_DISPLAY (f),
1369 DefaultColormap (FRAME_W32_DISPLAY (f),
1370 DefaultScreen (FRAME_W32_DISPLAY (f))),
1371 &fore_color);
1372 XQueryColor (FRAME_W32_DISPLAY (f),
1373 DefaultColormap (FRAME_W32_DISPLAY (f),
1374 DefaultScreen (FRAME_W32_DISPLAY (f))),
1375 &back_color);
1376 XRecolorCursor (FRAME_W32_DISPLAY (f), cursor,
1377 &fore_color, &back_color);
1378 XRecolorCursor (FRAME_W32_DISPLAY (f), nontext_cursor,
1379 &fore_color, &back_color);
1380 XRecolorCursor (FRAME_W32_DISPLAY (f), mode_cursor,
1381 &fore_color, &back_color);
1382 XRecolorCursor (FRAME_W32_DISPLAY (f), hand_cursor,
1383 &fore_color, &back_color);
1384 XRecolorCursor (FRAME_W32_DISPLAY (f), hourglass_cursor,
1385 &fore_color, &back_color);
1388 if (FRAME_W32_WINDOW (f) != 0)
1389 XDefineCursor (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f), cursor);
1391 if (cursor != f->output_data.w32->text_cursor && f->output_data.w32->text_cursor != 0)
1392 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->text_cursor);
1393 f->output_data.w32->text_cursor = cursor;
1395 if (nontext_cursor != f->output_data.w32->nontext_cursor
1396 && f->output_data.w32->nontext_cursor != 0)
1397 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->nontext_cursor);
1398 f->output_data.w32->nontext_cursor = nontext_cursor;
1400 if (hourglass_cursor != f->output_data.w32->hourglass_cursor
1401 && f->output_data.w32->hourglass_cursor != 0)
1402 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->hourglass_cursor);
1403 f->output_data.w32->hourglass_cursor = hourglass_cursor;
1405 if (mode_cursor != f->output_data.w32->modeline_cursor
1406 && f->output_data.w32->modeline_cursor != 0)
1407 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->modeline_cursor);
1408 f->output_data.w32->modeline_cursor = mode_cursor;
1410 if (hand_cursor != f->output_data.w32->hand_cursor
1411 && f->output_data.w32->hand_cursor != 0)
1412 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->hand_cursor);
1413 f->output_data.w32->hand_cursor = hand_cursor;
1415 XFlush (FRAME_W32_DISPLAY (f));
1416 unblock_input ();
1418 update_face_from_frame_parameter (f, Qmouse_color, arg);
1419 #endif /* TODO */
1422 void
1423 x_set_cursor_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
1425 unsigned long fore_pixel, pixel;
1427 if (!NILP (Vx_cursor_fore_pixel))
1428 fore_pixel = x_decode_color (f, Vx_cursor_fore_pixel,
1429 WHITE_PIX_DEFAULT (f));
1430 else
1431 fore_pixel = FRAME_BACKGROUND_PIXEL (f);
1433 pixel = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1435 /* Make sure that the cursor color differs from the background color. */
1436 if (pixel == FRAME_BACKGROUND_PIXEL (f))
1438 pixel = f->output_data.w32->mouse_pixel;
1439 if (pixel == fore_pixel)
1440 fore_pixel = FRAME_BACKGROUND_PIXEL (f);
1443 f->output_data.w32->cursor_foreground_pixel = fore_pixel;
1444 f->output_data.w32->cursor_pixel = pixel;
1446 if (FRAME_W32_WINDOW (f) != 0)
1448 block_input ();
1449 /* Update frame's cursor_gc. */
1450 f->output_data.w32->cursor_gc->foreground = fore_pixel;
1451 f->output_data.w32->cursor_gc->background = pixel;
1453 unblock_input ();
1455 if (FRAME_VISIBLE_P (f))
1457 x_update_cursor (f, 0);
1458 x_update_cursor (f, 1);
1462 update_face_from_frame_parameter (f, Qcursor_color, arg);
1465 /* Set the border-color of frame F to pixel value PIX.
1466 Note that this does not fully take effect if done before
1467 F has a window. */
1469 void
1470 x_set_border_pixel (struct frame *f, int pix)
1473 f->output_data.w32->border_pixel = pix;
1475 if (FRAME_W32_WINDOW (f) != 0 && f->border_width > 0)
1477 if (FRAME_VISIBLE_P (f))
1478 redraw_frame (f);
1482 /* Set the border-color of frame F to value described by ARG.
1483 ARG can be a string naming a color.
1484 The border-color is used for the border that is drawn by the server.
1485 Note that this does not fully take effect if done before
1486 F has a window; it must be redone when the window is created. */
1488 void
1489 x_set_border_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
1491 int pix;
1493 CHECK_STRING (arg);
1494 pix = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1495 x_set_border_pixel (f, pix);
1496 update_face_from_frame_parameter (f, Qborder_color, arg);
1500 void
1501 x_set_cursor_type (FRAME_PTR f, Lisp_Object arg, Lisp_Object oldval)
1503 set_frame_cursor_types (f, arg);
1505 /* Make sure the cursor gets redrawn. */
1506 cursor_type_changed = 1;
1509 void
1510 x_set_icon_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
1512 int result;
1514 if (NILP (arg) && NILP (oldval))
1515 return;
1517 if (STRINGP (arg) && STRINGP (oldval)
1518 && EQ (Fstring_equal (oldval, arg), Qt))
1519 return;
1521 if (SYMBOLP (arg) && SYMBOLP (oldval) && EQ (arg, oldval))
1522 return;
1524 block_input ();
1526 result = x_bitmap_icon (f, arg);
1527 if (result)
1529 unblock_input ();
1530 error ("No icon window available");
1533 unblock_input ();
1536 void
1537 x_set_icon_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
1539 if (STRINGP (arg))
1541 if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
1542 return;
1544 else if (!NILP (arg) || NILP (oldval))
1545 return;
1547 fset_icon_name (f, arg);
1549 #if 0
1550 if (f->output_data.w32->icon_bitmap != 0)
1551 return;
1553 block_input ();
1555 result = x_text_icon (f,
1556 SSDATA ((!NILP (f->icon_name)
1557 ? f->icon_name
1558 : !NILP (f->title)
1559 ? f->title
1560 : f->name)));
1562 if (result)
1564 unblock_input ();
1565 error ("No icon window available");
1568 /* If the window was unmapped (and its icon was mapped),
1569 the new icon is not mapped, so map the window in its stead. */
1570 if (FRAME_VISIBLE_P (f))
1572 #ifdef USE_X_TOOLKIT
1573 XtPopup (f->output_data.w32->widget, XtGrabNone);
1574 #endif
1575 XMapWindow (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f));
1578 XFlush (FRAME_W32_DISPLAY (f));
1579 unblock_input ();
1580 #endif
1584 void
1585 x_set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
1587 int nlines;
1589 /* Right now, menu bars don't work properly in minibuf-only frames;
1590 most of the commands try to apply themselves to the minibuffer
1591 frame itself, and get an error because you can't switch buffers
1592 in or split the minibuffer window. */
1593 if (FRAME_MINIBUF_ONLY_P (f))
1594 return;
1596 if (INTEGERP (value))
1597 nlines = XINT (value);
1598 else
1599 nlines = 0;
1601 FRAME_MENU_BAR_LINES (f) = 0;
1602 if (nlines)
1603 FRAME_EXTERNAL_MENU_BAR (f) = 1;
1604 else
1606 if (FRAME_EXTERNAL_MENU_BAR (f) == 1)
1607 free_frame_menubar (f);
1608 FRAME_EXTERNAL_MENU_BAR (f) = 0;
1610 /* Adjust the frame size so that the client (text) dimensions
1611 remain the same. This depends on FRAME_EXTERNAL_MENU_BAR being
1612 set correctly. */
1613 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
1614 do_pending_window_change (0);
1616 adjust_glyphs (f);
1620 /* Set the number of lines used for the tool bar of frame F to VALUE.
1621 VALUE not an integer, or < 0 means set the lines to zero. OLDVAL
1622 is the old number of tool bar lines. This function changes the
1623 height of all windows on frame F to match the new tool bar height.
1624 The frame's height doesn't change. */
1626 void
1627 x_set_tool_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
1629 int delta, nlines, root_height;
1630 Lisp_Object root_window;
1632 /* Treat tool bars like menu bars. */
1633 if (FRAME_MINIBUF_ONLY_P (f))
1634 return;
1636 /* Use VALUE only if an integer >= 0. */
1637 if (INTEGERP (value) && XINT (value) >= 0)
1638 nlines = XFASTINT (value);
1639 else
1640 nlines = 0;
1642 /* Make sure we redisplay all windows in this frame. */
1643 ++windows_or_buffers_changed;
1645 delta = nlines - FRAME_TOOL_BAR_LINES (f);
1647 /* Don't resize the tool-bar to more than we have room for. */
1648 root_window = FRAME_ROOT_WINDOW (f);
1649 root_height = WINDOW_TOTAL_LINES (XWINDOW (root_window));
1650 if (root_height - delta < 1)
1652 delta = root_height - 1;
1653 nlines = FRAME_TOOL_BAR_LINES (f) + delta;
1656 FRAME_TOOL_BAR_LINES (f) = nlines;
1657 resize_frame_windows (f, FRAME_LINES (f), 0);
1658 adjust_glyphs (f);
1660 /* We also have to make sure that the internal border at the top of
1661 the frame, below the menu bar or tool bar, is redrawn when the
1662 tool bar disappears. This is so because the internal border is
1663 below the tool bar if one is displayed, but is below the menu bar
1664 if there isn't a tool bar. The tool bar draws into the area
1665 below the menu bar. */
1666 if (FRAME_W32_WINDOW (f) && FRAME_TOOL_BAR_LINES (f) == 0)
1668 clear_frame (f);
1669 clear_current_matrices (f);
1672 /* If the tool bar gets smaller, the internal border below it
1673 has to be cleared. It was formerly part of the display
1674 of the larger tool bar, and updating windows won't clear it. */
1675 if (delta < 0)
1677 int height = FRAME_INTERNAL_BORDER_WIDTH (f);
1678 int width = FRAME_PIXEL_WIDTH (f);
1679 int y = nlines * FRAME_LINE_HEIGHT (f);
1681 block_input ();
1683 HDC hdc = get_frame_dc (f);
1684 w32_clear_area (f, hdc, 0, y, width, height);
1685 release_frame_dc (f, hdc);
1687 unblock_input ();
1689 if (WINDOWP (f->tool_bar_window))
1690 clear_glyph_matrix (XWINDOW (f->tool_bar_window)->current_matrix);
1693 run_window_configuration_change_hook (f);
1698 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
1699 w32_id_name.
1701 If EXPLICIT is non-zero, that indicates that lisp code is setting the
1702 name; if NAME is a string, set F's name to NAME and set
1703 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
1705 If EXPLICIT is zero, that indicates that Emacs redisplay code is
1706 suggesting a new name, which lisp code should override; if
1707 F->explicit_name is set, ignore the new name; otherwise, set it. */
1709 void
1710 x_set_name (struct frame *f, Lisp_Object name, int explicit)
1712 /* Make sure that requests from lisp code override requests from
1713 Emacs redisplay code. */
1714 if (explicit)
1716 /* If we're switching from explicit to implicit, we had better
1717 update the mode lines and thereby update the title. */
1718 if (f->explicit_name && NILP (name))
1719 update_mode_lines = 1;
1721 f->explicit_name = ! NILP (name);
1723 else if (f->explicit_name)
1724 return;
1726 /* If NAME is nil, set the name to the w32_id_name. */
1727 if (NILP (name))
1729 /* Check for no change needed in this very common case
1730 before we do any consing. */
1731 if (!strcmp (FRAME_W32_DISPLAY_INFO (f)->w32_id_name,
1732 SDATA (f->name)))
1733 return;
1734 name = build_string (FRAME_W32_DISPLAY_INFO (f)->w32_id_name);
1736 else
1737 CHECK_STRING (name);
1739 /* Don't change the name if it's already NAME. */
1740 if (! NILP (Fstring_equal (name, f->name)))
1741 return;
1743 fset_name (f, name);
1745 /* For setting the frame title, the title parameter should override
1746 the name parameter. */
1747 if (! NILP (f->title))
1748 name = f->title;
1750 if (FRAME_W32_WINDOW (f))
1752 block_input ();
1753 GUI_FN (SetWindowText) (FRAME_W32_WINDOW (f),
1754 GUI_SDATA (GUI_ENCODE_SYSTEM (name)));
1755 unblock_input ();
1759 /* This function should be called when the user's lisp code has
1760 specified a name for the frame; the name will override any set by the
1761 redisplay code. */
1762 void
1763 x_explicitly_set_name (FRAME_PTR f, Lisp_Object arg, Lisp_Object oldval)
1765 x_set_name (f, arg, 1);
1768 /* This function should be called by Emacs redisplay code to set the
1769 name; names set this way will never override names set by the user's
1770 lisp code. */
1771 void
1772 x_implicitly_set_name (FRAME_PTR f, Lisp_Object arg, Lisp_Object oldval)
1774 x_set_name (f, arg, 0);
1777 /* Change the title of frame F to NAME.
1778 If NAME is nil, use the frame name as the title. */
1780 void
1781 x_set_title (struct frame *f, Lisp_Object name, Lisp_Object old_name)
1783 /* Don't change the title if it's already NAME. */
1784 if (EQ (name, f->title))
1785 return;
1787 update_mode_lines = 1;
1789 fset_title (f, name);
1791 if (NILP (name))
1792 name = f->name;
1794 if (FRAME_W32_WINDOW (f))
1796 block_input ();
1797 GUI_FN (SetWindowText) (FRAME_W32_WINDOW (f),
1798 GUI_SDATA (GUI_ENCODE_SYSTEM (name)));
1799 unblock_input ();
1803 void
1804 x_set_scroll_bar_default_width (struct frame *f)
1806 int wid = FRAME_COLUMN_WIDTH (f);
1808 FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = GetSystemMetrics (SM_CXVSCROLL);
1809 FRAME_CONFIG_SCROLL_BAR_COLS (f) = (FRAME_CONFIG_SCROLL_BAR_WIDTH (f) +
1810 wid - 1) / wid;
1814 /* Subroutines for creating a frame. */
1816 Cursor
1817 w32_load_cursor (LPCTSTR name)
1819 /* Try first to load cursor from application resource. */
1820 Cursor cursor = LoadImage ((HINSTANCE) GetModuleHandle (NULL),
1821 name, IMAGE_CURSOR, 0, 0,
1822 LR_DEFAULTCOLOR | LR_DEFAULTSIZE | LR_SHARED);
1823 if (!cursor)
1825 /* Then try to load a shared predefined cursor. */
1826 cursor = LoadImage (NULL, name, IMAGE_CURSOR, 0, 0,
1827 LR_DEFAULTCOLOR | LR_DEFAULTSIZE | LR_SHARED);
1829 return cursor;
1832 static LRESULT CALLBACK w32_wnd_proc (HWND, UINT, WPARAM, LPARAM);
1834 #define INIT_WINDOW_CLASS(WC) \
1835 (WC).style = CS_HREDRAW | CS_VREDRAW; \
1836 (WC).lpfnWndProc = (WNDPROC) w32_wnd_proc; \
1837 (WC).cbClsExtra = 0; \
1838 (WC).cbWndExtra = WND_EXTRA_BYTES; \
1839 (WC).hInstance = hinst; \
1840 (WC).hIcon = LoadIcon (hinst, EMACS_CLASS); \
1841 (WC).hCursor = w32_load_cursor (IDC_ARROW); \
1842 (WC).hbrBackground = NULL; \
1843 (WC).lpszMenuName = NULL; \
1845 static BOOL
1846 w32_init_class (HINSTANCE hinst)
1848 if (w32_unicode_gui)
1850 WNDCLASSW uwc;
1851 INIT_WINDOW_CLASS(uwc);
1852 uwc.lpszClassName = L"Emacs";
1854 return RegisterClassW (&uwc);
1856 else
1858 WNDCLASS wc;
1859 INIT_WINDOW_CLASS(wc);
1860 wc.lpszClassName = EMACS_CLASS;
1862 return RegisterClassA (&wc);
1866 static HWND
1867 w32_createscrollbar (struct frame *f, struct scroll_bar * bar)
1869 return (CreateWindow ("SCROLLBAR", "", SBS_VERT | WS_CHILD | WS_VISIBLE,
1870 /* Position and size of scroll bar. */
1871 XINT (bar->left) + VERTICAL_SCROLL_BAR_WIDTH_TRIM,
1872 XINT (bar->top),
1873 XINT (bar->width) - VERTICAL_SCROLL_BAR_WIDTH_TRIM * 2,
1874 XINT (bar->height),
1875 FRAME_W32_WINDOW (f),
1876 NULL,
1877 hinst,
1878 NULL));
1881 static void
1882 w32_createwindow (struct frame *f)
1884 HWND hwnd;
1885 RECT rect;
1886 Lisp_Object top = Qunbound;
1887 Lisp_Object left = Qunbound;
1888 struct w32_display_info *dpyinfo = &one_w32_display_info;
1890 rect.left = rect.top = 0;
1891 rect.right = FRAME_PIXEL_WIDTH (f);
1892 rect.bottom = FRAME_PIXEL_HEIGHT (f);
1894 AdjustWindowRect (&rect, f->output_data.w32->dwStyle,
1895 FRAME_EXTERNAL_MENU_BAR (f));
1897 /* Do first time app init */
1899 w32_init_class (hinst);
1901 if (f->size_hint_flags & USPosition || f->size_hint_flags & PPosition)
1903 XSETINT (left, f->left_pos);
1904 XSETINT (top, f->top_pos);
1906 else if (EQ (left, Qunbound) && EQ (top, Qunbound))
1908 /* When called with RES_TYPE_NUMBER, w32_get_arg will return zero
1909 for anything that is not a number and is not Qunbound. */
1910 left = x_get_arg (dpyinfo, Qnil, Qleft, "left", "Left", RES_TYPE_NUMBER);
1911 top = x_get_arg (dpyinfo, Qnil, Qtop, "top", "Top", RES_TYPE_NUMBER);
1914 FRAME_W32_WINDOW (f) = hwnd
1915 = CreateWindow (EMACS_CLASS,
1916 f->namebuf,
1917 f->output_data.w32->dwStyle | WS_CLIPCHILDREN,
1918 EQ (left, Qunbound) ? CW_USEDEFAULT : XINT (left),
1919 EQ (top, Qunbound) ? CW_USEDEFAULT : XINT (top),
1920 rect.right - rect.left,
1921 rect.bottom - rect.top,
1922 NULL,
1923 NULL,
1924 hinst,
1925 NULL);
1927 if (hwnd)
1929 SetWindowLong (hwnd, WND_FONTWIDTH_INDEX, FRAME_COLUMN_WIDTH (f));
1930 SetWindowLong (hwnd, WND_LINEHEIGHT_INDEX, FRAME_LINE_HEIGHT (f));
1931 SetWindowLong (hwnd, WND_BORDER_INDEX, FRAME_INTERNAL_BORDER_WIDTH (f));
1932 SetWindowLong (hwnd, WND_SCROLLBAR_INDEX, f->scroll_bar_actual_width);
1933 SetWindowLong (hwnd, WND_BACKGROUND_INDEX, FRAME_BACKGROUND_PIXEL (f));
1935 /* Enable drag-n-drop. */
1936 DragAcceptFiles (hwnd, TRUE);
1938 /* Do this to discard the default setting specified by our parent. */
1939 ShowWindow (hwnd, SW_HIDE);
1941 /* Update frame positions. */
1942 GetWindowRect (hwnd, &rect);
1943 f->left_pos = rect.left;
1944 f->top_pos = rect.top;
1948 static void
1949 my_post_msg (W32Msg * wmsg, HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam)
1951 wmsg->msg.hwnd = hwnd;
1952 wmsg->msg.message = msg;
1953 wmsg->msg.wParam = wParam;
1954 wmsg->msg.lParam = lParam;
1955 wmsg->msg.time = GetMessageTime ();
1957 post_msg (wmsg);
1960 /* GetKeyState and MapVirtualKey on Windows 95 do not actually distinguish
1961 between left and right keys as advertised. We test for this
1962 support dynamically, and set a flag when the support is absent. If
1963 absent, we keep track of the left and right control and alt keys
1964 ourselves. This is particularly necessary on keyboards that rely
1965 upon the AltGr key, which is represented as having the left control
1966 and right alt keys pressed. For these keyboards, we need to know
1967 when the left alt key has been pressed in addition to the AltGr key
1968 so that we can properly support M-AltGr-key sequences (such as M-@
1969 on Swedish keyboards). */
1971 #define EMACS_LCONTROL 0
1972 #define EMACS_RCONTROL 1
1973 #define EMACS_LMENU 2
1974 #define EMACS_RMENU 3
1976 static int modifiers[4];
1977 static int modifiers_recorded;
1978 static int modifier_key_support_tested;
1980 static void
1981 test_modifier_support (unsigned int wparam)
1983 unsigned int l, r;
1985 if (wparam != VK_CONTROL && wparam != VK_MENU)
1986 return;
1987 if (wparam == VK_CONTROL)
1989 l = VK_LCONTROL;
1990 r = VK_RCONTROL;
1992 else
1994 l = VK_LMENU;
1995 r = VK_RMENU;
1997 if (!(GetKeyState (l) & 0x8000) && !(GetKeyState (r) & 0x8000))
1998 modifiers_recorded = 1;
1999 else
2000 modifiers_recorded = 0;
2001 modifier_key_support_tested = 1;
2004 static void
2005 record_keydown (unsigned int wparam, unsigned int lparam)
2007 int i;
2009 if (!modifier_key_support_tested)
2010 test_modifier_support (wparam);
2012 if ((wparam != VK_CONTROL && wparam != VK_MENU) || !modifiers_recorded)
2013 return;
2015 if (wparam == VK_CONTROL)
2016 i = (lparam & 0x1000000) ? EMACS_RCONTROL : EMACS_LCONTROL;
2017 else
2018 i = (lparam & 0x1000000) ? EMACS_RMENU : EMACS_LMENU;
2020 modifiers[i] = 1;
2023 static void
2024 record_keyup (unsigned int wparam, unsigned int lparam)
2026 int i;
2028 if ((wparam != VK_CONTROL && wparam != VK_MENU) || !modifiers_recorded)
2029 return;
2031 if (wparam == VK_CONTROL)
2032 i = (lparam & 0x1000000) ? EMACS_RCONTROL : EMACS_LCONTROL;
2033 else
2034 i = (lparam & 0x1000000) ? EMACS_RMENU : EMACS_LMENU;
2036 modifiers[i] = 0;
2039 /* Emacs can lose focus while a modifier key has been pressed. When
2040 it regains focus, be conservative and clear all modifiers since
2041 we cannot reconstruct the left and right modifier state. */
2042 static void
2043 reset_modifiers (void)
2045 SHORT ctrl, alt;
2047 if (GetFocus () == NULL)
2048 /* Emacs doesn't have keyboard focus. Do nothing. */
2049 return;
2051 ctrl = GetAsyncKeyState (VK_CONTROL);
2052 alt = GetAsyncKeyState (VK_MENU);
2054 if (!(ctrl & 0x08000))
2055 /* Clear any recorded control modifier state. */
2056 modifiers[EMACS_RCONTROL] = modifiers[EMACS_LCONTROL] = 0;
2058 if (!(alt & 0x08000))
2059 /* Clear any recorded alt modifier state. */
2060 modifiers[EMACS_RMENU] = modifiers[EMACS_LMENU] = 0;
2062 /* Update the state of all modifier keys, because modifiers used in
2063 hot-key combinations can get stuck on if Emacs loses focus as a
2064 result of a hot-key being pressed. */
2066 BYTE keystate[256];
2068 #define CURRENT_STATE(key) ((GetAsyncKeyState (key) & 0x8000) >> 8)
2070 GetKeyboardState (keystate);
2071 keystate[VK_SHIFT] = CURRENT_STATE (VK_SHIFT);
2072 keystate[VK_CONTROL] = CURRENT_STATE (VK_CONTROL);
2073 keystate[VK_LCONTROL] = CURRENT_STATE (VK_LCONTROL);
2074 keystate[VK_RCONTROL] = CURRENT_STATE (VK_RCONTROL);
2075 keystate[VK_MENU] = CURRENT_STATE (VK_MENU);
2076 keystate[VK_LMENU] = CURRENT_STATE (VK_LMENU);
2077 keystate[VK_RMENU] = CURRENT_STATE (VK_RMENU);
2078 keystate[VK_LWIN] = CURRENT_STATE (VK_LWIN);
2079 keystate[VK_RWIN] = CURRENT_STATE (VK_RWIN);
2080 keystate[VK_APPS] = CURRENT_STATE (VK_APPS);
2081 SetKeyboardState (keystate);
2085 /* Synchronize modifier state with what is reported with the current
2086 keystroke. Even if we cannot distinguish between left and right
2087 modifier keys, we know that, if no modifiers are set, then neither
2088 the left or right modifier should be set. */
2089 static void
2090 sync_modifiers (void)
2092 if (!modifiers_recorded)
2093 return;
2095 if (!(GetKeyState (VK_CONTROL) & 0x8000))
2096 modifiers[EMACS_RCONTROL] = modifiers[EMACS_LCONTROL] = 0;
2098 if (!(GetKeyState (VK_MENU) & 0x8000))
2099 modifiers[EMACS_RMENU] = modifiers[EMACS_LMENU] = 0;
2102 static int
2103 modifier_set (int vkey)
2105 /* Warning: The fact that VK_NUMLOCK is not treated as the other 2
2106 toggle keys is not an omission! If you want to add it, you will
2107 have to make changes in the default sub-case of the WM_KEYDOWN
2108 switch, because if the NUMLOCK modifier is set, the code there
2109 will directly convert any key that looks like an ASCII letter,
2110 and also downcase those that look like upper-case ASCII. */
2111 if (vkey == VK_CAPITAL)
2113 if (NILP (Vw32_enable_caps_lock))
2114 return 0;
2115 else
2116 return (GetKeyState (vkey) & 0x1);
2118 if (vkey == VK_SCROLL)
2120 if (NILP (Vw32_scroll_lock_modifier)
2121 /* w32-scroll-lock-modifier can be any non-nil value that is
2122 not one of the modifiers, in which case it shall be ignored. */
2123 || !( EQ (Vw32_scroll_lock_modifier, Qhyper)
2124 || EQ (Vw32_scroll_lock_modifier, Qsuper)
2125 || EQ (Vw32_scroll_lock_modifier, Qmeta)
2126 || EQ (Vw32_scroll_lock_modifier, Qalt)
2127 || EQ (Vw32_scroll_lock_modifier, Qcontrol)
2128 || EQ (Vw32_scroll_lock_modifier, Qshift)))
2129 return 0;
2130 else
2131 return (GetKeyState (vkey) & 0x1);
2134 if (!modifiers_recorded)
2135 return (GetKeyState (vkey) & 0x8000);
2137 switch (vkey)
2139 case VK_LCONTROL:
2140 return modifiers[EMACS_LCONTROL];
2141 case VK_RCONTROL:
2142 return modifiers[EMACS_RCONTROL];
2143 case VK_LMENU:
2144 return modifiers[EMACS_LMENU];
2145 case VK_RMENU:
2146 return modifiers[EMACS_RMENU];
2148 return (GetKeyState (vkey) & 0x8000);
2151 /* Convert between the modifier bits W32 uses and the modifier bits
2152 Emacs uses. */
2154 unsigned int
2155 w32_key_to_modifier (int key)
2157 Lisp_Object key_mapping;
2159 switch (key)
2161 case VK_LWIN:
2162 key_mapping = Vw32_lwindow_modifier;
2163 break;
2164 case VK_RWIN:
2165 key_mapping = Vw32_rwindow_modifier;
2166 break;
2167 case VK_APPS:
2168 key_mapping = Vw32_apps_modifier;
2169 break;
2170 case VK_SCROLL:
2171 key_mapping = Vw32_scroll_lock_modifier;
2172 break;
2173 default:
2174 key_mapping = Qnil;
2177 /* NB. This code runs in the input thread, asynchronously to the lisp
2178 thread, so we must be careful to ensure access to lisp data is
2179 thread-safe. The following code is safe because the modifier
2180 variable values are updated atomically from lisp and symbols are
2181 not relocated by GC. Also, we don't have to worry about seeing GC
2182 markbits here. */
2183 if (EQ (key_mapping, Qhyper))
2184 return hyper_modifier;
2185 if (EQ (key_mapping, Qsuper))
2186 return super_modifier;
2187 if (EQ (key_mapping, Qmeta))
2188 return meta_modifier;
2189 if (EQ (key_mapping, Qalt))
2190 return alt_modifier;
2191 if (EQ (key_mapping, Qctrl))
2192 return ctrl_modifier;
2193 if (EQ (key_mapping, Qcontrol)) /* synonym for ctrl */
2194 return ctrl_modifier;
2195 if (EQ (key_mapping, Qshift))
2196 return shift_modifier;
2198 /* Don't generate any modifier if not explicitly requested. */
2199 return 0;
2202 static unsigned int
2203 w32_get_modifiers (void)
2205 return ((modifier_set (VK_SHIFT) ? shift_modifier : 0) |
2206 (modifier_set (VK_CONTROL) ? ctrl_modifier : 0) |
2207 (modifier_set (VK_LWIN) ? w32_key_to_modifier (VK_LWIN) : 0) |
2208 (modifier_set (VK_RWIN) ? w32_key_to_modifier (VK_RWIN) : 0) |
2209 (modifier_set (VK_APPS) ? w32_key_to_modifier (VK_APPS) : 0) |
2210 (modifier_set (VK_SCROLL) ? w32_key_to_modifier (VK_SCROLL) : 0) |
2211 (modifier_set (VK_MENU) ?
2212 ((NILP (Vw32_alt_is_meta)) ? alt_modifier : meta_modifier) : 0));
2215 /* We map the VK_* modifiers into console modifier constants
2216 so that we can use the same routines to handle both console
2217 and window input. */
2219 static int
2220 construct_console_modifiers (void)
2222 int mods;
2224 mods = 0;
2225 mods |= (modifier_set (VK_SHIFT)) ? SHIFT_PRESSED : 0;
2226 mods |= (modifier_set (VK_CAPITAL)) ? CAPSLOCK_ON : 0;
2227 mods |= (modifier_set (VK_SCROLL)) ? SCROLLLOCK_ON : 0;
2228 mods |= (modifier_set (VK_NUMLOCK)) ? NUMLOCK_ON : 0;
2229 mods |= (modifier_set (VK_LCONTROL)) ? LEFT_CTRL_PRESSED : 0;
2230 mods |= (modifier_set (VK_RCONTROL)) ? RIGHT_CTRL_PRESSED : 0;
2231 mods |= (modifier_set (VK_LMENU)) ? LEFT_ALT_PRESSED : 0;
2232 mods |= (modifier_set (VK_RMENU)) ? RIGHT_ALT_PRESSED : 0;
2233 mods |= (modifier_set (VK_LWIN)) ? LEFT_WIN_PRESSED : 0;
2234 mods |= (modifier_set (VK_RWIN)) ? RIGHT_WIN_PRESSED : 0;
2235 mods |= (modifier_set (VK_APPS)) ? APPS_PRESSED : 0;
2237 return mods;
2240 static int
2241 w32_get_key_modifiers (unsigned int wparam, unsigned int lparam)
2243 int mods;
2245 /* Convert to emacs modifiers. */
2246 mods = w32_kbd_mods_to_emacs (construct_console_modifiers (), wparam);
2248 return mods;
2251 unsigned int
2252 map_keypad_keys (unsigned int virt_key, unsigned int extended)
2254 if (virt_key < VK_CLEAR || virt_key > VK_DELETE)
2255 return virt_key;
2257 if (virt_key == VK_RETURN)
2258 return (extended ? VK_NUMPAD_ENTER : VK_RETURN);
2260 if (virt_key >= VK_PRIOR && virt_key <= VK_DOWN)
2261 return (!extended ? (VK_NUMPAD_PRIOR + (virt_key - VK_PRIOR)) : virt_key);
2263 if (virt_key == VK_INSERT || virt_key == VK_DELETE)
2264 return (!extended ? (VK_NUMPAD_INSERT + (virt_key - VK_INSERT)) : virt_key);
2266 if (virt_key == VK_CLEAR)
2267 return (!extended ? VK_NUMPAD_CLEAR : virt_key);
2269 return virt_key;
2272 /* List of special key combinations which w32 would normally capture,
2273 but Emacs should grab instead. Not directly visible to lisp, to
2274 simplify synchronization. Each item is an integer encoding a virtual
2275 key code and modifier combination to capture. */
2276 static Lisp_Object w32_grabbed_keys;
2278 #define HOTKEY(vk, mods) make_number (((vk) & 255) | ((mods) << 8))
2279 #define HOTKEY_ID(k) (XFASTINT (k) & 0xbfff)
2280 #define HOTKEY_VK_CODE(k) (XFASTINT (k) & 255)
2281 #define HOTKEY_MODIFIERS(k) (XFASTINT (k) >> 8)
2283 #define RAW_HOTKEY_ID(k) ((k) & 0xbfff)
2284 #define RAW_HOTKEY_VK_CODE(k) ((k) & 255)
2285 #define RAW_HOTKEY_MODIFIERS(k) ((k) >> 8)
2287 /* Register hot-keys for reserved key combinations when Emacs has
2288 keyboard focus, since this is the only way Emacs can receive key
2289 combinations like Alt-Tab which are used by the system. */
2291 static void
2292 register_hot_keys (HWND hwnd)
2294 Lisp_Object keylist;
2296 /* Use CONSP, since we are called asynchronously. */
2297 for (keylist = w32_grabbed_keys; CONSP (keylist); keylist = XCDR (keylist))
2299 Lisp_Object key = XCAR (keylist);
2301 /* Deleted entries get set to nil. */
2302 if (!INTEGERP (key))
2303 continue;
2305 RegisterHotKey (hwnd, HOTKEY_ID (key),
2306 HOTKEY_MODIFIERS (key), HOTKEY_VK_CODE (key));
2310 static void
2311 unregister_hot_keys (HWND hwnd)
2313 Lisp_Object keylist;
2315 for (keylist = w32_grabbed_keys; CONSP (keylist); keylist = XCDR (keylist))
2317 Lisp_Object key = XCAR (keylist);
2319 if (!INTEGERP (key))
2320 continue;
2322 UnregisterHotKey (hwnd, HOTKEY_ID (key));
2326 #if EMACSDEBUG
2327 const char*
2328 w32_name_of_message (UINT msg)
2330 unsigned i;
2331 static char buf[64];
2332 static const struct {
2333 UINT msg;
2334 const char* name;
2335 } msgnames[] = {
2336 #define M(msg) { msg, # msg }
2337 M (WM_PAINT),
2338 M (WM_TIMER),
2339 M (WM_USER),
2340 M (WM_MOUSEMOVE),
2341 M (WM_LBUTTONUP),
2342 M (WM_KEYDOWN),
2343 M (WM_EMACS_KILL),
2344 M (WM_EMACS_CREATEWINDOW),
2345 M (WM_EMACS_DONE),
2346 M (WM_EMACS_CREATESCROLLBAR),
2347 M (WM_EMACS_SHOWWINDOW),
2348 M (WM_EMACS_SETWINDOWPOS),
2349 M (WM_EMACS_DESTROYWINDOW),
2350 M (WM_EMACS_TRACKPOPUPMENU),
2351 M (WM_EMACS_SETFOCUS),
2352 M (WM_EMACS_SETFOREGROUND),
2353 M (WM_EMACS_SETLOCALE),
2354 M (WM_EMACS_SETKEYBOARDLAYOUT),
2355 M (WM_EMACS_REGISTER_HOT_KEY),
2356 M (WM_EMACS_UNREGISTER_HOT_KEY),
2357 M (WM_EMACS_TOGGLE_LOCK_KEY),
2358 M (WM_EMACS_TRACK_CARET),
2359 M (WM_EMACS_DESTROY_CARET),
2360 M (WM_EMACS_SHOW_CARET),
2361 M (WM_EMACS_HIDE_CARET),
2362 M (WM_EMACS_SETCURSOR),
2363 M (WM_EMACS_PAINT),
2364 M (WM_CHAR),
2365 #undef M
2366 { 0, 0 }
2369 for (i = 0; msgnames[i].name; ++i)
2370 if (msgnames[i].msg == msg)
2371 return msgnames[i].name;
2373 sprintf (buf, "message 0x%04x", (unsigned)msg);
2374 return buf;
2376 #endif /* EMACSDEBUG */
2378 /* Here's an overview of how Emacs input works in GUI sessions on
2379 MS-Windows. (For description of non-GUI input, see the commentary
2380 before w32_console_read_socket in w32inevt.c.)
2382 System messages are read and processed by w32_msg_pump below. This
2383 function runs in a separate thread. It handles a small number of
2384 custom WM_EMACS_* messages (posted by the main thread, look for
2385 PostMessage calls), and dispatches the rest to w32_wnd_proc, which
2386 is the main window procedure for the entire Emacs application.
2388 w32_wnd_proc also runs in the same separate input thread. It
2389 handles some messages, mostly those that need GDI calls, by itself.
2390 For the others, it calls my_post_msg, which inserts the messages
2391 into the input queue serviced by w32_read_socket.
2393 w32_read_socket runs in the main (a.k.a. "Lisp") thread, and is
2394 called synchronously from keyboard.c when it is known or suspected
2395 that some input is available. w32_read_socket either handles
2396 messages immediately, or converts them into Emacs input events and
2397 stuffs them into kbd_buffer, where kbd_buffer_get_event can get at
2398 them and process them when read_char and its callers require
2399 input.
2401 Under Cygwin with the W32 toolkit, the use of /dev/windows with
2402 select(2) takes the place of w32_read_socket.
2406 /* Main message dispatch loop. */
2408 static void
2409 w32_msg_pump (deferred_msg * msg_buf)
2411 MSG msg;
2412 WPARAM result;
2413 HWND focus_window;
2415 msh_mousewheel = RegisterWindowMessage (MSH_MOUSEWHEEL);
2417 while ((w32_unicode_gui ? GetMessageW : GetMessageA) (&msg, NULL, 0, 0))
2420 /* DebPrint (("w32_msg_pump: %s time:%u\n", */
2421 /* w32_name_of_message (msg.message), msg.time)); */
2423 if (msg.hwnd == NULL)
2425 switch (msg.message)
2427 case WM_NULL:
2428 /* Produced by complete_deferred_msg; just ignore. */
2429 break;
2430 case WM_EMACS_CREATEWINDOW:
2431 /* Initialize COM for this window. Even though we don't use it,
2432 some third party shell extensions can cause it to be used in
2433 system dialogs, which causes a crash if it is not initialized.
2434 This is a known bug in Windows, which was fixed long ago, but
2435 the patch for XP is not publicly available until XP SP3,
2436 and older versions will never be patched. */
2437 CoInitialize (NULL);
2438 w32_createwindow ((struct frame *) msg.wParam);
2439 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE, 0, 0))
2440 emacs_abort ();
2441 break;
2442 case WM_EMACS_SETLOCALE:
2443 SetThreadLocale (msg.wParam);
2444 /* Reply is not expected. */
2445 break;
2446 case WM_EMACS_SETKEYBOARDLAYOUT:
2447 result = (WPARAM) ActivateKeyboardLayout ((HKL) msg.wParam, 0);
2448 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE,
2449 result, 0))
2450 emacs_abort ();
2451 break;
2452 case WM_EMACS_REGISTER_HOT_KEY:
2453 focus_window = GetFocus ();
2454 if (focus_window != NULL)
2455 RegisterHotKey (focus_window,
2456 RAW_HOTKEY_ID (msg.wParam),
2457 RAW_HOTKEY_MODIFIERS (msg.wParam),
2458 RAW_HOTKEY_VK_CODE (msg.wParam));
2459 /* Reply is not expected. */
2460 break;
2461 case WM_EMACS_UNREGISTER_HOT_KEY:
2462 focus_window = GetFocus ();
2463 if (focus_window != NULL)
2464 UnregisterHotKey (focus_window, RAW_HOTKEY_ID (msg.wParam));
2465 /* Mark item as erased. NB: this code must be
2466 thread-safe. The next line is okay because the cons
2467 cell is never made into garbage and is not relocated by
2468 GC. */
2469 XSETCAR (XIL ((EMACS_INT) msg.lParam), Qnil);
2470 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE, 0, 0))
2471 emacs_abort ();
2472 break;
2473 case WM_EMACS_TOGGLE_LOCK_KEY:
2475 int vk_code = (int) msg.wParam;
2476 int cur_state = (GetKeyState (vk_code) & 1);
2477 Lisp_Object new_state = XIL ((EMACS_INT) msg.lParam);
2479 /* NB: This code must be thread-safe. It is safe to
2480 call NILP because symbols are not relocated by GC,
2481 and pointer here is not touched by GC (so the markbit
2482 can't be set). Numbers are safe because they are
2483 immediate values. */
2484 if (NILP (new_state)
2485 || (NUMBERP (new_state)
2486 && ((XUINT (new_state)) & 1) != cur_state))
2488 one_w32_display_info.faked_key = vk_code;
2490 keybd_event ((BYTE) vk_code,
2491 (BYTE) MapVirtualKey (vk_code, 0),
2492 KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
2493 keybd_event ((BYTE) vk_code,
2494 (BYTE) MapVirtualKey (vk_code, 0),
2495 KEYEVENTF_EXTENDEDKEY | 0, 0);
2496 keybd_event ((BYTE) vk_code,
2497 (BYTE) MapVirtualKey (vk_code, 0),
2498 KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
2499 cur_state = !cur_state;
2501 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE,
2502 cur_state, 0))
2503 emacs_abort ();
2505 break;
2506 #ifdef MSG_DEBUG
2507 /* Broadcast messages make it here, so you need to be looking
2508 for something in particular for this to be useful. */
2509 default:
2510 DebPrint (("msg %x not expected by w32_msg_pump\n", msg.message));
2511 #endif
2514 else
2516 if (w32_unicode_gui)
2517 DispatchMessageW (&msg);
2518 else
2519 DispatchMessageA (&msg);
2522 /* Exit nested loop when our deferred message has completed. */
2523 if (msg_buf->completed)
2524 break;
2528 deferred_msg * deferred_msg_head;
2530 static deferred_msg *
2531 find_deferred_msg (HWND hwnd, UINT msg)
2533 deferred_msg * item;
2535 /* Don't actually need synchronization for read access, since
2536 modification of single pointer is always atomic. */
2537 /* enter_crit (); */
2539 for (item = deferred_msg_head; item != NULL; item = item->next)
2540 if (item->w32msg.msg.hwnd == hwnd
2541 && item->w32msg.msg.message == msg)
2542 break;
2544 /* leave_crit (); */
2546 return item;
2549 static LRESULT
2550 send_deferred_msg (deferred_msg * msg_buf,
2551 HWND hwnd,
2552 UINT msg,
2553 WPARAM wParam,
2554 LPARAM lParam)
2556 /* Only input thread can send deferred messages. */
2557 if (GetCurrentThreadId () != dwWindowsThreadId)
2558 emacs_abort ();
2560 /* It is an error to send a message that is already deferred. */
2561 if (find_deferred_msg (hwnd, msg) != NULL)
2562 emacs_abort ();
2564 /* Enforced synchronization is not needed because this is the only
2565 function that alters deferred_msg_head, and the following critical
2566 section is guaranteed to only be serially reentered (since only the
2567 input thread can call us). */
2569 /* enter_crit (); */
2571 msg_buf->completed = 0;
2572 msg_buf->next = deferred_msg_head;
2573 deferred_msg_head = msg_buf;
2574 my_post_msg (&msg_buf->w32msg, hwnd, msg, wParam, lParam);
2576 /* leave_crit (); */
2578 /* Start a new nested message loop to process other messages until
2579 this one is completed. */
2580 w32_msg_pump (msg_buf);
2582 deferred_msg_head = msg_buf->next;
2584 return msg_buf->result;
2587 void
2588 complete_deferred_msg (HWND hwnd, UINT msg, LRESULT result)
2590 deferred_msg * msg_buf = find_deferred_msg (hwnd, msg);
2592 if (msg_buf == NULL)
2593 /* Message may have been canceled, so don't abort. */
2594 return;
2596 msg_buf->result = result;
2597 msg_buf->completed = 1;
2599 /* Ensure input thread is woken so it notices the completion. */
2600 PostThreadMessage (dwWindowsThreadId, WM_NULL, 0, 0);
2603 static void
2604 cancel_all_deferred_msgs (void)
2606 deferred_msg * item;
2608 /* Don't actually need synchronization for read access, since
2609 modification of single pointer is always atomic. */
2610 /* enter_crit (); */
2612 for (item = deferred_msg_head; item != NULL; item = item->next)
2614 item->result = 0;
2615 item->completed = 1;
2618 /* leave_crit (); */
2620 /* Ensure input thread is woken so it notices the completion. */
2621 PostThreadMessage (dwWindowsThreadId, WM_NULL, 0, 0);
2624 DWORD WINAPI
2625 w32_msg_worker (void *arg)
2627 MSG msg;
2628 deferred_msg dummy_buf;
2630 /* Ensure our message queue is created */
2632 PeekMessage (&msg, NULL, 0, 0, PM_NOREMOVE);
2634 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE, 0, 0))
2635 emacs_abort ();
2637 memset (&dummy_buf, 0, sizeof (dummy_buf));
2638 dummy_buf.w32msg.msg.hwnd = NULL;
2639 dummy_buf.w32msg.msg.message = WM_NULL;
2641 /* This is the initial message loop which should only exit when the
2642 application quits. */
2643 w32_msg_pump (&dummy_buf);
2645 return 0;
2648 static void
2649 signal_user_input (void)
2651 /* Interrupt any lisp that wants to be interrupted by input. */
2652 if (!NILP (Vthrow_on_input))
2654 Vquit_flag = Vthrow_on_input;
2655 /* Doing a QUIT from this thread is a bad idea, since this
2656 unwinds the stack of the Lisp thread, and the Windows runtime
2657 rightfully barfs. Disabled. */
2658 #if 0
2659 /* If we're inside a function that wants immediate quits,
2660 do it now. */
2661 if (immediate_quit && NILP (Vinhibit_quit))
2663 immediate_quit = 0;
2664 QUIT;
2666 #endif
2671 static void
2672 post_character_message (HWND hwnd, UINT msg,
2673 WPARAM wParam, LPARAM lParam,
2674 DWORD modifiers)
2676 W32Msg wmsg;
2678 wmsg.dwModifiers = modifiers;
2680 /* Detect quit_char and set quit-flag directly. Note that we
2681 still need to post a message to ensure the main thread will be
2682 woken up if blocked in sys_select, but we do NOT want to post
2683 the quit_char message itself (because it will usually be as if
2684 the user had typed quit_char twice). Instead, we post a dummy
2685 message that has no particular effect. */
2687 int c = wParam;
2688 if (isalpha (c) && wmsg.dwModifiers == ctrl_modifier)
2689 c = make_ctrl_char (c) & 0377;
2690 if (c == quit_char
2691 || (wmsg.dwModifiers == 0
2692 && w32_quit_key && wParam == w32_quit_key))
2694 Vquit_flag = Qt;
2696 /* The choice of message is somewhat arbitrary, as long as
2697 the main thread handler just ignores it. */
2698 msg = WM_NULL;
2700 /* Interrupt any blocking system calls. */
2701 signal_quit ();
2703 /* As a safety precaution, forcibly complete any deferred
2704 messages. This is a kludge, but I don't see any particularly
2705 clean way to handle the situation where a deferred message is
2706 "dropped" in the lisp thread, and will thus never be
2707 completed, eg. by the user trying to activate the menubar
2708 when the lisp thread is busy, and then typing C-g when the
2709 menubar doesn't open promptly (with the result that the
2710 menubar never responds at all because the deferred
2711 WM_INITMENU message is never completed). Another problem
2712 situation is when the lisp thread calls SendMessage (to send
2713 a window manager command) when a message has been deferred;
2714 the lisp thread gets blocked indefinitely waiting for the
2715 deferred message to be completed, which itself is waiting for
2716 the lisp thread to respond.
2718 Note that we don't want to block the input thread waiting for
2719 a response from the lisp thread (although that would at least
2720 solve the deadlock problem above), because we want to be able
2721 to receive C-g to interrupt the lisp thread. */
2722 cancel_all_deferred_msgs ();
2724 else
2725 signal_user_input ();
2728 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
2731 /* Main window procedure */
2733 static LRESULT CALLBACK
2734 w32_wnd_proc (HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam)
2736 struct frame *f;
2737 struct w32_display_info *dpyinfo = &one_w32_display_info;
2738 W32Msg wmsg;
2739 int windows_translate;
2740 int key;
2742 /* Note that it is okay to call x_window_to_frame, even though we are
2743 not running in the main lisp thread, because frame deletion
2744 requires the lisp thread to synchronize with this thread. Thus, if
2745 a frame struct is returned, it can be used without concern that the
2746 lisp thread might make it disappear while we are using it.
2748 NB. Walking the frame list in this thread is safe (as long as
2749 writes of Lisp_Object slots are atomic, which they are on Windows).
2750 Although delete-frame can destructively modify the frame list while
2751 we are walking it, a garbage collection cannot occur until after
2752 delete-frame has synchronized with this thread.
2754 It is also safe to use functions that make GDI calls, such as
2755 w32_clear_rect, because these functions must obtain a DC handle
2756 from the frame struct using get_frame_dc which is thread-aware. */
2758 switch (msg)
2760 case WM_ERASEBKGND:
2761 f = x_window_to_frame (dpyinfo, hwnd);
2762 if (f)
2764 HDC hdc = get_frame_dc (f);
2765 GetUpdateRect (hwnd, &wmsg.rect, FALSE);
2766 w32_clear_rect (f, hdc, &wmsg.rect);
2767 release_frame_dc (f, hdc);
2769 #if defined (W32_DEBUG_DISPLAY)
2770 DebPrint (("WM_ERASEBKGND (frame %p): erasing %d,%d-%d,%d\n",
2772 wmsg.rect.left, wmsg.rect.top,
2773 wmsg.rect.right, wmsg.rect.bottom));
2774 #endif /* W32_DEBUG_DISPLAY */
2776 return 1;
2777 case WM_PALETTECHANGED:
2778 /* ignore our own changes */
2779 if ((HWND)wParam != hwnd)
2781 f = x_window_to_frame (dpyinfo, hwnd);
2782 if (f)
2783 /* get_frame_dc will realize our palette and force all
2784 frames to be redrawn if needed. */
2785 release_frame_dc (f, get_frame_dc (f));
2787 return 0;
2788 case WM_PAINT:
2790 PAINTSTRUCT paintStruct;
2791 RECT update_rect;
2792 memset (&update_rect, 0, sizeof (update_rect));
2794 f = x_window_to_frame (dpyinfo, hwnd);
2795 if (f == 0)
2797 DebPrint (("WM_PAINT received for unknown window %p\n", hwnd));
2798 return 0;
2801 /* MSDN Docs say not to call BeginPaint if GetUpdateRect
2802 fails. Apparently this can happen under some
2803 circumstances. */
2804 if (GetUpdateRect (hwnd, &update_rect, FALSE) || !w32_strict_painting)
2806 enter_crit ();
2807 BeginPaint (hwnd, &paintStruct);
2809 /* The rectangles returned by GetUpdateRect and BeginPaint
2810 do not always match. Play it safe by assuming both areas
2811 are invalid. */
2812 UnionRect (&(wmsg.rect), &update_rect, &(paintStruct.rcPaint));
2814 #if defined (W32_DEBUG_DISPLAY)
2815 DebPrint (("WM_PAINT (frame %p): painting %d,%d-%d,%d\n",
2817 wmsg.rect.left, wmsg.rect.top,
2818 wmsg.rect.right, wmsg.rect.bottom));
2819 DebPrint ((" [update region is %d,%d-%d,%d]\n",
2820 update_rect.left, update_rect.top,
2821 update_rect.right, update_rect.bottom));
2822 #endif
2823 EndPaint (hwnd, &paintStruct);
2824 leave_crit ();
2826 /* Change the message type to prevent Windows from
2827 combining WM_PAINT messages in the Lisp thread's queue,
2828 since Windows assumes that each message queue is
2829 dedicated to one frame and does not bother checking
2830 that hwnd matches before combining them. */
2831 my_post_msg (&wmsg, hwnd, WM_EMACS_PAINT, wParam, lParam);
2833 return 0;
2836 /* If GetUpdateRect returns 0 (meaning there is no update
2837 region), assume the whole window needs to be repainted. */
2838 GetClientRect (hwnd, &wmsg.rect);
2839 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
2840 return 0;
2843 case WM_INPUTLANGCHANGE:
2844 /* Inform lisp thread of keyboard layout changes. */
2845 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
2847 /* Clear dead keys in the keyboard state; for simplicity only
2848 preserve modifier key states. */
2850 int i;
2851 BYTE keystate[256];
2853 GetKeyboardState (keystate);
2854 for (i = 0; i < 256; i++)
2855 if (1
2856 && i != VK_SHIFT
2857 && i != VK_LSHIFT
2858 && i != VK_RSHIFT
2859 && i != VK_CAPITAL
2860 && i != VK_NUMLOCK
2861 && i != VK_SCROLL
2862 && i != VK_CONTROL
2863 && i != VK_LCONTROL
2864 && i != VK_RCONTROL
2865 && i != VK_MENU
2866 && i != VK_LMENU
2867 && i != VK_RMENU
2868 && i != VK_LWIN
2869 && i != VK_RWIN)
2870 keystate[i] = 0;
2871 SetKeyboardState (keystate);
2873 goto dflt;
2875 case WM_HOTKEY:
2876 /* Synchronize hot keys with normal input. */
2877 PostMessage (hwnd, WM_KEYDOWN, HIWORD (lParam), 0);
2878 return (0);
2880 case WM_KEYUP:
2881 case WM_SYSKEYUP:
2882 record_keyup (wParam, lParam);
2883 goto dflt;
2885 case WM_KEYDOWN:
2886 case WM_SYSKEYDOWN:
2887 /* Ignore keystrokes we fake ourself; see below. */
2888 if (dpyinfo->faked_key == wParam)
2890 dpyinfo->faked_key = 0;
2891 /* Make sure TranslateMessage sees them though (as long as
2892 they don't produce WM_CHAR messages). This ensures that
2893 indicator lights are toggled promptly on Windows 9x, for
2894 example. */
2895 if (wParam < 256 && lispy_function_keys[wParam])
2897 windows_translate = 1;
2898 goto translate;
2900 return 0;
2903 /* Synchronize modifiers with current keystroke. */
2904 sync_modifiers ();
2905 record_keydown (wParam, lParam);
2906 wParam = map_keypad_keys (wParam, (lParam & 0x1000000L) != 0);
2908 windows_translate = 0;
2910 switch (wParam)
2912 case VK_LWIN:
2913 if (NILP (Vw32_pass_lwindow_to_system))
2915 /* Prevent system from acting on keyup (which opens the
2916 Start menu if no other key was pressed) by simulating a
2917 press of Space which we will ignore. */
2918 if (GetAsyncKeyState (wParam) & 1)
2920 if (NUMBERP (Vw32_phantom_key_code))
2921 key = XUINT (Vw32_phantom_key_code) & 255;
2922 else
2923 key = VK_SPACE;
2924 dpyinfo->faked_key = key;
2925 keybd_event (key, (BYTE) MapVirtualKey (key, 0), 0, 0);
2928 if (!NILP (Vw32_lwindow_modifier))
2929 return 0;
2930 break;
2931 case VK_RWIN:
2932 if (NILP (Vw32_pass_rwindow_to_system))
2934 if (GetAsyncKeyState (wParam) & 1)
2936 if (NUMBERP (Vw32_phantom_key_code))
2937 key = XUINT (Vw32_phantom_key_code) & 255;
2938 else
2939 key = VK_SPACE;
2940 dpyinfo->faked_key = key;
2941 keybd_event (key, (BYTE) MapVirtualKey (key, 0), 0, 0);
2944 if (!NILP (Vw32_rwindow_modifier))
2945 return 0;
2946 break;
2947 case VK_APPS:
2948 if (!NILP (Vw32_apps_modifier))
2949 return 0;
2950 break;
2951 case VK_MENU:
2952 if (NILP (Vw32_pass_alt_to_system))
2953 /* Prevent DefWindowProc from activating the menu bar if an
2954 Alt key is pressed and released by itself. */
2955 return 0;
2956 windows_translate = 1;
2957 break;
2958 case VK_CAPITAL:
2959 /* Decide whether to treat as modifier or function key. */
2960 if (NILP (Vw32_enable_caps_lock))
2961 goto disable_lock_key;
2962 windows_translate = 1;
2963 break;
2964 case VK_NUMLOCK:
2965 /* Decide whether to treat as modifier or function key. */
2966 if (NILP (Vw32_enable_num_lock))
2967 goto disable_lock_key;
2968 windows_translate = 1;
2969 break;
2970 case VK_SCROLL:
2971 /* Decide whether to treat as modifier or function key. */
2972 if (NILP (Vw32_scroll_lock_modifier))
2973 goto disable_lock_key;
2974 windows_translate = 1;
2975 break;
2976 disable_lock_key:
2977 /* Ensure the appropriate lock key state (and indicator light)
2978 remains in the same state. We do this by faking another
2979 press of the relevant key. Apparently, this really is the
2980 only way to toggle the state of the indicator lights. */
2981 dpyinfo->faked_key = wParam;
2982 keybd_event ((BYTE) wParam, (BYTE) MapVirtualKey (wParam, 0),
2983 KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
2984 keybd_event ((BYTE) wParam, (BYTE) MapVirtualKey (wParam, 0),
2985 KEYEVENTF_EXTENDEDKEY | 0, 0);
2986 keybd_event ((BYTE) wParam, (BYTE) MapVirtualKey (wParam, 0),
2987 KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
2988 /* Ensure indicator lights are updated promptly on Windows 9x
2989 (TranslateMessage apparently does this), after forwarding
2990 input event. */
2991 post_character_message (hwnd, msg, wParam, lParam,
2992 w32_get_key_modifiers (wParam, lParam));
2993 windows_translate = 1;
2994 break;
2995 case VK_CONTROL:
2996 case VK_SHIFT:
2997 case VK_PROCESSKEY: /* Generated by IME. */
2998 windows_translate = 1;
2999 break;
3000 case VK_CANCEL:
3001 /* Windows maps Ctrl-Pause (aka Ctrl-Break) into VK_CANCEL,
3002 which is confusing for purposes of key binding; convert
3003 VK_CANCEL events into VK_PAUSE events. */
3004 wParam = VK_PAUSE;
3005 break;
3006 case VK_PAUSE:
3007 /* Windows maps Ctrl-NumLock into VK_PAUSE, which is confusing
3008 for purposes of key binding; convert these back into
3009 VK_NUMLOCK events, at least when we want to see NumLock key
3010 presses. (Note that there is never any possibility that
3011 VK_PAUSE with Ctrl really is C-Pause as per above.) */
3012 if (NILP (Vw32_enable_num_lock) && modifier_set (VK_CONTROL))
3013 wParam = VK_NUMLOCK;
3014 break;
3015 default:
3016 /* If not defined as a function key, change it to a WM_CHAR message. */
3017 if (wParam > 255 || !lispy_function_keys[wParam])
3019 DWORD modifiers = construct_console_modifiers ();
3021 if (!NILP (Vw32_recognize_altgr)
3022 && modifier_set (VK_LCONTROL) && modifier_set (VK_RMENU))
3024 /* Always let TranslateMessage handle AltGr key chords;
3025 for some reason, ToAscii doesn't always process AltGr
3026 chords correctly. */
3027 windows_translate = 1;
3029 else if ((modifiers & (~SHIFT_PRESSED & ~CAPSLOCK_ON)) != 0)
3031 /* Handle key chords including any modifiers other
3032 than shift directly, in order to preserve as much
3033 modifier information as possible. */
3034 if ('A' <= wParam && wParam <= 'Z')
3036 /* Don't translate modified alphabetic keystrokes,
3037 so the user doesn't need to constantly switch
3038 layout to type control or meta keystrokes when
3039 the normal layout translates alphabetic
3040 characters to non-ascii characters. */
3041 if (!modifier_set (VK_SHIFT))
3042 wParam += ('a' - 'A');
3043 msg = WM_CHAR;
3045 else
3047 /* Try to handle other keystrokes by determining the
3048 base character (ie. translating the base key plus
3049 shift modifier). */
3050 int add;
3051 KEY_EVENT_RECORD key;
3053 key.bKeyDown = TRUE;
3054 key.wRepeatCount = 1;
3055 key.wVirtualKeyCode = wParam;
3056 key.wVirtualScanCode = (lParam & 0xFF0000) >> 16;
3057 key.uChar.AsciiChar = 0;
3058 key.dwControlKeyState = modifiers;
3060 add = w32_kbd_patch_key (&key, w32_keyboard_codepage);
3061 /* 0 means an unrecognized keycode, negative means
3062 dead key. Ignore both. */
3063 while (--add >= 0)
3065 /* Forward asciified character sequence. */
3066 post_character_message
3067 (hwnd, WM_CHAR,
3068 (unsigned char) key.uChar.AsciiChar, lParam,
3069 w32_get_key_modifiers (wParam, lParam));
3070 w32_kbd_patch_key (&key, w32_keyboard_codepage);
3072 return 0;
3075 else
3077 /* Let TranslateMessage handle everything else. */
3078 windows_translate = 1;
3083 translate:
3084 if (windows_translate)
3086 MSG windows_msg = { hwnd, msg, wParam, lParam, 0, {0,0} };
3087 windows_msg.time = GetMessageTime ();
3088 TranslateMessage (&windows_msg);
3089 goto dflt;
3092 /* Fall through */
3094 case WM_SYSCHAR:
3095 case WM_CHAR:
3096 if (wParam > 255 )
3098 W32Msg wmsg;
3100 wmsg.dwModifiers = w32_get_key_modifiers (wParam, lParam);
3101 signal_user_input ();
3102 my_post_msg (&wmsg, hwnd, WM_UNICHAR, wParam, lParam);
3105 else
3106 post_character_message (hwnd, msg, wParam, lParam,
3107 w32_get_key_modifiers (wParam, lParam));
3108 break;
3110 case WM_UNICHAR:
3111 /* WM_UNICHAR looks promising from the docs, but the exact
3112 circumstances in which TranslateMessage sends it is one of those
3113 Microsoft secret API things that EU and US courts are supposed
3114 to have put a stop to already. Spy++ shows it being sent to Notepad
3115 and other MS apps, but never to Emacs.
3117 Some third party IMEs send it in accordance with the official
3118 documentation though, so handle it here.
3120 UNICODE_NOCHAR is used to test for support for this message.
3121 TRUE indicates that the message is supported. */
3122 if (wParam == UNICODE_NOCHAR)
3123 return TRUE;
3126 W32Msg wmsg;
3127 wmsg.dwModifiers = w32_get_key_modifiers (wParam, lParam);
3128 signal_user_input ();
3129 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3131 break;
3133 case WM_IME_CHAR:
3134 /* If we can't get the IME result as Unicode, use default processing,
3135 which will at least allow characters decodable in the system locale
3136 get through. */
3137 if (!get_composition_string_fn)
3138 goto dflt;
3140 else if (!ignore_ime_char)
3142 wchar_t * buffer;
3143 int size, i;
3144 W32Msg wmsg;
3145 HIMC context = get_ime_context_fn (hwnd);
3146 wmsg.dwModifiers = w32_get_key_modifiers (wParam, lParam);
3147 /* Get buffer size. */
3148 size = get_composition_string_fn (context, GCS_RESULTSTR, NULL, 0);
3149 buffer = alloca (size);
3150 size = get_composition_string_fn (context, GCS_RESULTSTR,
3151 buffer, size);
3152 release_ime_context_fn (hwnd, context);
3154 signal_user_input ();
3155 for (i = 0; i < size / sizeof (wchar_t); i++)
3157 my_post_msg (&wmsg, hwnd, WM_UNICHAR, (WPARAM) buffer[i],
3158 lParam);
3160 /* Ignore the messages for the rest of the
3161 characters in the string that was output above. */
3162 ignore_ime_char = (size / sizeof (wchar_t)) - 1;
3164 else
3165 ignore_ime_char--;
3167 break;
3169 case WM_IME_STARTCOMPOSITION:
3170 if (!set_ime_composition_window_fn)
3171 goto dflt;
3172 else
3174 COMPOSITIONFORM form;
3175 HIMC context;
3176 struct window *w;
3178 f = x_window_to_frame (dpyinfo, hwnd);
3179 w = XWINDOW (FRAME_SELECTED_WINDOW (f));
3181 form.dwStyle = CFS_RECT;
3182 form.ptCurrentPos.x = w32_system_caret_x;
3183 form.ptCurrentPos.y = w32_system_caret_y;
3185 form.rcArea.left = WINDOW_TEXT_TO_FRAME_PIXEL_X (w, 0);
3186 form.rcArea.top = WINDOW_TOP_EDGE_Y (w);
3187 if (BUFFERP (w->contents))
3188 form.rcArea.top += WINDOW_HEADER_LINE_HEIGHT (w);
3189 form.rcArea.right = (WINDOW_BOX_RIGHT_EDGE_X (w)
3190 - WINDOW_RIGHT_MARGIN_WIDTH (w)
3191 - WINDOW_RIGHT_FRINGE_WIDTH (w));
3192 form.rcArea.bottom = (WINDOW_BOTTOM_EDGE_Y (w)
3193 - WINDOW_MODE_LINE_HEIGHT (w));
3195 context = get_ime_context_fn (hwnd);
3197 if (!context)
3198 break;
3200 set_ime_composition_window_fn (context, &form);
3201 release_ime_context_fn (hwnd, context);
3203 break;
3205 case WM_IME_ENDCOMPOSITION:
3206 ignore_ime_char = 0;
3207 goto dflt;
3209 /* Simulate middle mouse button events when left and right buttons
3210 are used together, but only if user has two button mouse. */
3211 case WM_LBUTTONDOWN:
3212 case WM_RBUTTONDOWN:
3213 if (w32_num_mouse_buttons > 2)
3214 goto handle_plain_button;
3217 int this = (msg == WM_LBUTTONDOWN) ? LMOUSE : RMOUSE;
3218 int other = (msg == WM_LBUTTONDOWN) ? RMOUSE : LMOUSE;
3220 if (button_state & this)
3221 return 0;
3223 if (button_state == 0)
3224 SetCapture (hwnd);
3226 button_state |= this;
3228 if (button_state & other)
3230 if (mouse_button_timer)
3232 KillTimer (hwnd, mouse_button_timer);
3233 mouse_button_timer = 0;
3235 /* Generate middle mouse event instead. */
3236 msg = WM_MBUTTONDOWN;
3237 button_state |= MMOUSE;
3239 else if (button_state & MMOUSE)
3241 /* Ignore button event if we've already generated a
3242 middle mouse down event. This happens if the
3243 user releases and press one of the two buttons
3244 after we've faked a middle mouse event. */
3245 return 0;
3247 else
3249 /* Flush out saved message. */
3250 post_msg (&saved_mouse_button_msg);
3252 wmsg.dwModifiers = w32_get_modifiers ();
3253 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3254 signal_user_input ();
3256 /* Clear message buffer. */
3257 saved_mouse_button_msg.msg.hwnd = 0;
3259 else
3261 /* Hold onto message for now. */
3262 mouse_button_timer =
3263 SetTimer (hwnd, MOUSE_BUTTON_ID,
3264 w32_mouse_button_tolerance, NULL);
3265 saved_mouse_button_msg.msg.hwnd = hwnd;
3266 saved_mouse_button_msg.msg.message = msg;
3267 saved_mouse_button_msg.msg.wParam = wParam;
3268 saved_mouse_button_msg.msg.lParam = lParam;
3269 saved_mouse_button_msg.msg.time = GetMessageTime ();
3270 saved_mouse_button_msg.dwModifiers = w32_get_modifiers ();
3273 return 0;
3275 case WM_LBUTTONUP:
3276 case WM_RBUTTONUP:
3277 if (w32_num_mouse_buttons > 2)
3278 goto handle_plain_button;
3281 int this = (msg == WM_LBUTTONUP) ? LMOUSE : RMOUSE;
3282 int other = (msg == WM_LBUTTONUP) ? RMOUSE : LMOUSE;
3284 if ((button_state & this) == 0)
3285 return 0;
3287 button_state &= ~this;
3289 if (button_state & MMOUSE)
3291 /* Only generate event when second button is released. */
3292 if ((button_state & other) == 0)
3294 msg = WM_MBUTTONUP;
3295 button_state &= ~MMOUSE;
3297 if (button_state) emacs_abort ();
3299 else
3300 return 0;
3302 else
3304 /* Flush out saved message if necessary. */
3305 if (saved_mouse_button_msg.msg.hwnd)
3307 post_msg (&saved_mouse_button_msg);
3310 wmsg.dwModifiers = w32_get_modifiers ();
3311 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3312 signal_user_input ();
3314 /* Always clear message buffer and cancel timer. */
3315 saved_mouse_button_msg.msg.hwnd = 0;
3316 KillTimer (hwnd, mouse_button_timer);
3317 mouse_button_timer = 0;
3319 if (button_state == 0)
3320 ReleaseCapture ();
3322 return 0;
3324 case WM_XBUTTONDOWN:
3325 case WM_XBUTTONUP:
3326 if (w32_pass_extra_mouse_buttons_to_system)
3327 goto dflt;
3328 /* else fall through and process them. */
3329 case WM_MBUTTONDOWN:
3330 case WM_MBUTTONUP:
3331 handle_plain_button:
3333 BOOL up;
3334 int button;
3336 /* Ignore middle and extra buttons as long as the menu is active. */
3337 f = x_window_to_frame (dpyinfo, hwnd);
3338 if (f && f->output_data.w32->menubar_active)
3339 return 0;
3341 if (parse_button (msg, HIWORD (wParam), &button, &up))
3343 if (up) ReleaseCapture ();
3344 else SetCapture (hwnd);
3345 button = (button == 0) ? LMOUSE :
3346 ((button == 1) ? MMOUSE : RMOUSE);
3347 if (up)
3348 button_state &= ~button;
3349 else
3350 button_state |= button;
3354 wmsg.dwModifiers = w32_get_modifiers ();
3355 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3356 signal_user_input ();
3358 /* Need to return true for XBUTTON messages, false for others,
3359 to indicate that we processed the message. */
3360 return (msg == WM_XBUTTONDOWN || msg == WM_XBUTTONUP);
3362 case WM_MOUSEMOVE:
3363 /* Ignore mouse movements as long as the menu is active. These
3364 movements are processed by the window manager anyway, and
3365 it's wrong to handle them as if they happened on the
3366 underlying frame. */
3367 f = x_window_to_frame (dpyinfo, hwnd);
3368 if (f && f->output_data.w32->menubar_active)
3369 return 0;
3371 /* If the mouse has just moved into the frame, start tracking
3372 it, so we will be notified when it leaves the frame. Mouse
3373 tracking only works under W98 and NT4 and later. On earlier
3374 versions, there is no way of telling when the mouse leaves the
3375 frame, so we just have to put up with help-echo and mouse
3376 highlighting remaining while the frame is not active. */
3377 if (track_mouse_event_fn && !track_mouse_window
3378 /* If the menu bar is active, turning on tracking of mouse
3379 movement events might send these events to the tooltip
3380 frame, if the user happens to move the mouse pointer over
3381 the tooltip. But since we don't process events for
3382 tooltip frames, this causes Windows to present a
3383 hourglass cursor, which is ugly and unexpected. So don't
3384 enable tracking mouse events in this case; they will be
3385 restarted when the menu pops down. (Confusingly, the
3386 menubar_active member of f->output_data.w32, tested
3387 above, is only set when a menu was popped up _not_ from
3388 the frame's menu bar, but via x-popup-menu.) */
3389 && !menubar_in_use)
3391 TRACKMOUSEEVENT tme;
3392 tme.cbSize = sizeof (tme);
3393 tme.dwFlags = TME_LEAVE;
3394 tme.hwndTrack = hwnd;
3396 track_mouse_event_fn (&tme);
3397 track_mouse_window = hwnd;
3399 case WM_VSCROLL:
3400 if (w32_mouse_move_interval <= 0
3401 || (msg == WM_MOUSEMOVE && button_state == 0))
3403 wmsg.dwModifiers = w32_get_modifiers ();
3404 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3405 return 0;
3408 /* Hang onto mouse move and scroll messages for a bit, to avoid
3409 sending such events to Emacs faster than it can process them.
3410 If we get more events before the timer from the first message
3411 expires, we just replace the first message. */
3413 if (saved_mouse_move_msg.msg.hwnd == 0)
3414 mouse_move_timer =
3415 SetTimer (hwnd, MOUSE_MOVE_ID,
3416 w32_mouse_move_interval, NULL);
3418 /* Hold onto message for now. */
3419 saved_mouse_move_msg.msg.hwnd = hwnd;
3420 saved_mouse_move_msg.msg.message = msg;
3421 saved_mouse_move_msg.msg.wParam = wParam;
3422 saved_mouse_move_msg.msg.lParam = lParam;
3423 saved_mouse_move_msg.msg.time = GetMessageTime ();
3424 saved_mouse_move_msg.dwModifiers = w32_get_modifiers ();
3426 return 0;
3428 case WM_MOUSEWHEEL:
3429 case WM_DROPFILES:
3430 wmsg.dwModifiers = w32_get_modifiers ();
3431 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3432 signal_user_input ();
3433 return 0;
3435 case WM_APPCOMMAND:
3436 if (w32_pass_multimedia_buttons_to_system)
3437 goto dflt;
3438 /* Otherwise, pass to lisp, the same way we do with mousehwheel. */
3439 case WM_MOUSEHWHEEL:
3440 wmsg.dwModifiers = w32_get_modifiers ();
3441 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3442 signal_user_input ();
3443 /* Non-zero must be returned when WM_MOUSEHWHEEL messages are
3444 handled, to prevent the system trying to handle it by faking
3445 scroll bar events. */
3446 return 1;
3448 case WM_TIMER:
3449 /* Flush out saved messages if necessary. */
3450 if (wParam == mouse_button_timer)
3452 if (saved_mouse_button_msg.msg.hwnd)
3454 post_msg (&saved_mouse_button_msg);
3455 signal_user_input ();
3456 saved_mouse_button_msg.msg.hwnd = 0;
3458 KillTimer (hwnd, mouse_button_timer);
3459 mouse_button_timer = 0;
3461 else if (wParam == mouse_move_timer)
3463 if (saved_mouse_move_msg.msg.hwnd)
3465 post_msg (&saved_mouse_move_msg);
3466 saved_mouse_move_msg.msg.hwnd = 0;
3468 KillTimer (hwnd, mouse_move_timer);
3469 mouse_move_timer = 0;
3471 else if (wParam == menu_free_timer)
3473 KillTimer (hwnd, menu_free_timer);
3474 menu_free_timer = 0;
3475 f = x_window_to_frame (dpyinfo, hwnd);
3476 /* If a popup menu is active, don't wipe its strings. */
3477 if (menubar_in_use
3478 && current_popup_menu == NULL)
3480 /* Free memory used by owner-drawn and help-echo strings. */
3481 w32_free_menu_strings (hwnd);
3482 if (f)
3483 f->output_data.w32->menubar_active = 0;
3484 menubar_in_use = 0;
3487 return 0;
3489 case WM_NCACTIVATE:
3490 /* Windows doesn't send us focus messages when putting up and
3491 taking down a system popup dialog as for Ctrl-Alt-Del on Windows 95.
3492 The only indication we get that something happened is receiving
3493 this message afterwards. So this is a good time to reset our
3494 keyboard modifiers' state. */
3495 reset_modifiers ();
3496 goto dflt;
3498 case WM_INITMENU:
3499 button_state = 0;
3500 ReleaseCapture ();
3501 /* We must ensure menu bar is fully constructed and up to date
3502 before allowing user interaction with it. To achieve this
3503 we send this message to the lisp thread and wait for a
3504 reply (whose value is not actually needed) to indicate that
3505 the menu bar is now ready for use, so we can now return.
3507 To remain responsive in the meantime, we enter a nested message
3508 loop that can process all other messages.
3510 However, we skip all this if the message results from calling
3511 TrackPopupMenu - in fact, we must NOT attempt to send the lisp
3512 thread a message because it is blocked on us at this point. We
3513 set menubar_active before calling TrackPopupMenu to indicate
3514 this (there is no possibility of confusion with real menubar
3515 being active). */
3517 f = x_window_to_frame (dpyinfo, hwnd);
3518 if (f
3519 && (f->output_data.w32->menubar_active
3520 /* We can receive this message even in the absence of a
3521 menubar (ie. when the system menu is activated) - in this
3522 case we do NOT want to forward the message, otherwise it
3523 will cause the menubar to suddenly appear when the user
3524 had requested it to be turned off! */
3525 || f->output_data.w32->menubar_widget == NULL))
3526 return 0;
3529 deferred_msg msg_buf;
3531 /* Detect if message has already been deferred; in this case
3532 we cannot return any sensible value to ignore this. */
3533 if (find_deferred_msg (hwnd, msg) != NULL)
3534 emacs_abort ();
3536 menubar_in_use = 1;
3538 return send_deferred_msg (&msg_buf, hwnd, msg, wParam, lParam);
3541 case WM_EXITMENULOOP:
3542 f = x_window_to_frame (dpyinfo, hwnd);
3544 /* If a menu is still active, check again after a short delay,
3545 since Windows often (always?) sends the WM_EXITMENULOOP
3546 before the corresponding WM_COMMAND message.
3547 Don't do this if a popup menu is active, since it is only
3548 menubar menus that require cleaning up in this way.
3550 if (f && menubar_in_use && current_popup_menu == NULL)
3551 menu_free_timer = SetTimer (hwnd, MENU_FREE_ID, MENU_FREE_DELAY, NULL);
3553 /* If hourglass cursor should be displayed, display it now. */
3554 if (f && f->output_data.w32->hourglass_p)
3555 SetCursor (f->output_data.w32->hourglass_cursor);
3557 goto dflt;
3559 case WM_MENUSELECT:
3560 /* Direct handling of help_echo in menus. Should be safe now
3561 that we generate the help_echo by placing a help event in the
3562 keyboard buffer. */
3564 HMENU menu = (HMENU) lParam;
3565 UINT menu_item = (UINT) LOWORD (wParam);
3566 UINT flags = (UINT) HIWORD (wParam);
3568 w32_menu_display_help (hwnd, menu, menu_item, flags);
3570 return 0;
3572 case WM_MEASUREITEM:
3573 f = x_window_to_frame (dpyinfo, hwnd);
3574 if (f)
3576 MEASUREITEMSTRUCT * pMis = (MEASUREITEMSTRUCT *) lParam;
3578 if (pMis->CtlType == ODT_MENU)
3580 /* Work out dimensions for popup menu titles. */
3581 char * title = (char *) pMis->itemData;
3582 HDC hdc = GetDC (hwnd);
3583 HFONT menu_font = GetCurrentObject (hdc, OBJ_FONT);
3584 LOGFONT menu_logfont;
3585 HFONT old_font;
3586 SIZE size;
3588 GetObject (menu_font, sizeof (menu_logfont), &menu_logfont);
3589 menu_logfont.lfWeight = FW_BOLD;
3590 menu_font = CreateFontIndirect (&menu_logfont);
3591 old_font = SelectObject (hdc, menu_font);
3593 pMis->itemHeight = GetSystemMetrics (SM_CYMENUSIZE);
3594 if (title)
3596 if (unicode_append_menu)
3597 GetTextExtentPoint32W (hdc, (WCHAR *) title,
3598 wcslen ((WCHAR *) title),
3599 &size);
3600 else
3601 GetTextExtentPoint32 (hdc, title, strlen (title), &size);
3603 pMis->itemWidth = size.cx;
3604 if (pMis->itemHeight < size.cy)
3605 pMis->itemHeight = size.cy;
3607 else
3608 pMis->itemWidth = 0;
3610 SelectObject (hdc, old_font);
3611 DeleteObject (menu_font);
3612 ReleaseDC (hwnd, hdc);
3613 return TRUE;
3616 return 0;
3618 case WM_DRAWITEM:
3619 f = x_window_to_frame (dpyinfo, hwnd);
3620 if (f)
3622 DRAWITEMSTRUCT * pDis = (DRAWITEMSTRUCT *) lParam;
3624 if (pDis->CtlType == ODT_MENU)
3626 /* Draw popup menu title. */
3627 char * title = (char *) pDis->itemData;
3628 if (title)
3630 HDC hdc = pDis->hDC;
3631 HFONT menu_font = GetCurrentObject (hdc, OBJ_FONT);
3632 LOGFONT menu_logfont;
3633 HFONT old_font;
3635 GetObject (menu_font, sizeof (menu_logfont), &menu_logfont);
3636 menu_logfont.lfWeight = FW_BOLD;
3637 menu_font = CreateFontIndirect (&menu_logfont);
3638 old_font = SelectObject (hdc, menu_font);
3640 /* Always draw title as if not selected. */
3641 if (unicode_append_menu)
3642 ExtTextOutW (hdc,
3643 pDis->rcItem.left
3644 + GetSystemMetrics (SM_CXMENUCHECK),
3645 pDis->rcItem.top,
3646 ETO_OPAQUE, &pDis->rcItem,
3647 (WCHAR *) title,
3648 wcslen ((WCHAR *) title), NULL);
3649 else
3650 ExtTextOut (hdc,
3651 pDis->rcItem.left
3652 + GetSystemMetrics (SM_CXMENUCHECK),
3653 pDis->rcItem.top,
3654 ETO_OPAQUE, &pDis->rcItem,
3655 title, strlen (title), NULL);
3657 SelectObject (hdc, old_font);
3658 DeleteObject (menu_font);
3660 return TRUE;
3663 return 0;
3665 #if 0
3666 /* Still not right - can't distinguish between clicks in the
3667 client area of the frame from clicks forwarded from the scroll
3668 bars - may have to hook WM_NCHITTEST to remember the mouse
3669 position and then check if it is in the client area ourselves. */
3670 case WM_MOUSEACTIVATE:
3671 /* Discard the mouse click that activates a frame, allowing the
3672 user to click anywhere without changing point (or worse!).
3673 Don't eat mouse clicks on scrollbars though!! */
3674 if (LOWORD (lParam) == HTCLIENT )
3675 return MA_ACTIVATEANDEAT;
3676 goto dflt;
3677 #endif
3679 case WM_MOUSELEAVE:
3680 /* No longer tracking mouse. */
3681 track_mouse_window = NULL;
3683 case WM_ACTIVATEAPP:
3684 case WM_ACTIVATE:
3685 case WM_WINDOWPOSCHANGED:
3686 case WM_SHOWWINDOW:
3687 /* Inform lisp thread that a frame might have just been obscured
3688 or exposed, so should recheck visibility of all frames. */
3689 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3690 goto dflt;
3692 case WM_SETFOCUS:
3693 dpyinfo->faked_key = 0;
3694 reset_modifiers ();
3695 register_hot_keys (hwnd);
3696 goto command;
3697 case WM_KILLFOCUS:
3698 unregister_hot_keys (hwnd);
3699 button_state = 0;
3700 ReleaseCapture ();
3701 /* Relinquish the system caret. */
3702 if (w32_system_caret_hwnd)
3704 w32_visible_system_caret_hwnd = NULL;
3705 w32_system_caret_hwnd = NULL;
3706 DestroyCaret ();
3708 goto command;
3709 case WM_COMMAND:
3710 menubar_in_use = 0;
3711 f = x_window_to_frame (dpyinfo, hwnd);
3712 if (f && HIWORD (wParam) == 0)
3714 if (menu_free_timer)
3716 KillTimer (hwnd, menu_free_timer);
3717 menu_free_timer = 0;
3720 case WM_MOVE:
3721 case WM_SIZE:
3722 command:
3723 wmsg.dwModifiers = w32_get_modifiers ();
3724 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3725 goto dflt;
3727 case WM_DESTROY:
3728 CoUninitialize ();
3729 return 0;
3731 case WM_CLOSE:
3732 wmsg.dwModifiers = w32_get_modifiers ();
3733 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3734 return 0;
3736 case WM_WINDOWPOSCHANGING:
3737 /* Don't restrict the sizing of tip frames. */
3738 if (hwnd == tip_window)
3739 return 0;
3741 /* Don't restrict the sizing of fullscreened frames, allowing them to be
3742 flush with the sides of the screen. */
3743 f = x_window_to_frame (dpyinfo, hwnd);
3744 if (f && FRAME_PREV_FSMODE (f) != FULLSCREEN_NONE)
3745 return 0;
3748 WINDOWPLACEMENT wp;
3749 LPWINDOWPOS lppos = (WINDOWPOS *) lParam;
3751 wp.length = sizeof (WINDOWPLACEMENT);
3752 GetWindowPlacement (hwnd, &wp);
3754 if (wp.showCmd != SW_SHOWMINIMIZED && (lppos->flags & SWP_NOSIZE) == 0)
3756 RECT rect;
3757 int wdiff;
3758 int hdiff;
3759 DWORD font_width;
3760 DWORD line_height;
3761 DWORD internal_border;
3762 DWORD scrollbar_extra;
3763 RECT wr;
3765 wp.length = sizeof (wp);
3766 GetWindowRect (hwnd, &wr);
3768 enter_crit ();
3770 font_width = GetWindowLong (hwnd, WND_FONTWIDTH_INDEX);
3771 line_height = GetWindowLong (hwnd, WND_LINEHEIGHT_INDEX);
3772 internal_border = GetWindowLong (hwnd, WND_BORDER_INDEX);
3773 scrollbar_extra = GetWindowLong (hwnd, WND_SCROLLBAR_INDEX);
3775 leave_crit ();
3777 memset (&rect, 0, sizeof (rect));
3778 AdjustWindowRect (&rect, GetWindowLong (hwnd, GWL_STYLE),
3779 GetMenu (hwnd) != NULL);
3781 /* Force width and height of client area to be exact
3782 multiples of the character cell dimensions. */
3783 wdiff = (lppos->cx - (rect.right - rect.left)
3784 - 2 * internal_border - scrollbar_extra)
3785 % font_width;
3786 hdiff = (lppos->cy - (rect.bottom - rect.top)
3787 - 2 * internal_border)
3788 % line_height;
3790 if (wdiff || hdiff)
3792 /* For right/bottom sizing we can just fix the sizes.
3793 However for top/left sizing we will need to fix the X
3794 and Y positions as well. */
3796 int cx_mintrack = GetSystemMetrics (SM_CXMINTRACK);
3797 int cy_mintrack = GetSystemMetrics (SM_CYMINTRACK);
3799 lppos->cx = max (lppos->cx - wdiff, cx_mintrack);
3800 lppos->cy = max (lppos->cy - hdiff, cy_mintrack);
3802 if (wp.showCmd != SW_SHOWMAXIMIZED
3803 && (lppos->flags & SWP_NOMOVE) == 0)
3805 if (lppos->x != wr.left || lppos->y != wr.top)
3807 lppos->x += wdiff;
3808 lppos->y += hdiff;
3810 else
3812 lppos->flags |= SWP_NOMOVE;
3816 return 0;
3821 goto dflt;
3823 case WM_GETMINMAXINFO:
3824 /* Hack to allow resizing the Emacs frame above the screen size.
3825 Note that Windows 9x limits coordinates to 16-bits. */
3826 ((LPMINMAXINFO) lParam)->ptMaxTrackSize.x = 32767;
3827 ((LPMINMAXINFO) lParam)->ptMaxTrackSize.y = 32767;
3828 return 0;
3830 case WM_SETCURSOR:
3831 if (LOWORD (lParam) == HTCLIENT)
3833 f = x_window_to_frame (dpyinfo, hwnd);
3834 if (f && f->output_data.w32->hourglass_p
3835 && !menubar_in_use && !current_popup_menu)
3836 SetCursor (f->output_data.w32->hourglass_cursor);
3837 else if (f)
3838 SetCursor (f->output_data.w32->current_cursor);
3839 return 0;
3841 goto dflt;
3843 case WM_EMACS_SETCURSOR:
3845 Cursor cursor = (Cursor) wParam;
3846 f = x_window_to_frame (dpyinfo, hwnd);
3847 if (f && cursor)
3849 f->output_data.w32->current_cursor = cursor;
3850 if (!f->output_data.w32->hourglass_p)
3851 SetCursor (cursor);
3853 return 0;
3856 case WM_EMACS_CREATESCROLLBAR:
3857 return (LRESULT) w32_createscrollbar ((struct frame *) wParam,
3858 (struct scroll_bar *) lParam);
3860 case WM_EMACS_SHOWWINDOW:
3861 return ShowWindow ((HWND) wParam, (WPARAM) lParam);
3863 case WM_EMACS_BRINGTOTOP:
3864 case WM_EMACS_SETFOREGROUND:
3866 HWND foreground_window;
3867 DWORD foreground_thread, retval;
3869 /* On NT 5.0, and apparently Windows 98, it is necessary to
3870 attach to the thread that currently has focus in order to
3871 pull the focus away from it. */
3872 foreground_window = GetForegroundWindow ();
3873 foreground_thread = GetWindowThreadProcessId (foreground_window, NULL);
3874 if (!foreground_window
3875 || foreground_thread == GetCurrentThreadId ()
3876 || !AttachThreadInput (GetCurrentThreadId (),
3877 foreground_thread, TRUE))
3878 foreground_thread = 0;
3880 retval = SetForegroundWindow ((HWND) wParam);
3881 if (msg == WM_EMACS_BRINGTOTOP)
3882 retval = BringWindowToTop ((HWND) wParam);
3884 /* Detach from the previous foreground thread. */
3885 if (foreground_thread)
3886 AttachThreadInput (GetCurrentThreadId (),
3887 foreground_thread, FALSE);
3889 return retval;
3892 case WM_EMACS_SETWINDOWPOS:
3894 WINDOWPOS * pos = (WINDOWPOS *) wParam;
3895 return SetWindowPos (hwnd, pos->hwndInsertAfter,
3896 pos->x, pos->y, pos->cx, pos->cy, pos->flags);
3899 case WM_EMACS_DESTROYWINDOW:
3900 DragAcceptFiles ((HWND) wParam, FALSE);
3901 return DestroyWindow ((HWND) wParam);
3903 case WM_EMACS_HIDE_CARET:
3904 return HideCaret (hwnd);
3906 case WM_EMACS_SHOW_CARET:
3907 return ShowCaret (hwnd);
3909 case WM_EMACS_DESTROY_CARET:
3910 w32_system_caret_hwnd = NULL;
3911 w32_visible_system_caret_hwnd = NULL;
3912 return DestroyCaret ();
3914 case WM_EMACS_TRACK_CARET:
3915 /* If there is currently no system caret, create one. */
3916 if (w32_system_caret_hwnd == NULL)
3918 /* Use the default caret width, and avoid changing it
3919 unnecessarily, as it confuses screen reader software. */
3920 w32_system_caret_hwnd = hwnd;
3921 CreateCaret (hwnd, NULL, 0,
3922 w32_system_caret_height);
3925 if (!SetCaretPos (w32_system_caret_x, w32_system_caret_y))
3926 return 0;
3927 /* Ensure visible caret gets turned on when requested. */
3928 else if (w32_use_visible_system_caret
3929 && w32_visible_system_caret_hwnd != hwnd)
3931 w32_visible_system_caret_hwnd = hwnd;
3932 return ShowCaret (hwnd);
3934 /* Ensure visible caret gets turned off when requested. */
3935 else if (!w32_use_visible_system_caret
3936 && w32_visible_system_caret_hwnd)
3938 w32_visible_system_caret_hwnd = NULL;
3939 return HideCaret (hwnd);
3941 else
3942 return 1;
3944 case WM_EMACS_TRACKPOPUPMENU:
3946 UINT flags;
3947 POINT *pos;
3948 int retval;
3949 pos = (POINT *)lParam;
3950 flags = TPM_CENTERALIGN;
3951 if (button_state & LMOUSE)
3952 flags |= TPM_LEFTBUTTON;
3953 else if (button_state & RMOUSE)
3954 flags |= TPM_RIGHTBUTTON;
3956 /* Remember we did a SetCapture on the initial mouse down event,
3957 so for safety, we make sure the capture is canceled now. */
3958 ReleaseCapture ();
3959 button_state = 0;
3961 /* Use menubar_active to indicate that WM_INITMENU is from
3962 TrackPopupMenu below, and should be ignored. */
3963 f = x_window_to_frame (dpyinfo, hwnd);
3964 if (f)
3965 f->output_data.w32->menubar_active = 1;
3967 if (TrackPopupMenu ((HMENU)wParam, flags, pos->x, pos->y,
3968 0, hwnd, NULL))
3970 MSG amsg;
3971 /* Eat any mouse messages during popupmenu */
3972 while (PeekMessage (&amsg, hwnd, WM_MOUSEFIRST, WM_MOUSELAST,
3973 PM_REMOVE));
3974 /* Get the menu selection, if any */
3975 if (PeekMessage (&amsg, hwnd, WM_COMMAND, WM_COMMAND, PM_REMOVE))
3977 retval = LOWORD (amsg.wParam);
3979 else
3981 retval = 0;
3984 else
3986 retval = -1;
3989 return retval;
3991 case WM_EMACS_FILENOTIFY:
3992 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3993 return 1;
3995 default:
3996 /* Check for messages registered at runtime. */
3997 if (msg == msh_mousewheel)
3999 wmsg.dwModifiers = w32_get_modifiers ();
4000 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4001 signal_user_input ();
4002 return 0;
4005 dflt:
4006 return (w32_unicode_gui ? DefWindowProcW : DefWindowProcA) (hwnd, msg, wParam, lParam);
4009 /* The most common default return code for handled messages is 0. */
4010 return 0;
4013 static void
4014 my_create_window (struct frame * f)
4016 MSG msg;
4018 if (!PostThreadMessage (dwWindowsThreadId, WM_EMACS_CREATEWINDOW, (WPARAM)f, 0))
4019 emacs_abort ();
4020 GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE);
4024 /* Create a tooltip window. Unlike my_create_window, we do not do this
4025 indirectly via the Window thread, as we do not need to process Window
4026 messages for the tooltip. Creating tooltips indirectly also creates
4027 deadlocks when tooltips are created for menu items. */
4028 static void
4029 my_create_tip_window (struct frame *f)
4031 RECT rect;
4033 rect.left = rect.top = 0;
4034 rect.right = FRAME_PIXEL_WIDTH (f);
4035 rect.bottom = FRAME_PIXEL_HEIGHT (f);
4037 AdjustWindowRect (&rect, f->output_data.w32->dwStyle,
4038 FRAME_EXTERNAL_MENU_BAR (f));
4040 tip_window = FRAME_W32_WINDOW (f)
4041 = CreateWindow (EMACS_CLASS,
4042 f->namebuf,
4043 f->output_data.w32->dwStyle,
4044 f->left_pos,
4045 f->top_pos,
4046 rect.right - rect.left,
4047 rect.bottom - rect.top,
4048 FRAME_W32_WINDOW (SELECTED_FRAME ()), /* owner */
4049 NULL,
4050 hinst,
4051 NULL);
4053 if (tip_window)
4055 SetWindowLong (tip_window, WND_FONTWIDTH_INDEX, FRAME_COLUMN_WIDTH (f));
4056 SetWindowLong (tip_window, WND_LINEHEIGHT_INDEX, FRAME_LINE_HEIGHT (f));
4057 SetWindowLong (tip_window, WND_BORDER_INDEX, FRAME_INTERNAL_BORDER_WIDTH (f));
4058 SetWindowLong (tip_window, WND_BACKGROUND_INDEX, FRAME_BACKGROUND_PIXEL (f));
4060 /* Tip frames have no scrollbars. */
4061 SetWindowLong (tip_window, WND_SCROLLBAR_INDEX, 0);
4063 /* Do this to discard the default setting specified by our parent. */
4064 ShowWindow (tip_window, SW_HIDE);
4069 /* Create and set up the w32 window for frame F. */
4071 static void
4072 w32_window (struct frame *f, long window_prompting, int minibuffer_only)
4074 block_input ();
4076 /* Use the resource name as the top-level window name
4077 for looking up resources. Make a non-Lisp copy
4078 for the window manager, so GC relocation won't bother it.
4080 Elsewhere we specify the window name for the window manager. */
4083 char *str = SSDATA (Vx_resource_name);
4084 f->namebuf = xmalloc (strlen (str) + 1);
4085 strcpy (f->namebuf, str);
4088 my_create_window (f);
4090 validate_x_resource_name ();
4092 /* x_set_name normally ignores requests to set the name if the
4093 requested name is the same as the current name. This is the one
4094 place where that assumption isn't correct; f->name is set, but
4095 the server hasn't been told. */
4097 Lisp_Object name;
4098 int explicit = f->explicit_name;
4100 f->explicit_name = 0;
4101 name = f->name;
4102 fset_name (f, Qnil);
4103 x_set_name (f, name, explicit);
4106 unblock_input ();
4108 if (!minibuffer_only && FRAME_EXTERNAL_MENU_BAR (f))
4109 initialize_frame_menubar (f);
4111 if (FRAME_W32_WINDOW (f) == 0)
4112 error ("Unable to create window");
4115 /* Handle the icon stuff for this window. Perhaps later we might
4116 want an x_set_icon_position which can be called interactively as
4117 well. */
4119 static void
4120 x_icon (struct frame *f, Lisp_Object parms)
4122 Lisp_Object icon_x, icon_y;
4123 struct w32_display_info *dpyinfo = &one_w32_display_info;
4125 /* Set the position of the icon. Note that Windows 95 groups all
4126 icons in the tray. */
4127 icon_x = x_get_arg (dpyinfo, parms, Qicon_left, 0, 0, RES_TYPE_NUMBER);
4128 icon_y = x_get_arg (dpyinfo, parms, Qicon_top, 0, 0, RES_TYPE_NUMBER);
4129 if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
4131 CHECK_NUMBER (icon_x);
4132 CHECK_NUMBER (icon_y);
4134 else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
4135 error ("Both left and top icon corners of icon must be specified");
4137 block_input ();
4139 if (! EQ (icon_x, Qunbound))
4140 x_wm_set_icon_position (f, XINT (icon_x), XINT (icon_y));
4142 #if 0 /* TODO */
4143 /* Start up iconic or window? */
4144 x_wm_set_window_state
4145 (f, (EQ (x_get_arg (dpyinfo, parms, Qvisibility, 0, 0, RES_TYPE_SYMBOL), Qicon)
4146 ? IconicState
4147 : NormalState));
4149 x_text_icon (f, SSDATA ((!NILP (f->icon_name)
4150 ? f->icon_name
4151 : f->name)));
4152 #endif
4154 unblock_input ();
4158 static void
4159 x_make_gc (struct frame *f)
4161 XGCValues gc_values;
4163 block_input ();
4165 /* Create the GC's of this frame.
4166 Note that many default values are used. */
4168 /* Normal video */
4169 gc_values.font = FRAME_FONT (f);
4171 /* Cursor has cursor-color background, background-color foreground. */
4172 gc_values.foreground = FRAME_BACKGROUND_PIXEL (f);
4173 gc_values.background = f->output_data.w32->cursor_pixel;
4174 f->output_data.w32->cursor_gc
4175 = XCreateGC (NULL, FRAME_W32_WINDOW (f),
4176 (GCFont | GCForeground | GCBackground),
4177 &gc_values);
4179 /* Reliefs. */
4180 f->output_data.w32->white_relief.gc = 0;
4181 f->output_data.w32->black_relief.gc = 0;
4183 unblock_input ();
4187 /* Handler for signals raised during x_create_frame and
4188 x_create_tip_frame. FRAME is the frame which is partially
4189 constructed. */
4191 static Lisp_Object
4192 unwind_create_frame (Lisp_Object frame)
4194 struct frame *f = XFRAME (frame);
4196 /* If frame is ``official'', nothing to do. */
4197 if (NILP (Fmemq (frame, Vframe_list)))
4199 #ifdef GLYPH_DEBUG
4200 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
4201 #endif
4203 x_free_frame_resources (f);
4204 free_glyphs (f);
4206 #ifdef GLYPH_DEBUG
4207 /* Check that reference counts are indeed correct. */
4208 eassert (dpyinfo->reference_count == dpyinfo_refcount);
4209 eassert (dpyinfo->terminal->image_cache->refcount == image_cache_refcount);
4210 #endif
4211 return Qt;
4214 return Qnil;
4217 static void
4218 x_default_font_parameter (struct frame *f, Lisp_Object parms)
4220 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
4221 Lisp_Object font_param = x_get_arg (dpyinfo, parms, Qfont, NULL, NULL,
4222 RES_TYPE_STRING);
4223 Lisp_Object font;
4224 if (EQ (font_param, Qunbound))
4225 font_param = Qnil;
4226 font = !NILP (font_param) ? font_param
4227 : x_get_arg (dpyinfo, parms, Qfont, "font", "Font", RES_TYPE_STRING);
4229 if (!STRINGP (font))
4231 int i;
4232 static char *names[]
4233 = { "Courier New-10",
4234 "-*-Courier-normal-r-*-*-13-*-*-*-c-*-iso8859-1",
4235 "-*-Fixedsys-normal-r-*-*-12-*-*-*-c-*-iso8859-1",
4236 "Fixedsys",
4237 NULL };
4239 for (i = 0; names[i]; i++)
4241 font = font_open_by_name (f, build_unibyte_string (names[i]));
4242 if (! NILP (font))
4243 break;
4245 if (NILP (font))
4246 error ("No suitable font was found");
4248 else if (!NILP (font_param))
4250 /* Remember the explicit font parameter, so we can re-apply it after
4251 we've applied the `default' face settings. */
4252 x_set_frame_parameters (f, Fcons (Fcons (Qfont_param, font_param), Qnil));
4254 x_default_parameter (f, parms, Qfont, font, "font", "Font", RES_TYPE_STRING);
4257 DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
4258 1, 1, 0,
4259 doc: /* Make a new window, which is called a \"frame\" in Emacs terms.
4260 Return an Emacs frame object.
4261 PARAMETERS is an alist of frame parameters.
4262 If the parameters specify that the frame should not have a minibuffer,
4263 and do not specify a specific minibuffer window to use,
4264 then `default-minibuffer-frame' must be a frame whose minibuffer can
4265 be shared by the new frame.
4267 This function is an internal primitive--use `make-frame' instead. */)
4268 (Lisp_Object parameters)
4270 struct frame *f;
4271 Lisp_Object frame, tem;
4272 Lisp_Object name;
4273 int minibuffer_only = 0;
4274 long window_prompting = 0;
4275 int width, height;
4276 ptrdiff_t count = SPECPDL_INDEX ();
4277 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
4278 Lisp_Object display;
4279 struct w32_display_info *dpyinfo = NULL;
4280 Lisp_Object parent;
4281 struct kboard *kb;
4283 /* Make copy of frame parameters because the original is in pure
4284 storage now. */
4285 parameters = Fcopy_alist (parameters);
4287 /* Use this general default value to start with
4288 until we know if this frame has a specified name. */
4289 Vx_resource_name = Vinvocation_name;
4291 display = x_get_arg (dpyinfo, parameters, Qterminal, 0, 0, RES_TYPE_NUMBER);
4292 if (EQ (display, Qunbound))
4293 display = x_get_arg (dpyinfo, parameters, Qdisplay, 0, 0, RES_TYPE_STRING);
4294 if (EQ (display, Qunbound))
4295 display = Qnil;
4296 dpyinfo = check_x_display_info (display);
4297 kb = dpyinfo->terminal->kboard;
4299 if (!dpyinfo->terminal->name)
4300 error ("Terminal is not live, can't create new frames on it");
4302 name = x_get_arg (dpyinfo, parameters, Qname, "name", "Name", RES_TYPE_STRING);
4303 if (!STRINGP (name)
4304 && ! EQ (name, Qunbound)
4305 && ! NILP (name))
4306 error ("Invalid frame name--not a string or nil");
4308 if (STRINGP (name))
4309 Vx_resource_name = name;
4311 /* See if parent window is specified. */
4312 parent = x_get_arg (dpyinfo, parameters, Qparent_id, NULL, NULL, RES_TYPE_NUMBER);
4313 if (EQ (parent, Qunbound))
4314 parent = Qnil;
4315 if (! NILP (parent))
4316 CHECK_NUMBER (parent);
4318 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
4319 /* No need to protect DISPLAY because that's not used after passing
4320 it to make_frame_without_minibuffer. */
4321 frame = Qnil;
4322 GCPRO4 (parameters, parent, name, frame);
4323 tem = x_get_arg (dpyinfo, parameters, Qminibuffer, "minibuffer", "Minibuffer",
4324 RES_TYPE_SYMBOL);
4325 if (EQ (tem, Qnone) || NILP (tem))
4326 f = make_frame_without_minibuffer (Qnil, kb, display);
4327 else if (EQ (tem, Qonly))
4329 f = make_minibuffer_frame ();
4330 minibuffer_only = 1;
4332 else if (WINDOWP (tem))
4333 f = make_frame_without_minibuffer (tem, kb, display);
4334 else
4335 f = make_frame (1);
4337 XSETFRAME (frame, f);
4339 /* By default, make scrollbars the system standard width. */
4340 FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = GetSystemMetrics (SM_CXVSCROLL);
4342 f->terminal = dpyinfo->terminal;
4344 f->output_method = output_w32;
4345 f->output_data.w32 = xzalloc (sizeof (struct w32_output));
4346 FRAME_FONTSET (f) = -1;
4348 fset_icon_name
4349 (f, x_get_arg (dpyinfo, parameters, Qicon_name, "iconName", "Title",
4350 RES_TYPE_STRING));
4351 if (! STRINGP (f->icon_name))
4352 fset_icon_name (f, Qnil);
4354 /* FRAME_W32_DISPLAY_INFO (f) = dpyinfo; */
4356 /* With FRAME_X_DISPLAY_INFO set up, this unwind-protect is safe. */
4357 record_unwind_protect (unwind_create_frame, frame);
4358 #ifdef GLYPH_DEBUG
4359 image_cache_refcount =
4360 FRAME_IMAGE_CACHE (f) ? FRAME_IMAGE_CACHE (f)->refcount : 0;
4361 dpyinfo_refcount = dpyinfo->reference_count;
4362 #endif /* GLYPH_DEBUG */
4364 /* Specify the parent under which to make this window. */
4366 if (!NILP (parent))
4368 f->output_data.w32->parent_desc = (Window) XFASTINT (parent);
4369 f->output_data.w32->explicit_parent = 1;
4371 else
4373 f->output_data.w32->parent_desc = FRAME_W32_DISPLAY_INFO (f)->root_window;
4374 f->output_data.w32->explicit_parent = 0;
4377 /* Set the name; the functions to which we pass f expect the name to
4378 be set. */
4379 if (EQ (name, Qunbound) || NILP (name))
4381 fset_name (f, build_string (dpyinfo->w32_id_name));
4382 f->explicit_name = 0;
4384 else
4386 fset_name (f, name);
4387 f->explicit_name = 1;
4388 /* use the frame's title when getting resources for this frame. */
4389 specbind (Qx_resource_name, name);
4392 if (uniscribe_available)
4393 register_font_driver (&uniscribe_font_driver, f);
4394 register_font_driver (&w32font_driver, f);
4396 x_default_parameter (f, parameters, Qfont_backend, Qnil,
4397 "fontBackend", "FontBackend", RES_TYPE_STRING);
4398 /* Extract the window parameters from the supplied values
4399 that are needed to determine window geometry. */
4400 x_default_font_parameter (f, parameters);
4401 x_default_parameter (f, parameters, Qborder_width, make_number (2),
4402 "borderWidth", "BorderWidth", RES_TYPE_NUMBER);
4404 /* We recognize either internalBorderWidth or internalBorder
4405 (which is what xterm calls it). */
4406 if (NILP (Fassq (Qinternal_border_width, parameters)))
4408 Lisp_Object value;
4410 value = x_get_arg (dpyinfo, parameters, Qinternal_border_width,
4411 "internalBorder", "InternalBorder", RES_TYPE_NUMBER);
4412 if (! EQ (value, Qunbound))
4413 parameters = Fcons (Fcons (Qinternal_border_width, value),
4414 parameters);
4416 /* Default internalBorderWidth to 0 on Windows to match other programs. */
4417 x_default_parameter (f, parameters, Qinternal_border_width, make_number (0),
4418 "internalBorderWidth", "InternalBorder", RES_TYPE_NUMBER);
4419 x_default_parameter (f, parameters, Qvertical_scroll_bars, Qright,
4420 "verticalScrollBars", "ScrollBars", RES_TYPE_SYMBOL);
4422 /* Also do the stuff which must be set before the window exists. */
4423 x_default_parameter (f, parameters, Qforeground_color, build_string ("black"),
4424 "foreground", "Foreground", RES_TYPE_STRING);
4425 x_default_parameter (f, parameters, Qbackground_color, build_string ("white"),
4426 "background", "Background", RES_TYPE_STRING);
4427 x_default_parameter (f, parameters, Qmouse_color, build_string ("black"),
4428 "pointerColor", "Foreground", RES_TYPE_STRING);
4429 x_default_parameter (f, parameters, Qborder_color, build_string ("black"),
4430 "borderColor", "BorderColor", RES_TYPE_STRING);
4431 x_default_parameter (f, parameters, Qscreen_gamma, Qnil,
4432 "screenGamma", "ScreenGamma", RES_TYPE_FLOAT);
4433 x_default_parameter (f, parameters, Qline_spacing, Qnil,
4434 "lineSpacing", "LineSpacing", RES_TYPE_NUMBER);
4435 x_default_parameter (f, parameters, Qleft_fringe, Qnil,
4436 "leftFringe", "LeftFringe", RES_TYPE_NUMBER);
4437 x_default_parameter (f, parameters, Qright_fringe, Qnil,
4438 "rightFringe", "RightFringe", RES_TYPE_NUMBER);
4440 /* Init faces before x_default_parameter is called for scroll-bar
4441 parameters because that function calls x_set_scroll_bar_width,
4442 which calls change_frame_size, which calls Fset_window_buffer,
4443 which runs hooks, which call Fvertical_motion. At the end, we
4444 end up in init_iterator with a null face cache, which should not
4445 happen. */
4446 init_frame_faces (f);
4448 /* The X resources controlling the menu-bar and tool-bar are
4449 processed specially at startup, and reflected in the mode
4450 variables; ignore them here. */
4451 x_default_parameter (f, parameters, Qmenu_bar_lines,
4452 NILP (Vmenu_bar_mode)
4453 ? make_number (0) : make_number (1),
4454 NULL, NULL, RES_TYPE_NUMBER);
4455 x_default_parameter (f, parameters, Qtool_bar_lines,
4456 NILP (Vtool_bar_mode)
4457 ? make_number (0) : make_number (1),
4458 NULL, NULL, RES_TYPE_NUMBER);
4460 x_default_parameter (f, parameters, Qbuffer_predicate, Qnil,
4461 "bufferPredicate", "BufferPredicate", RES_TYPE_SYMBOL);
4462 x_default_parameter (f, parameters, Qtitle, Qnil,
4463 "title", "Title", RES_TYPE_STRING);
4464 x_default_parameter (f, parameters, Qfullscreen, Qnil,
4465 "fullscreen", "Fullscreen", RES_TYPE_SYMBOL);
4467 f->output_data.w32->dwStyle = WS_OVERLAPPEDWINDOW;
4468 f->output_data.w32->parent_desc = FRAME_W32_DISPLAY_INFO (f)->root_window;
4470 f->output_data.w32->text_cursor = w32_load_cursor (IDC_IBEAM);
4471 f->output_data.w32->nontext_cursor = w32_load_cursor (IDC_ARROW);
4472 f->output_data.w32->modeline_cursor = w32_load_cursor (IDC_ARROW);
4473 f->output_data.w32->hand_cursor = w32_load_cursor (IDC_HAND);
4474 f->output_data.w32->hourglass_cursor = w32_load_cursor (IDC_WAIT);
4475 f->output_data.w32->horizontal_drag_cursor = w32_load_cursor (IDC_SIZEWE);
4477 f->output_data.w32->current_cursor = f->output_data.w32->nontext_cursor;
4479 window_prompting = x_figure_window_size (f, parameters, 1);
4481 tem = x_get_arg (dpyinfo, parameters, Qunsplittable, 0, 0, RES_TYPE_BOOLEAN);
4482 f->no_split = minibuffer_only || EQ (tem, Qt);
4484 w32_window (f, window_prompting, minibuffer_only);
4485 x_icon (f, parameters);
4487 x_make_gc (f);
4489 /* Now consider the frame official. */
4490 f->terminal->reference_count++;
4491 FRAME_W32_DISPLAY_INFO (f)->reference_count++;
4492 Vframe_list = Fcons (frame, Vframe_list);
4494 /* We need to do this after creating the window, so that the
4495 icon-creation functions can say whose icon they're describing. */
4496 x_default_parameter (f, parameters, Qicon_type, Qnil,
4497 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL);
4499 x_default_parameter (f, parameters, Qauto_raise, Qnil,
4500 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN);
4501 x_default_parameter (f, parameters, Qauto_lower, Qnil,
4502 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN);
4503 x_default_parameter (f, parameters, Qcursor_type, Qbox,
4504 "cursorType", "CursorType", RES_TYPE_SYMBOL);
4505 x_default_parameter (f, parameters, Qscroll_bar_width, Qnil,
4506 "scrollBarWidth", "ScrollBarWidth", RES_TYPE_NUMBER);
4507 x_default_parameter (f, parameters, Qalpha, Qnil,
4508 "alpha", "Alpha", RES_TYPE_NUMBER);
4510 /* Dimensions, especially FRAME_LINES (f), must be done via change_frame_size.
4511 Change will not be effected unless different from the current
4512 FRAME_LINES (f). */
4513 width = FRAME_COLS (f);
4514 height = FRAME_LINES (f);
4516 FRAME_LINES (f) = 0;
4517 SET_FRAME_COLS (f, 0);
4518 change_frame_size (f, height, width, 1, 0, 0);
4520 /* Tell the server what size and position, etc, we want, and how
4521 badly we want them. This should be done after we have the menu
4522 bar so that its size can be taken into account. */
4523 block_input ();
4524 x_wm_set_size_hint (f, window_prompting, 0);
4525 unblock_input ();
4527 /* Make the window appear on the frame and enable display, unless
4528 the caller says not to. However, with explicit parent, Emacs
4529 cannot control visibility, so don't try. */
4530 if (! f->output_data.w32->explicit_parent)
4532 Lisp_Object visibility;
4534 visibility = x_get_arg (dpyinfo, parameters, Qvisibility, 0, 0, RES_TYPE_SYMBOL);
4535 if (EQ (visibility, Qunbound))
4536 visibility = Qt;
4538 if (EQ (visibility, Qicon))
4539 x_iconify_frame (f);
4540 else if (! NILP (visibility))
4541 x_make_frame_visible (f);
4542 else
4543 /* Must have been Qnil. */
4547 /* Initialize `default-minibuffer-frame' in case this is the first
4548 frame on this terminal. */
4549 if (FRAME_HAS_MINIBUF_P (f)
4550 && (!FRAMEP (KVAR (kb, Vdefault_minibuffer_frame))
4551 || !FRAME_LIVE_P (XFRAME (KVAR (kb, Vdefault_minibuffer_frame)))))
4552 kset_default_minibuffer_frame (kb, frame);
4554 /* All remaining specified parameters, which have not been "used"
4555 by x_get_arg and friends, now go in the misc. alist of the frame. */
4556 for (tem = parameters; CONSP (tem); tem = XCDR (tem))
4557 if (CONSP (XCAR (tem)) && !NILP (XCAR (XCAR (tem))))
4558 fset_param_alist (f, Fcons (XCAR (tem), f->param_alist));
4560 UNGCPRO;
4562 /* Make sure windows on this frame appear in calls to next-window
4563 and similar functions. */
4564 Vwindow_list = Qnil;
4566 return unbind_to (count, frame);
4569 /* FRAME is used only to get a handle on the X display. We don't pass the
4570 display info directly because we're called from frame.c, which doesn't
4571 know about that structure. */
4572 Lisp_Object
4573 x_get_focus_frame (struct frame *frame)
4575 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (frame);
4576 Lisp_Object xfocus;
4577 if (! dpyinfo->w32_focus_frame)
4578 return Qnil;
4580 XSETFRAME (xfocus, dpyinfo->w32_focus_frame);
4581 return xfocus;
4584 DEFUN ("x-focus-frame", Fx_focus_frame, Sx_focus_frame, 1, 1, 0,
4585 doc: /* Give FRAME input focus, raising to foreground if necessary. */)
4586 (Lisp_Object frame)
4588 x_focus_on_frame (decode_window_system_frame (frame));
4589 return Qnil;
4593 DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1, 2, 0,
4594 doc: /* Internal function called by `color-defined-p', which see.
4595 \(Note that the Nextstep version of this function ignores FRAME.) */)
4596 (Lisp_Object color, Lisp_Object frame)
4598 XColor foo;
4599 FRAME_PTR f = decode_window_system_frame (frame);
4601 CHECK_STRING (color);
4603 if (w32_defined_color (f, SDATA (color), &foo, 0))
4604 return Qt;
4605 else
4606 return Qnil;
4609 DEFUN ("xw-color-values", Fxw_color_values, Sxw_color_values, 1, 2, 0,
4610 doc: /* Internal function called by `color-values', which see. */)
4611 (Lisp_Object color, Lisp_Object frame)
4613 XColor foo;
4614 FRAME_PTR f = decode_window_system_frame (frame);
4616 CHECK_STRING (color);
4618 if (w32_defined_color (f, SDATA (color), &foo, 0))
4619 return list3i ((GetRValue (foo.pixel) << 8) | GetRValue (foo.pixel),
4620 (GetGValue (foo.pixel) << 8) | GetGValue (foo.pixel),
4621 (GetBValue (foo.pixel) << 8) | GetBValue (foo.pixel));
4622 else
4623 return Qnil;
4626 DEFUN ("xw-display-color-p", Fxw_display_color_p, Sxw_display_color_p, 0, 1, 0,
4627 doc: /* Internal function called by `display-color-p', which see. */)
4628 (Lisp_Object display)
4630 struct w32_display_info *dpyinfo = check_x_display_info (display);
4632 if ((dpyinfo->n_planes * dpyinfo->n_cbits) <= 2)
4633 return Qnil;
4635 return Qt;
4638 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p,
4639 Sx_display_grayscale_p, 0, 1, 0,
4640 doc: /* Return t if DISPLAY supports shades of gray.
4641 Note that color displays do support shades of gray.
4642 The optional argument DISPLAY specifies which display to ask about.
4643 DISPLAY should be either a frame or a display name (a string).
4644 If omitted or nil, that stands for the selected frame's display. */)
4645 (Lisp_Object display)
4647 struct w32_display_info *dpyinfo = check_x_display_info (display);
4649 if ((dpyinfo->n_planes * dpyinfo->n_cbits) <= 1)
4650 return Qnil;
4652 return Qt;
4655 DEFUN ("x-display-pixel-width", Fx_display_pixel_width,
4656 Sx_display_pixel_width, 0, 1, 0,
4657 doc: /* Return the width in pixels of DISPLAY.
4658 The optional argument DISPLAY specifies which display to ask about.
4659 DISPLAY should be either a frame or a display name (a string).
4660 If omitted or nil, that stands for the selected frame's display. */)
4661 (Lisp_Object display)
4663 struct w32_display_info *dpyinfo = check_x_display_info (display);
4665 return make_number (x_display_pixel_width (dpyinfo));
4668 DEFUN ("x-display-pixel-height", Fx_display_pixel_height,
4669 Sx_display_pixel_height, 0, 1, 0,
4670 doc: /* Return the height in pixels of DISPLAY.
4671 The optional argument DISPLAY specifies which display to ask about.
4672 DISPLAY should be either a frame or a display name (a string).
4673 If omitted or nil, that stands for the selected frame's display. */)
4674 (Lisp_Object display)
4676 struct w32_display_info *dpyinfo = check_x_display_info (display);
4678 return make_number (x_display_pixel_height (dpyinfo));
4681 DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes,
4682 0, 1, 0,
4683 doc: /* Return the number of bitplanes of DISPLAY.
4684 The optional argument DISPLAY specifies which display to ask about.
4685 DISPLAY should be either a frame or a display name (a string).
4686 If omitted or nil, that stands for the selected frame's display. */)
4687 (Lisp_Object display)
4689 struct w32_display_info *dpyinfo = check_x_display_info (display);
4691 return make_number (dpyinfo->n_planes * dpyinfo->n_cbits);
4694 DEFUN ("x-display-color-cells", Fx_display_color_cells, Sx_display_color_cells,
4695 0, 1, 0,
4696 doc: /* Return the number of color cells of DISPLAY.
4697 The optional argument DISPLAY specifies which display to ask about.
4698 DISPLAY should be either a frame or a display name (a string).
4699 If omitted or nil, that stands for the selected frame's display. */)
4700 (Lisp_Object display)
4702 struct w32_display_info *dpyinfo = check_x_display_info (display);
4703 int cap;
4705 /* Don't use NCOLORS: it returns incorrect results under remote
4706 * desktop. We force 24+ bit depths to 24-bit, both to prevent an
4707 * overflow and because probably is more meaningful on Windows
4708 * anyway. */
4710 cap = 1 << min (dpyinfo->n_planes * dpyinfo->n_cbits, 24);
4711 return make_number (cap);
4714 DEFUN ("x-server-max-request-size", Fx_server_max_request_size,
4715 Sx_server_max_request_size,
4716 0, 1, 0,
4717 doc: /* Return the maximum request size of the server of DISPLAY.
4718 The optional argument DISPLAY specifies which display to ask about.
4719 DISPLAY should be either a frame or a display name (a string).
4720 If omitted or nil, that stands for the selected frame's display. */)
4721 (Lisp_Object display)
4723 return make_number (1);
4726 DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0,
4727 doc: /* Return the "vendor ID" string of the W32 system (Microsoft).
4728 The optional argument DISPLAY specifies which display to ask about.
4729 DISPLAY should be either a frame or a display name (a string).
4730 If omitted or nil, that stands for the selected frame's display. */)
4731 (Lisp_Object display)
4733 return build_string ("Microsoft Corp.");
4736 DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0,
4737 doc: /* Return the version numbers of the server of DISPLAY.
4738 The value is a list of three integers: the major and minor
4739 version numbers of the X Protocol in use, and the distributor-specific
4740 release number. See also the function `x-server-vendor'.
4742 The optional argument DISPLAY specifies which display to ask about.
4743 DISPLAY should be either a frame or a display name (a string).
4744 If omitted or nil, that stands for the selected frame's display. */)
4745 (Lisp_Object display)
4747 return list3i (w32_major_version, w32_minor_version, w32_build_number);
4750 DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0,
4751 doc: /* Return the number of screens on the server of DISPLAY.
4752 The optional argument DISPLAY specifies which display to ask about.
4753 DISPLAY should be either a frame or a display name (a string).
4754 If omitted or nil, that stands for the selected frame's display. */)
4755 (Lisp_Object display)
4757 return make_number (1);
4760 DEFUN ("x-display-mm-height", Fx_display_mm_height,
4761 Sx_display_mm_height, 0, 1, 0,
4762 doc: /* Return the height in millimeters of DISPLAY.
4763 The optional argument DISPLAY specifies which display to ask about.
4764 DISPLAY should be either a frame or a display name (a string).
4765 If omitted or nil, that stands for the selected frame's display. */)
4766 (Lisp_Object display)
4768 struct w32_display_info *dpyinfo = check_x_display_info (display);
4769 HDC hdc;
4770 int cap;
4772 hdc = GetDC (dpyinfo->root_window);
4774 cap = GetDeviceCaps (hdc, VERTSIZE);
4776 ReleaseDC (dpyinfo->root_window, hdc);
4778 return make_number (cap);
4781 DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0,
4782 doc: /* Return the width in millimeters of DISPLAY.
4783 The optional argument DISPLAY specifies which display to ask about.
4784 DISPLAY should be either a frame or a display name (a string).
4785 If omitted or nil, that stands for the selected frame's display. */)
4786 (Lisp_Object display)
4788 struct w32_display_info *dpyinfo = check_x_display_info (display);
4790 HDC hdc;
4791 int cap;
4793 hdc = GetDC (dpyinfo->root_window);
4795 cap = GetDeviceCaps (hdc, HORZSIZE);
4797 ReleaseDC (dpyinfo->root_window, hdc);
4799 return make_number (cap);
4802 DEFUN ("x-display-backing-store", Fx_display_backing_store,
4803 Sx_display_backing_store, 0, 1, 0,
4804 doc: /* Return an indication of whether DISPLAY does backing store.
4805 The value may be `always', `when-mapped', or `not-useful'.
4806 The optional argument DISPLAY specifies which display to ask about.
4807 DISPLAY should be either a frame or a display name (a string).
4808 If omitted or nil, that stands for the selected frame's display. */)
4809 (Lisp_Object display)
4811 return intern ("not-useful");
4814 DEFUN ("x-display-visual-class", Fx_display_visual_class,
4815 Sx_display_visual_class, 0, 1, 0,
4816 doc: /* Return the visual class of DISPLAY.
4817 The value is one of the symbols `static-gray', `gray-scale',
4818 `static-color', `pseudo-color', `true-color', or `direct-color'.
4820 The optional argument DISPLAY specifies which display to ask about.
4821 DISPLAY should be either a frame or a display name (a string).
4822 If omitted or nil, that stands for the selected frame's display. */)
4823 (Lisp_Object display)
4825 struct w32_display_info *dpyinfo = check_x_display_info (display);
4826 Lisp_Object result = Qnil;
4828 if (dpyinfo->has_palette)
4829 result = intern ("pseudo-color");
4830 else if (dpyinfo->n_planes * dpyinfo->n_cbits == 1)
4831 result = intern ("static-grey");
4832 else if (dpyinfo->n_planes * dpyinfo->n_cbits == 4)
4833 result = intern ("static-color");
4834 else if (dpyinfo->n_planes * dpyinfo->n_cbits > 8)
4835 result = intern ("true-color");
4837 return result;
4840 DEFUN ("x-display-save-under", Fx_display_save_under,
4841 Sx_display_save_under, 0, 1, 0,
4842 doc: /* Return t if DISPLAY supports the save-under feature.
4843 The optional argument DISPLAY specifies which display to ask about.
4844 DISPLAY should be either a frame or a display name (a string).
4845 If omitted or nil, that stands for the selected frame's display. */)
4846 (Lisp_Object display)
4848 return Qnil;
4851 DEFUN ("set-message-beep", Fset_message_beep, Sset_message_beep, 1, 1, 0,
4852 doc: /* Set the sound generated when the bell is rung.
4853 SOUND is 'asterisk, 'exclamation, 'hand, 'question, 'ok, or 'silent
4854 to use the corresponding system sound for the bell. The 'silent sound
4855 prevents Emacs from making any sound at all.
4856 SOUND is nil to use the normal beep. */)
4857 (Lisp_Object sound)
4859 CHECK_SYMBOL (sound);
4861 if (NILP (sound))
4862 sound_type = 0xFFFFFFFF;
4863 else if (EQ (sound, intern ("asterisk")))
4864 sound_type = MB_ICONASTERISK;
4865 else if (EQ (sound, intern ("exclamation")))
4866 sound_type = MB_ICONEXCLAMATION;
4867 else if (EQ (sound, intern ("hand")))
4868 sound_type = MB_ICONHAND;
4869 else if (EQ (sound, intern ("question")))
4870 sound_type = MB_ICONQUESTION;
4871 else if (EQ (sound, intern ("ok")))
4872 sound_type = MB_OK;
4873 else if (EQ (sound, intern ("silent")))
4874 sound_type = MB_EMACS_SILENT;
4875 else
4876 sound_type = 0xFFFFFFFF;
4878 return sound;
4883 x_pixel_width (register struct frame *f)
4885 return FRAME_PIXEL_WIDTH (f);
4889 x_pixel_height (register struct frame *f)
4891 return FRAME_PIXEL_HEIGHT (f);
4895 x_screen_planes (register struct frame *f)
4897 return FRAME_W32_DISPLAY_INFO (f)->n_planes;
4900 /* Return the display structure for the display named NAME.
4901 Open a new connection if necessary. */
4903 struct w32_display_info *
4904 x_display_info_for_name (Lisp_Object name)
4906 Lisp_Object names;
4907 struct w32_display_info *dpyinfo;
4909 CHECK_STRING (name);
4911 for (dpyinfo = &one_w32_display_info, names = w32_display_name_list;
4912 dpyinfo && !NILP (w32_display_name_list);
4913 dpyinfo = dpyinfo->next, names = XCDR (names))
4915 Lisp_Object tem;
4916 tem = Fstring_equal (XCAR (XCAR (names)), name);
4917 if (!NILP (tem))
4918 return dpyinfo;
4921 /* Use this general default value to start with. */
4922 Vx_resource_name = Vinvocation_name;
4924 validate_x_resource_name ();
4926 dpyinfo = w32_term_init (name, (unsigned char *)0,
4927 SSDATA (Vx_resource_name));
4929 if (dpyinfo == 0)
4930 error ("Cannot connect to server %s", SDATA (name));
4932 XSETFASTINT (Vwindow_system_version, w32_major_version);
4934 return dpyinfo;
4937 DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
4938 1, 3, 0, doc: /* Open a connection to a display server.
4939 DISPLAY is the name of the display to connect to.
4940 Optional second arg XRM-STRING is a string of resources in xrdb format.
4941 If the optional third arg MUST-SUCCEED is non-nil,
4942 terminate Emacs if we can't open the connection.
4943 \(In the Nextstep version, the last two arguments are currently ignored.) */)
4944 (Lisp_Object display, Lisp_Object xrm_string, Lisp_Object must_succeed)
4946 unsigned char *xrm_option;
4947 struct w32_display_info *dpyinfo;
4949 CHECK_STRING (display);
4951 /* Signal an error in order to encourage correct use from callers.
4952 * If we ever support multiple window systems in the same Emacs,
4953 * we'll need callers to be precise about what window system they
4954 * want. */
4956 if (strcmp (SSDATA (display), "w32") != 0)
4957 error ("The name of the display in this Emacs must be \"w32\"");
4959 /* If initialization has already been done, return now to avoid
4960 overwriting critical parts of one_w32_display_info. */
4961 if (window_system_available (NULL))
4962 return Qnil;
4964 if (! NILP (xrm_string))
4965 CHECK_STRING (xrm_string);
4967 #if 0
4968 if (! EQ (Vwindow_system, intern ("w32")))
4969 error ("Not using Microsoft Windows");
4970 #endif
4972 /* Allow color mapping to be defined externally; first look in user's
4973 HOME directory, then in Emacs etc dir for a file called rgb.txt. */
4975 Lisp_Object color_file;
4976 struct gcpro gcpro1;
4978 color_file = build_string ("~/rgb.txt");
4980 GCPRO1 (color_file);
4982 if (NILP (Ffile_readable_p (color_file)))
4983 color_file =
4984 Fexpand_file_name (build_string ("rgb.txt"),
4985 Fsymbol_value (intern ("data-directory")));
4987 Vw32_color_map = Fx_load_color_file (color_file);
4989 UNGCPRO;
4991 if (NILP (Vw32_color_map))
4992 Vw32_color_map = w32_default_color_map ();
4994 /* Merge in system logical colors. */
4995 add_system_logical_colors_to_map (&Vw32_color_map);
4997 if (! NILP (xrm_string))
4998 xrm_option = SDATA (xrm_string);
4999 else
5000 xrm_option = (unsigned char *) 0;
5002 /* Use this general default value to start with. */
5003 /* First remove .exe suffix from invocation-name - it looks ugly. */
5005 char basename[ MAX_PATH ], *str;
5007 strcpy (basename, SDATA (Vinvocation_name));
5008 str = strrchr (basename, '.');
5009 if (str) *str = 0;
5010 Vinvocation_name = build_string (basename);
5012 Vx_resource_name = Vinvocation_name;
5014 validate_x_resource_name ();
5016 /* This is what opens the connection and sets x_current_display.
5017 This also initializes many symbols, such as those used for input. */
5018 dpyinfo = w32_term_init (display, xrm_option,
5019 SSDATA (Vx_resource_name));
5021 if (dpyinfo == 0)
5023 if (!NILP (must_succeed))
5024 fatal ("Cannot connect to server %s.\n",
5025 SDATA (display));
5026 else
5027 error ("Cannot connect to server %s", SDATA (display));
5030 XSETFASTINT (Vwindow_system_version, w32_major_version);
5031 return Qnil;
5034 DEFUN ("x-close-connection", Fx_close_connection,
5035 Sx_close_connection, 1, 1, 0,
5036 doc: /* Close the connection to DISPLAY's server.
5037 For DISPLAY, specify either a frame or a display name (a string).
5038 If DISPLAY is nil, that stands for the selected frame's display. */)
5039 (Lisp_Object display)
5041 struct w32_display_info *dpyinfo = check_x_display_info (display);
5043 if (dpyinfo->reference_count > 0)
5044 error ("Display still has frames on it");
5046 block_input ();
5047 x_destroy_all_bitmaps (dpyinfo);
5049 x_delete_display (dpyinfo);
5050 unblock_input ();
5052 return Qnil;
5055 DEFUN ("x-display-list", Fx_display_list, Sx_display_list, 0, 0, 0,
5056 doc: /* Return the list of display names that Emacs has connections to. */)
5057 (void)
5059 Lisp_Object tail, result;
5061 result = Qnil;
5062 for (tail = w32_display_name_list; CONSP (tail); tail = XCDR (tail))
5063 result = Fcons (XCAR (XCAR (tail)), result);
5065 return result;
5068 DEFUN ("x-synchronize", Fx_synchronize, Sx_synchronize, 1, 2, 0,
5069 doc: /* If ON is non-nil, report X errors as soon as the erring request is made.
5070 This function only has an effect on X Windows. With MS Windows, it is
5071 defined but does nothing.
5073 If ON is nil, allow buffering of requests.
5074 Turning on synchronization prohibits the Xlib routines from buffering
5075 requests and seriously degrades performance, but makes debugging much
5076 easier.
5077 The optional second argument TERMINAL specifies which display to act on.
5078 TERMINAL should be a terminal object, a frame or a display name (a string).
5079 If TERMINAL is omitted or nil, that stands for the selected frame's display. */)
5080 (Lisp_Object on, Lisp_Object display)
5082 return Qnil;
5087 /***********************************************************************
5088 Window properties
5089 ***********************************************************************/
5091 #if 0 /* TODO : port window properties to W32 */
5093 DEFUN ("x-change-window-property", Fx_change_window_property,
5094 Sx_change_window_property, 2, 6, 0,
5095 doc: /* Change window property PROP to VALUE on the X window of FRAME.
5096 PROP must be a string. VALUE may be a string or a list of conses,
5097 numbers and/or strings. If an element in the list is a string, it is
5098 converted to an atom and the value of the Atom is used. If an element
5099 is a cons, it is converted to a 32 bit number where the car is the 16
5100 top bits and the cdr is the lower 16 bits.
5102 FRAME nil or omitted means use the selected frame.
5103 If TYPE is given and non-nil, it is the name of the type of VALUE.
5104 If TYPE is not given or nil, the type is STRING.
5105 FORMAT gives the size in bits of each element if VALUE is a list.
5106 It must be one of 8, 16 or 32.
5107 If VALUE is a string or FORMAT is nil or not given, FORMAT defaults to 8.
5108 If OUTER-P is non-nil, the property is changed for the outer X window of
5109 FRAME. Default is to change on the edit X window. */)
5110 (Lisp_Object prop, Lisp_Object value, Lisp_Object frame,
5111 Lisp_Object type, Lisp_Object format, Lisp_Object outer_p)
5113 struct frame *f = decode_window_system_frame (frame);
5114 Atom prop_atom;
5116 CHECK_STRING (prop);
5117 CHECK_STRING (value);
5119 block_input ();
5120 prop_atom = XInternAtom (FRAME_W32_DISPLAY (f), SDATA (prop), False);
5121 XChangeProperty (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f),
5122 prop_atom, XA_STRING, 8, PropModeReplace,
5123 SDATA (value), SCHARS (value));
5125 /* Make sure the property is set when we return. */
5126 XFlush (FRAME_W32_DISPLAY (f));
5127 unblock_input ();
5129 return value;
5133 DEFUN ("x-delete-window-property", Fx_delete_window_property,
5134 Sx_delete_window_property, 1, 2, 0,
5135 doc: /* Remove window property PROP from X window of FRAME.
5136 FRAME nil or omitted means use the selected frame. Value is PROP. */)
5137 (Lisp_Object prop, Lisp_Object frame)
5139 struct frame *f = decode_window_system_frame (frame);
5140 Atom prop_atom;
5142 CHECK_STRING (prop);
5143 block_input ();
5144 prop_atom = XInternAtom (FRAME_W32_DISPLAY (f), SDATA (prop), False);
5145 XDeleteProperty (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f), prop_atom);
5147 /* Make sure the property is removed when we return. */
5148 XFlush (FRAME_W32_DISPLAY (f));
5149 unblock_input ();
5151 return prop;
5155 DEFUN ("x-window-property", Fx_window_property, Sx_window_property,
5156 1, 6, 0,
5157 doc: /* Value is the value of window property PROP on FRAME.
5158 If FRAME is nil or omitted, use the selected frame.
5160 On X Windows, the following optional arguments are also accepted:
5161 If TYPE is nil or omitted, get the property as a string.
5162 Otherwise TYPE is the name of the atom that denotes the type expected.
5163 If SOURCE is non-nil, get the property on that window instead of from
5164 FRAME. The number 0 denotes the root window.
5165 If DELETE-P is non-nil, delete the property after retrieving it.
5166 If VECTOR-RET-P is non-nil, don't return a string but a vector of values.
5168 On MS Windows, this function accepts but ignores those optional arguments.
5170 Value is nil if FRAME hasn't a property with name PROP or if PROP has
5171 no value of TYPE (always string in the MS Windows case). */)
5172 (Lisp_Object prop, Lisp_Object frame, Lisp_Object type,
5173 Lisp_Object source, Lisp_Object delete_p, Lisp_Object vector_ret_p)
5175 struct frame *f = decode_window_system_frame (frame);
5176 Atom prop_atom;
5177 int rc;
5178 Lisp_Object prop_value = Qnil;
5179 char *tmp_data = NULL;
5180 Atom actual_type;
5181 int actual_format;
5182 unsigned long actual_size, bytes_remaining;
5184 CHECK_STRING (prop);
5185 block_input ();
5186 prop_atom = XInternAtom (FRAME_W32_DISPLAY (f), SDATA (prop), False);
5187 rc = XGetWindowProperty (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f),
5188 prop_atom, 0, 0, False, XA_STRING,
5189 &actual_type, &actual_format, &actual_size,
5190 &bytes_remaining, (unsigned char **) &tmp_data);
5191 if (rc == Success)
5193 int size = bytes_remaining;
5195 XFree (tmp_data);
5196 tmp_data = NULL;
5198 rc = XGetWindowProperty (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f),
5199 prop_atom, 0, bytes_remaining,
5200 False, XA_STRING,
5201 &actual_type, &actual_format,
5202 &actual_size, &bytes_remaining,
5203 (unsigned char **) &tmp_data);
5204 if (rc == Success)
5205 prop_value = make_string (tmp_data, size);
5207 XFree (tmp_data);
5210 unblock_input ();
5212 return prop_value;
5214 return Qnil;
5217 #endif /* TODO */
5220 /***********************************************************************
5221 Busy cursor
5222 ***********************************************************************/
5224 void
5225 w32_note_current_window (void)
5227 struct frame * f = SELECTED_FRAME ();
5229 if (!FRAME_W32_P (f))
5230 return;
5232 hourglass_hwnd = FRAME_W32_WINDOW (f);
5235 void
5236 show_hourglass (struct atimer *timer)
5238 struct frame *f;
5240 hourglass_atimer = NULL;
5242 block_input ();
5243 f = x_window_to_frame (&one_w32_display_info,
5244 hourglass_hwnd);
5246 if (f)
5247 f->output_data.w32->hourglass_p = 0;
5248 else
5249 f = SELECTED_FRAME ();
5251 if (!FRAME_W32_P (f))
5252 return;
5254 w32_show_hourglass (f);
5255 unblock_input ();
5258 void
5259 hide_hourglass (void)
5261 block_input ();
5262 w32_hide_hourglass ();
5263 unblock_input ();
5267 /* Display an hourglass cursor. Set the hourglass_p flag in display info
5268 to indicate that an hourglass cursor is shown. */
5270 static void
5271 w32_show_hourglass (struct frame *f)
5273 if (!hourglass_shown_p)
5275 f->output_data.w32->hourglass_p = 1;
5276 if (!menubar_in_use && !current_popup_menu)
5277 SetCursor (f->output_data.w32->hourglass_cursor);
5278 hourglass_shown_p = 1;
5283 /* Hide the hourglass cursor on all frames, if it is currently shown. */
5285 static void
5286 w32_hide_hourglass (void)
5288 if (hourglass_shown_p)
5290 struct frame *f = x_window_to_frame (&one_w32_display_info,
5291 hourglass_hwnd);
5292 if (f)
5293 f->output_data.w32->hourglass_p = 0;
5294 else
5295 /* If frame was deleted, restore to selected frame's cursor. */
5296 f = SELECTED_FRAME ();
5298 if (FRAME_W32_P (f))
5299 SetCursor (f->output_data.w32->current_cursor);
5300 else
5301 /* No cursors on non GUI frames - restore to stock arrow cursor. */
5302 SetCursor (w32_load_cursor (IDC_ARROW));
5304 hourglass_shown_p = 0;
5310 /***********************************************************************
5311 Tool tips
5312 ***********************************************************************/
5314 static Lisp_Object x_create_tip_frame (struct w32_display_info *,
5315 Lisp_Object, Lisp_Object);
5316 static void compute_tip_xy (struct frame *, Lisp_Object, Lisp_Object,
5317 Lisp_Object, int, int, int *, int *);
5319 /* The frame of a currently visible tooltip. */
5321 Lisp_Object tip_frame;
5323 /* If non-nil, a timer started that hides the last tooltip when it
5324 fires. */
5326 Lisp_Object tip_timer;
5327 Window tip_window;
5329 /* If non-nil, a vector of 3 elements containing the last args
5330 with which x-show-tip was called. See there. */
5332 Lisp_Object last_show_tip_args;
5335 static Lisp_Object
5336 unwind_create_tip_frame (Lisp_Object frame)
5338 Lisp_Object deleted;
5340 deleted = unwind_create_frame (frame);
5341 if (EQ (deleted, Qt))
5343 tip_window = NULL;
5344 tip_frame = Qnil;
5347 return deleted;
5351 /* Create a frame for a tooltip on the display described by DPYINFO.
5352 PARMS is a list of frame parameters. TEXT is the string to
5353 display in the tip frame. Value is the frame.
5355 Note that functions called here, esp. x_default_parameter can
5356 signal errors, for instance when a specified color name is
5357 undefined. We have to make sure that we're in a consistent state
5358 when this happens. */
5360 static Lisp_Object
5361 x_create_tip_frame (struct w32_display_info *dpyinfo,
5362 Lisp_Object parms, Lisp_Object text)
5364 struct frame *f;
5365 Lisp_Object frame;
5366 Lisp_Object name;
5367 long window_prompting = 0;
5368 int width, height;
5369 ptrdiff_t count = SPECPDL_INDEX ();
5370 struct gcpro gcpro1, gcpro2, gcpro3;
5371 struct kboard *kb;
5372 int face_change_count_before = face_change_count;
5373 Lisp_Object buffer;
5374 struct buffer *old_buffer;
5376 /* Use this general default value to start with until we know if
5377 this frame has a specified name. */
5378 Vx_resource_name = Vinvocation_name;
5380 kb = dpyinfo->terminal->kboard;
5382 /* The calls to x_get_arg remove elements from PARMS, so copy it to
5383 avoid destructive changes behind our caller's back. */
5384 parms = Fcopy_alist (parms);
5386 /* Get the name of the frame to use for resource lookup. */
5387 name = x_get_arg (dpyinfo, parms, Qname, "name", "Name", RES_TYPE_STRING);
5388 if (!STRINGP (name)
5389 && !EQ (name, Qunbound)
5390 && !NILP (name))
5391 error ("Invalid frame name--not a string or nil");
5392 Vx_resource_name = name;
5394 frame = Qnil;
5395 GCPRO3 (parms, name, frame);
5396 /* Make a frame without minibuffer nor mode-line. */
5397 f = make_frame (0);
5398 f->wants_modeline = 0;
5399 XSETFRAME (frame, f);
5401 buffer = Fget_buffer_create (build_string (" *tip*"));
5402 /* Use set_window_buffer instead of Fset_window_buffer (see
5403 discussion of bug#11984, bug#12025, bug#12026). */
5404 set_window_buffer (FRAME_ROOT_WINDOW (f), buffer, 0, 0);
5405 old_buffer = current_buffer;
5406 set_buffer_internal_1 (XBUFFER (buffer));
5407 bset_truncate_lines (current_buffer, Qnil);
5408 specbind (Qinhibit_read_only, Qt);
5409 specbind (Qinhibit_modification_hooks, Qt);
5410 Ferase_buffer ();
5411 Finsert (1, &text);
5412 set_buffer_internal_1 (old_buffer);
5414 record_unwind_protect (unwind_create_tip_frame, frame);
5416 /* By setting the output method, we're essentially saying that
5417 the frame is live, as per FRAME_LIVE_P. If we get a signal
5418 from this point on, x_destroy_window might screw up reference
5419 counts etc. */
5420 f->terminal = dpyinfo->terminal;
5421 f->output_method = output_w32;
5422 f->output_data.w32 = xzalloc (sizeof (struct w32_output));
5424 FRAME_FONTSET (f) = -1;
5425 fset_icon_name (f, Qnil);
5427 #ifdef GLYPH_DEBUG
5428 image_cache_refcount =
5429 FRAME_IMAGE_CACHE (f) ? FRAME_IMAGE_CACHE (f)->refcount : 0;
5430 dpyinfo_refcount = dpyinfo->reference_count;
5431 #endif /* GLYPH_DEBUG */
5432 FRAME_KBOARD (f) = kb;
5433 f->output_data.w32->parent_desc = FRAME_W32_DISPLAY_INFO (f)->root_window;
5434 f->output_data.w32->explicit_parent = 0;
5436 /* Set the name; the functions to which we pass f expect the name to
5437 be set. */
5438 if (EQ (name, Qunbound) || NILP (name))
5440 fset_name (f, build_string (dpyinfo->w32_id_name));
5441 f->explicit_name = 0;
5443 else
5445 fset_name (f, name);
5446 f->explicit_name = 1;
5447 /* use the frame's title when getting resources for this frame. */
5448 specbind (Qx_resource_name, name);
5451 if (uniscribe_available)
5452 register_font_driver (&uniscribe_font_driver, f);
5453 register_font_driver (&w32font_driver, f);
5455 x_default_parameter (f, parms, Qfont_backend, Qnil,
5456 "fontBackend", "FontBackend", RES_TYPE_STRING);
5458 /* Extract the window parameters from the supplied values
5459 that are needed to determine window geometry. */
5460 x_default_font_parameter (f, parms);
5462 x_default_parameter (f, parms, Qborder_width, make_number (2),
5463 "borderWidth", "BorderWidth", RES_TYPE_NUMBER);
5464 /* This defaults to 2 in order to match xterm. We recognize either
5465 internalBorderWidth or internalBorder (which is what xterm calls
5466 it). */
5467 if (NILP (Fassq (Qinternal_border_width, parms)))
5469 Lisp_Object value;
5471 value = x_get_arg (dpyinfo, parms, Qinternal_border_width,
5472 "internalBorder", "internalBorder", RES_TYPE_NUMBER);
5473 if (! EQ (value, Qunbound))
5474 parms = Fcons (Fcons (Qinternal_border_width, value),
5475 parms);
5477 x_default_parameter (f, parms, Qinternal_border_width, make_number (1),
5478 "internalBorderWidth", "internalBorderWidth",
5479 RES_TYPE_NUMBER);
5481 /* Also do the stuff which must be set before the window exists. */
5482 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
5483 "foreground", "Foreground", RES_TYPE_STRING);
5484 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
5485 "background", "Background", RES_TYPE_STRING);
5486 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
5487 "pointerColor", "Foreground", RES_TYPE_STRING);
5488 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
5489 "cursorColor", "Foreground", RES_TYPE_STRING);
5490 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
5491 "borderColor", "BorderColor", RES_TYPE_STRING);
5493 /* Init faces before x_default_parameter is called for scroll-bar
5494 parameters because that function calls x_set_scroll_bar_width,
5495 which calls change_frame_size, which calls Fset_window_buffer,
5496 which runs hooks, which call Fvertical_motion. At the end, we
5497 end up in init_iterator with a null face cache, which should not
5498 happen. */
5499 init_frame_faces (f);
5501 f->output_data.w32->dwStyle = WS_BORDER | WS_POPUP | WS_DISABLED;
5502 f->output_data.w32->parent_desc = FRAME_W32_DISPLAY_INFO (f)->root_window;
5504 window_prompting = x_figure_window_size (f, parms, 0);
5506 /* No fringes on tip frame. */
5507 f->fringe_cols = 0;
5508 f->left_fringe_width = 0;
5509 f->right_fringe_width = 0;
5511 block_input ();
5512 my_create_tip_window (f);
5513 unblock_input ();
5515 x_make_gc (f);
5517 x_default_parameter (f, parms, Qauto_raise, Qnil,
5518 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN);
5519 x_default_parameter (f, parms, Qauto_lower, Qnil,
5520 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN);
5521 x_default_parameter (f, parms, Qcursor_type, Qbox,
5522 "cursorType", "CursorType", RES_TYPE_SYMBOL);
5524 /* Dimensions, especially FRAME_LINES (f), must be done via change_frame_size.
5525 Change will not be effected unless different from the current
5526 FRAME_LINES (f). */
5527 width = FRAME_COLS (f);
5528 height = FRAME_LINES (f);
5529 FRAME_LINES (f) = 0;
5530 SET_FRAME_COLS (f, 0);
5531 change_frame_size (f, height, width, 1, 0, 0);
5533 /* Add `tooltip' frame parameter's default value. */
5534 if (NILP (Fframe_parameter (frame, Qtooltip)))
5535 Fmodify_frame_parameters (frame, Fcons (Fcons (Qtooltip, Qt), Qnil));
5537 /* Set up faces after all frame parameters are known. This call
5538 also merges in face attributes specified for new frames.
5540 Frame parameters may be changed if .Xdefaults contains
5541 specifications for the default font. For example, if there is an
5542 `Emacs.default.attributeBackground: pink', the `background-color'
5543 attribute of the frame get's set, which let's the internal border
5544 of the tooltip frame appear in pink. Prevent this. */
5546 Lisp_Object bg = Fframe_parameter (frame, Qbackground_color);
5547 Lisp_Object fg = Fframe_parameter (frame, Qforeground_color);
5548 Lisp_Object colors = Qnil;
5550 /* Set tip_frame here, so that */
5551 tip_frame = frame;
5552 call2 (Qface_set_after_frame_default, frame, Qnil);
5554 if (!EQ (bg, Fframe_parameter (frame, Qbackground_color)))
5555 colors = Fcons (Fcons (Qbackground_color, bg), colors);
5556 if (!EQ (fg, Fframe_parameter (frame, Qforeground_color)))
5557 colors = Fcons (Fcons (Qforeground_color, fg), colors);
5559 if (!NILP (colors))
5560 Fmodify_frame_parameters (frame, colors);
5563 f->no_split = 1;
5565 UNGCPRO;
5567 /* Now that the frame is official, it counts as a reference to
5568 its display. */
5569 FRAME_W32_DISPLAY_INFO (f)->reference_count++;
5570 f->terminal->reference_count++;
5572 /* It is now ok to make the frame official even if we get an error
5573 below. And the frame needs to be on Vframe_list or making it
5574 visible won't work. */
5575 Vframe_list = Fcons (frame, Vframe_list);
5577 /* Setting attributes of faces of the tooltip frame from resources
5578 and similar will increment face_change_count, which leads to the
5579 clearing of all current matrices. Since this isn't necessary
5580 here, avoid it by resetting face_change_count to the value it
5581 had before we created the tip frame. */
5582 face_change_count = face_change_count_before;
5584 /* Discard the unwind_protect. */
5585 return unbind_to (count, frame);
5589 /* Compute where to display tip frame F. PARMS is the list of frame
5590 parameters for F. DX and DY are specified offsets from the current
5591 location of the mouse. WIDTH and HEIGHT are the width and height
5592 of the tooltip. Return coordinates relative to the root window of
5593 the display in *ROOT_X, and *ROOT_Y. */
5595 static void
5596 compute_tip_xy (struct frame *f,
5597 Lisp_Object parms, Lisp_Object dx, Lisp_Object dy,
5598 int width, int height, int *root_x, int *root_y)
5600 Lisp_Object left, top;
5601 int min_x, min_y, max_x, max_y;
5603 /* User-specified position? */
5604 left = Fcdr (Fassq (Qleft, parms));
5605 top = Fcdr (Fassq (Qtop, parms));
5607 /* Move the tooltip window where the mouse pointer is. Resize and
5608 show it. */
5609 if (!INTEGERP (left) || !INTEGERP (top))
5611 POINT pt;
5613 /* Default min and max values. */
5614 min_x = 0;
5615 min_y = 0;
5616 max_x = x_display_pixel_width (FRAME_W32_DISPLAY_INFO (f));
5617 max_y = x_display_pixel_height (FRAME_W32_DISPLAY_INFO (f));
5619 block_input ();
5620 GetCursorPos (&pt);
5621 *root_x = pt.x;
5622 *root_y = pt.y;
5623 unblock_input ();
5625 /* If multiple monitor support is available, constrain the tip onto
5626 the current monitor. This improves the above by allowing negative
5627 co-ordinates if monitor positions are such that they are valid, and
5628 snaps a tooltip onto a single monitor if we are close to the edge
5629 where it would otherwise flow onto the other monitor (or into
5630 nothingness if there is a gap in the overlap). */
5631 if (monitor_from_point_fn && get_monitor_info_fn)
5633 struct MONITOR_INFO info;
5634 HMONITOR monitor
5635 = monitor_from_point_fn (pt, MONITOR_DEFAULT_TO_NEAREST);
5636 info.cbSize = sizeof (info);
5638 if (get_monitor_info_fn (monitor, &info))
5640 min_x = info.rcWork.left;
5641 min_y = info.rcWork.top;
5642 max_x = info.rcWork.right;
5643 max_y = info.rcWork.bottom;
5648 if (INTEGERP (top))
5649 *root_y = XINT (top);
5650 else if (*root_y + XINT (dy) <= min_y)
5651 *root_y = min_y; /* Can happen for negative dy */
5652 else if (*root_y + XINT (dy) + height <= max_y)
5653 /* It fits below the pointer */
5654 *root_y += XINT (dy);
5655 else if (height + XINT (dy) + min_y <= *root_y)
5656 /* It fits above the pointer. */
5657 *root_y -= height + XINT (dy);
5658 else
5659 /* Put it on the top. */
5660 *root_y = min_y;
5662 if (INTEGERP (left))
5663 *root_x = XINT (left);
5664 else if (*root_x + XINT (dx) <= min_x)
5665 *root_x = 0; /* Can happen for negative dx */
5666 else if (*root_x + XINT (dx) + width <= max_x)
5667 /* It fits to the right of the pointer. */
5668 *root_x += XINT (dx);
5669 else if (width + XINT (dx) + min_x <= *root_x)
5670 /* It fits to the left of the pointer. */
5671 *root_x -= width + XINT (dx);
5672 else
5673 /* Put it left justified on the screen -- it ought to fit that way. */
5674 *root_x = min_x;
5678 DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0,
5679 doc: /* Show STRING in a \"tooltip\" window on frame FRAME.
5680 A tooltip window is a small window displaying a string.
5682 This is an internal function; Lisp code should call `tooltip-show'.
5684 FRAME nil or omitted means use the selected frame.
5686 PARMS is an optional list of frame parameters which can be
5687 used to change the tooltip's appearance.
5689 Automatically hide the tooltip after TIMEOUT seconds. TIMEOUT nil
5690 means use the default timeout of 5 seconds.
5692 If the list of frame parameters PARMS contains a `left' parameter,
5693 the tooltip is displayed at that x-position. Otherwise it is
5694 displayed at the mouse position, with offset DX added (default is 5 if
5695 DX isn't specified). Likewise for the y-position; if a `top' frame
5696 parameter is specified, it determines the y-position of the tooltip
5697 window, otherwise it is displayed at the mouse position, with offset
5698 DY added (default is -10).
5700 A tooltip's maximum size is specified by `x-max-tooltip-size'.
5701 Text larger than the specified size is clipped. */)
5702 (Lisp_Object string, Lisp_Object frame, Lisp_Object parms, Lisp_Object timeout, Lisp_Object dx, Lisp_Object dy)
5704 struct frame *f;
5705 struct window *w;
5706 int root_x, root_y;
5707 struct buffer *old_buffer;
5708 struct text_pos pos;
5709 int i, width, height, seen_reversed_p;
5710 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
5711 int old_windows_or_buffers_changed = windows_or_buffers_changed;
5712 ptrdiff_t count = SPECPDL_INDEX ();
5714 specbind (Qinhibit_redisplay, Qt);
5716 GCPRO4 (string, parms, frame, timeout);
5718 CHECK_STRING (string);
5719 f = decode_window_system_frame (frame);
5720 if (NILP (timeout))
5721 timeout = make_number (5);
5722 else
5723 CHECK_NATNUM (timeout);
5725 if (NILP (dx))
5726 dx = make_number (5);
5727 else
5728 CHECK_NUMBER (dx);
5730 if (NILP (dy))
5731 dy = make_number (-10);
5732 else
5733 CHECK_NUMBER (dy);
5735 if (NILP (last_show_tip_args))
5736 last_show_tip_args = Fmake_vector (make_number (3), Qnil);
5738 if (!NILP (tip_frame))
5740 Lisp_Object last_string = AREF (last_show_tip_args, 0);
5741 Lisp_Object last_frame = AREF (last_show_tip_args, 1);
5742 Lisp_Object last_parms = AREF (last_show_tip_args, 2);
5744 if (EQ (frame, last_frame)
5745 && !NILP (Fequal (last_string, string))
5746 && !NILP (Fequal (last_parms, parms)))
5748 struct frame *f = XFRAME (tip_frame);
5750 /* Only DX and DY have changed. */
5751 if (!NILP (tip_timer))
5753 Lisp_Object timer = tip_timer;
5754 tip_timer = Qnil;
5755 call1 (Qcancel_timer, timer);
5758 block_input ();
5759 compute_tip_xy (f, parms, dx, dy, FRAME_PIXEL_WIDTH (f),
5760 FRAME_PIXEL_HEIGHT (f), &root_x, &root_y);
5762 /* Put tooltip in topmost group and in position. */
5763 SetWindowPos (FRAME_W32_WINDOW (f), HWND_TOPMOST,
5764 root_x, root_y, 0, 0,
5765 SWP_NOSIZE | SWP_NOACTIVATE);
5767 /* Ensure tooltip is on top of other topmost windows (eg menus). */
5768 SetWindowPos (FRAME_W32_WINDOW (f), HWND_TOP,
5769 0, 0, 0, 0,
5770 SWP_NOMOVE | SWP_NOSIZE | SWP_NOACTIVATE);
5772 unblock_input ();
5773 goto start_timer;
5777 /* Hide a previous tip, if any. */
5778 Fx_hide_tip ();
5780 ASET (last_show_tip_args, 0, string);
5781 ASET (last_show_tip_args, 1, frame);
5782 ASET (last_show_tip_args, 2, parms);
5784 /* Add default values to frame parameters. */
5785 if (NILP (Fassq (Qname, parms)))
5786 parms = Fcons (Fcons (Qname, build_string ("tooltip")), parms);
5787 if (NILP (Fassq (Qinternal_border_width, parms)))
5788 parms = Fcons (Fcons (Qinternal_border_width, make_number (3)), parms);
5789 if (NILP (Fassq (Qborder_width, parms)))
5790 parms = Fcons (Fcons (Qborder_width, make_number (1)), parms);
5791 if (NILP (Fassq (Qborder_color, parms)))
5792 parms = Fcons (Fcons (Qborder_color, build_string ("lightyellow")), parms);
5793 if (NILP (Fassq (Qbackground_color, parms)))
5794 parms = Fcons (Fcons (Qbackground_color, build_string ("lightyellow")),
5795 parms);
5797 /* Block input until the tip has been fully drawn, to avoid crashes
5798 when drawing tips in menus. */
5799 block_input ();
5801 /* Create a frame for the tooltip, and record it in the global
5802 variable tip_frame. */
5803 frame = x_create_tip_frame (FRAME_W32_DISPLAY_INFO (f), parms, string);
5804 f = XFRAME (frame);
5806 /* Set up the frame's root window. */
5807 w = XWINDOW (FRAME_ROOT_WINDOW (f));
5808 w->left_col = 0;
5809 w->top_line = 0;
5811 if (CONSP (Vx_max_tooltip_size)
5812 && INTEGERP (XCAR (Vx_max_tooltip_size))
5813 && XINT (XCAR (Vx_max_tooltip_size)) > 0
5814 && INTEGERP (XCDR (Vx_max_tooltip_size))
5815 && XINT (XCDR (Vx_max_tooltip_size)) > 0)
5817 w->total_cols = XFASTINT (XCAR (Vx_max_tooltip_size));
5818 w->total_lines = XFASTINT (XCDR (Vx_max_tooltip_size));
5820 else
5822 w->total_cols = 80;
5823 w->total_lines = 40;
5826 FRAME_TOTAL_COLS (f) = WINDOW_TOTAL_COLS (w);
5827 adjust_glyphs (f);
5828 w->pseudo_window_p = 1;
5830 /* Display the tooltip text in a temporary buffer. */
5831 old_buffer = current_buffer;
5832 set_buffer_internal_1 (XBUFFER (XWINDOW (FRAME_ROOT_WINDOW (f))->contents));
5833 bset_truncate_lines (current_buffer, Qnil);
5834 clear_glyph_matrix (w->desired_matrix);
5835 clear_glyph_matrix (w->current_matrix);
5836 SET_TEXT_POS (pos, BEGV, BEGV_BYTE);
5837 try_window (FRAME_ROOT_WINDOW (f), pos, TRY_WINDOW_IGNORE_FONTS_CHANGE);
5839 /* Compute width and height of the tooltip. */
5840 width = height = seen_reversed_p = 0;
5841 for (i = 0; i < w->desired_matrix->nrows; ++i)
5843 struct glyph_row *row = &w->desired_matrix->rows[i];
5844 struct glyph *last;
5845 int row_width;
5847 /* Stop at the first empty row at the end. */
5848 if (!row->enabled_p || !MATRIX_ROW_DISPLAYS_TEXT_P (row))
5849 break;
5851 /* Let the row go over the full width of the frame. */
5852 row->full_width_p = 1;
5854 row_width = row->pixel_width;
5855 if (row->used[TEXT_AREA])
5857 if (!row->reversed_p)
5859 /* There's a glyph at the end of rows that is used to
5860 place the cursor there. Don't include the width of
5861 this glyph. */
5862 last = &row->glyphs[TEXT_AREA][row->used[TEXT_AREA] - 1];
5863 if (INTEGERP (last->object))
5864 row_width -= last->pixel_width;
5866 else
5868 /* There could be a stretch glyph at the beginning of R2L
5869 rows that is produced by extend_face_to_end_of_line.
5870 Don't count that glyph. */
5871 struct glyph *g = row->glyphs[TEXT_AREA];
5873 if (g->type == STRETCH_GLYPH && INTEGERP (g->object))
5875 row_width -= g->pixel_width;
5876 seen_reversed_p = 1;
5881 height += row->height;
5882 width = max (width, row_width);
5885 /* If we've seen partial-length R2L rows, we need to re-adjust the
5886 tool-tip frame width and redisplay it again, to avoid over-wide
5887 tips due to the stretch glyph that extends R2L lines to full
5888 width of the frame. */
5889 if (seen_reversed_p)
5891 /* w->total_cols and FRAME_TOTAL_COLS want the width in columns,
5892 not in pixels. */
5893 width /= WINDOW_FRAME_COLUMN_WIDTH (w);
5894 w->total_cols = width;
5895 FRAME_TOTAL_COLS (f) = width;
5896 adjust_glyphs (f);
5897 w->pseudo_window_p = 1;
5898 clear_glyph_matrix (w->desired_matrix);
5899 clear_glyph_matrix (w->current_matrix);
5900 try_window (FRAME_ROOT_WINDOW (f), pos, TRY_WINDOW_IGNORE_FONTS_CHANGE);
5901 width = height = 0;
5902 /* Recompute width and height of the tooltip. */
5903 for (i = 0; i < w->desired_matrix->nrows; ++i)
5905 struct glyph_row *row = &w->desired_matrix->rows[i];
5906 struct glyph *last;
5907 int row_width;
5909 if (!row->enabled_p || !MATRIX_ROW_DISPLAYS_TEXT_P (row))
5910 break;
5911 row->full_width_p = 1;
5912 row_width = row->pixel_width;
5913 if (row->used[TEXT_AREA] && !row->reversed_p)
5915 last = &row->glyphs[TEXT_AREA][row->used[TEXT_AREA] - 1];
5916 if (INTEGERP (last->object))
5917 row_width -= last->pixel_width;
5920 height += row->height;
5921 width = max (width, row_width);
5925 /* Round up the height to an integral multiple of FRAME_LINE_HEIGHT. */
5926 if (height % FRAME_LINE_HEIGHT (f) != 0)
5927 height += FRAME_LINE_HEIGHT (f) - height % FRAME_LINE_HEIGHT (f);
5928 /* Add the frame's internal border to the width and height the w32
5929 window should have. */
5930 height += 2 * FRAME_INTERNAL_BORDER_WIDTH (f);
5931 width += 2 * FRAME_INTERNAL_BORDER_WIDTH (f);
5933 /* Move the tooltip window where the mouse pointer is. Resize and
5934 show it. */
5935 compute_tip_xy (f, parms, dx, dy, width, height, &root_x, &root_y);
5938 /* Adjust Window size to take border into account. */
5939 RECT rect;
5940 rect.left = rect.top = 0;
5941 rect.right = width;
5942 rect.bottom = height;
5943 AdjustWindowRect (&rect, f->output_data.w32->dwStyle,
5944 FRAME_EXTERNAL_MENU_BAR (f));
5946 /* Position and size tooltip, and put it in the topmost group.
5947 The add-on of FRAME_COLUMN_WIDTH to the 5th argument is a
5948 peculiarity of w32 display: without it, some fonts cause the
5949 last character of the tip to be truncated or wrapped around to
5950 the next line. */
5951 SetWindowPos (FRAME_W32_WINDOW (f), HWND_TOPMOST,
5952 root_x, root_y,
5953 rect.right - rect.left + FRAME_COLUMN_WIDTH (f),
5954 rect.bottom - rect.top, SWP_NOACTIVATE);
5956 /* Ensure tooltip is on top of other topmost windows (eg menus). */
5957 SetWindowPos (FRAME_W32_WINDOW (f), HWND_TOP,
5958 0, 0, 0, 0,
5959 SWP_NOMOVE | SWP_NOSIZE | SWP_NOACTIVATE);
5961 /* Let redisplay know that we have made the frame visible already. */
5962 SET_FRAME_VISIBLE (f, 1);
5964 ShowWindow (FRAME_W32_WINDOW (f), SW_SHOWNOACTIVATE);
5967 /* Draw into the window. */
5968 w->must_be_updated_p = 1;
5969 update_single_window (w, 1);
5971 unblock_input ();
5973 /* Restore original current buffer. */
5974 set_buffer_internal_1 (old_buffer);
5975 windows_or_buffers_changed = old_windows_or_buffers_changed;
5977 start_timer:
5978 /* Let the tip disappear after timeout seconds. */
5979 tip_timer = call3 (intern ("run-at-time"), timeout, Qnil,
5980 intern ("x-hide-tip"));
5982 UNGCPRO;
5983 return unbind_to (count, Qnil);
5987 DEFUN ("x-hide-tip", Fx_hide_tip, Sx_hide_tip, 0, 0, 0,
5988 doc: /* Hide the current tooltip window, if there is any.
5989 Value is t if tooltip was open, nil otherwise. */)
5990 (void)
5992 ptrdiff_t count;
5993 Lisp_Object deleted, frame, timer;
5994 struct gcpro gcpro1, gcpro2;
5996 /* Return quickly if nothing to do. */
5997 if (NILP (tip_timer) && NILP (tip_frame))
5998 return Qnil;
6000 frame = tip_frame;
6001 timer = tip_timer;
6002 GCPRO2 (frame, timer);
6003 tip_frame = tip_timer = deleted = Qnil;
6005 count = SPECPDL_INDEX ();
6006 specbind (Qinhibit_redisplay, Qt);
6007 specbind (Qinhibit_quit, Qt);
6009 if (!NILP (timer))
6010 call1 (Qcancel_timer, timer);
6012 if (FRAMEP (frame))
6014 delete_frame (frame, Qnil);
6015 deleted = Qt;
6018 UNGCPRO;
6019 return unbind_to (count, deleted);
6022 /***********************************************************************
6023 File selection dialog
6024 ***********************************************************************/
6026 #define FILE_NAME_TEXT_FIELD edt1
6027 #define FILE_NAME_COMBO_BOX cmb13
6028 #define FILE_NAME_LIST lst1
6030 /* Callback for altering the behavior of the Open File dialog.
6031 Makes the Filename text field contain "Current Directory" and be
6032 read-only when "Directories" is selected in the filter. This
6033 allows us to work around the fact that the standard Open File
6034 dialog does not support directories. */
6035 static UINT_PTR CALLBACK
6036 file_dialog_callback (HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam)
6038 if (msg == WM_NOTIFY)
6040 #ifdef NTGUI_UNICODE
6041 OFNOTIFYW * notify = (OFNOTIFYW *)lParam;
6042 #else /* !NTGUI_UNICODE */
6043 OFNOTIFYA * notify = (OFNOTIFYA *)lParam;
6044 #endif /* NTGUI_UNICODE */
6045 /* Detect when the Filter dropdown is changed. */
6046 if (notify->hdr.code == CDN_TYPECHANGE
6047 || notify->hdr.code == CDN_INITDONE)
6049 HWND dialog = GetParent (hwnd);
6050 HWND edit_control = GetDlgItem (dialog, FILE_NAME_TEXT_FIELD);
6051 HWND list = GetDlgItem (dialog, FILE_NAME_LIST);
6053 /* At least on Windows 7, the above attempt to get the window handle
6054 to the File Name Text Field fails. The following code does the
6055 job though. Note that this code is based on my examination of the
6056 window hierarchy using Microsoft Spy++. bk */
6057 if (edit_control == NULL)
6059 HWND tmp = GetDlgItem (dialog, FILE_NAME_COMBO_BOX);
6060 if (tmp)
6062 tmp = GetWindow (tmp, GW_CHILD);
6063 if (tmp)
6064 edit_control = GetWindow (tmp, GW_CHILD);
6068 /* Directories is in index 2. */
6069 if (notify->lpOFN->nFilterIndex == 2)
6071 CommDlg_OpenSave_SetControlText (dialog, FILE_NAME_TEXT_FIELD,
6072 GUISTR ("Current Directory"));
6073 EnableWindow (edit_control, FALSE);
6074 /* Note that at least on Windows 7, the above call to EnableWindow
6075 disables the window that would ordinarily have focus. If we
6076 do not set focus to some other window here, focus will land in
6077 no man's land and the user will be unable to tab through the
6078 dialog box (pressing tab will only result in a beep).
6079 Avoid that problem by setting focus to the list here. */
6080 if (notify->hdr.code == CDN_INITDONE)
6081 SetFocus (list);
6083 else
6085 /* Don't override default filename on init done. */
6086 if (notify->hdr.code == CDN_TYPECHANGE)
6087 CommDlg_OpenSave_SetControlText (dialog,
6088 FILE_NAME_TEXT_FIELD,
6089 GUISTR (""));
6090 EnableWindow (edit_control, TRUE);
6094 return 0;
6097 DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 5, 0,
6098 doc: /* Read file name, prompting with PROMPT in directory DIR.
6099 Use a file selection dialog. Select DEFAULT-FILENAME in the dialog's file
6100 selection box, if specified. If MUSTMATCH is non-nil, the returned file
6101 or directory must exist.
6103 This function is only defined on NS, MS Windows, and X Windows with the
6104 Motif or Gtk toolkits. With the Motif toolkit, ONLY-DIR-P is ignored.
6105 Otherwise, if ONLY-DIR-P is non-nil, the user can only select directories. */)
6106 (Lisp_Object prompt, Lisp_Object dir, Lisp_Object default_filename, Lisp_Object mustmatch, Lisp_Object only_dir_p)
6108 /* Filter index: 1: All Files, 2: Directories only */
6109 static const guichar_t filter[] =
6110 GUISTR ("All Files (*.*)\0*.*\0Directories\0*|*\0");
6112 Lisp_Object filename = default_filename;
6113 struct frame *f = SELECTED_FRAME ();
6114 BOOL file_opened = FALSE;
6115 Lisp_Object orig_dir = dir;
6116 Lisp_Object orig_prompt = prompt;
6118 /* If we compile with _WIN32_WINNT set to 0x0400 (for NT4
6119 compatibility) we end up with the old file dialogs. Define a big
6120 enough struct for the new dialog to trick GetOpenFileName into
6121 giving us the new dialogs on newer versions of Windows. */
6122 struct {
6123 #ifdef NTGUI_UNICODE
6124 OPENFILENAMEW details;
6125 #else /* !NTGUI_UNICODE */
6126 OPENFILENAMEA details;
6127 #endif /* NTGUI_UNICODE */
6129 #if _WIN32_WINNT < 0x500 /* < win2k */
6130 PVOID pvReserved;
6131 DWORD dwReserved;
6132 DWORD FlagsEx;
6133 #endif /* < win2k */
6134 } new_file_details;
6136 #ifdef NTGUI_UNICODE
6137 wchar_t filename_buf[32*1024 + 1]; // NT kernel maximum
6138 OPENFILENAMEW * file_details = &new_file_details.details;
6139 #else /* not NTGUI_UNICODE */
6140 char filename_buf[MAX_PATH + 1];
6141 OPENFILENAMEA * file_details = &new_file_details.details;
6142 #endif /* NTGUI_UNICODE */
6144 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
6145 GCPRO6 (prompt, dir, default_filename, mustmatch, only_dir_p, filename);
6148 struct gcpro gcpro1, gcpro2;
6149 GCPRO2 (orig_dir, orig_prompt); /* There is no GCPRON, N>6. */
6151 /* Note: under NTGUI_UNICODE, we do _NOT_ use ENCODE_FILE: the
6152 system file encoding expected by the platform APIs (e.g. Cygwin's
6153 POSIX implementation) may not be the same as the encoding expected
6154 by the Windows "ANSI" APIs! */
6156 CHECK_STRING (prompt);
6157 CHECK_STRING (dir);
6159 dir = Fexpand_file_name (dir, Qnil);
6161 if (STRINGP (filename))
6162 filename = Ffile_name_nondirectory (filename);
6163 else
6164 filename = empty_unibyte_string;
6166 #ifdef CYGWIN
6167 dir = Fcygwin_convert_file_name_to_windows (dir, Qt);
6168 if (SCHARS (filename) > 0)
6169 filename = Fcygwin_convert_file_name_to_windows (filename, Qnil);
6170 #endif
6172 CHECK_STRING (dir);
6173 CHECK_STRING (filename);
6175 /* The code in file_dialog_callback that attempts to set the text
6176 of the file name edit window when handling the CDN_INITDONE
6177 WM_NOTIFY message does not work. Setting filename to "Current
6178 Directory" in the only_dir_p case here does work however. */
6179 if (SCHARS (filename) == 0 && ! NILP (only_dir_p))
6180 filename = build_string ("Current Directory");
6182 /* Convert the values we've computed so far to system form. */
6183 #ifdef NTGUI_UNICODE
6184 to_unicode (prompt, &prompt);
6185 to_unicode (dir, &dir);
6186 to_unicode (filename, &filename);
6187 #else /* !NTGUI_UNICODE */
6188 prompt = ENCODE_FILE (prompt);
6189 dir = ENCODE_FILE (dir);
6190 filename = ENCODE_FILE (filename);
6192 /* We modify these in-place, so make copies for safety. */
6193 dir = Fcopy_sequence (dir);
6194 unixtodos_filename (SDATA (dir));
6195 filename = Fcopy_sequence (filename);
6196 unixtodos_filename (SDATA (filename));
6197 #endif /* NTGUI_UNICODE */
6199 /* Fill in the structure for the call to GetOpenFileName below.
6200 For NTGUI_UNICODE builds (which run only on NT), we just use
6201 the actual size of the structure. For non-NTGUI_UNICODE
6202 builds, we tell the OS we're using an old version of the
6203 structure if the OS isn't new enough to support the newer
6204 version. */
6205 memset (&new_file_details, 0, sizeof (new_file_details));
6207 if (w32_major_version > 4 && w32_major_version < 95)
6208 file_details->lStructSize = sizeof (new_file_details);
6209 else
6210 file_details->lStructSize = sizeof (*file_details);
6212 /* Set up the inout parameter for the selected file name. */
6213 if (SBYTES (filename) + 1 > sizeof (filename_buf))
6214 report_file_error ("filename too long", default_filename);
6216 memcpy (filename_buf, SDATA (filename), SBYTES (filename) + 1);
6217 file_details->lpstrFile = filename_buf;
6218 file_details->nMaxFile = sizeof (filename_buf) / sizeof (*filename_buf);
6220 file_details->hwndOwner = FRAME_W32_WINDOW (f);
6221 /* Undocumented Bug in Common File Dialog:
6222 If a filter is not specified, shell links are not resolved. */
6223 file_details->lpstrFilter = filter;
6224 file_details->lpstrInitialDir = (guichar_t*) SDATA (dir);
6225 file_details->lpstrTitle = (guichar_t*) SDATA (prompt);
6226 file_details->nFilterIndex = NILP (only_dir_p) ? 1 : 2;
6227 file_details->Flags = (OFN_HIDEREADONLY | OFN_NOCHANGEDIR
6228 | OFN_EXPLORER | OFN_ENABLEHOOK);
6230 if (!NILP (mustmatch))
6232 /* Require that the path to the parent directory exists. */
6233 file_details->Flags |= OFN_PATHMUSTEXIST;
6234 /* If we are looking for a file, require that it exists. */
6235 if (NILP (only_dir_p))
6236 file_details->Flags |= OFN_FILEMUSTEXIST;
6240 int count = SPECPDL_INDEX ();
6241 /* Prevent redisplay. */
6242 specbind (Qinhibit_redisplay, Qt);
6243 block_input ();
6244 file_details->lpfnHook = file_dialog_callback;
6246 file_opened = GUI_FN (GetOpenFileName) (file_details);
6247 unblock_input ();
6248 unbind_to (count, Qnil);
6251 if (file_opened)
6253 /* Get an Emacs string from the value Windows gave us. */
6254 #ifdef NTGUI_UNICODE
6255 filename = from_unicode_buffer (filename_buf);
6256 #else /* !NTGUI_UNICODE */
6257 dostounix_filename (filename_buf, 0);
6258 filename = DECODE_FILE (build_string (filename_buf));
6259 #endif /* NTGUI_UNICODE */
6261 #ifdef CYGWIN
6262 filename = Fcygwin_convert_file_name_from_windows (filename, Qt);
6263 #endif /* CYGWIN */
6265 /* Strip the dummy filename off the end of the string if we
6266 added it to select a directory. */
6267 if (file_details->nFilterIndex == 2)
6269 filename = Ffile_name_directory (filename);
6272 /* User canceled the dialog without making a selection. */
6273 else if (!CommDlgExtendedError ())
6274 filename = Qnil;
6275 /* An error occurred, fallback on reading from the mini-buffer. */
6276 else
6277 filename = Fcompleting_read (
6278 orig_prompt,
6279 intern ("read-file-name-internal"),
6280 orig_dir,
6281 mustmatch,
6282 orig_dir,
6283 Qfile_name_history,
6284 default_filename,
6285 Qnil);
6287 UNGCPRO;
6290 /* Make "Cancel" equivalent to C-g. */
6291 if (NILP (filename))
6292 Fsignal (Qquit, Qnil);
6294 RETURN_UNGCPRO (filename);
6298 #ifdef WINDOWSNT
6299 /* Moving files to the system recycle bin.
6300 Used by `move-file-to-trash' instead of the default moving to ~/.Trash */
6301 DEFUN ("system-move-file-to-trash", Fsystem_move_file_to_trash,
6302 Ssystem_move_file_to_trash, 1, 1, 0,
6303 doc: /* Move file or directory named FILENAME to the recycle bin. */)
6304 (Lisp_Object filename)
6306 Lisp_Object handler;
6307 Lisp_Object encoded_file;
6308 Lisp_Object operation;
6310 operation = Qdelete_file;
6311 if (!NILP (Ffile_directory_p (filename))
6312 && NILP (Ffile_symlink_p (filename)))
6314 operation = intern ("delete-directory");
6315 filename = Fdirectory_file_name (filename);
6317 filename = Fexpand_file_name (filename, Qnil);
6319 handler = Ffind_file_name_handler (filename, operation);
6320 if (!NILP (handler))
6321 return call2 (handler, operation, filename);
6323 encoded_file = ENCODE_FILE (filename);
6326 const char * path;
6327 SHFILEOPSTRUCT file_op;
6328 char tmp_path[MAX_PATH + 1];
6330 path = map_w32_filename (SDATA (encoded_file), NULL);
6332 /* On Windows, write permission is required to delete/move files. */
6333 _chmod (path, 0666);
6335 memset (tmp_path, 0, sizeof (tmp_path));
6336 strcpy (tmp_path, path);
6338 memset (&file_op, 0, sizeof (file_op));
6339 file_op.hwnd = HWND_DESKTOP;
6340 file_op.wFunc = FO_DELETE;
6341 file_op.pFrom = tmp_path;
6342 file_op.fFlags = FOF_SILENT | FOF_NOCONFIRMATION | FOF_ALLOWUNDO
6343 | FOF_NOERRORUI | FOF_NO_CONNECTED_ELEMENTS;
6344 file_op.fAnyOperationsAborted = FALSE;
6346 if (SHFileOperation (&file_op) != 0)
6347 report_file_error ("Removing old name", list1 (filename));
6349 return Qnil;
6352 #endif /* WINDOWSNT */
6355 /***********************************************************************
6356 w32 specialized functions
6357 ***********************************************************************/
6359 DEFUN ("w32-send-sys-command", Fw32_send_sys_command,
6360 Sw32_send_sys_command, 1, 2, 0,
6361 doc: /* Send frame a Windows WM_SYSCOMMAND message of type COMMAND.
6362 Some useful values for COMMAND are #xf030 to maximize frame (#xf020
6363 to minimize), #xf120 to restore frame to original size, and #xf100
6364 to activate the menubar for keyboard access. #xf140 activates the
6365 screen saver if defined.
6367 If optional parameter FRAME is not specified, use selected frame. */)
6368 (Lisp_Object command, Lisp_Object frame)
6370 FRAME_PTR f = decode_window_system_frame (frame);
6372 CHECK_NUMBER (command);
6374 PostMessage (FRAME_W32_WINDOW (f), WM_SYSCOMMAND, XINT (command), 0);
6376 return Qnil;
6379 DEFUN ("w32-shell-execute", Fw32_shell_execute, Sw32_shell_execute, 2, 4, 0,
6380 doc: /* Get Windows to perform OPERATION on DOCUMENT.
6381 This is a wrapper around the ShellExecute system function, which
6382 invokes the application registered to handle OPERATION for DOCUMENT.
6384 OPERATION is either nil or a string that names a supported operation.
6385 What operations can be used depends on the particular DOCUMENT and its
6386 handler application, but typically it is one of the following common
6387 operations:
6389 \"open\" - open DOCUMENT, which could be a file, a directory, or an
6390 executable program. If it is an application, that
6391 application is launched in the current buffer's default
6392 directory. Otherwise, the application associated with
6393 DOCUMENT is launched in the buffer's default directory.
6394 \"print\" - print DOCUMENT, which must be a file
6395 \"explore\" - start the Windows Explorer on DOCUMENT
6396 \"edit\" - launch an editor and open DOCUMENT for editing; which
6397 editor is launched depends on the association for the
6398 specified DOCUMENT
6399 \"find\" - initiate search starting from DOCUMENT which must specify
6400 a directory
6401 nil - invoke the default OPERATION, or \"open\" if default is
6402 not defined or unavailable
6404 DOCUMENT is typically the name of a document file or a URL, but can
6405 also be a program executable to run, or a directory to open in the
6406 Windows Explorer.
6408 If DOCUMENT is a program executable, the optional third arg PARAMETERS
6409 can be a string containing command line parameters that will be passed
6410 to the program; otherwise, PARAMETERS should be nil or unspecified.
6412 Optional fourth argument SHOW-FLAG can be used to control how the
6413 application will be displayed when it is invoked. If SHOW-FLAG is nil
6414 or unspecified, the application is displayed normally, otherwise it is
6415 an integer representing a ShowWindow flag:
6417 0 - start hidden
6418 1 - start normally
6419 3 - start maximized
6420 6 - start minimized */)
6421 (Lisp_Object operation, Lisp_Object document, Lisp_Object parameters, Lisp_Object show_flag)
6423 Lisp_Object current_dir;
6424 char *errstr;
6426 CHECK_STRING (document);
6428 /* Encode filename, current directory and parameters. */
6429 current_dir = BVAR (current_buffer, directory);
6431 #ifdef CYGWIN
6432 current_dir = Fcygwin_convert_file_name_to_windows (current_dir, Qt);
6433 if (STRINGP (document))
6434 document = Fcygwin_convert_file_name_to_windows (document, Qt);
6435 #endif /* CYGWIN */
6437 current_dir = GUI_ENCODE_FILE (current_dir);
6438 if (STRINGP (document))
6439 document = GUI_ENCODE_FILE (document);
6440 if (STRINGP (parameters))
6441 parameters = GUI_ENCODE_SYSTEM (parameters);
6443 if ((int) GUI_FN (ShellExecute) (NULL,
6444 (STRINGP (operation) ?
6445 GUI_SDATA (operation) : NULL),
6446 GUI_SDATA (document),
6447 (STRINGP (parameters) ?
6448 GUI_SDATA (parameters) : NULL),
6449 GUI_SDATA (current_dir),
6450 (INTEGERP (show_flag) ?
6451 XINT (show_flag) : SW_SHOWDEFAULT))
6452 > 32)
6453 return Qt;
6454 errstr = w32_strerror (0);
6455 /* The error string might be encoded in the locale's encoding. */
6456 if (!NILP (Vlocale_coding_system))
6458 Lisp_Object decoded =
6459 code_convert_string_norecord (build_unibyte_string (errstr),
6460 Vlocale_coding_system, 0);
6461 errstr = SSDATA (decoded);
6463 error ("ShellExecute failed: %s", errstr);
6466 /* Lookup virtual keycode from string representing the name of a
6467 non-ascii keystroke into the corresponding virtual key, using
6468 lispy_function_keys. */
6469 static int
6470 lookup_vk_code (char *key)
6472 int i;
6474 for (i = 0; i < 256; i++)
6475 if (lispy_function_keys[i]
6476 && strcmp (lispy_function_keys[i], key) == 0)
6477 return i;
6479 return -1;
6482 /* Convert a one-element vector style key sequence to a hot key
6483 definition. */
6484 static Lisp_Object
6485 w32_parse_hot_key (Lisp_Object key)
6487 /* Copied from Fdefine_key and store_in_keymap. */
6488 register Lisp_Object c;
6489 int vk_code;
6490 int lisp_modifiers;
6491 int w32_modifiers;
6492 struct gcpro gcpro1;
6494 CHECK_VECTOR (key);
6496 if (ASIZE (key) != 1)
6497 return Qnil;
6499 GCPRO1 (key);
6501 c = AREF (key, 0);
6503 if (CONSP (c) && lucid_event_type_list_p (c))
6504 c = Fevent_convert_list (c);
6506 UNGCPRO;
6508 if (! INTEGERP (c) && ! SYMBOLP (c))
6509 error ("Key definition is invalid");
6511 /* Work out the base key and the modifiers. */
6512 if (SYMBOLP (c))
6514 c = parse_modifiers (c);
6515 lisp_modifiers = XINT (Fcar (Fcdr (c)));
6516 c = Fcar (c);
6517 if (!SYMBOLP (c))
6518 emacs_abort ();
6519 vk_code = lookup_vk_code (SDATA (SYMBOL_NAME (c)));
6521 else if (INTEGERP (c))
6523 lisp_modifiers = XINT (c) & ~CHARACTERBITS;
6524 /* Many ascii characters are their own virtual key code. */
6525 vk_code = XINT (c) & CHARACTERBITS;
6528 if (vk_code < 0 || vk_code > 255)
6529 return Qnil;
6531 if ((lisp_modifiers & meta_modifier) != 0
6532 && !NILP (Vw32_alt_is_meta))
6533 lisp_modifiers |= alt_modifier;
6535 /* Supply defs missing from mingw32. */
6536 #ifndef MOD_ALT
6537 #define MOD_ALT 0x0001
6538 #define MOD_CONTROL 0x0002
6539 #define MOD_SHIFT 0x0004
6540 #define MOD_WIN 0x0008
6541 #endif
6543 /* Convert lisp modifiers to Windows hot-key form. */
6544 w32_modifiers = (lisp_modifiers & hyper_modifier) ? MOD_WIN : 0;
6545 w32_modifiers |= (lisp_modifiers & alt_modifier) ? MOD_ALT : 0;
6546 w32_modifiers |= (lisp_modifiers & ctrl_modifier) ? MOD_CONTROL : 0;
6547 w32_modifiers |= (lisp_modifiers & shift_modifier) ? MOD_SHIFT : 0;
6549 return HOTKEY (vk_code, w32_modifiers);
6552 DEFUN ("w32-register-hot-key", Fw32_register_hot_key,
6553 Sw32_register_hot_key, 1, 1, 0,
6554 doc: /* Register KEY as a hot-key combination.
6555 Certain key combinations like Alt-Tab are reserved for system use on
6556 Windows, and therefore are normally intercepted by the system. However,
6557 most of these key combinations can be received by registering them as
6558 hot-keys, overriding their special meaning.
6560 KEY must be a one element key definition in vector form that would be
6561 acceptable to `define-key' (e.g. [A-tab] for Alt-Tab). The meta
6562 modifier is interpreted as Alt if `w32-alt-is-meta' is t, and hyper
6563 is always interpreted as the Windows modifier keys.
6565 The return value is the hotkey-id if registered, otherwise nil. */)
6566 (Lisp_Object key)
6568 key = w32_parse_hot_key (key);
6570 if (!NILP (key) && NILP (Fmemq (key, w32_grabbed_keys)))
6572 /* Reuse an empty slot if possible. */
6573 Lisp_Object item = Fmemq (Qnil, w32_grabbed_keys);
6575 /* Safe to add new key to list, even if we have focus. */
6576 if (NILP (item))
6577 w32_grabbed_keys = Fcons (key, w32_grabbed_keys);
6578 else
6579 XSETCAR (item, key);
6581 /* Notify input thread about new hot-key definition, so that it
6582 takes effect without needing to switch focus. */
6583 PostThreadMessage (dwWindowsThreadId, WM_EMACS_REGISTER_HOT_KEY,
6584 (WPARAM) XLI (key), 0);
6587 return key;
6590 DEFUN ("w32-unregister-hot-key", Fw32_unregister_hot_key,
6591 Sw32_unregister_hot_key, 1, 1, 0,
6592 doc: /* Unregister KEY as a hot-key combination. */)
6593 (Lisp_Object key)
6595 Lisp_Object item;
6597 if (!INTEGERP (key))
6598 key = w32_parse_hot_key (key);
6600 item = Fmemq (key, w32_grabbed_keys);
6602 if (!NILP (item))
6604 /* Notify input thread about hot-key definition being removed, so
6605 that it takes effect without needing focus switch. */
6606 if (PostThreadMessage (dwWindowsThreadId, WM_EMACS_UNREGISTER_HOT_KEY,
6607 (WPARAM) XINT (XCAR (item)), (LPARAM) XLI (item)))
6609 MSG msg;
6610 GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE);
6612 return Qt;
6614 return Qnil;
6617 DEFUN ("w32-registered-hot-keys", Fw32_registered_hot_keys,
6618 Sw32_registered_hot_keys, 0, 0, 0,
6619 doc: /* Return list of registered hot-key IDs. */)
6620 (void)
6622 return Fdelq (Qnil, Fcopy_sequence (w32_grabbed_keys));
6625 DEFUN ("w32-reconstruct-hot-key", Fw32_reconstruct_hot_key,
6626 Sw32_reconstruct_hot_key, 1, 1, 0,
6627 doc: /* Convert hot-key ID to a lisp key combination.
6628 usage: (w32-reconstruct-hot-key ID) */)
6629 (Lisp_Object hotkeyid)
6631 int vk_code, w32_modifiers;
6632 Lisp_Object key;
6634 CHECK_NUMBER (hotkeyid);
6636 vk_code = HOTKEY_VK_CODE (hotkeyid);
6637 w32_modifiers = HOTKEY_MODIFIERS (hotkeyid);
6639 if (vk_code < 256 && lispy_function_keys[vk_code])
6640 key = intern (lispy_function_keys[vk_code]);
6641 else
6642 key = make_number (vk_code);
6644 key = Fcons (key, Qnil);
6645 if (w32_modifiers & MOD_SHIFT)
6646 key = Fcons (Qshift, key);
6647 if (w32_modifiers & MOD_CONTROL)
6648 key = Fcons (Qctrl, key);
6649 if (w32_modifiers & MOD_ALT)
6650 key = Fcons (NILP (Vw32_alt_is_meta) ? Qalt : Qmeta, key);
6651 if (w32_modifiers & MOD_WIN)
6652 key = Fcons (Qhyper, key);
6654 return key;
6657 DEFUN ("w32-toggle-lock-key", Fw32_toggle_lock_key,
6658 Sw32_toggle_lock_key, 1, 2, 0,
6659 doc: /* Toggle the state of the lock key KEY.
6660 KEY can be `capslock', `kp-numlock', or `scroll'.
6661 If the optional parameter NEW-STATE is a number, then the state of KEY
6662 is set to off if the low bit of NEW-STATE is zero, otherwise on. */)
6663 (Lisp_Object key, Lisp_Object new_state)
6665 int vk_code;
6667 if (EQ (key, intern ("capslock")))
6668 vk_code = VK_CAPITAL;
6669 else if (EQ (key, intern ("kp-numlock")))
6670 vk_code = VK_NUMLOCK;
6671 else if (EQ (key, intern ("scroll")))
6672 vk_code = VK_SCROLL;
6673 else
6674 return Qnil;
6676 if (!dwWindowsThreadId)
6677 return make_number (w32_console_toggle_lock_key (vk_code, new_state));
6679 if (PostThreadMessage (dwWindowsThreadId, WM_EMACS_TOGGLE_LOCK_KEY,
6680 (WPARAM) vk_code, (LPARAM) XLI (new_state)))
6682 MSG msg;
6683 GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE);
6684 return make_number (msg.wParam);
6686 return Qnil;
6689 DEFUN ("w32-window-exists-p", Fw32_window_exists_p, Sw32_window_exists_p,
6690 2, 2, 0,
6691 doc: /* Return non-nil if a window exists with the specified CLASS and NAME.
6693 This is a direct interface to the Windows API FindWindow function. */)
6694 (Lisp_Object class, Lisp_Object name)
6696 HWND hnd;
6698 if (!NILP (class))
6699 CHECK_STRING (class);
6700 if (!NILP (name))
6701 CHECK_STRING (name);
6703 hnd = FindWindow (STRINGP (class) ? ((LPCTSTR) SDATA (class)) : NULL,
6704 STRINGP (name) ? ((LPCTSTR) SDATA (name)) : NULL);
6705 if (!hnd)
6706 return Qnil;
6707 return Qt;
6710 DEFUN ("w32-battery-status", Fw32_battery_status, Sw32_battery_status, 0, 0, 0,
6711 doc: /* Get power status information from Windows system.
6713 The following %-sequences are provided:
6714 %L AC line status (verbose)
6715 %B Battery status (verbose)
6716 %b Battery status, empty means high, `-' means low,
6717 `!' means critical, and `+' means charging
6718 %p Battery load percentage
6719 %s Remaining time (to charge or discharge) in seconds
6720 %m Remaining time (to charge or discharge) in minutes
6721 %h Remaining time (to charge or discharge) in hours
6722 %t Remaining time (to charge or discharge) in the form `h:min' */)
6723 (void)
6725 Lisp_Object status = Qnil;
6727 SYSTEM_POWER_STATUS system_status;
6728 if (GetSystemPowerStatus (&system_status))
6730 Lisp_Object line_status, battery_status, battery_status_symbol;
6731 Lisp_Object load_percentage, seconds, minutes, hours, remain;
6733 long seconds_left = (long) system_status.BatteryLifeTime;
6735 if (system_status.ACLineStatus == 0)
6736 line_status = build_string ("off-line");
6737 else if (system_status.ACLineStatus == 1)
6738 line_status = build_string ("on-line");
6739 else
6740 line_status = build_string ("N/A");
6742 if (system_status.BatteryFlag & 128)
6744 battery_status = build_string ("N/A");
6745 battery_status_symbol = empty_unibyte_string;
6747 else if (system_status.BatteryFlag & 8)
6749 battery_status = build_string ("charging");
6750 battery_status_symbol = build_string ("+");
6751 if (system_status.BatteryFullLifeTime != -1L)
6752 seconds_left = system_status.BatteryFullLifeTime - seconds_left;
6754 else if (system_status.BatteryFlag & 4)
6756 battery_status = build_string ("critical");
6757 battery_status_symbol = build_string ("!");
6759 else if (system_status.BatteryFlag & 2)
6761 battery_status = build_string ("low");
6762 battery_status_symbol = build_string ("-");
6764 else if (system_status.BatteryFlag & 1)
6766 battery_status = build_string ("high");
6767 battery_status_symbol = empty_unibyte_string;
6769 else
6771 battery_status = build_string ("medium");
6772 battery_status_symbol = empty_unibyte_string;
6775 if (system_status.BatteryLifePercent > 100)
6776 load_percentage = build_string ("N/A");
6777 else
6779 char buffer[16];
6780 snprintf (buffer, 16, "%d", system_status.BatteryLifePercent);
6781 load_percentage = build_string (buffer);
6784 if (seconds_left < 0)
6785 seconds = minutes = hours = remain = build_string ("N/A");
6786 else
6788 long m;
6789 float h;
6790 char buffer[16];
6791 snprintf (buffer, 16, "%ld", seconds_left);
6792 seconds = build_string (buffer);
6794 m = seconds_left / 60;
6795 snprintf (buffer, 16, "%ld", m);
6796 minutes = build_string (buffer);
6798 h = seconds_left / 3600.0;
6799 snprintf (buffer, 16, "%3.1f", h);
6800 hours = build_string (buffer);
6802 snprintf (buffer, 16, "%ld:%02ld", m / 60, m % 60);
6803 remain = build_string (buffer);
6806 status = listn (CONSTYPE_HEAP, 8,
6807 Fcons (make_number ('L'), line_status),
6808 Fcons (make_number ('B'), battery_status),
6809 Fcons (make_number ('b'), battery_status_symbol),
6810 Fcons (make_number ('p'), load_percentage),
6811 Fcons (make_number ('s'), seconds),
6812 Fcons (make_number ('m'), minutes),
6813 Fcons (make_number ('h'), hours),
6814 Fcons (make_number ('t'), remain));
6816 return status;
6820 #ifdef WINDOWSNT
6821 DEFUN ("file-system-info", Ffile_system_info, Sfile_system_info, 1, 1, 0,
6822 doc: /* Return storage information about the file system FILENAME is on.
6823 Value is a list of floats (TOTAL FREE AVAIL), where TOTAL is the total
6824 storage of the file system, FREE is the free storage, and AVAIL is the
6825 storage available to a non-superuser. All 3 numbers are in bytes.
6826 If the underlying system call fails, value is nil. */)
6827 (Lisp_Object filename)
6829 Lisp_Object encoded, value;
6831 CHECK_STRING (filename);
6832 filename = Fexpand_file_name (filename, Qnil);
6833 encoded = ENCODE_FILE (filename);
6835 value = Qnil;
6837 /* Determining the required information on Windows turns out, sadly,
6838 to be more involved than one would hope. The original Windows API
6839 call for this will return bogus information on some systems, but we
6840 must dynamically probe for the replacement api, since that was
6841 added rather late on. */
6843 HMODULE hKernel = GetModuleHandle ("kernel32");
6844 BOOL (*pfn_GetDiskFreeSpaceEx)
6845 (char *, PULARGE_INTEGER, PULARGE_INTEGER, PULARGE_INTEGER)
6846 = (void *) GetProcAddress (hKernel, "GetDiskFreeSpaceEx");
6848 /* On Windows, we may need to specify the root directory of the
6849 volume holding FILENAME. */
6850 char rootname[MAX_PATH];
6851 char *name = SDATA (encoded);
6853 /* find the root name of the volume if given */
6854 if (isalpha (name[0]) && name[1] == ':')
6856 rootname[0] = name[0];
6857 rootname[1] = name[1];
6858 rootname[2] = '\\';
6859 rootname[3] = 0;
6861 else if (IS_DIRECTORY_SEP (name[0]) && IS_DIRECTORY_SEP (name[1]))
6863 char *str = rootname;
6864 int slashes = 4;
6867 if (IS_DIRECTORY_SEP (*name) && --slashes == 0)
6868 break;
6869 *str++ = *name++;
6871 while ( *name );
6873 *str++ = '\\';
6874 *str = 0;
6877 if (pfn_GetDiskFreeSpaceEx)
6879 /* Unsigned large integers cannot be cast to double, so
6880 use signed ones instead. */
6881 LARGE_INTEGER availbytes;
6882 LARGE_INTEGER freebytes;
6883 LARGE_INTEGER totalbytes;
6885 if (pfn_GetDiskFreeSpaceEx (rootname,
6886 (ULARGE_INTEGER *)&availbytes,
6887 (ULARGE_INTEGER *)&totalbytes,
6888 (ULARGE_INTEGER *)&freebytes))
6889 value = list3 (make_float ((double) totalbytes.QuadPart),
6890 make_float ((double) freebytes.QuadPart),
6891 make_float ((double) availbytes.QuadPart));
6893 else
6895 DWORD sectors_per_cluster;
6896 DWORD bytes_per_sector;
6897 DWORD free_clusters;
6898 DWORD total_clusters;
6900 if (GetDiskFreeSpace (rootname,
6901 &sectors_per_cluster,
6902 &bytes_per_sector,
6903 &free_clusters,
6904 &total_clusters))
6905 value = list3 (make_float ((double) total_clusters
6906 * sectors_per_cluster * bytes_per_sector),
6907 make_float ((double) free_clusters
6908 * sectors_per_cluster * bytes_per_sector),
6909 make_float ((double) free_clusters
6910 * sectors_per_cluster * bytes_per_sector));
6914 return value;
6916 #endif /* WINDOWSNT */
6919 DEFUN ("default-printer-name", Fdefault_printer_name, Sdefault_printer_name,
6920 0, 0, 0, doc: /* Return the name of Windows default printer device. */)
6921 (void)
6923 static char pname_buf[256];
6924 int err;
6925 HANDLE hPrn;
6926 PRINTER_INFO_2 *ppi2 = NULL;
6927 DWORD dwNeeded = 0, dwReturned = 0;
6929 /* Retrieve the default string from Win.ini (the registry).
6930 * String will be in form "printername,drivername,portname".
6931 * This is the most portable way to get the default printer. */
6932 if (GetProfileString ("windows", "device", ",,", pname_buf, sizeof (pname_buf)) <= 0)
6933 return Qnil;
6934 /* printername precedes first "," character */
6935 strtok (pname_buf, ",");
6936 /* We want to know more than the printer name */
6937 if (!OpenPrinter (pname_buf, &hPrn, NULL))
6938 return Qnil;
6939 GetPrinter (hPrn, 2, NULL, 0, &dwNeeded);
6940 if (dwNeeded == 0)
6942 ClosePrinter (hPrn);
6943 return Qnil;
6945 /* Allocate memory for the PRINTER_INFO_2 struct */
6946 ppi2 = xmalloc (dwNeeded);
6947 if (!ppi2)
6949 ClosePrinter (hPrn);
6950 return Qnil;
6952 /* Call GetPrinter again with big enough memory block. */
6953 err = GetPrinter (hPrn, 2, (LPBYTE)ppi2, dwNeeded, &dwReturned);
6954 ClosePrinter (hPrn);
6955 if (!err)
6957 xfree (ppi2);
6958 return Qnil;
6961 if (ppi2)
6963 if (ppi2->Attributes & PRINTER_ATTRIBUTE_SHARED && ppi2->pServerName)
6965 /* a remote printer */
6966 if (*ppi2->pServerName == '\\')
6967 snprintf (pname_buf, sizeof (pname_buf), "%s\\%s", ppi2->pServerName,
6968 ppi2->pShareName);
6969 else
6970 snprintf (pname_buf, sizeof (pname_buf), "\\\\%s\\%s", ppi2->pServerName,
6971 ppi2->pShareName);
6972 pname_buf[sizeof (pname_buf) - 1] = '\0';
6974 else
6976 /* a local printer */
6977 strncpy (pname_buf, ppi2->pPortName, sizeof (pname_buf));
6978 pname_buf[sizeof (pname_buf) - 1] = '\0';
6979 /* `pPortName' can include several ports, delimited by ','.
6980 * we only use the first one. */
6981 strtok (pname_buf, ",");
6983 xfree (ppi2);
6986 return build_string (pname_buf);
6990 /* Equivalent of strerror for W32 error codes. */
6991 char *
6992 w32_strerror (int error_no)
6994 static char buf[500];
6995 DWORD ret;
6997 if (error_no == 0)
6998 error_no = GetLastError ();
7000 ret = FormatMessage (FORMAT_MESSAGE_FROM_SYSTEM |
7001 FORMAT_MESSAGE_IGNORE_INSERTS,
7002 NULL,
7003 error_no,
7004 0, /* choose most suitable language */
7005 buf, sizeof (buf), NULL);
7007 while (ret > 0 && (buf[ret - 1] == '\n' ||
7008 buf[ret - 1] == '\r' ))
7009 --ret;
7010 buf[ret] = '\0';
7011 if (!ret)
7012 sprintf (buf, "w32 error %u", error_no);
7014 return buf;
7017 /* For convenience when debugging. (You cannot call GetLastError
7018 directly from GDB: it will crash, because it uses the __stdcall
7019 calling convention, not the _cdecl convention assumed by GDB.) */
7020 DWORD
7021 w32_last_error (void)
7023 return GetLastError ();
7026 /* Cache information describing the NT system for later use. */
7027 void
7028 cache_system_info (void)
7030 union
7032 struct info
7034 char major;
7035 char minor;
7036 short platform;
7037 } info;
7038 DWORD data;
7039 } version;
7041 /* Cache the module handle of Emacs itself. */
7042 hinst = GetModuleHandle (NULL);
7044 /* Cache the version of the operating system. */
7045 version.data = GetVersion ();
7046 w32_major_version = version.info.major;
7047 w32_minor_version = version.info.minor;
7049 if (version.info.platform & 0x8000)
7050 os_subtype = OS_9X;
7051 else
7052 os_subtype = OS_NT;
7054 /* Cache page size, allocation unit, processor type, etc. */
7055 GetSystemInfo (&sysinfo_cache);
7056 syspage_mask = (DWORD_PTR)sysinfo_cache.dwPageSize - 1;
7058 /* Cache os info. */
7059 osinfo_cache.dwOSVersionInfoSize = sizeof (OSVERSIONINFO);
7060 GetVersionEx (&osinfo_cache);
7062 w32_build_number = osinfo_cache.dwBuildNumber;
7063 if (os_subtype == OS_9X)
7064 w32_build_number &= 0xffff;
7066 w32_num_mouse_buttons = GetSystemMetrics (SM_CMOUSEBUTTONS);
7069 #ifdef EMACSDEBUG
7070 void
7071 _DebPrint (const char *fmt, ...)
7073 char buf[1024];
7074 va_list args;
7076 va_start (args, fmt);
7077 vsprintf (buf, fmt, args);
7078 va_end (args);
7079 #if CYGWIN
7080 fprintf (stderr, "%s", buf);
7081 #endif
7082 OutputDebugString (buf);
7084 #endif
7087 w32_console_toggle_lock_key (int vk_code, Lisp_Object new_state)
7089 int cur_state = (GetKeyState (vk_code) & 1);
7091 if (NILP (new_state)
7092 || (NUMBERP (new_state)
7093 && ((XUINT (new_state)) & 1) != cur_state))
7095 #ifdef WINDOWSNT
7096 faked_key = vk_code;
7097 #endif /* WINDOWSNT */
7099 keybd_event ((BYTE) vk_code,
7100 (BYTE) MapVirtualKey (vk_code, 0),
7101 KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
7102 keybd_event ((BYTE) vk_code,
7103 (BYTE) MapVirtualKey (vk_code, 0),
7104 KEYEVENTF_EXTENDEDKEY | 0, 0);
7105 keybd_event ((BYTE) vk_code,
7106 (BYTE) MapVirtualKey (vk_code, 0),
7107 KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
7108 cur_state = !cur_state;
7111 return cur_state;
7114 /* Translate console modifiers to emacs modifiers.
7115 German keyboard support (Kai Morgan Zeise 2/18/95). */
7117 w32_kbd_mods_to_emacs (DWORD mods, WORD key)
7119 int retval = 0;
7121 /* If we recognize right-alt and left-ctrl as AltGr, and it has been
7122 pressed, first remove those modifiers. */
7123 if (!NILP (Vw32_recognize_altgr)
7124 && (mods & (RIGHT_ALT_PRESSED | LEFT_CTRL_PRESSED))
7125 == (RIGHT_ALT_PRESSED | LEFT_CTRL_PRESSED))
7126 mods &= ~ (RIGHT_ALT_PRESSED | LEFT_CTRL_PRESSED);
7128 if (mods & (RIGHT_ALT_PRESSED | LEFT_ALT_PRESSED))
7129 retval = ((NILP (Vw32_alt_is_meta)) ? alt_modifier : meta_modifier);
7131 if (mods & (RIGHT_CTRL_PRESSED | LEFT_CTRL_PRESSED))
7133 retval |= ctrl_modifier;
7134 if ((mods & (RIGHT_CTRL_PRESSED | LEFT_CTRL_PRESSED))
7135 == (RIGHT_CTRL_PRESSED | LEFT_CTRL_PRESSED))
7136 retval |= meta_modifier;
7139 if (mods & LEFT_WIN_PRESSED)
7140 retval |= w32_key_to_modifier (VK_LWIN);
7141 if (mods & RIGHT_WIN_PRESSED)
7142 retval |= w32_key_to_modifier (VK_RWIN);
7143 if (mods & APPS_PRESSED)
7144 retval |= w32_key_to_modifier (VK_APPS);
7145 if (mods & SCROLLLOCK_ON)
7146 retval |= w32_key_to_modifier (VK_SCROLL);
7148 /* Just in case someone wanted the original behavior, make it
7149 optional by setting w32-capslock-is-shiftlock to t. */
7150 if (NILP (Vw32_capslock_is_shiftlock)
7151 /* Keys that should _not_ be affected by CapsLock. */
7152 && ( (key == VK_BACK)
7153 || (key == VK_TAB)
7154 || (key == VK_CLEAR)
7155 || (key == VK_RETURN)
7156 || (key == VK_ESCAPE)
7157 || ((key >= VK_SPACE) && (key <= VK_HELP))
7158 || ((key >= VK_NUMPAD0) && (key <= VK_F24))
7159 || ((key >= VK_NUMPAD_CLEAR) && (key <= VK_NUMPAD_DELETE))
7162 /* Only consider shift state. */
7163 if ((mods & SHIFT_PRESSED) != 0)
7164 retval |= shift_modifier;
7166 else
7168 /* Ignore CapsLock state if not enabled. */
7169 if (NILP (Vw32_enable_caps_lock))
7170 mods &= ~CAPSLOCK_ON;
7171 if ((mods & (SHIFT_PRESSED | CAPSLOCK_ON)) != 0)
7172 retval |= shift_modifier;
7175 return retval;
7178 /* The return code indicates key code size. cpID is the codepage to
7179 use for translation to Unicode; -1 means use the current console
7180 input codepage. */
7182 w32_kbd_patch_key (KEY_EVENT_RECORD *event, int cpId)
7184 unsigned int key_code = event->wVirtualKeyCode;
7185 unsigned int mods = event->dwControlKeyState;
7186 BYTE keystate[256];
7187 static BYTE ansi_code[4];
7188 static int isdead = 0;
7190 if (isdead == 2)
7192 event->uChar.AsciiChar = ansi_code[2];
7193 isdead = 0;
7194 return 1;
7196 if (event->uChar.AsciiChar != 0)
7197 return 1;
7199 memset (keystate, 0, sizeof (keystate));
7200 keystate[key_code] = 0x80;
7201 if (mods & SHIFT_PRESSED)
7202 keystate[VK_SHIFT] = 0x80;
7203 if (mods & CAPSLOCK_ON)
7204 keystate[VK_CAPITAL] = 1;
7205 /* If we recognize right-alt and left-ctrl as AltGr, set the key
7206 states accordingly before invoking ToAscii. */
7207 if (!NILP (Vw32_recognize_altgr)
7208 && (mods & LEFT_CTRL_PRESSED) && (mods & RIGHT_ALT_PRESSED))
7210 keystate[VK_CONTROL] = 0x80;
7211 keystate[VK_LCONTROL] = 0x80;
7212 keystate[VK_MENU] = 0x80;
7213 keystate[VK_RMENU] = 0x80;
7216 #if 0
7217 /* Because of an OS bug, ToAscii corrupts the stack when called to
7218 convert a dead key in console mode on NT4. Unfortunately, trying
7219 to check for dead keys using MapVirtualKey doesn't work either -
7220 these functions apparently use internal information about keyboard
7221 layout which doesn't get properly updated in console programs when
7222 changing layout (though apparently it gets partly updated,
7223 otherwise ToAscii wouldn't crash). */
7224 if (is_dead_key (event->wVirtualKeyCode))
7225 return 0;
7226 #endif
7228 /* On NT, call ToUnicode instead and then convert to the current
7229 console input codepage. */
7230 if (os_subtype == OS_NT)
7232 WCHAR buf[128];
7234 isdead = ToUnicode (event->wVirtualKeyCode, event->wVirtualScanCode,
7235 keystate, buf, 128, 0);
7236 if (isdead > 0)
7238 /* When we are called from the GUI message processing code,
7239 we are passed the current keyboard codepage, a positive
7240 number, to use below. */
7241 if (cpId == -1)
7242 cpId = GetConsoleCP ();
7244 event->uChar.UnicodeChar = buf[isdead - 1];
7245 isdead = WideCharToMultiByte (cpId, 0, buf, isdead,
7246 ansi_code, 4, NULL, NULL);
7248 else
7249 isdead = 0;
7251 else
7253 isdead = ToAscii (event->wVirtualKeyCode, event->wVirtualScanCode,
7254 keystate, (LPWORD) ansi_code, 0);
7257 if (isdead == 0)
7258 return 0;
7259 event->uChar.AsciiChar = ansi_code[0];
7260 return isdead;
7264 void
7265 w32_sys_ring_bell (struct frame *f)
7267 if (sound_type == 0xFFFFFFFF)
7269 Beep (666, 100);
7271 else if (sound_type == MB_EMACS_SILENT)
7273 /* Do nothing. */
7275 else
7276 MessageBeep (sound_type);
7280 /***********************************************************************
7281 Initialization
7282 ***********************************************************************/
7284 /* Keep this list in the same order as frame_parms in frame.c.
7285 Use 0 for unsupported frame parameters. */
7287 frame_parm_handler w32_frame_parm_handlers[] =
7289 x_set_autoraise,
7290 x_set_autolower,
7291 x_set_background_color,
7292 x_set_border_color,
7293 x_set_border_width,
7294 x_set_cursor_color,
7295 x_set_cursor_type,
7296 x_set_font,
7297 x_set_foreground_color,
7298 x_set_icon_name,
7299 x_set_icon_type,
7300 x_set_internal_border_width,
7301 x_set_menu_bar_lines,
7302 x_set_mouse_color,
7303 x_explicitly_set_name,
7304 x_set_scroll_bar_width,
7305 x_set_title,
7306 x_set_unsplittable,
7307 x_set_vertical_scroll_bars,
7308 x_set_visibility,
7309 x_set_tool_bar_lines,
7310 0, /* x_set_scroll_bar_foreground, */
7311 0, /* x_set_scroll_bar_background, */
7312 x_set_screen_gamma,
7313 x_set_line_spacing,
7314 x_set_fringe_width,
7315 x_set_fringe_width,
7316 0, /* x_set_wait_for_wm, */
7317 x_set_fullscreen,
7318 x_set_font_backend,
7319 x_set_alpha,
7320 0, /* x_set_sticky */
7321 0, /* x_set_tool_bar_position */
7324 void
7325 syms_of_w32fns (void)
7327 globals_of_w32fns ();
7328 track_mouse_window = NULL;
7330 w32_visible_system_caret_hwnd = NULL;
7332 DEFSYM (Qsuppress_icon, "suppress-icon");
7333 DEFSYM (Qundefined_color, "undefined-color");
7334 DEFSYM (Qcancel_timer, "cancel-timer");
7335 DEFSYM (Qhyper, "hyper");
7336 DEFSYM (Qsuper, "super");
7337 DEFSYM (Qmeta, "meta");
7338 DEFSYM (Qalt, "alt");
7339 DEFSYM (Qctrl, "ctrl");
7340 DEFSYM (Qcontrol, "control");
7341 DEFSYM (Qshift, "shift");
7342 DEFSYM (Qfont_param, "font-parameter");
7343 /* This is the end of symbol initialization. */
7346 Fput (Qundefined_color, Qerror_conditions,
7347 listn (CONSTYPE_PURE, 2, Qundefined_color, Qerror));
7348 Fput (Qundefined_color, Qerror_message,
7349 build_pure_c_string ("Undefined color"));
7351 staticpro (&w32_grabbed_keys);
7352 w32_grabbed_keys = Qnil;
7354 DEFVAR_LISP ("w32-color-map", Vw32_color_map,
7355 doc: /* An array of color name mappings for Windows. */);
7356 Vw32_color_map = Qnil;
7358 DEFVAR_LISP ("w32-pass-alt-to-system", Vw32_pass_alt_to_system,
7359 doc: /* Non-nil if Alt key presses are passed on to Windows.
7360 When non-nil, for example, Alt pressed and released and then space will
7361 open the System menu. When nil, Emacs processes the Alt key events, and
7362 then silently swallows them. */);
7363 Vw32_pass_alt_to_system = Qnil;
7365 DEFVAR_LISP ("w32-alt-is-meta", Vw32_alt_is_meta,
7366 doc: /* Non-nil if the Alt key is to be considered the same as the META key.
7367 When nil, Emacs will translate the Alt key to the ALT modifier, not to META. */);
7368 Vw32_alt_is_meta = Qt;
7370 DEFVAR_INT ("w32-quit-key", w32_quit_key,
7371 doc: /* If non-zero, the virtual key code for an alternative quit key. */);
7372 w32_quit_key = 0;
7374 DEFVAR_LISP ("w32-pass-lwindow-to-system",
7375 Vw32_pass_lwindow_to_system,
7376 doc: /* If non-nil, the left \"Windows\" key is passed on to Windows.
7378 When non-nil, the Start menu is opened by tapping the key.
7379 If you set this to nil, the left \"Windows\" key is processed by Emacs
7380 according to the value of `w32-lwindow-modifier', which see.
7382 Note that some combinations of the left \"Windows\" key with other keys are
7383 caught by Windows at low level, and so binding them in Emacs will have no
7384 effect. For example, <lwindow>-r always pops up the Windows Run dialog,
7385 <lwindow>-<Pause> pops up the "System Properties" dialog, etc. However, see
7386 the doc string of `w32-phantom-key-code'. */);
7387 Vw32_pass_lwindow_to_system = Qt;
7389 DEFVAR_LISP ("w32-pass-rwindow-to-system",
7390 Vw32_pass_rwindow_to_system,
7391 doc: /* If non-nil, the right \"Windows\" key is passed on to Windows.
7393 When non-nil, the Start menu is opened by tapping the key.
7394 If you set this to nil, the right \"Windows\" key is processed by Emacs
7395 according to the value of `w32-rwindow-modifier', which see.
7397 Note that some combinations of the right \"Windows\" key with other keys are
7398 caught by Windows at low level, and so binding them in Emacs will have no
7399 effect. For example, <rwindow>-r always pops up the Windows Run dialog,
7400 <rwindow>-<Pause> pops up the "System Properties" dialog, etc. However, see
7401 the doc string of `w32-phantom-key-code'. */);
7402 Vw32_pass_rwindow_to_system = Qt;
7404 DEFVAR_LISP ("w32-phantom-key-code",
7405 Vw32_phantom_key_code,
7406 doc: /* Virtual key code used to generate \"phantom\" key presses.
7407 Value is a number between 0 and 255.
7409 Phantom key presses are generated in order to stop the system from
7410 acting on \"Windows\" key events when `w32-pass-lwindow-to-system' or
7411 `w32-pass-rwindow-to-system' is nil. */);
7412 /* Although 255 is technically not a valid key code, it works and
7413 means that this hack won't interfere with any real key code. */
7414 XSETINT (Vw32_phantom_key_code, 255);
7416 DEFVAR_LISP ("w32-enable-num-lock",
7417 Vw32_enable_num_lock,
7418 doc: /* If non-nil, the Num Lock key acts normally.
7419 Set to nil to handle Num Lock as the `kp-numlock' key. */);
7420 Vw32_enable_num_lock = Qt;
7422 DEFVAR_LISP ("w32-enable-caps-lock",
7423 Vw32_enable_caps_lock,
7424 doc: /* If non-nil, the Caps Lock key acts normally.
7425 Set to nil to handle Caps Lock as the `capslock' key. */);
7426 Vw32_enable_caps_lock = Qt;
7428 DEFVAR_LISP ("w32-scroll-lock-modifier",
7429 Vw32_scroll_lock_modifier,
7430 doc: /* Modifier to use for the Scroll Lock ON state.
7431 The value can be hyper, super, meta, alt, control or shift for the
7432 respective modifier, or nil to handle Scroll Lock as the `scroll' key.
7433 Any other value will cause the Scroll Lock key to be ignored. */);
7434 Vw32_scroll_lock_modifier = Qnil;
7436 DEFVAR_LISP ("w32-lwindow-modifier",
7437 Vw32_lwindow_modifier,
7438 doc: /* Modifier to use for the left \"Windows\" key.
7439 The value can be hyper, super, meta, alt, control or shift for the
7440 respective modifier, or nil to appear as the `lwindow' key.
7441 Any other value will cause the key to be ignored. */);
7442 Vw32_lwindow_modifier = Qnil;
7444 DEFVAR_LISP ("w32-rwindow-modifier",
7445 Vw32_rwindow_modifier,
7446 doc: /* Modifier to use for the right \"Windows\" key.
7447 The value can be hyper, super, meta, alt, control or shift for the
7448 respective modifier, or nil to appear as the `rwindow' key.
7449 Any other value will cause the key to be ignored. */);
7450 Vw32_rwindow_modifier = Qnil;
7452 DEFVAR_LISP ("w32-apps-modifier",
7453 Vw32_apps_modifier,
7454 doc: /* Modifier to use for the \"Apps\" key.
7455 The value can be hyper, super, meta, alt, control or shift for the
7456 respective modifier, or nil to appear as the `apps' key.
7457 Any other value will cause the key to be ignored. */);
7458 Vw32_apps_modifier = Qnil;
7460 DEFVAR_BOOL ("w32-enable-synthesized-fonts", w32_enable_synthesized_fonts,
7461 doc: /* Non-nil enables selection of artificially italicized and bold fonts. */);
7462 w32_enable_synthesized_fonts = 0;
7464 DEFVAR_LISP ("w32-enable-palette", Vw32_enable_palette,
7465 doc: /* Non-nil enables Windows palette management to map colors exactly. */);
7466 Vw32_enable_palette = Qt;
7468 DEFVAR_INT ("w32-mouse-button-tolerance",
7469 w32_mouse_button_tolerance,
7470 doc: /* Analogue of double click interval for faking middle mouse events.
7471 The value is the minimum time in milliseconds that must elapse between
7472 left and right button down events before they are considered distinct events.
7473 If both mouse buttons are depressed within this interval, a middle mouse
7474 button down event is generated instead. */);
7475 w32_mouse_button_tolerance = GetDoubleClickTime () / 2;
7477 DEFVAR_INT ("w32-mouse-move-interval",
7478 w32_mouse_move_interval,
7479 doc: /* Minimum interval between mouse move events.
7480 The value is the minimum time in milliseconds that must elapse between
7481 successive mouse move (or scroll bar drag) events before they are
7482 reported as lisp events. */);
7483 w32_mouse_move_interval = 0;
7485 DEFVAR_BOOL ("w32-pass-extra-mouse-buttons-to-system",
7486 w32_pass_extra_mouse_buttons_to_system,
7487 doc: /* If non-nil, the fourth and fifth mouse buttons are passed to Windows.
7488 Recent versions of Windows support mice with up to five buttons.
7489 Since most applications don't support these extra buttons, most mouse
7490 drivers will allow you to map them to functions at the system level.
7491 If this variable is non-nil, Emacs will pass them on, allowing the
7492 system to handle them. */);
7493 w32_pass_extra_mouse_buttons_to_system = 0;
7495 DEFVAR_BOOL ("w32-pass-multimedia-buttons-to-system",
7496 w32_pass_multimedia_buttons_to_system,
7497 doc: /* If non-nil, media buttons are passed to Windows.
7498 Some modern keyboards contain buttons for controlling media players, web
7499 browsers and other applications. Generally these buttons are handled on a
7500 system wide basis, but by setting this to nil they are made available
7501 to Emacs for binding. Depending on your keyboard, additional keys that
7502 may be available are:
7504 browser-back, browser-forward, browser-refresh, browser-stop,
7505 browser-search, browser-favorites, browser-home,
7506 mail, mail-reply, mail-forward, mail-send,
7507 app-1, app-2,
7508 help, find, new, open, close, save, print, undo, redo, copy, cut, paste,
7509 spell-check, correction-list, toggle-dictate-command,
7510 media-next, media-previous, media-stop, media-play-pause, media-select,
7511 media-play, media-pause, media-record, media-fast-forward, media-rewind,
7512 media-channel-up, media-channel-down,
7513 volume-mute, volume-up, volume-down,
7514 mic-volume-mute, mic-volume-down, mic-volume-up, mic-toggle,
7515 bass-down, bass-boost, bass-up, treble-down, treble-up */);
7516 w32_pass_multimedia_buttons_to_system = 1;
7518 #if 0 /* TODO: Mouse cursor customization. */
7519 DEFVAR_LISP ("x-pointer-shape", Vx_pointer_shape,
7520 doc: /* The shape of the pointer when over text.
7521 Changing the value does not affect existing frames
7522 unless you set the mouse color. */);
7523 Vx_pointer_shape = Qnil;
7525 Vx_nontext_pointer_shape = Qnil;
7527 Vx_mode_pointer_shape = Qnil;
7529 DEFVAR_LISP ("x-hourglass-pointer-shape", Vx_hourglass_pointer_shape,
7530 doc: /* The shape of the pointer when Emacs is busy.
7531 This variable takes effect when you create a new frame
7532 or when you set the mouse color. */);
7533 Vx_hourglass_pointer_shape = Qnil;
7535 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
7536 Vx_sensitive_text_pointer_shape,
7537 doc: /* The shape of the pointer when over mouse-sensitive text.
7538 This variable takes effect when you create a new frame
7539 or when you set the mouse color. */);
7540 Vx_sensitive_text_pointer_shape = Qnil;
7542 DEFVAR_LISP ("x-window-horizontal-drag-cursor",
7543 Vx_window_horizontal_drag_shape,
7544 doc: /* Pointer shape to use for indicating a window can be dragged horizontally.
7545 This variable takes effect when you create a new frame
7546 or when you set the mouse color. */);
7547 Vx_window_horizontal_drag_shape = Qnil;
7548 #endif
7550 DEFVAR_LISP ("x-cursor-fore-pixel", Vx_cursor_fore_pixel,
7551 doc: /* A string indicating the foreground color of the cursor box. */);
7552 Vx_cursor_fore_pixel = Qnil;
7554 DEFVAR_LISP ("x-max-tooltip-size", Vx_max_tooltip_size,
7555 doc: /* Maximum size for tooltips.
7556 Value is a pair (COLUMNS . ROWS). Text larger than this is clipped. */);
7557 Vx_max_tooltip_size = Fcons (make_number (80), make_number (40));
7559 DEFVAR_LISP ("x-no-window-manager", Vx_no_window_manager,
7560 doc: /* Non-nil if no window manager is in use.
7561 Emacs doesn't try to figure this out; this is always nil
7562 unless you set it to something else. */);
7563 /* We don't have any way to find this out, so set it to nil
7564 and maybe the user would like to set it to t. */
7565 Vx_no_window_manager = Qnil;
7567 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
7568 Vx_pixel_size_width_font_regexp,
7569 doc: /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'.
7571 Since Emacs gets width of a font matching with this regexp from
7572 PIXEL_SIZE field of the name, font finding mechanism gets faster for
7573 such a font. This is especially effective for such large fonts as
7574 Chinese, Japanese, and Korean. */);
7575 Vx_pixel_size_width_font_regexp = Qnil;
7577 DEFVAR_LISP ("w32-bdf-filename-alist",
7578 Vw32_bdf_filename_alist,
7579 doc: /* List of bdf fonts and their corresponding filenames. */);
7580 Vw32_bdf_filename_alist = Qnil;
7582 DEFVAR_BOOL ("w32-strict-fontnames",
7583 w32_strict_fontnames,
7584 doc: /* Non-nil means only use fonts that are exact matches for those requested.
7585 Default is nil, which allows old fontnames that are not XLFD compliant,
7586 and allows third-party CJK display to work by specifying false charset
7587 fields to trick Emacs into translating to Big5, SJIS etc.
7588 Setting this to t will prevent wrong fonts being selected when
7589 fontsets are automatically created. */);
7590 w32_strict_fontnames = 0;
7592 DEFVAR_BOOL ("w32-strict-painting",
7593 w32_strict_painting,
7594 doc: /* Non-nil means use strict rules for repainting frames.
7595 Set this to nil to get the old behavior for repainting; this should
7596 only be necessary if the default setting causes problems. */);
7597 w32_strict_painting = 1;
7599 #if 0 /* TODO: Port to W32 */
7600 defsubr (&Sx_change_window_property);
7601 defsubr (&Sx_delete_window_property);
7602 defsubr (&Sx_window_property);
7603 #endif
7604 defsubr (&Sxw_display_color_p);
7605 defsubr (&Sx_display_grayscale_p);
7606 defsubr (&Sxw_color_defined_p);
7607 defsubr (&Sxw_color_values);
7608 defsubr (&Sx_server_max_request_size);
7609 defsubr (&Sx_server_vendor);
7610 defsubr (&Sx_server_version);
7611 defsubr (&Sx_display_pixel_width);
7612 defsubr (&Sx_display_pixel_height);
7613 defsubr (&Sx_display_mm_width);
7614 defsubr (&Sx_display_mm_height);
7615 defsubr (&Sx_display_screens);
7616 defsubr (&Sx_display_planes);
7617 defsubr (&Sx_display_color_cells);
7618 defsubr (&Sx_display_visual_class);
7619 defsubr (&Sx_display_backing_store);
7620 defsubr (&Sx_display_save_under);
7621 defsubr (&Sx_create_frame);
7622 defsubr (&Sx_open_connection);
7623 defsubr (&Sx_close_connection);
7624 defsubr (&Sx_display_list);
7625 defsubr (&Sx_synchronize);
7626 defsubr (&Sx_focus_frame);
7628 /* W32 specific functions */
7630 defsubr (&Sw32_define_rgb_color);
7631 defsubr (&Sw32_default_color_map);
7632 defsubr (&Sw32_send_sys_command);
7633 defsubr (&Sw32_shell_execute);
7634 defsubr (&Sw32_register_hot_key);
7635 defsubr (&Sw32_unregister_hot_key);
7636 defsubr (&Sw32_registered_hot_keys);
7637 defsubr (&Sw32_reconstruct_hot_key);
7638 defsubr (&Sw32_toggle_lock_key);
7639 defsubr (&Sw32_window_exists_p);
7640 defsubr (&Sw32_battery_status);
7642 #ifdef WINDOWSNT
7643 defsubr (&Sfile_system_info);
7644 #endif
7646 defsubr (&Sdefault_printer_name);
7647 defsubr (&Sset_message_beep);
7649 hourglass_hwnd = NULL;
7651 defsubr (&Sx_show_tip);
7652 defsubr (&Sx_hide_tip);
7653 tip_timer = Qnil;
7654 staticpro (&tip_timer);
7655 tip_frame = Qnil;
7656 staticpro (&tip_frame);
7658 last_show_tip_args = Qnil;
7659 staticpro (&last_show_tip_args);
7661 defsubr (&Sx_file_dialog);
7662 #ifdef WINDOWSNT
7663 defsubr (&Ssystem_move_file_to_trash);
7664 #endif
7669 globals_of_w32fns is used to initialize those global variables that
7670 must always be initialized on startup even when the global variable
7671 initialized is non zero (see the function main in emacs.c).
7672 globals_of_w32fns is called from syms_of_w32fns when the global
7673 variable initialized is 0 and directly from main when initialized
7674 is non zero.
7676 void
7677 globals_of_w32fns (void)
7679 HMODULE user32_lib = GetModuleHandle ("user32.dll");
7681 TrackMouseEvent not available in all versions of Windows, so must load
7682 it dynamically. Do it once, here, instead of every time it is used.
7684 track_mouse_event_fn = (TrackMouseEvent_Proc)
7685 GetProcAddress (user32_lib, "TrackMouseEvent");
7687 monitor_from_point_fn = (MonitorFromPoint_Proc)
7688 GetProcAddress (user32_lib, "MonitorFromPoint");
7689 get_monitor_info_fn = (GetMonitorInfo_Proc)
7690 GetProcAddress (user32_lib, "GetMonitorInfoA");
7691 monitor_from_window_fn = (MonitorFromWindow_Proc)
7692 GetProcAddress (user32_lib, "MonitorFromWindow");
7695 HMODULE imm32_lib = GetModuleHandle ("imm32.dll");
7696 get_composition_string_fn = (ImmGetCompositionString_Proc)
7697 GetProcAddress (imm32_lib, "ImmGetCompositionStringW");
7698 get_ime_context_fn = (ImmGetContext_Proc)
7699 GetProcAddress (imm32_lib, "ImmGetContext");
7700 release_ime_context_fn = (ImmReleaseContext_Proc)
7701 GetProcAddress (imm32_lib, "ImmReleaseContext");
7702 set_ime_composition_window_fn = (ImmSetCompositionWindow_Proc)
7703 GetProcAddress (imm32_lib, "ImmSetCompositionWindow");
7705 DEFVAR_INT ("w32-ansi-code-page",
7706 w32_ansi_code_page,
7707 doc: /* The ANSI code page used by the system. */);
7708 w32_ansi_code_page = GetACP ();
7710 if (os_subtype == OS_NT)
7711 w32_unicode_gui = 1;
7712 else
7713 w32_unicode_gui = 0;
7715 /* MessageBox does not work without this when linked to comctl32.dll 6.0. */
7716 InitCommonControls ();
7718 syms_of_w32uniscribe ();
7721 typedef USHORT (WINAPI * CaptureStackBackTrace_proc) (ULONG, ULONG, PVOID *,
7722 PULONG);
7724 #define BACKTRACE_LIMIT_MAX 62
7727 w32_backtrace (void **buffer, int limit)
7729 static CaptureStackBackTrace_proc s_pfn_CaptureStackBackTrace = NULL;
7730 HMODULE hm_kernel32 = NULL;
7732 if (!s_pfn_CaptureStackBackTrace)
7734 hm_kernel32 = LoadLibrary ("Kernel32.dll");
7735 s_pfn_CaptureStackBackTrace =
7736 (CaptureStackBackTrace_proc) GetProcAddress (hm_kernel32,
7737 "RtlCaptureStackBackTrace");
7739 if (s_pfn_CaptureStackBackTrace)
7740 return s_pfn_CaptureStackBackTrace (0, min (BACKTRACE_LIMIT_MAX, limit),
7741 buffer, NULL);
7742 return 0;
7745 void
7746 emacs_abort (void)
7748 int button;
7749 button = MessageBox (NULL,
7750 "A fatal error has occurred!\n\n"
7751 "Would you like to attach a debugger?\n\n"
7752 "Select:\n"
7753 "YES -- to debug Emacs, or\n"
7754 "NO -- to abort Emacs and produce a backtrace\n"
7755 " (emacs_backtrace.txt in current directory)."
7756 #if __GNUC__
7757 "\n\n(type \"gdb -p <emacs-PID>\" and\n"
7758 "\"continue\" inside GDB before clicking YES.)"
7759 #endif
7760 , "Emacs Abort Dialog",
7761 MB_ICONEXCLAMATION | MB_TASKMODAL
7762 | MB_SETFOREGROUND | MB_YESNO);
7763 switch (button)
7765 case IDYES:
7766 DebugBreak ();
7767 exit (2); /* tell the compiler we will never return */
7768 case IDNO:
7769 default:
7771 void *stack[BACKTRACE_LIMIT_MAX + 1];
7772 int i = w32_backtrace (stack, BACKTRACE_LIMIT_MAX + 1);
7774 if (i)
7776 #ifdef CYGWIN
7777 int stderr_fd = 2;
7778 #else
7779 HANDLE errout = GetStdHandle (STD_ERROR_HANDLE);
7780 int stderr_fd = -1;
7781 #endif
7782 int errfile_fd = -1;
7783 int j;
7785 #ifndef CYGWIN
7786 if (errout && errout != INVALID_HANDLE_VALUE)
7787 stderr_fd = _open_osfhandle ((intptr_t)errout, O_APPEND | O_BINARY);
7788 #endif
7789 if (stderr_fd >= 0)
7790 write (stderr_fd, "\r\nBacktrace:\r\n", 14);
7791 #ifdef CYGWIN
7792 #define _open open
7793 #endif
7794 errfile_fd = _open ("emacs_backtrace.txt", O_RDWR | O_CREAT | O_BINARY, S_IREAD | S_IWRITE);
7795 if (errfile_fd >= 0)
7797 lseek (errfile_fd, 0L, SEEK_END);
7798 write (errfile_fd, "\r\nBacktrace:\r\n", 14);
7801 for (j = 0; j < i; j++)
7803 char buf[INT_BUFSIZE_BOUND (void *)];
7805 /* stack[] gives the return addresses, whereas we want
7806 the address of the call, so decrease each address
7807 by approximate size of 1 CALL instruction. */
7808 sprintf (buf, "0x%p\r\n", (char *)stack[j] - sizeof(void *));
7809 if (stderr_fd >= 0)
7810 write (stderr_fd, buf, strlen (buf));
7811 if (errfile_fd >= 0)
7812 write (errfile_fd, buf, strlen (buf));
7814 if (i == BACKTRACE_LIMIT_MAX)
7816 if (stderr_fd >= 0)
7817 write (stderr_fd, "...\r\n", 5);
7818 if (errfile_fd >= 0)
7819 write (errfile_fd, "...\r\n", 5);
7821 if (errfile_fd >= 0)
7822 close (errfile_fd);
7824 abort ();
7825 break;
7830 #ifdef NTGUI_UNICODE
7832 Lisp_Object
7833 ntgui_encode_system (Lisp_Object str)
7835 Lisp_Object encoded;
7836 to_unicode (str, &encoded);
7837 return encoded;
7840 #endif /* NTGUI_UNICODE */