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