* cl.texi (Argument Lists): Clarify explicit keyword arguments.
[emacs.git] / src / w32fns.c
blob8003d7917191e73e945fcb4c921333cca8135e85
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
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>
31 #include "lisp.h"
32 #include "w32term.h"
33 #include "frame.h"
34 #include "window.h"
35 #include "buffer.h"
36 #include "intervals.h"
37 #include "dispextern.h"
38 #include "keyboard.h"
39 #include "blockinput.h"
40 #include "epaths.h"
41 #include "character.h"
42 #include "charset.h"
43 #include "coding.h"
44 #include "ccl.h"
45 #include "fontset.h"
46 #include "systime.h"
47 #include "termhooks.h"
48 #include "w32heap.h"
50 #include "bitmaps/gray.xbm"
52 #include <commctrl.h>
53 #include <commdlg.h>
54 #include <shellapi.h>
55 #include <ctype.h>
56 #include <winspool.h>
57 #include <objbase.h>
59 #include <dlgs.h>
60 #include <imm.h>
61 #define FILE_NAME_TEXT_FIELD edt1
63 #include "font.h"
64 #include "w32font.h"
66 #ifndef FOF_NO_CONNECTED_ELEMENTS
67 #define FOF_NO_CONNECTED_ELEMENTS 0x2000
68 #endif
70 void syms_of_w32fns ();
71 void globals_of_w32fns ();
73 extern void free_frame_menubar ();
74 extern double atof ();
75 extern int w32_console_toggle_lock_key P_ ((int, Lisp_Object));
76 extern void w32_menu_display_help P_ ((HWND, HMENU, UINT, UINT));
77 extern void w32_free_menu_strings P_ ((HWND));
78 extern const char *map_w32_filename P_ ((const char *, const char **));
80 extern int quit_char;
82 extern char *lispy_function_keys[];
84 /* The colormap for converting color names to RGB values */
85 Lisp_Object Vw32_color_map;
87 /* Non nil if alt key presses are passed on to Windows. */
88 Lisp_Object Vw32_pass_alt_to_system;
90 /* Non nil if alt key is translated to meta_modifier, nil if it is translated
91 to alt_modifier. */
92 Lisp_Object Vw32_alt_is_meta;
94 /* If non-zero, the windows virtual key code for an alternative quit key. */
95 int w32_quit_key;
97 /* Non nil if left window key events are passed on to Windows (this only
98 affects whether "tapping" the key opens the Start menu). */
99 Lisp_Object Vw32_pass_lwindow_to_system;
101 /* Non nil if right window key events are passed on to Windows (this
102 only affects whether "tapping" the key opens the Start menu). */
103 Lisp_Object Vw32_pass_rwindow_to_system;
105 /* Virtual key code used to generate "phantom" key presses in order
106 to stop system from acting on Windows key events. */
107 Lisp_Object Vw32_phantom_key_code;
109 /* Modifier associated with the left "Windows" key, or nil to act as a
110 normal key. */
111 Lisp_Object Vw32_lwindow_modifier;
113 /* Modifier associated with the right "Windows" key, or nil to act as a
114 normal key. */
115 Lisp_Object Vw32_rwindow_modifier;
117 /* Modifier associated with the "Apps" key, or nil to act as a normal
118 key. */
119 Lisp_Object Vw32_apps_modifier;
121 /* Value is nil if Num Lock acts as a function key. */
122 Lisp_Object Vw32_enable_num_lock;
124 /* Value is nil if Caps Lock acts as a function key. */
125 Lisp_Object Vw32_enable_caps_lock;
127 /* Modifier associated with Scroll Lock, or nil to act as a normal key. */
128 Lisp_Object Vw32_scroll_lock_modifier;
130 /* Switch to control whether we inhibit requests for synthesized bold
131 and italic versions of fonts. */
132 int w32_enable_synthesized_fonts;
134 /* Enable palette management. */
135 Lisp_Object Vw32_enable_palette;
137 /* Control how close left/right button down events must be to
138 be converted to a middle button down event. */
139 int w32_mouse_button_tolerance;
141 /* Minimum interval between mouse movement (and scroll bar drag)
142 events that are passed on to the event loop. */
143 int w32_mouse_move_interval;
145 /* Flag to indicate if XBUTTON events should be passed on to Windows. */
146 static int w32_pass_extra_mouse_buttons_to_system;
148 /* Flag to indicate if media keys should be passed on to Windows. */
149 static int w32_pass_multimedia_buttons_to_system;
151 /* Non nil if no window manager is in use. */
152 Lisp_Object Vx_no_window_manager;
154 /* If non-zero, a w32 timer that, when it expires, displays an
155 hourglass cursor on all frames. */
156 static unsigned hourglass_timer = 0;
157 static HWND hourglass_hwnd = NULL;
159 #if 0 /* TODO: Mouse cursor customization. */
160 /* The background and shape of the mouse pointer, and shape when not
161 over text or in the modeline. */
162 Lisp_Object Vx_pointer_shape, Vx_nontext_pointer_shape, Vx_mode_pointer_shape;
163 Lisp_Object Vx_hourglass_pointer_shape, Vx_window_horizontal_drag_shape;
165 /* The shape when over mouse-sensitive text. */
167 Lisp_Object Vx_sensitive_text_pointer_shape;
168 #endif
170 #ifndef IDC_HAND
171 #define IDC_HAND MAKEINTRESOURCE(32649)
172 #endif
174 /* Color of chars displayed in cursor box. */
175 Lisp_Object Vx_cursor_fore_pixel;
177 /* Nonzero if using Windows. */
179 static int w32_in_use;
181 /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'. */
183 Lisp_Object Vx_pixel_size_width_font_regexp;
185 /* Alist of bdf fonts and the files that define them. */
186 Lisp_Object Vw32_bdf_filename_alist;
188 /* A flag to control whether fonts are matched strictly or not. */
189 static int w32_strict_fontnames;
191 /* A flag to control whether we should only repaint if GetUpdateRect
192 indicates there is an update region. */
193 static int w32_strict_painting;
195 Lisp_Object Qnone;
196 Lisp_Object Qsuppress_icon;
197 Lisp_Object Qundefined_color;
198 Lisp_Object Qcancel_timer;
199 Lisp_Object Qfont_param;
200 Lisp_Object Qhyper;
201 Lisp_Object Qsuper;
202 Lisp_Object Qmeta;
203 Lisp_Object Qalt;
204 Lisp_Object Qctrl;
205 Lisp_Object Qcontrol;
206 Lisp_Object Qshift;
209 /* The ANSI codepage. */
210 int w32_ansi_code_page;
212 /* Prefix for system colors. */
213 #define SYSTEM_COLOR_PREFIX "System"
214 #define SYSTEM_COLOR_PREFIX_LEN (sizeof (SYSTEM_COLOR_PREFIX) - 1)
216 /* State variables for emulating a three button mouse. */
217 #define LMOUSE 1
218 #define MMOUSE 2
219 #define RMOUSE 4
221 static int button_state = 0;
222 static W32Msg saved_mouse_button_msg;
223 static unsigned mouse_button_timer = 0; /* non-zero when timer is active */
224 static W32Msg saved_mouse_move_msg;
225 static unsigned mouse_move_timer = 0;
227 /* Window that is tracking the mouse. */
228 static HWND track_mouse_window;
230 /* Multi-monitor API definitions that are not pulled from the headers
231 since we are compiling for NT 4. */
232 #ifndef MONITOR_DEFAULT_TO_NEAREST
233 #define MONITOR_DEFAULT_TO_NEAREST 2
234 #endif
235 /* MinGW headers define MONITORINFO unconditionally, but MSVC ones don't.
236 To avoid a compile error on one or the other, redefine with a new name. */
237 struct MONITOR_INFO
239 DWORD cbSize;
240 RECT rcMonitor;
241 RECT rcWork;
242 DWORD dwFlags;
245 /* Reportedly, VS 6 does not have this in its headers. */
246 #if defined(_MSC_VER) && _MSC_VER < 1300
247 DECLARE_HANDLE(HMONITOR);
248 #endif
250 typedef BOOL (WINAPI * TrackMouseEvent_Proc)
251 (IN OUT LPTRACKMOUSEEVENT lpEventTrack);
252 typedef LONG (WINAPI * ImmGetCompositionString_Proc)
253 (IN HIMC context, IN DWORD index, OUT LPVOID buffer, IN DWORD bufLen);
254 typedef HIMC (WINAPI * ImmGetContext_Proc) (IN HWND window);
255 typedef HWND (WINAPI * ImmReleaseContext_Proc) (IN HWND wnd, IN HIMC context);
256 typedef HWND (WINAPI * ImmSetCompositionWindow_Proc) (IN HIMC context,
257 IN COMPOSITIONFORM *form);
258 typedef HMONITOR (WINAPI * MonitorFromPoint_Proc) (IN POINT pt, IN DWORD flags);
259 typedef BOOL (WINAPI * GetMonitorInfo_Proc)
260 (IN HMONITOR monitor, OUT struct MONITOR_INFO* info);
262 TrackMouseEvent_Proc track_mouse_event_fn = NULL;
263 ClipboardSequence_Proc clipboard_sequence_fn = NULL;
264 ImmGetCompositionString_Proc get_composition_string_fn = NULL;
265 ImmGetContext_Proc get_ime_context_fn = NULL;
266 ImmReleaseContext_Proc release_ime_context_fn = NULL;
267 ImmSetCompositionWindow_Proc set_ime_composition_window_fn = NULL;
268 MonitorFromPoint_Proc monitor_from_point_fn = NULL;
269 GetMonitorInfo_Proc get_monitor_info_fn = NULL;
271 extern AppendMenuW_Proc unicode_append_menu;
273 /* Flag to selectively ignore WM_IME_CHAR messages. */
274 static int ignore_ime_char = 0;
276 /* W95 mousewheel handler */
277 unsigned int msh_mousewheel = 0;
279 /* Timers */
280 #define MOUSE_BUTTON_ID 1
281 #define MOUSE_MOVE_ID 2
282 #define MENU_FREE_ID 3
283 #define HOURGLASS_ID 4
284 /* The delay (milliseconds) before a menu is freed after WM_EXITMENULOOP
285 is received. */
286 #define MENU_FREE_DELAY 1000
287 static unsigned menu_free_timer = 0;
289 /* The below are defined in frame.c. */
291 extern Lisp_Object Vwindow_system_version;
293 #ifdef GLYPH_DEBUG
294 int image_cache_refcount, dpyinfo_refcount;
295 #endif
298 /* From w32term.c. */
299 extern int w32_num_mouse_buttons;
300 extern Lisp_Object Vw32_recognize_altgr;
302 extern HWND w32_system_caret_hwnd;
304 extern int w32_system_caret_height;
305 extern int w32_system_caret_x;
306 extern int w32_system_caret_y;
307 extern int w32_use_visible_system_caret;
309 static HWND w32_visible_system_caret_hwnd;
311 /* From w32menu.c */
312 extern HMENU current_popup_menu;
313 static int menubar_in_use = 0;
315 /* From w32uniscribe.c */
316 extern void syms_of_w32uniscribe ();
317 extern int uniscribe_available;
319 /* Function prototypes for hourglass support. */
320 static void w32_show_hourglass P_ ((struct frame *));
321 static void w32_hide_hourglass P_ ((void));
325 /* Error if we are not connected to MS-Windows. */
326 void
327 check_w32 ()
329 if (! w32_in_use)
330 error ("MS-Windows not in use or not initialized");
333 /* Nonzero if we can use mouse menus.
334 You should not call this unless HAVE_MENUS is defined. */
337 have_menus_p ()
339 return w32_in_use;
342 /* Extract a frame as a FRAME_PTR, defaulting to the selected frame
343 and checking validity for W32. */
345 FRAME_PTR
346 check_x_frame (frame)
347 Lisp_Object frame;
349 FRAME_PTR f;
351 if (NILP (frame))
352 frame = selected_frame;
353 CHECK_LIVE_FRAME (frame);
354 f = XFRAME (frame);
355 if (! FRAME_W32_P (f))
356 error ("Non-W32 frame used");
357 return f;
360 /* Let the user specify a display with a frame.
361 nil stands for the selected frame--or, if that is not a w32 frame,
362 the first display on the list. */
364 struct w32_display_info *
365 check_x_display_info (frame)
366 Lisp_Object frame;
368 if (NILP (frame))
370 struct frame *sf = XFRAME (selected_frame);
372 if (FRAME_W32_P (sf) && FRAME_LIVE_P (sf))
373 return FRAME_W32_DISPLAY_INFO (sf);
374 else
375 return &one_w32_display_info;
377 else if (STRINGP (frame))
378 return x_display_info_for_name (frame);
379 else
381 FRAME_PTR f;
383 CHECK_LIVE_FRAME (frame);
384 f = XFRAME (frame);
385 if (! FRAME_W32_P (f))
386 error ("Non-W32 frame used");
387 return FRAME_W32_DISPLAY_INFO (f);
391 /* Return the Emacs frame-object corresponding to an w32 window.
392 It could be the frame's main window or an icon window. */
394 /* This function can be called during GC, so use GC_xxx type test macros. */
396 struct frame *
397 x_window_to_frame (dpyinfo, wdesc)
398 struct w32_display_info *dpyinfo;
399 HWND wdesc;
401 Lisp_Object tail, frame;
402 struct frame *f;
404 for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
406 frame = XCAR (tail);
407 if (!FRAMEP (frame))
408 continue;
409 f = XFRAME (frame);
410 if (!FRAME_W32_P (f) || FRAME_W32_DISPLAY_INFO (f) != dpyinfo)
411 continue;
413 if (FRAME_W32_WINDOW (f) == wdesc)
414 return f;
416 return 0;
420 static Lisp_Object unwind_create_frame P_ ((Lisp_Object));
421 static Lisp_Object unwind_create_tip_frame P_ ((Lisp_Object));
422 static void my_create_window P_ ((struct frame *));
423 static void my_create_tip_window P_ ((struct frame *));
425 /* TODO: Native Input Method support; see x_create_im. */
426 void x_set_foreground_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
427 void x_set_background_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
428 void x_set_mouse_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
429 void x_set_cursor_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
430 void x_set_border_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
431 void x_set_cursor_type P_ ((struct frame *, Lisp_Object, Lisp_Object));
432 void x_set_icon_type P_ ((struct frame *, Lisp_Object, Lisp_Object));
433 void x_set_icon_name P_ ((struct frame *, Lisp_Object, Lisp_Object));
434 void x_explicitly_set_name P_ ((struct frame *, Lisp_Object, Lisp_Object));
435 void x_set_menu_bar_lines P_ ((struct frame *, Lisp_Object, Lisp_Object));
436 void x_set_title P_ ((struct frame *, Lisp_Object, Lisp_Object));
437 void x_set_tool_bar_lines P_ ((struct frame *, Lisp_Object, Lisp_Object));
438 static void x_edge_detection P_ ((struct frame *, struct image *, Lisp_Object,
439 Lisp_Object));
444 /* Store the screen positions of frame F into XPTR and YPTR.
445 These are the positions of the containing window manager window,
446 not Emacs's own window. */
448 void
449 x_real_positions (f, xptr, yptr)
450 FRAME_PTR f;
451 int *xptr, *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 (red, green, blue, name)
482 Lisp_Object red, green, blue, name;
484 Lisp_Object rgb;
485 Lisp_Object oldrgb = Qnil;
486 Lisp_Object entry;
488 CHECK_NUMBER (red);
489 CHECK_NUMBER (green);
490 CHECK_NUMBER (blue);
491 CHECK_STRING (name);
493 XSETINT (rgb, RGB (XUINT (red), XUINT (green), XUINT (blue)));
495 BLOCK_INPUT;
497 /* replace existing entry in w32-color-map or add new entry. */
498 entry = Fassoc (name, Vw32_color_map);
499 if (NILP (entry))
501 entry = Fcons (name, rgb);
502 Vw32_color_map = Fcons (entry, Vw32_color_map);
504 else
506 oldrgb = Fcdr (entry);
507 Fsetcdr (entry, rgb);
510 UNBLOCK_INPUT;
512 return (oldrgb);
515 /* The default colors for the w32 color map */
516 typedef struct colormap_t
518 char *name;
519 COLORREF colorref;
520 } colormap_t;
522 colormap_t w32_color_map[] =
524 {"snow" , PALETTERGB (255,250,250)},
525 {"ghost white" , PALETTERGB (248,248,255)},
526 {"GhostWhite" , PALETTERGB (248,248,255)},
527 {"white smoke" , PALETTERGB (245,245,245)},
528 {"WhiteSmoke" , PALETTERGB (245,245,245)},
529 {"gainsboro" , PALETTERGB (220,220,220)},
530 {"floral white" , PALETTERGB (255,250,240)},
531 {"FloralWhite" , PALETTERGB (255,250,240)},
532 {"old lace" , PALETTERGB (253,245,230)},
533 {"OldLace" , PALETTERGB (253,245,230)},
534 {"linen" , PALETTERGB (250,240,230)},
535 {"antique white" , PALETTERGB (250,235,215)},
536 {"AntiqueWhite" , PALETTERGB (250,235,215)},
537 {"papaya whip" , PALETTERGB (255,239,213)},
538 {"PapayaWhip" , PALETTERGB (255,239,213)},
539 {"blanched almond" , PALETTERGB (255,235,205)},
540 {"BlanchedAlmond" , PALETTERGB (255,235,205)},
541 {"bisque" , PALETTERGB (255,228,196)},
542 {"peach puff" , PALETTERGB (255,218,185)},
543 {"PeachPuff" , PALETTERGB (255,218,185)},
544 {"navajo white" , PALETTERGB (255,222,173)},
545 {"NavajoWhite" , PALETTERGB (255,222,173)},
546 {"moccasin" , PALETTERGB (255,228,181)},
547 {"cornsilk" , PALETTERGB (255,248,220)},
548 {"ivory" , PALETTERGB (255,255,240)},
549 {"lemon chiffon" , PALETTERGB (255,250,205)},
550 {"LemonChiffon" , PALETTERGB (255,250,205)},
551 {"seashell" , PALETTERGB (255,245,238)},
552 {"honeydew" , PALETTERGB (240,255,240)},
553 {"mint cream" , PALETTERGB (245,255,250)},
554 {"MintCream" , PALETTERGB (245,255,250)},
555 {"azure" , PALETTERGB (240,255,255)},
556 {"alice blue" , PALETTERGB (240,248,255)},
557 {"AliceBlue" , PALETTERGB (240,248,255)},
558 {"lavender" , PALETTERGB (230,230,250)},
559 {"lavender blush" , PALETTERGB (255,240,245)},
560 {"LavenderBlush" , PALETTERGB (255,240,245)},
561 {"misty rose" , PALETTERGB (255,228,225)},
562 {"MistyRose" , PALETTERGB (255,228,225)},
563 {"white" , PALETTERGB (255,255,255)},
564 {"black" , PALETTERGB ( 0, 0, 0)},
565 {"dark slate gray" , PALETTERGB ( 47, 79, 79)},
566 {"DarkSlateGray" , PALETTERGB ( 47, 79, 79)},
567 {"dark slate grey" , PALETTERGB ( 47, 79, 79)},
568 {"DarkSlateGrey" , PALETTERGB ( 47, 79, 79)},
569 {"dim gray" , PALETTERGB (105,105,105)},
570 {"DimGray" , PALETTERGB (105,105,105)},
571 {"dim grey" , PALETTERGB (105,105,105)},
572 {"DimGrey" , PALETTERGB (105,105,105)},
573 {"slate gray" , PALETTERGB (112,128,144)},
574 {"SlateGray" , PALETTERGB (112,128,144)},
575 {"slate grey" , PALETTERGB (112,128,144)},
576 {"SlateGrey" , PALETTERGB (112,128,144)},
577 {"light slate gray" , PALETTERGB (119,136,153)},
578 {"LightSlateGray" , PALETTERGB (119,136,153)},
579 {"light slate grey" , PALETTERGB (119,136,153)},
580 {"LightSlateGrey" , PALETTERGB (119,136,153)},
581 {"gray" , PALETTERGB (190,190,190)},
582 {"grey" , PALETTERGB (190,190,190)},
583 {"light grey" , PALETTERGB (211,211,211)},
584 {"LightGrey" , PALETTERGB (211,211,211)},
585 {"light gray" , PALETTERGB (211,211,211)},
586 {"LightGray" , PALETTERGB (211,211,211)},
587 {"midnight blue" , PALETTERGB ( 25, 25,112)},
588 {"MidnightBlue" , PALETTERGB ( 25, 25,112)},
589 {"navy" , PALETTERGB ( 0, 0,128)},
590 {"navy blue" , PALETTERGB ( 0, 0,128)},
591 {"NavyBlue" , PALETTERGB ( 0, 0,128)},
592 {"cornflower blue" , PALETTERGB (100,149,237)},
593 {"CornflowerBlue" , PALETTERGB (100,149,237)},
594 {"dark slate blue" , PALETTERGB ( 72, 61,139)},
595 {"DarkSlateBlue" , PALETTERGB ( 72, 61,139)},
596 {"slate blue" , PALETTERGB (106, 90,205)},
597 {"SlateBlue" , PALETTERGB (106, 90,205)},
598 {"medium slate blue" , PALETTERGB (123,104,238)},
599 {"MediumSlateBlue" , PALETTERGB (123,104,238)},
600 {"light slate blue" , PALETTERGB (132,112,255)},
601 {"LightSlateBlue" , PALETTERGB (132,112,255)},
602 {"medium blue" , PALETTERGB ( 0, 0,205)},
603 {"MediumBlue" , PALETTERGB ( 0, 0,205)},
604 {"royal blue" , PALETTERGB ( 65,105,225)},
605 {"RoyalBlue" , PALETTERGB ( 65,105,225)},
606 {"blue" , PALETTERGB ( 0, 0,255)},
607 {"dodger blue" , PALETTERGB ( 30,144,255)},
608 {"DodgerBlue" , PALETTERGB ( 30,144,255)},
609 {"deep sky blue" , PALETTERGB ( 0,191,255)},
610 {"DeepSkyBlue" , PALETTERGB ( 0,191,255)},
611 {"sky blue" , PALETTERGB (135,206,235)},
612 {"SkyBlue" , PALETTERGB (135,206,235)},
613 {"light sky blue" , PALETTERGB (135,206,250)},
614 {"LightSkyBlue" , PALETTERGB (135,206,250)},
615 {"steel blue" , PALETTERGB ( 70,130,180)},
616 {"SteelBlue" , PALETTERGB ( 70,130,180)},
617 {"light steel blue" , PALETTERGB (176,196,222)},
618 {"LightSteelBlue" , PALETTERGB (176,196,222)},
619 {"light blue" , PALETTERGB (173,216,230)},
620 {"LightBlue" , PALETTERGB (173,216,230)},
621 {"powder blue" , PALETTERGB (176,224,230)},
622 {"PowderBlue" , PALETTERGB (176,224,230)},
623 {"pale turquoise" , PALETTERGB (175,238,238)},
624 {"PaleTurquoise" , PALETTERGB (175,238,238)},
625 {"dark turquoise" , PALETTERGB ( 0,206,209)},
626 {"DarkTurquoise" , PALETTERGB ( 0,206,209)},
627 {"medium turquoise" , PALETTERGB ( 72,209,204)},
628 {"MediumTurquoise" , PALETTERGB ( 72,209,204)},
629 {"turquoise" , PALETTERGB ( 64,224,208)},
630 {"cyan" , PALETTERGB ( 0,255,255)},
631 {"light cyan" , PALETTERGB (224,255,255)},
632 {"LightCyan" , PALETTERGB (224,255,255)},
633 {"cadet blue" , PALETTERGB ( 95,158,160)},
634 {"CadetBlue" , PALETTERGB ( 95,158,160)},
635 {"medium aquamarine" , PALETTERGB (102,205,170)},
636 {"MediumAquamarine" , PALETTERGB (102,205,170)},
637 {"aquamarine" , PALETTERGB (127,255,212)},
638 {"dark green" , PALETTERGB ( 0,100, 0)},
639 {"DarkGreen" , PALETTERGB ( 0,100, 0)},
640 {"dark olive green" , PALETTERGB ( 85,107, 47)},
641 {"DarkOliveGreen" , PALETTERGB ( 85,107, 47)},
642 {"dark sea green" , PALETTERGB (143,188,143)},
643 {"DarkSeaGreen" , PALETTERGB (143,188,143)},
644 {"sea green" , PALETTERGB ( 46,139, 87)},
645 {"SeaGreen" , PALETTERGB ( 46,139, 87)},
646 {"medium sea green" , PALETTERGB ( 60,179,113)},
647 {"MediumSeaGreen" , PALETTERGB ( 60,179,113)},
648 {"light sea green" , PALETTERGB ( 32,178,170)},
649 {"LightSeaGreen" , PALETTERGB ( 32,178,170)},
650 {"pale green" , PALETTERGB (152,251,152)},
651 {"PaleGreen" , PALETTERGB (152,251,152)},
652 {"spring green" , PALETTERGB ( 0,255,127)},
653 {"SpringGreen" , PALETTERGB ( 0,255,127)},
654 {"lawn green" , PALETTERGB (124,252, 0)},
655 {"LawnGreen" , PALETTERGB (124,252, 0)},
656 {"green" , PALETTERGB ( 0,255, 0)},
657 {"chartreuse" , PALETTERGB (127,255, 0)},
658 {"medium spring green" , PALETTERGB ( 0,250,154)},
659 {"MediumSpringGreen" , PALETTERGB ( 0,250,154)},
660 {"green yellow" , PALETTERGB (173,255, 47)},
661 {"GreenYellow" , PALETTERGB (173,255, 47)},
662 {"lime green" , PALETTERGB ( 50,205, 50)},
663 {"LimeGreen" , PALETTERGB ( 50,205, 50)},
664 {"yellow green" , PALETTERGB (154,205, 50)},
665 {"YellowGreen" , PALETTERGB (154,205, 50)},
666 {"forest green" , PALETTERGB ( 34,139, 34)},
667 {"ForestGreen" , PALETTERGB ( 34,139, 34)},
668 {"olive drab" , PALETTERGB (107,142, 35)},
669 {"OliveDrab" , PALETTERGB (107,142, 35)},
670 {"dark khaki" , PALETTERGB (189,183,107)},
671 {"DarkKhaki" , PALETTERGB (189,183,107)},
672 {"khaki" , PALETTERGB (240,230,140)},
673 {"pale goldenrod" , PALETTERGB (238,232,170)},
674 {"PaleGoldenrod" , PALETTERGB (238,232,170)},
675 {"light goldenrod yellow" , PALETTERGB (250,250,210)},
676 {"LightGoldenrodYellow" , PALETTERGB (250,250,210)},
677 {"light yellow" , PALETTERGB (255,255,224)},
678 {"LightYellow" , PALETTERGB (255,255,224)},
679 {"yellow" , PALETTERGB (255,255, 0)},
680 {"gold" , PALETTERGB (255,215, 0)},
681 {"light goldenrod" , PALETTERGB (238,221,130)},
682 {"LightGoldenrod" , PALETTERGB (238,221,130)},
683 {"goldenrod" , PALETTERGB (218,165, 32)},
684 {"dark goldenrod" , PALETTERGB (184,134, 11)},
685 {"DarkGoldenrod" , PALETTERGB (184,134, 11)},
686 {"rosy brown" , PALETTERGB (188,143,143)},
687 {"RosyBrown" , PALETTERGB (188,143,143)},
688 {"indian red" , PALETTERGB (205, 92, 92)},
689 {"IndianRed" , PALETTERGB (205, 92, 92)},
690 {"saddle brown" , PALETTERGB (139, 69, 19)},
691 {"SaddleBrown" , PALETTERGB (139, 69, 19)},
692 {"sienna" , PALETTERGB (160, 82, 45)},
693 {"peru" , PALETTERGB (205,133, 63)},
694 {"burlywood" , PALETTERGB (222,184,135)},
695 {"beige" , PALETTERGB (245,245,220)},
696 {"wheat" , PALETTERGB (245,222,179)},
697 {"sandy brown" , PALETTERGB (244,164, 96)},
698 {"SandyBrown" , PALETTERGB (244,164, 96)},
699 {"tan" , PALETTERGB (210,180,140)},
700 {"chocolate" , PALETTERGB (210,105, 30)},
701 {"firebrick" , PALETTERGB (178,34, 34)},
702 {"brown" , PALETTERGB (165,42, 42)},
703 {"dark salmon" , PALETTERGB (233,150,122)},
704 {"DarkSalmon" , PALETTERGB (233,150,122)},
705 {"salmon" , PALETTERGB (250,128,114)},
706 {"light salmon" , PALETTERGB (255,160,122)},
707 {"LightSalmon" , PALETTERGB (255,160,122)},
708 {"orange" , PALETTERGB (255,165, 0)},
709 {"dark orange" , PALETTERGB (255,140, 0)},
710 {"DarkOrange" , PALETTERGB (255,140, 0)},
711 {"coral" , PALETTERGB (255,127, 80)},
712 {"light coral" , PALETTERGB (240,128,128)},
713 {"LightCoral" , PALETTERGB (240,128,128)},
714 {"tomato" , PALETTERGB (255, 99, 71)},
715 {"orange red" , PALETTERGB (255, 69, 0)},
716 {"OrangeRed" , PALETTERGB (255, 69, 0)},
717 {"red" , PALETTERGB (255, 0, 0)},
718 {"hot pink" , PALETTERGB (255,105,180)},
719 {"HotPink" , PALETTERGB (255,105,180)},
720 {"deep pink" , PALETTERGB (255, 20,147)},
721 {"DeepPink" , PALETTERGB (255, 20,147)},
722 {"pink" , PALETTERGB (255,192,203)},
723 {"light pink" , PALETTERGB (255,182,193)},
724 {"LightPink" , PALETTERGB (255,182,193)},
725 {"pale violet red" , PALETTERGB (219,112,147)},
726 {"PaleVioletRed" , PALETTERGB (219,112,147)},
727 {"maroon" , PALETTERGB (176, 48, 96)},
728 {"medium violet red" , PALETTERGB (199, 21,133)},
729 {"MediumVioletRed" , PALETTERGB (199, 21,133)},
730 {"violet red" , PALETTERGB (208, 32,144)},
731 {"VioletRed" , PALETTERGB (208, 32,144)},
732 {"magenta" , PALETTERGB (255, 0,255)},
733 {"violet" , PALETTERGB (238,130,238)},
734 {"plum" , PALETTERGB (221,160,221)},
735 {"orchid" , PALETTERGB (218,112,214)},
736 {"medium orchid" , PALETTERGB (186, 85,211)},
737 {"MediumOrchid" , PALETTERGB (186, 85,211)},
738 {"dark orchid" , PALETTERGB (153, 50,204)},
739 {"DarkOrchid" , PALETTERGB (153, 50,204)},
740 {"dark violet" , PALETTERGB (148, 0,211)},
741 {"DarkViolet" , PALETTERGB (148, 0,211)},
742 {"blue violet" , PALETTERGB (138, 43,226)},
743 {"BlueViolet" , PALETTERGB (138, 43,226)},
744 {"purple" , PALETTERGB (160, 32,240)},
745 {"medium purple" , PALETTERGB (147,112,219)},
746 {"MediumPurple" , PALETTERGB (147,112,219)},
747 {"thistle" , PALETTERGB (216,191,216)},
748 {"gray0" , PALETTERGB ( 0, 0, 0)},
749 {"grey0" , PALETTERGB ( 0, 0, 0)},
750 {"dark grey" , PALETTERGB (169,169,169)},
751 {"DarkGrey" , PALETTERGB (169,169,169)},
752 {"dark gray" , PALETTERGB (169,169,169)},
753 {"DarkGray" , PALETTERGB (169,169,169)},
754 {"dark blue" , PALETTERGB ( 0, 0,139)},
755 {"DarkBlue" , PALETTERGB ( 0, 0,139)},
756 {"dark cyan" , PALETTERGB ( 0,139,139)},
757 {"DarkCyan" , PALETTERGB ( 0,139,139)},
758 {"dark magenta" , PALETTERGB (139, 0,139)},
759 {"DarkMagenta" , PALETTERGB (139, 0,139)},
760 {"dark red" , PALETTERGB (139, 0, 0)},
761 {"DarkRed" , PALETTERGB (139, 0, 0)},
762 {"light green" , PALETTERGB (144,238,144)},
763 {"LightGreen" , PALETTERGB (144,238,144)},
766 DEFUN ("w32-default-color-map", Fw32_default_color_map, Sw32_default_color_map,
767 0, 0, 0, doc: /* Return the default color map. */)
770 int i;
771 colormap_t *pc = w32_color_map;
772 Lisp_Object cmap;
774 BLOCK_INPUT;
776 cmap = Qnil;
778 for (i = 0; i < sizeof (w32_color_map) / sizeof (w32_color_map[0]);
779 pc++, i++)
780 cmap = Fcons (Fcons (build_string (pc->name),
781 make_number (pc->colorref)),
782 cmap);
784 UNBLOCK_INPUT;
786 return (cmap);
789 static Lisp_Object
790 w32_to_x_color (rgb)
791 Lisp_Object rgb;
793 Lisp_Object color;
795 CHECK_NUMBER (rgb);
797 BLOCK_INPUT;
799 color = Frassq (rgb, Vw32_color_map);
801 UNBLOCK_INPUT;
803 if (!NILP (color))
804 return (Fcar (color));
805 else
806 return Qnil;
809 static Lisp_Object
810 w32_color_map_lookup (colorname)
811 char *colorname;
813 Lisp_Object tail, ret = Qnil;
815 BLOCK_INPUT;
817 for (tail = Vw32_color_map; CONSP (tail); tail = XCDR (tail))
819 register Lisp_Object elt, tem;
821 elt = XCAR (tail);
822 if (!CONSP (elt)) continue;
824 tem = Fcar (elt);
826 if (lstrcmpi (SDATA (tem), colorname) == 0)
828 ret = Fcdr (elt);
829 break;
832 QUIT;
836 UNBLOCK_INPUT;
838 return ret;
842 static void
843 add_system_logical_colors_to_map (system_colors)
844 Lisp_Object *system_colors;
846 HKEY colors_key;
848 /* Other registry operations are done with input blocked. */
849 BLOCK_INPUT;
851 /* Look for "Control Panel/Colors" under User and Machine registry
852 settings. */
853 if (RegOpenKeyEx (HKEY_CURRENT_USER, "Control Panel\\Colors", 0,
854 KEY_READ, &colors_key) == ERROR_SUCCESS
855 || RegOpenKeyEx (HKEY_LOCAL_MACHINE, "Control Panel\\Colors", 0,
856 KEY_READ, &colors_key) == ERROR_SUCCESS)
858 /* List all keys. */
859 char color_buffer[64];
860 char full_name_buffer[MAX_PATH + SYSTEM_COLOR_PREFIX_LEN];
861 int index = 0;
862 DWORD name_size, color_size;
863 char *name_buffer = full_name_buffer + SYSTEM_COLOR_PREFIX_LEN;
865 name_size = sizeof (full_name_buffer) - SYSTEM_COLOR_PREFIX_LEN;
866 color_size = sizeof (color_buffer);
868 strcpy (full_name_buffer, SYSTEM_COLOR_PREFIX);
870 while (RegEnumValueA (colors_key, index, name_buffer, &name_size,
871 NULL, NULL, color_buffer, &color_size)
872 == ERROR_SUCCESS)
874 int r, g, b;
875 if (sscanf (color_buffer, " %u %u %u", &r, &g, &b) == 3)
876 *system_colors = Fcons (Fcons (build_string (full_name_buffer),
877 make_number (RGB (r, g, b))),
878 *system_colors);
880 name_size = sizeof (full_name_buffer) - SYSTEM_COLOR_PREFIX_LEN;
881 color_size = sizeof (color_buffer);
882 index++;
884 RegCloseKey (colors_key);
887 UNBLOCK_INPUT;
891 static Lisp_Object
892 x_to_w32_color (colorname)
893 char * colorname;
895 register Lisp_Object ret = Qnil;
897 BLOCK_INPUT;
899 if (colorname[0] == '#')
901 /* Could be an old-style RGB Device specification. */
902 char *color;
903 int size;
904 color = colorname + 1;
906 size = strlen (color);
907 if (size == 3 || size == 6 || size == 9 || size == 12)
909 UINT colorval;
910 int i, pos;
911 pos = 0;
912 size /= 3;
913 colorval = 0;
915 for (i = 0; i < 3; i++)
917 char *end;
918 char t;
919 unsigned long value;
921 /* The check for 'x' in the following conditional takes into
922 account the fact that strtol allows a "0x" in front of
923 our numbers, and we don't. */
924 if (!isxdigit (color[0]) || color[1] == 'x')
925 break;
926 t = color[size];
927 color[size] = '\0';
928 value = strtoul (color, &end, 16);
929 color[size] = t;
930 if (errno == ERANGE || end - color != size)
931 break;
932 switch (size)
934 case 1:
935 value = value * 0x10;
936 break;
937 case 2:
938 break;
939 case 3:
940 value /= 0x10;
941 break;
942 case 4:
943 value /= 0x100;
944 break;
946 colorval |= (value << pos);
947 pos += 0x8;
948 if (i == 2)
950 UNBLOCK_INPUT;
951 XSETINT (ret, colorval);
952 return ret;
954 color = end;
958 else if (strnicmp (colorname, "rgb:", 4) == 0)
960 char *color;
961 UINT colorval;
962 int i, pos;
963 pos = 0;
965 colorval = 0;
966 color = colorname + 4;
967 for (i = 0; i < 3; i++)
969 char *end;
970 unsigned long value;
972 /* The check for 'x' in the following conditional takes into
973 account the fact that strtol allows a "0x" in front of
974 our numbers, and we don't. */
975 if (!isxdigit (color[0]) || color[1] == 'x')
976 break;
977 value = strtoul (color, &end, 16);
978 if (errno == ERANGE)
979 break;
980 switch (end - color)
982 case 1:
983 value = value * 0x10 + value;
984 break;
985 case 2:
986 break;
987 case 3:
988 value /= 0x10;
989 break;
990 case 4:
991 value /= 0x100;
992 break;
993 default:
994 value = ULONG_MAX;
996 if (value == ULONG_MAX)
997 break;
998 colorval |= (value << pos);
999 pos += 0x8;
1000 if (i == 2)
1002 if (*end != '\0')
1003 break;
1004 UNBLOCK_INPUT;
1005 XSETINT (ret, colorval);
1006 return ret;
1008 if (*end != '/')
1009 break;
1010 color = end + 1;
1013 else if (strnicmp (colorname, "rgbi:", 5) == 0)
1015 /* This is an RGB Intensity specification. */
1016 char *color;
1017 UINT colorval;
1018 int i, pos;
1019 pos = 0;
1021 colorval = 0;
1022 color = colorname + 5;
1023 for (i = 0; i < 3; i++)
1025 char *end;
1026 double value;
1027 UINT val;
1029 value = strtod (color, &end);
1030 if (errno == ERANGE)
1031 break;
1032 if (value < 0.0 || value > 1.0)
1033 break;
1034 val = (UINT)(0x100 * value);
1035 /* We used 0x100 instead of 0xFF to give a continuous
1036 range between 0.0 and 1.0 inclusive. The next statement
1037 fixes the 1.0 case. */
1038 if (val == 0x100)
1039 val = 0xFF;
1040 colorval |= (val << pos);
1041 pos += 0x8;
1042 if (i == 2)
1044 if (*end != '\0')
1045 break;
1046 UNBLOCK_INPUT;
1047 XSETINT (ret, colorval);
1048 return ret;
1050 if (*end != '/')
1051 break;
1052 color = end + 1;
1055 /* I am not going to attempt to handle any of the CIE color schemes
1056 or TekHVC, since I don't know the algorithms for conversion to
1057 RGB. */
1059 /* If we fail to lookup the color name in w32_color_map, then check the
1060 colorname to see if it can be crudely approximated: If the X color
1061 ends in a number (e.g., "darkseagreen2"), strip the number and
1062 return the result of looking up the base color name. */
1063 ret = w32_color_map_lookup (colorname);
1064 if (NILP (ret))
1066 int len = strlen (colorname);
1068 if (isdigit (colorname[len - 1]))
1070 char *ptr, *approx = alloca (len + 1);
1072 strcpy (approx, colorname);
1073 ptr = &approx[len - 1];
1074 while (ptr > approx && isdigit (*ptr))
1075 *ptr-- = '\0';
1077 ret = w32_color_map_lookup (approx);
1081 UNBLOCK_INPUT;
1082 return ret;
1085 void
1086 w32_regenerate_palette (FRAME_PTR f)
1088 struct w32_palette_entry * list;
1089 LOGPALETTE * log_palette;
1090 HPALETTE new_palette;
1091 int i;
1093 /* don't bother trying to create palette if not supported */
1094 if (! FRAME_W32_DISPLAY_INFO (f)->has_palette)
1095 return;
1097 log_palette = (LOGPALETTE *)
1098 alloca (sizeof (LOGPALETTE) +
1099 FRAME_W32_DISPLAY_INFO (f)->num_colors * sizeof (PALETTEENTRY));
1100 log_palette->palVersion = 0x300;
1101 log_palette->palNumEntries = FRAME_W32_DISPLAY_INFO (f)->num_colors;
1103 list = FRAME_W32_DISPLAY_INFO (f)->color_list;
1104 for (i = 0;
1105 i < FRAME_W32_DISPLAY_INFO (f)->num_colors;
1106 i++, list = list->next)
1107 log_palette->palPalEntry[i] = list->entry;
1109 new_palette = CreatePalette (log_palette);
1111 enter_crit ();
1113 if (FRAME_W32_DISPLAY_INFO (f)->palette)
1114 DeleteObject (FRAME_W32_DISPLAY_INFO (f)->palette);
1115 FRAME_W32_DISPLAY_INFO (f)->palette = new_palette;
1117 /* Realize display palette and garbage all frames. */
1118 release_frame_dc (f, get_frame_dc (f));
1120 leave_crit ();
1123 #define W32_COLOR(pe) RGB (pe.peRed, pe.peGreen, pe.peBlue)
1124 #define SET_W32_COLOR(pe, color) \
1125 do \
1127 pe.peRed = GetRValue (color); \
1128 pe.peGreen = GetGValue (color); \
1129 pe.peBlue = GetBValue (color); \
1130 pe.peFlags = 0; \
1131 } while (0)
1133 #if 0
1134 /* Keep these around in case we ever want to track color usage. */
1135 void
1136 w32_map_color (FRAME_PTR f, COLORREF color)
1138 struct w32_palette_entry * list = FRAME_W32_DISPLAY_INFO (f)->color_list;
1140 if (NILP (Vw32_enable_palette))
1141 return;
1143 /* check if color is already mapped */
1144 while (list)
1146 if (W32_COLOR (list->entry) == color)
1148 ++list->refcount;
1149 return;
1151 list = list->next;
1154 /* not already mapped, so add to list and recreate Windows palette */
1155 list = (struct w32_palette_entry *)
1156 xmalloc (sizeof (struct w32_palette_entry));
1157 SET_W32_COLOR (list->entry, color);
1158 list->refcount = 1;
1159 list->next = FRAME_W32_DISPLAY_INFO (f)->color_list;
1160 FRAME_W32_DISPLAY_INFO (f)->color_list = list;
1161 FRAME_W32_DISPLAY_INFO (f)->num_colors++;
1163 /* set flag that palette must be regenerated */
1164 FRAME_W32_DISPLAY_INFO (f)->regen_palette = TRUE;
1167 void
1168 w32_unmap_color (FRAME_PTR f, COLORREF color)
1170 struct w32_palette_entry * list = FRAME_W32_DISPLAY_INFO (f)->color_list;
1171 struct w32_palette_entry **prev = &FRAME_W32_DISPLAY_INFO (f)->color_list;
1173 if (NILP (Vw32_enable_palette))
1174 return;
1176 /* check if color is already mapped */
1177 while (list)
1179 if (W32_COLOR (list->entry) == color)
1181 if (--list->refcount == 0)
1183 *prev = list->next;
1184 xfree (list);
1185 FRAME_W32_DISPLAY_INFO (f)->num_colors--;
1186 break;
1188 else
1189 return;
1191 prev = &list->next;
1192 list = list->next;
1195 /* set flag that palette must be regenerated */
1196 FRAME_W32_DISPLAY_INFO (f)->regen_palette = TRUE;
1198 #endif
1201 /* Gamma-correct COLOR on frame F. */
1203 void
1204 gamma_correct (f, color)
1205 struct frame *f;
1206 COLORREF *color;
1208 if (f->gamma)
1210 *color = PALETTERGB (
1211 pow (GetRValue (*color) / 255.0, f->gamma) * 255.0 + 0.5,
1212 pow (GetGValue (*color) / 255.0, f->gamma) * 255.0 + 0.5,
1213 pow (GetBValue (*color) / 255.0, f->gamma) * 255.0 + 0.5);
1218 /* Decide if color named COLOR is valid for the display associated with
1219 the selected frame; if so, return the rgb values in COLOR_DEF.
1220 If ALLOC is nonzero, allocate a new colormap cell. */
1223 w32_defined_color (f, color, color_def, alloc)
1224 FRAME_PTR f;
1225 char *color;
1226 XColor *color_def;
1227 int alloc;
1229 register Lisp_Object tem;
1230 COLORREF w32_color_ref;
1232 tem = x_to_w32_color (color);
1234 if (!NILP (tem))
1236 if (f)
1238 /* Apply gamma correction. */
1239 w32_color_ref = XUINT (tem);
1240 gamma_correct (f, &w32_color_ref);
1241 XSETINT (tem, w32_color_ref);
1244 /* Map this color to the palette if it is enabled. */
1245 if (!NILP (Vw32_enable_palette))
1247 struct w32_palette_entry * entry =
1248 one_w32_display_info.color_list;
1249 struct w32_palette_entry ** prev =
1250 &one_w32_display_info.color_list;
1252 /* check if color is already mapped */
1253 while (entry)
1255 if (W32_COLOR (entry->entry) == XUINT (tem))
1256 break;
1257 prev = &entry->next;
1258 entry = entry->next;
1261 if (entry == NULL && alloc)
1263 /* not already mapped, so add to list */
1264 entry = (struct w32_palette_entry *)
1265 xmalloc (sizeof (struct w32_palette_entry));
1266 SET_W32_COLOR (entry->entry, XUINT (tem));
1267 entry->next = NULL;
1268 *prev = entry;
1269 one_w32_display_info.num_colors++;
1271 /* set flag that palette must be regenerated */
1272 one_w32_display_info.regen_palette = TRUE;
1275 /* Ensure COLORREF value is snapped to nearest color in (default)
1276 palette by simulating the PALETTERGB macro. This works whether
1277 or not the display device has a palette. */
1278 w32_color_ref = XUINT (tem) | 0x2000000;
1280 color_def->pixel = w32_color_ref;
1281 color_def->red = GetRValue (w32_color_ref) * 256;
1282 color_def->green = GetGValue (w32_color_ref) * 256;
1283 color_def->blue = GetBValue (w32_color_ref) * 256;
1285 return 1;
1287 else
1289 return 0;
1293 /* Given a string ARG naming a color, compute a pixel value from it
1294 suitable for screen F.
1295 If F is not a color screen, return DEF (default) regardless of what
1296 ARG says. */
1299 x_decode_color (f, arg, def)
1300 FRAME_PTR f;
1301 Lisp_Object arg;
1302 int def;
1304 XColor cdef;
1306 CHECK_STRING (arg);
1308 if (strcmp (SDATA (arg), "black") == 0)
1309 return BLACK_PIX_DEFAULT (f);
1310 else if (strcmp (SDATA (arg), "white") == 0)
1311 return WHITE_PIX_DEFAULT (f);
1313 if ((FRAME_W32_DISPLAY_INFO (f)->n_planes * FRAME_W32_DISPLAY_INFO (f)->n_cbits) == 1)
1314 return def;
1316 /* w32_defined_color is responsible for coping with failures
1317 by looking for a near-miss. */
1318 if (w32_defined_color (f, SDATA (arg), &cdef, 1))
1319 return cdef.pixel;
1321 /* defined_color failed; return an ultimate default. */
1322 return def;
1327 /* Functions called only from `x_set_frame_param'
1328 to set individual parameters.
1330 If FRAME_W32_WINDOW (f) is 0,
1331 the frame is being created and its window does not exist yet.
1332 In that case, just record the parameter's new value
1333 in the standard place; do not attempt to change the window. */
1335 void
1336 x_set_foreground_color (f, arg, oldval)
1337 struct frame *f;
1338 Lisp_Object arg, oldval;
1340 struct w32_output *x = f->output_data.w32;
1341 PIX_TYPE fg, old_fg;
1343 fg = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1344 old_fg = FRAME_FOREGROUND_PIXEL (f);
1345 FRAME_FOREGROUND_PIXEL (f) = fg;
1347 if (FRAME_W32_WINDOW (f) != 0)
1349 if (x->cursor_pixel == old_fg)
1350 x->cursor_pixel = fg;
1352 update_face_from_frame_parameter (f, Qforeground_color, arg);
1353 if (FRAME_VISIBLE_P (f))
1354 redraw_frame (f);
1358 void
1359 x_set_background_color (f, arg, oldval)
1360 struct frame *f;
1361 Lisp_Object arg, oldval;
1363 FRAME_BACKGROUND_PIXEL (f)
1364 = x_decode_color (f, arg, WHITE_PIX_DEFAULT (f));
1366 if (FRAME_W32_WINDOW (f) != 0)
1368 SetWindowLong (FRAME_W32_WINDOW (f), WND_BACKGROUND_INDEX,
1369 FRAME_BACKGROUND_PIXEL (f));
1371 update_face_from_frame_parameter (f, Qbackground_color, arg);
1373 if (FRAME_VISIBLE_P (f))
1374 redraw_frame (f);
1378 void
1379 x_set_mouse_color (f, arg, oldval)
1380 struct frame *f;
1381 Lisp_Object arg, oldval;
1383 Cursor cursor, nontext_cursor, mode_cursor, hand_cursor;
1384 int count;
1385 int mask_color;
1387 if (!EQ (Qnil, arg))
1388 f->output_data.w32->mouse_pixel
1389 = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1390 mask_color = FRAME_BACKGROUND_PIXEL (f);
1392 /* Don't let pointers be invisible. */
1393 if (mask_color == f->output_data.w32->mouse_pixel
1394 && mask_color == FRAME_BACKGROUND_PIXEL (f))
1395 f->output_data.w32->mouse_pixel = FRAME_FOREGROUND_PIXEL (f);
1397 #if 0 /* TODO : Mouse cursor customization. */
1398 BLOCK_INPUT;
1400 /* It's not okay to crash if the user selects a screwy cursor. */
1401 count = x_catch_errors (FRAME_W32_DISPLAY (f));
1403 if (!EQ (Qnil, Vx_pointer_shape))
1405 CHECK_NUMBER (Vx_pointer_shape);
1406 cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XINT (Vx_pointer_shape));
1408 else
1409 cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_xterm);
1410 x_check_errors (FRAME_W32_DISPLAY (f), "bad text pointer cursor: %s");
1412 if (!EQ (Qnil, Vx_nontext_pointer_shape))
1414 CHECK_NUMBER (Vx_nontext_pointer_shape);
1415 nontext_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f),
1416 XINT (Vx_nontext_pointer_shape));
1418 else
1419 nontext_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_left_ptr);
1420 x_check_errors (FRAME_W32_DISPLAY (f), "bad nontext pointer cursor: %s");
1422 if (!EQ (Qnil, Vx_hourglass_pointer_shape))
1424 CHECK_NUMBER (Vx_hourglass_pointer_shape);
1425 hourglass_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f),
1426 XINT (Vx_hourglass_pointer_shape));
1428 else
1429 hourglass_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_watch);
1430 x_check_errors (FRAME_W32_DISPLAY (f), "bad busy pointer cursor: %s");
1432 x_check_errors (FRAME_W32_DISPLAY (f), "bad nontext pointer cursor: %s");
1433 if (!EQ (Qnil, Vx_mode_pointer_shape))
1435 CHECK_NUMBER (Vx_mode_pointer_shape);
1436 mode_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f),
1437 XINT (Vx_mode_pointer_shape));
1439 else
1440 mode_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_xterm);
1441 x_check_errors (FRAME_W32_DISPLAY (f), "bad modeline pointer cursor: %s");
1443 if (!EQ (Qnil, Vx_sensitive_text_pointer_shape))
1445 CHECK_NUMBER (Vx_sensitive_text_pointer_shape);
1446 hand_cursor
1447 = XCreateFontCursor (FRAME_W32_DISPLAY (f),
1448 XINT (Vx_sensitive_text_pointer_shape));
1450 else
1451 hand_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_crosshair);
1453 if (!NILP (Vx_window_horizontal_drag_shape))
1455 CHECK_NUMBER (Vx_window_horizontal_drag_shape);
1456 horizontal_drag_cursor
1457 = XCreateFontCursor (FRAME_X_DISPLAY (f),
1458 XINT (Vx_window_horizontal_drag_shape));
1460 else
1461 horizontal_drag_cursor
1462 = XCreateFontCursor (FRAME_X_DISPLAY (f), XC_sb_h_double_arrow);
1464 /* Check and report errors with the above calls. */
1465 x_check_errors (FRAME_W32_DISPLAY (f), "can't set cursor shape: %s");
1466 x_uncatch_errors (FRAME_W32_DISPLAY (f), count);
1469 XColor fore_color, back_color;
1471 fore_color.pixel = f->output_data.w32->mouse_pixel;
1472 back_color.pixel = mask_color;
1473 XQueryColor (FRAME_W32_DISPLAY (f),
1474 DefaultColormap (FRAME_W32_DISPLAY (f),
1475 DefaultScreen (FRAME_W32_DISPLAY (f))),
1476 &fore_color);
1477 XQueryColor (FRAME_W32_DISPLAY (f),
1478 DefaultColormap (FRAME_W32_DISPLAY (f),
1479 DefaultScreen (FRAME_W32_DISPLAY (f))),
1480 &back_color);
1481 XRecolorCursor (FRAME_W32_DISPLAY (f), cursor,
1482 &fore_color, &back_color);
1483 XRecolorCursor (FRAME_W32_DISPLAY (f), nontext_cursor,
1484 &fore_color, &back_color);
1485 XRecolorCursor (FRAME_W32_DISPLAY (f), mode_cursor,
1486 &fore_color, &back_color);
1487 XRecolorCursor (FRAME_W32_DISPLAY (f), hand_cursor,
1488 &fore_color, &back_color);
1489 XRecolorCursor (FRAME_W32_DISPLAY (f), hourglass_cursor,
1490 &fore_color, &back_color);
1493 if (FRAME_W32_WINDOW (f) != 0)
1494 XDefineCursor (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f), cursor);
1496 if (cursor != f->output_data.w32->text_cursor && f->output_data.w32->text_cursor != 0)
1497 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->text_cursor);
1498 f->output_data.w32->text_cursor = cursor;
1500 if (nontext_cursor != f->output_data.w32->nontext_cursor
1501 && f->output_data.w32->nontext_cursor != 0)
1502 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->nontext_cursor);
1503 f->output_data.w32->nontext_cursor = nontext_cursor;
1505 if (hourglass_cursor != f->output_data.w32->hourglass_cursor
1506 && f->output_data.w32->hourglass_cursor != 0)
1507 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->hourglass_cursor);
1508 f->output_data.w32->hourglass_cursor = hourglass_cursor;
1510 if (mode_cursor != f->output_data.w32->modeline_cursor
1511 && f->output_data.w32->modeline_cursor != 0)
1512 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->modeline_cursor);
1513 f->output_data.w32->modeline_cursor = mode_cursor;
1515 if (hand_cursor != f->output_data.w32->hand_cursor
1516 && f->output_data.w32->hand_cursor != 0)
1517 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->hand_cursor);
1518 f->output_data.w32->hand_cursor = hand_cursor;
1520 XFlush (FRAME_W32_DISPLAY (f));
1521 UNBLOCK_INPUT;
1523 update_face_from_frame_parameter (f, Qmouse_color, arg);
1524 #endif /* TODO */
1527 void
1528 x_set_cursor_color (f, arg, oldval)
1529 struct frame *f;
1530 Lisp_Object arg, oldval;
1532 unsigned long fore_pixel, pixel;
1534 if (!NILP (Vx_cursor_fore_pixel))
1535 fore_pixel = x_decode_color (f, Vx_cursor_fore_pixel,
1536 WHITE_PIX_DEFAULT (f));
1537 else
1538 fore_pixel = FRAME_BACKGROUND_PIXEL (f);
1540 pixel = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1542 /* Make sure that the cursor color differs from the background color. */
1543 if (pixel == FRAME_BACKGROUND_PIXEL (f))
1545 pixel = f->output_data.w32->mouse_pixel;
1546 if (pixel == fore_pixel)
1547 fore_pixel = FRAME_BACKGROUND_PIXEL (f);
1550 f->output_data.w32->cursor_foreground_pixel = fore_pixel;
1551 f->output_data.w32->cursor_pixel = pixel;
1553 if (FRAME_W32_WINDOW (f) != 0)
1555 BLOCK_INPUT;
1556 /* Update frame's cursor_gc. */
1557 f->output_data.w32->cursor_gc->foreground = fore_pixel;
1558 f->output_data.w32->cursor_gc->background = pixel;
1560 UNBLOCK_INPUT;
1562 if (FRAME_VISIBLE_P (f))
1564 x_update_cursor (f, 0);
1565 x_update_cursor (f, 1);
1569 update_face_from_frame_parameter (f, Qcursor_color, arg);
1572 /* Set the border-color of frame F to pixel value PIX.
1573 Note that this does not fully take effect if done before
1574 F has a window. */
1576 void
1577 x_set_border_pixel (f, pix)
1578 struct frame *f;
1579 int pix;
1582 f->output_data.w32->border_pixel = pix;
1584 if (FRAME_W32_WINDOW (f) != 0 && f->border_width > 0)
1586 if (FRAME_VISIBLE_P (f))
1587 redraw_frame (f);
1591 /* Set the border-color of frame F to value described by ARG.
1592 ARG can be a string naming a color.
1593 The border-color is used for the border that is drawn by the server.
1594 Note that this does not fully take effect if done before
1595 F has a window; it must be redone when the window is created. */
1597 void
1598 x_set_border_color (f, arg, oldval)
1599 struct frame *f;
1600 Lisp_Object arg, oldval;
1602 int pix;
1604 CHECK_STRING (arg);
1605 pix = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1606 x_set_border_pixel (f, pix);
1607 update_face_from_frame_parameter (f, Qborder_color, arg);
1611 void
1612 x_set_cursor_type (f, arg, oldval)
1613 FRAME_PTR f;
1614 Lisp_Object arg, oldval;
1616 set_frame_cursor_types (f, arg);
1618 /* Make sure the cursor gets redrawn. */
1619 cursor_type_changed = 1;
1622 void
1623 x_set_icon_type (f, arg, oldval)
1624 struct frame *f;
1625 Lisp_Object arg, oldval;
1627 int result;
1629 if (NILP (arg) && NILP (oldval))
1630 return;
1632 if (STRINGP (arg) && STRINGP (oldval)
1633 && EQ (Fstring_equal (oldval, arg), Qt))
1634 return;
1636 if (SYMBOLP (arg) && SYMBOLP (oldval) && EQ (arg, oldval))
1637 return;
1639 BLOCK_INPUT;
1641 result = x_bitmap_icon (f, arg);
1642 if (result)
1644 UNBLOCK_INPUT;
1645 error ("No icon window available");
1648 UNBLOCK_INPUT;
1651 void
1652 x_set_icon_name (f, arg, oldval)
1653 struct frame *f;
1654 Lisp_Object arg, oldval;
1656 if (STRINGP (arg))
1658 if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
1659 return;
1661 else if (!NILP (arg) || NILP (oldval))
1662 return;
1664 f->icon_name = arg;
1666 #if 0
1667 if (f->output_data.w32->icon_bitmap != 0)
1668 return;
1670 BLOCK_INPUT;
1672 result = x_text_icon (f,
1673 (char *) SDATA ((!NILP (f->icon_name)
1674 ? f->icon_name
1675 : !NILP (f->title)
1676 ? f->title
1677 : f->name)));
1679 if (result)
1681 UNBLOCK_INPUT;
1682 error ("No icon window available");
1685 /* If the window was unmapped (and its icon was mapped),
1686 the new icon is not mapped, so map the window in its stead. */
1687 if (FRAME_VISIBLE_P (f))
1689 #ifdef USE_X_TOOLKIT
1690 XtPopup (f->output_data.w32->widget, XtGrabNone);
1691 #endif
1692 XMapWindow (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f));
1695 XFlush (FRAME_W32_DISPLAY (f));
1696 UNBLOCK_INPUT;
1697 #endif
1701 void
1702 x_set_menu_bar_lines (f, value, oldval)
1703 struct frame *f;
1704 Lisp_Object value, oldval;
1706 int nlines;
1707 int olines = FRAME_MENU_BAR_LINES (f);
1709 /* Right now, menu bars don't work properly in minibuf-only frames;
1710 most of the commands try to apply themselves to the minibuffer
1711 frame itself, and get an error because you can't switch buffers
1712 in or split the minibuffer window. */
1713 if (FRAME_MINIBUF_ONLY_P (f))
1714 return;
1716 if (INTEGERP (value))
1717 nlines = XINT (value);
1718 else
1719 nlines = 0;
1721 FRAME_MENU_BAR_LINES (f) = 0;
1722 if (nlines)
1723 FRAME_EXTERNAL_MENU_BAR (f) = 1;
1724 else
1726 if (FRAME_EXTERNAL_MENU_BAR (f) == 1)
1727 free_frame_menubar (f);
1728 FRAME_EXTERNAL_MENU_BAR (f) = 0;
1730 /* Adjust the frame size so that the client (text) dimensions
1731 remain the same. This depends on FRAME_EXTERNAL_MENU_BAR being
1732 set correctly. */
1733 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
1734 do_pending_window_change (0);
1736 adjust_glyphs (f);
1740 /* Set the number of lines used for the tool bar of frame F to VALUE.
1741 VALUE not an integer, or < 0 means set the lines to zero. OLDVAL
1742 is the old number of tool bar lines. This function changes the
1743 height of all windows on frame F to match the new tool bar height.
1744 The frame's height doesn't change. */
1746 void
1747 x_set_tool_bar_lines (f, value, oldval)
1748 struct frame *f;
1749 Lisp_Object value, oldval;
1751 int delta, nlines, root_height;
1752 Lisp_Object root_window;
1754 /* Treat tool bars like menu bars. */
1755 if (FRAME_MINIBUF_ONLY_P (f))
1756 return;
1758 /* Use VALUE only if an integer >= 0. */
1759 if (INTEGERP (value) && XINT (value) >= 0)
1760 nlines = XFASTINT (value);
1761 else
1762 nlines = 0;
1764 /* Make sure we redisplay all windows in this frame. */
1765 ++windows_or_buffers_changed;
1767 delta = nlines - FRAME_TOOL_BAR_LINES (f);
1769 /* Don't resize the tool-bar to more than we have room for. */
1770 root_window = FRAME_ROOT_WINDOW (f);
1771 root_height = WINDOW_TOTAL_LINES (XWINDOW (root_window));
1772 if (root_height - delta < 1)
1774 delta = root_height - 1;
1775 nlines = FRAME_TOOL_BAR_LINES (f) + delta;
1778 FRAME_TOOL_BAR_LINES (f) = nlines;
1779 change_window_heights (root_window, delta);
1780 adjust_glyphs (f);
1782 /* We also have to make sure that the internal border at the top of
1783 the frame, below the menu bar or tool bar, is redrawn when the
1784 tool bar disappears. This is so because the internal border is
1785 below the tool bar if one is displayed, but is below the menu bar
1786 if there isn't a tool bar. The tool bar draws into the area
1787 below the menu bar. */
1788 if (FRAME_W32_WINDOW (f) && FRAME_TOOL_BAR_LINES (f) == 0)
1790 clear_frame (f);
1791 clear_current_matrices (f);
1794 /* If the tool bar gets smaller, the internal border below it
1795 has to be cleared. It was formerly part of the display
1796 of the larger tool bar, and updating windows won't clear it. */
1797 if (delta < 0)
1799 int height = FRAME_INTERNAL_BORDER_WIDTH (f);
1800 int width = FRAME_PIXEL_WIDTH (f);
1801 int y = nlines * FRAME_LINE_HEIGHT (f);
1803 BLOCK_INPUT;
1805 HDC hdc = get_frame_dc (f);
1806 w32_clear_area (f, hdc, 0, y, width, height);
1807 release_frame_dc (f, hdc);
1809 UNBLOCK_INPUT;
1811 if (WINDOWP (f->tool_bar_window))
1812 clear_glyph_matrix (XWINDOW (f->tool_bar_window)->current_matrix);
1817 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
1818 w32_id_name.
1820 If EXPLICIT is non-zero, that indicates that lisp code is setting the
1821 name; if NAME is a string, set F's name to NAME and set
1822 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
1824 If EXPLICIT is zero, that indicates that Emacs redisplay code is
1825 suggesting a new name, which lisp code should override; if
1826 F->explicit_name is set, ignore the new name; otherwise, set it. */
1828 void
1829 x_set_name (f, name, explicit)
1830 struct frame *f;
1831 Lisp_Object name;
1832 int explicit;
1834 /* Make sure that requests from lisp code override requests from
1835 Emacs redisplay code. */
1836 if (explicit)
1838 /* If we're switching from explicit to implicit, we had better
1839 update the mode lines and thereby update the title. */
1840 if (f->explicit_name && NILP (name))
1841 update_mode_lines = 1;
1843 f->explicit_name = ! NILP (name);
1845 else if (f->explicit_name)
1846 return;
1848 /* If NAME is nil, set the name to the w32_id_name. */
1849 if (NILP (name))
1851 /* Check for no change needed in this very common case
1852 before we do any consing. */
1853 if (!strcmp (FRAME_W32_DISPLAY_INFO (f)->w32_id_name,
1854 SDATA (f->name)))
1855 return;
1856 name = build_string (FRAME_W32_DISPLAY_INFO (f)->w32_id_name);
1858 else
1859 CHECK_STRING (name);
1861 /* Don't change the name if it's already NAME. */
1862 if (! NILP (Fstring_equal (name, f->name)))
1863 return;
1865 f->name = name;
1867 /* For setting the frame title, the title parameter should override
1868 the name parameter. */
1869 if (! NILP (f->title))
1870 name = f->title;
1872 if (FRAME_W32_WINDOW (f))
1874 if (STRING_MULTIBYTE (name))
1875 name = ENCODE_SYSTEM (name);
1877 BLOCK_INPUT;
1878 SetWindowText (FRAME_W32_WINDOW (f), SDATA (name));
1879 UNBLOCK_INPUT;
1883 /* This function should be called when the user's lisp code has
1884 specified a name for the frame; the name will override any set by the
1885 redisplay code. */
1886 void
1887 x_explicitly_set_name (f, arg, oldval)
1888 FRAME_PTR f;
1889 Lisp_Object arg, oldval;
1891 x_set_name (f, arg, 1);
1894 /* This function should be called by Emacs redisplay code to set the
1895 name; names set this way will never override names set by the user's
1896 lisp code. */
1897 void
1898 x_implicitly_set_name (f, arg, oldval)
1899 FRAME_PTR f;
1900 Lisp_Object arg, oldval;
1902 x_set_name (f, arg, 0);
1905 /* Change the title of frame F to NAME.
1906 If NAME is nil, use the frame name as the title. */
1908 void
1909 x_set_title (f, name, old_name)
1910 struct frame *f;
1911 Lisp_Object name, old_name;
1913 /* Don't change the title if it's already NAME. */
1914 if (EQ (name, f->title))
1915 return;
1917 update_mode_lines = 1;
1919 f->title = name;
1921 if (NILP (name))
1922 name = f->name;
1924 if (FRAME_W32_WINDOW (f))
1926 if (STRING_MULTIBYTE (name))
1927 name = ENCODE_SYSTEM (name);
1929 BLOCK_INPUT;
1930 SetWindowText (FRAME_W32_WINDOW (f), SDATA (name));
1931 UNBLOCK_INPUT;
1936 void x_set_scroll_bar_default_width (f)
1937 struct frame *f;
1939 int wid = FRAME_COLUMN_WIDTH (f);
1941 FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = GetSystemMetrics (SM_CXVSCROLL);
1942 FRAME_CONFIG_SCROLL_BAR_COLS (f) = (FRAME_CONFIG_SCROLL_BAR_WIDTH (f) +
1943 wid - 1) / wid;
1947 /* Subroutines for creating a frame. */
1949 Cursor
1950 w32_load_cursor (LPCTSTR name)
1952 /* Try first to load cursor from application resource. */
1953 Cursor cursor = LoadImage ((HINSTANCE) GetModuleHandle (NULL),
1954 name, IMAGE_CURSOR, 0, 0,
1955 LR_DEFAULTCOLOR | LR_DEFAULTSIZE | LR_SHARED);
1956 if (!cursor)
1958 /* Then try to load a shared predefined cursor. */
1959 cursor = LoadImage (NULL, name, IMAGE_CURSOR, 0, 0,
1960 LR_DEFAULTCOLOR | LR_DEFAULTSIZE | LR_SHARED);
1962 return cursor;
1965 extern LRESULT CALLBACK w32_wnd_proc ();
1967 static BOOL
1968 w32_init_class (hinst)
1969 HINSTANCE hinst;
1971 WNDCLASS wc;
1973 wc.style = CS_HREDRAW | CS_VREDRAW;
1974 wc.lpfnWndProc = (WNDPROC) w32_wnd_proc;
1975 wc.cbClsExtra = 0;
1976 wc.cbWndExtra = WND_EXTRA_BYTES;
1977 wc.hInstance = hinst;
1978 wc.hIcon = LoadIcon (hinst, EMACS_CLASS);
1979 wc.hCursor = w32_load_cursor (IDC_ARROW);
1980 wc.hbrBackground = NULL; /* GetStockObject (WHITE_BRUSH); */
1981 wc.lpszMenuName = NULL;
1982 wc.lpszClassName = EMACS_CLASS;
1984 return (RegisterClass (&wc));
1987 static HWND
1988 w32_createscrollbar (f, bar)
1989 struct frame *f;
1990 struct scroll_bar * bar;
1992 return (CreateWindow ("SCROLLBAR", "", SBS_VERT | WS_CHILD | WS_VISIBLE,
1993 /* Position and size of scroll bar. */
1994 XINT (bar->left) + VERTICAL_SCROLL_BAR_WIDTH_TRIM,
1995 XINT (bar->top),
1996 XINT (bar->width) - VERTICAL_SCROLL_BAR_WIDTH_TRIM * 2,
1997 XINT (bar->height),
1998 FRAME_W32_WINDOW (f),
1999 NULL,
2000 hinst,
2001 NULL));
2004 static void
2005 w32_createwindow (f)
2006 struct frame *f;
2008 HWND hwnd;
2009 RECT rect;
2010 Lisp_Object top = Qunbound;
2011 Lisp_Object left = Qunbound;
2012 struct w32_display_info *dpyinfo = &one_w32_display_info;
2014 rect.left = rect.top = 0;
2015 rect.right = FRAME_PIXEL_WIDTH (f);
2016 rect.bottom = FRAME_PIXEL_HEIGHT (f);
2018 AdjustWindowRect (&rect, f->output_data.w32->dwStyle,
2019 FRAME_EXTERNAL_MENU_BAR (f));
2021 /* Do first time app init */
2023 if (!hprevinst)
2025 w32_init_class (hinst);
2028 if (f->size_hint_flags & USPosition || f->size_hint_flags & PPosition)
2030 XSETINT (left, f->left_pos);
2031 XSETINT (top, f->top_pos);
2033 else if (EQ (left, Qunbound) && EQ (top, Qunbound))
2035 /* When called with RES_TYPE_NUMBER, w32_get_arg will return zero
2036 for anything that is not a number and is not Qunbound. */
2037 left = x_get_arg (dpyinfo, Qnil, Qleft, "left", "Left", RES_TYPE_NUMBER);
2038 top = x_get_arg (dpyinfo, Qnil, Qtop, "top", "Top", RES_TYPE_NUMBER);
2041 FRAME_W32_WINDOW (f) = hwnd
2042 = CreateWindow (EMACS_CLASS,
2043 f->namebuf,
2044 f->output_data.w32->dwStyle | WS_CLIPCHILDREN,
2045 EQ (left, Qunbound) ? CW_USEDEFAULT : XINT (left),
2046 EQ (top, Qunbound) ? CW_USEDEFAULT : XINT (top),
2047 rect.right - rect.left,
2048 rect.bottom - rect.top,
2049 NULL,
2050 NULL,
2051 hinst,
2052 NULL);
2054 if (hwnd)
2056 SetWindowLong (hwnd, WND_FONTWIDTH_INDEX, FRAME_COLUMN_WIDTH (f));
2057 SetWindowLong (hwnd, WND_LINEHEIGHT_INDEX, FRAME_LINE_HEIGHT (f));
2058 SetWindowLong (hwnd, WND_BORDER_INDEX, FRAME_INTERNAL_BORDER_WIDTH (f));
2059 SetWindowLong (hwnd, WND_SCROLLBAR_INDEX, f->scroll_bar_actual_width);
2060 SetWindowLong (hwnd, WND_BACKGROUND_INDEX, FRAME_BACKGROUND_PIXEL (f));
2062 /* Enable drag-n-drop. */
2063 DragAcceptFiles (hwnd, TRUE);
2065 /* Do this to discard the default setting specified by our parent. */
2066 ShowWindow (hwnd, SW_HIDE);
2068 /* Update frame positions. */
2069 GetWindowRect (hwnd, &rect);
2070 f->left_pos = rect.left;
2071 f->top_pos = rect.top;
2075 static void
2076 my_post_msg (wmsg, hwnd, msg, wParam, lParam)
2077 W32Msg * wmsg;
2078 HWND hwnd;
2079 UINT msg;
2080 WPARAM wParam;
2081 LPARAM lParam;
2083 wmsg->msg.hwnd = hwnd;
2084 wmsg->msg.message = msg;
2085 wmsg->msg.wParam = wParam;
2086 wmsg->msg.lParam = lParam;
2087 wmsg->msg.time = GetMessageTime ();
2089 post_msg (wmsg);
2092 /* GetKeyState and MapVirtualKey on Windows 95 do not actually distinguish
2093 between left and right keys as advertised. We test for this
2094 support dynamically, and set a flag when the support is absent. If
2095 absent, we keep track of the left and right control and alt keys
2096 ourselves. This is particularly necessary on keyboards that rely
2097 upon the AltGr key, which is represented as having the left control
2098 and right alt keys pressed. For these keyboards, we need to know
2099 when the left alt key has been pressed in addition to the AltGr key
2100 so that we can properly support M-AltGr-key sequences (such as M-@
2101 on Swedish keyboards). */
2103 #define EMACS_LCONTROL 0
2104 #define EMACS_RCONTROL 1
2105 #define EMACS_LMENU 2
2106 #define EMACS_RMENU 3
2108 static int modifiers[4];
2109 static int modifiers_recorded;
2110 static int modifier_key_support_tested;
2112 static void
2113 test_modifier_support (unsigned int wparam)
2115 unsigned int l, r;
2117 if (wparam != VK_CONTROL && wparam != VK_MENU)
2118 return;
2119 if (wparam == VK_CONTROL)
2121 l = VK_LCONTROL;
2122 r = VK_RCONTROL;
2124 else
2126 l = VK_LMENU;
2127 r = VK_RMENU;
2129 if (!(GetKeyState (l) & 0x8000) && !(GetKeyState (r) & 0x8000))
2130 modifiers_recorded = 1;
2131 else
2132 modifiers_recorded = 0;
2133 modifier_key_support_tested = 1;
2136 static void
2137 record_keydown (unsigned int wparam, unsigned int lparam)
2139 int i;
2141 if (!modifier_key_support_tested)
2142 test_modifier_support (wparam);
2144 if ((wparam != VK_CONTROL && wparam != VK_MENU) || !modifiers_recorded)
2145 return;
2147 if (wparam == VK_CONTROL)
2148 i = (lparam & 0x1000000) ? EMACS_RCONTROL : EMACS_LCONTROL;
2149 else
2150 i = (lparam & 0x1000000) ? EMACS_RMENU : EMACS_LMENU;
2152 modifiers[i] = 1;
2155 static void
2156 record_keyup (unsigned int wparam, unsigned int lparam)
2158 int i;
2160 if ((wparam != VK_CONTROL && wparam != VK_MENU) || !modifiers_recorded)
2161 return;
2163 if (wparam == VK_CONTROL)
2164 i = (lparam & 0x1000000) ? EMACS_RCONTROL : EMACS_LCONTROL;
2165 else
2166 i = (lparam & 0x1000000) ? EMACS_RMENU : EMACS_LMENU;
2168 modifiers[i] = 0;
2171 /* Emacs can lose focus while a modifier key has been pressed. When
2172 it regains focus, be conservative and clear all modifiers since
2173 we cannot reconstruct the left and right modifier state. */
2174 static void
2175 reset_modifiers ()
2177 SHORT ctrl, alt;
2179 if (GetFocus () == NULL)
2180 /* Emacs doesn't have keyboard focus. Do nothing. */
2181 return;
2183 ctrl = GetAsyncKeyState (VK_CONTROL);
2184 alt = GetAsyncKeyState (VK_MENU);
2186 if (!(ctrl & 0x08000))
2187 /* Clear any recorded control modifier state. */
2188 modifiers[EMACS_RCONTROL] = modifiers[EMACS_LCONTROL] = 0;
2190 if (!(alt & 0x08000))
2191 /* Clear any recorded alt modifier state. */
2192 modifiers[EMACS_RMENU] = modifiers[EMACS_LMENU] = 0;
2194 /* Update the state of all modifier keys, because modifiers used in
2195 hot-key combinations can get stuck on if Emacs loses focus as a
2196 result of a hot-key being pressed. */
2198 BYTE keystate[256];
2200 #define CURRENT_STATE(key) ((GetAsyncKeyState (key) & 0x8000) >> 8)
2202 GetKeyboardState (keystate);
2203 keystate[VK_SHIFT] = CURRENT_STATE (VK_SHIFT);
2204 keystate[VK_CONTROL] = CURRENT_STATE (VK_CONTROL);
2205 keystate[VK_LCONTROL] = CURRENT_STATE (VK_LCONTROL);
2206 keystate[VK_RCONTROL] = CURRENT_STATE (VK_RCONTROL);
2207 keystate[VK_MENU] = CURRENT_STATE (VK_MENU);
2208 keystate[VK_LMENU] = CURRENT_STATE (VK_LMENU);
2209 keystate[VK_RMENU] = CURRENT_STATE (VK_RMENU);
2210 keystate[VK_LWIN] = CURRENT_STATE (VK_LWIN);
2211 keystate[VK_RWIN] = CURRENT_STATE (VK_RWIN);
2212 keystate[VK_APPS] = CURRENT_STATE (VK_APPS);
2213 SetKeyboardState (keystate);
2217 /* Synchronize modifier state with what is reported with the current
2218 keystroke. Even if we cannot distinguish between left and right
2219 modifier keys, we know that, if no modifiers are set, then neither
2220 the left or right modifier should be set. */
2221 static void
2222 sync_modifiers ()
2224 if (!modifiers_recorded)
2225 return;
2227 if (!(GetKeyState (VK_CONTROL) & 0x8000))
2228 modifiers[EMACS_RCONTROL] = modifiers[EMACS_LCONTROL] = 0;
2230 if (!(GetKeyState (VK_MENU) & 0x8000))
2231 modifiers[EMACS_RMENU] = modifiers[EMACS_LMENU] = 0;
2234 static int
2235 modifier_set (int vkey)
2237 if (vkey == VK_CAPITAL || vkey == VK_SCROLL)
2238 return (GetKeyState (vkey) & 0x1);
2239 if (!modifiers_recorded)
2240 return (GetKeyState (vkey) & 0x8000);
2242 switch (vkey)
2244 case VK_LCONTROL:
2245 return modifiers[EMACS_LCONTROL];
2246 case VK_RCONTROL:
2247 return modifiers[EMACS_RCONTROL];
2248 case VK_LMENU:
2249 return modifiers[EMACS_LMENU];
2250 case VK_RMENU:
2251 return modifiers[EMACS_RMENU];
2253 return (GetKeyState (vkey) & 0x8000);
2256 /* Convert between the modifier bits W32 uses and the modifier bits
2257 Emacs uses. */
2259 unsigned int
2260 w32_key_to_modifier (int key)
2262 Lisp_Object key_mapping;
2264 switch (key)
2266 case VK_LWIN:
2267 key_mapping = Vw32_lwindow_modifier;
2268 break;
2269 case VK_RWIN:
2270 key_mapping = Vw32_rwindow_modifier;
2271 break;
2272 case VK_APPS:
2273 key_mapping = Vw32_apps_modifier;
2274 break;
2275 case VK_SCROLL:
2276 key_mapping = Vw32_scroll_lock_modifier;
2277 break;
2278 default:
2279 key_mapping = Qnil;
2282 /* NB. This code runs in the input thread, asychronously to the lisp
2283 thread, so we must be careful to ensure access to lisp data is
2284 thread-safe. The following code is safe because the modifier
2285 variable values are updated atomically from lisp and symbols are
2286 not relocated by GC. Also, we don't have to worry about seeing GC
2287 markbits here. */
2288 if (EQ (key_mapping, Qhyper))
2289 return hyper_modifier;
2290 if (EQ (key_mapping, Qsuper))
2291 return super_modifier;
2292 if (EQ (key_mapping, Qmeta))
2293 return meta_modifier;
2294 if (EQ (key_mapping, Qalt))
2295 return alt_modifier;
2296 if (EQ (key_mapping, Qctrl))
2297 return ctrl_modifier;
2298 if (EQ (key_mapping, Qcontrol)) /* synonym for ctrl */
2299 return ctrl_modifier;
2300 if (EQ (key_mapping, Qshift))
2301 return shift_modifier;
2303 /* Don't generate any modifier if not explicitly requested. */
2304 return 0;
2307 static unsigned int
2308 w32_get_modifiers ()
2310 return ((modifier_set (VK_SHIFT) ? shift_modifier : 0) |
2311 (modifier_set (VK_CONTROL) ? ctrl_modifier : 0) |
2312 (modifier_set (VK_LWIN) ? w32_key_to_modifier (VK_LWIN) : 0) |
2313 (modifier_set (VK_RWIN) ? w32_key_to_modifier (VK_RWIN) : 0) |
2314 (modifier_set (VK_APPS) ? w32_key_to_modifier (VK_APPS) : 0) |
2315 (modifier_set (VK_SCROLL) ? w32_key_to_modifier (VK_SCROLL) : 0) |
2316 (modifier_set (VK_MENU) ?
2317 ((NILP (Vw32_alt_is_meta)) ? alt_modifier : meta_modifier) : 0));
2320 /* We map the VK_* modifiers into console modifier constants
2321 so that we can use the same routines to handle both console
2322 and window input. */
2324 static int
2325 construct_console_modifiers ()
2327 int mods;
2329 mods = 0;
2330 mods |= (modifier_set (VK_SHIFT)) ? SHIFT_PRESSED : 0;
2331 mods |= (modifier_set (VK_CAPITAL)) ? CAPSLOCK_ON : 0;
2332 mods |= (modifier_set (VK_SCROLL)) ? SCROLLLOCK_ON : 0;
2333 mods |= (modifier_set (VK_NUMLOCK)) ? NUMLOCK_ON : 0;
2334 mods |= (modifier_set (VK_LCONTROL)) ? LEFT_CTRL_PRESSED : 0;
2335 mods |= (modifier_set (VK_RCONTROL)) ? RIGHT_CTRL_PRESSED : 0;
2336 mods |= (modifier_set (VK_LMENU)) ? LEFT_ALT_PRESSED : 0;
2337 mods |= (modifier_set (VK_RMENU)) ? RIGHT_ALT_PRESSED : 0;
2338 mods |= (modifier_set (VK_LWIN)) ? LEFT_WIN_PRESSED : 0;
2339 mods |= (modifier_set (VK_RWIN)) ? RIGHT_WIN_PRESSED : 0;
2340 mods |= (modifier_set (VK_APPS)) ? APPS_PRESSED : 0;
2342 return mods;
2345 static int
2346 w32_get_key_modifiers (unsigned int wparam, unsigned int lparam)
2348 int mods;
2350 /* Convert to emacs modifiers. */
2351 mods = w32_kbd_mods_to_emacs (construct_console_modifiers (), wparam);
2353 return mods;
2356 unsigned int
2357 map_keypad_keys (unsigned int virt_key, unsigned int extended)
2359 if (virt_key < VK_CLEAR || virt_key > VK_DELETE)
2360 return virt_key;
2362 if (virt_key == VK_RETURN)
2363 return (extended ? VK_NUMPAD_ENTER : VK_RETURN);
2365 if (virt_key >= VK_PRIOR && virt_key <= VK_DOWN)
2366 return (!extended ? (VK_NUMPAD_PRIOR + (virt_key - VK_PRIOR)) : virt_key);
2368 if (virt_key == VK_INSERT || virt_key == VK_DELETE)
2369 return (!extended ? (VK_NUMPAD_INSERT + (virt_key - VK_INSERT)) : virt_key);
2371 if (virt_key == VK_CLEAR)
2372 return (!extended ? VK_NUMPAD_CLEAR : virt_key);
2374 return virt_key;
2377 /* List of special key combinations which w32 would normally capture,
2378 but Emacs should grab instead. Not directly visible to lisp, to
2379 simplify synchronization. Each item is an integer encoding a virtual
2380 key code and modifier combination to capture. */
2381 static Lisp_Object w32_grabbed_keys;
2383 #define HOTKEY(vk, mods) make_number (((vk) & 255) | ((mods) << 8))
2384 #define HOTKEY_ID(k) (XFASTINT (k) & 0xbfff)
2385 #define HOTKEY_VK_CODE(k) (XFASTINT (k) & 255)
2386 #define HOTKEY_MODIFIERS(k) (XFASTINT (k) >> 8)
2388 #define RAW_HOTKEY_ID(k) ((k) & 0xbfff)
2389 #define RAW_HOTKEY_VK_CODE(k) ((k) & 255)
2390 #define RAW_HOTKEY_MODIFIERS(k) ((k) >> 8)
2392 /* Register hot-keys for reserved key combinations when Emacs has
2393 keyboard focus, since this is the only way Emacs can receive key
2394 combinations like Alt-Tab which are used by the system. */
2396 static void
2397 register_hot_keys (hwnd)
2398 HWND hwnd;
2400 Lisp_Object keylist;
2402 /* Use CONSP, since we are called asynchronously. */
2403 for (keylist = w32_grabbed_keys; CONSP (keylist); keylist = XCDR (keylist))
2405 Lisp_Object key = XCAR (keylist);
2407 /* Deleted entries get set to nil. */
2408 if (!INTEGERP (key))
2409 continue;
2411 RegisterHotKey (hwnd, HOTKEY_ID (key),
2412 HOTKEY_MODIFIERS (key), HOTKEY_VK_CODE (key));
2416 static void
2417 unregister_hot_keys (hwnd)
2418 HWND hwnd;
2420 Lisp_Object keylist;
2422 for (keylist = w32_grabbed_keys; CONSP (keylist); keylist = XCDR (keylist))
2424 Lisp_Object key = XCAR (keylist);
2426 if (!INTEGERP (key))
2427 continue;
2429 UnregisterHotKey (hwnd, HOTKEY_ID (key));
2433 /* Main message dispatch loop. */
2435 static void
2436 w32_msg_pump (deferred_msg * msg_buf)
2438 MSG msg;
2439 int result;
2440 HWND focus_window;
2442 msh_mousewheel = RegisterWindowMessage (MSH_MOUSEWHEEL);
2444 while (GetMessage (&msg, NULL, 0, 0))
2446 if (msg.hwnd == NULL)
2448 switch (msg.message)
2450 case WM_NULL:
2451 /* Produced by complete_deferred_msg; just ignore. */
2452 break;
2453 case WM_EMACS_CREATEWINDOW:
2454 /* Initialize COM for this window. Even though we don't use it,
2455 some third party shell extensions can cause it to be used in
2456 system dialogs, which causes a crash if it is not initialized.
2457 This is a known bug in Windows, which was fixed long ago, but
2458 the patch for XP is not publically available until XP SP3,
2459 and older versions will never be patched. */
2460 CoInitialize (NULL);
2461 w32_createwindow ((struct frame *) msg.wParam);
2462 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE, 0, 0))
2463 abort ();
2464 break;
2465 case WM_EMACS_SETLOCALE:
2466 SetThreadLocale (msg.wParam);
2467 /* Reply is not expected. */
2468 break;
2469 case WM_EMACS_SETKEYBOARDLAYOUT:
2470 result = (int) ActivateKeyboardLayout ((HKL) msg.wParam, 0);
2471 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE,
2472 result, 0))
2473 abort ();
2474 break;
2475 case WM_EMACS_REGISTER_HOT_KEY:
2476 focus_window = GetFocus ();
2477 if (focus_window != NULL)
2478 RegisterHotKey (focus_window,
2479 RAW_HOTKEY_ID (msg.wParam),
2480 RAW_HOTKEY_MODIFIERS (msg.wParam),
2481 RAW_HOTKEY_VK_CODE (msg.wParam));
2482 /* Reply is not expected. */
2483 break;
2484 case WM_EMACS_UNREGISTER_HOT_KEY:
2485 focus_window = GetFocus ();
2486 if (focus_window != NULL)
2487 UnregisterHotKey (focus_window, RAW_HOTKEY_ID (msg.wParam));
2488 /* Mark item as erased. NB: this code must be
2489 thread-safe. The next line is okay because the cons
2490 cell is never made into garbage and is not relocated by
2491 GC. */
2492 XSETCAR ((Lisp_Object) ((EMACS_INT) msg.lParam), Qnil);
2493 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE, 0, 0))
2494 abort ();
2495 break;
2496 case WM_EMACS_TOGGLE_LOCK_KEY:
2498 int vk_code = (int) msg.wParam;
2499 int cur_state = (GetKeyState (vk_code) & 1);
2500 Lisp_Object new_state = (Lisp_Object) ((EMACS_INT) msg.lParam);
2502 /* NB: This code must be thread-safe. It is safe to
2503 call NILP because symbols are not relocated by GC,
2504 and pointer here is not touched by GC (so the markbit
2505 can't be set). Numbers are safe because they are
2506 immediate values. */
2507 if (NILP (new_state)
2508 || (NUMBERP (new_state)
2509 && ((XUINT (new_state)) & 1) != cur_state))
2511 one_w32_display_info.faked_key = vk_code;
2513 keybd_event ((BYTE) vk_code,
2514 (BYTE) MapVirtualKey (vk_code, 0),
2515 KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
2516 keybd_event ((BYTE) vk_code,
2517 (BYTE) MapVirtualKey (vk_code, 0),
2518 KEYEVENTF_EXTENDEDKEY | 0, 0);
2519 keybd_event ((BYTE) vk_code,
2520 (BYTE) MapVirtualKey (vk_code, 0),
2521 KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
2522 cur_state = !cur_state;
2524 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE,
2525 cur_state, 0))
2526 abort ();
2528 break;
2529 #ifdef MSG_DEBUG
2530 /* Broadcast messages make it here, so you need to be looking
2531 for something in particular for this to be useful. */
2532 default:
2533 DebPrint (("msg %x not expected by w32_msg_pump\n", msg.message));
2534 #endif
2537 else
2539 DispatchMessage (&msg);
2542 /* Exit nested loop when our deferred message has completed. */
2543 if (msg_buf->completed)
2544 break;
2548 deferred_msg * deferred_msg_head;
2550 static deferred_msg *
2551 find_deferred_msg (HWND hwnd, UINT msg)
2553 deferred_msg * item;
2555 /* Don't actually need synchronization for read access, since
2556 modification of single pointer is always atomic. */
2557 /* enter_crit (); */
2559 for (item = deferred_msg_head; item != NULL; item = item->next)
2560 if (item->w32msg.msg.hwnd == hwnd
2561 && item->w32msg.msg.message == msg)
2562 break;
2564 /* leave_crit (); */
2566 return item;
2569 static LRESULT
2570 send_deferred_msg (deferred_msg * msg_buf,
2571 HWND hwnd,
2572 UINT msg,
2573 WPARAM wParam,
2574 LPARAM lParam)
2576 /* Only input thread can send deferred messages. */
2577 if (GetCurrentThreadId () != dwWindowsThreadId)
2578 abort ();
2580 /* It is an error to send a message that is already deferred. */
2581 if (find_deferred_msg (hwnd, msg) != NULL)
2582 abort ();
2584 /* Enforced synchronization is not needed because this is the only
2585 function that alters deferred_msg_head, and the following critical
2586 section is guaranteed to only be serially reentered (since only the
2587 input thread can call us). */
2589 /* enter_crit (); */
2591 msg_buf->completed = 0;
2592 msg_buf->next = deferred_msg_head;
2593 deferred_msg_head = msg_buf;
2594 my_post_msg (&msg_buf->w32msg, hwnd, msg, wParam, lParam);
2596 /* leave_crit (); */
2598 /* Start a new nested message loop to process other messages until
2599 this one is completed. */
2600 w32_msg_pump (msg_buf);
2602 deferred_msg_head = msg_buf->next;
2604 return msg_buf->result;
2607 void
2608 complete_deferred_msg (HWND hwnd, UINT msg, LRESULT result)
2610 deferred_msg * msg_buf = find_deferred_msg (hwnd, msg);
2612 if (msg_buf == NULL)
2613 /* Message may have been cancelled, so don't abort. */
2614 return;
2616 msg_buf->result = result;
2617 msg_buf->completed = 1;
2619 /* Ensure input thread is woken so it notices the completion. */
2620 PostThreadMessage (dwWindowsThreadId, WM_NULL, 0, 0);
2623 static void
2624 cancel_all_deferred_msgs ()
2626 deferred_msg * item;
2628 /* Don't actually need synchronization for read access, since
2629 modification of single pointer is always atomic. */
2630 /* enter_crit (); */
2632 for (item = deferred_msg_head; item != NULL; item = item->next)
2634 item->result = 0;
2635 item->completed = 1;
2638 /* leave_crit (); */
2640 /* Ensure input thread is woken so it notices the completion. */
2641 PostThreadMessage (dwWindowsThreadId, WM_NULL, 0, 0);
2644 DWORD WINAPI
2645 w32_msg_worker (void *arg)
2647 MSG msg;
2648 deferred_msg dummy_buf;
2650 /* Ensure our message queue is created */
2652 PeekMessage (&msg, NULL, 0, 0, PM_NOREMOVE);
2654 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE, 0, 0))
2655 abort ();
2657 memset (&dummy_buf, 0, sizeof (dummy_buf));
2658 dummy_buf.w32msg.msg.hwnd = NULL;
2659 dummy_buf.w32msg.msg.message = WM_NULL;
2661 /* This is the initial message loop which should only exit when the
2662 application quits. */
2663 w32_msg_pump (&dummy_buf);
2665 return 0;
2668 static void
2669 signal_user_input ()
2671 /* Interrupt any lisp that wants to be interrupted by input. */
2672 if (!NILP (Vthrow_on_input))
2674 Vquit_flag = Vthrow_on_input;
2675 /* If we're inside a function that wants immediate quits,
2676 do it now. */
2677 if (immediate_quit && NILP (Vinhibit_quit))
2679 immediate_quit = 0;
2680 QUIT;
2686 static void
2687 post_character_message (hwnd, msg, wParam, lParam, modifiers)
2688 HWND hwnd;
2689 UINT msg;
2690 WPARAM wParam;
2691 LPARAM lParam;
2692 DWORD modifiers;
2695 W32Msg wmsg;
2697 wmsg.dwModifiers = modifiers;
2699 /* Detect quit_char and set quit-flag directly. Note that we
2700 still need to post a message to ensure the main thread will be
2701 woken up if blocked in sys_select, but we do NOT want to post
2702 the quit_char message itself (because it will usually be as if
2703 the user had typed quit_char twice). Instead, we post a dummy
2704 message that has no particular effect. */
2706 int c = wParam;
2707 if (isalpha (c) && wmsg.dwModifiers == ctrl_modifier)
2708 c = make_ctrl_char (c) & 0377;
2709 if (c == quit_char
2710 || (wmsg.dwModifiers == 0 &&
2711 w32_quit_key && wParam == w32_quit_key))
2713 Vquit_flag = Qt;
2715 /* The choice of message is somewhat arbitrary, as long as
2716 the main thread handler just ignores it. */
2717 msg = WM_NULL;
2719 /* Interrupt any blocking system calls. */
2720 signal_quit ();
2722 /* As a safety precaution, forcibly complete any deferred
2723 messages. This is a kludge, but I don't see any particularly
2724 clean way to handle the situation where a deferred message is
2725 "dropped" in the lisp thread, and will thus never be
2726 completed, eg. by the user trying to activate the menubar
2727 when the lisp thread is busy, and then typing C-g when the
2728 menubar doesn't open promptly (with the result that the
2729 menubar never responds at all because the deferred
2730 WM_INITMENU message is never completed). Another problem
2731 situation is when the lisp thread calls SendMessage (to send
2732 a window manager command) when a message has been deferred;
2733 the lisp thread gets blocked indefinitely waiting for the
2734 deferred message to be completed, which itself is waiting for
2735 the lisp thread to respond.
2737 Note that we don't want to block the input thread waiting for
2738 a reponse from the lisp thread (although that would at least
2739 solve the deadlock problem above), because we want to be able
2740 to receive C-g to interrupt the lisp thread. */
2741 cancel_all_deferred_msgs ();
2743 else
2744 signal_user_input ();
2747 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
2750 /* Main window procedure */
2752 LRESULT CALLBACK
2753 w32_wnd_proc (hwnd, msg, wParam, lParam)
2754 HWND hwnd;
2755 UINT msg;
2756 WPARAM wParam;
2757 LPARAM lParam;
2759 struct frame *f;
2760 struct w32_display_info *dpyinfo = &one_w32_display_info;
2761 W32Msg wmsg;
2762 int windows_translate;
2763 int key;
2765 /* Note that it is okay to call x_window_to_frame, even though we are
2766 not running in the main lisp thread, because frame deletion
2767 requires the lisp thread to synchronize with this thread. Thus, if
2768 a frame struct is returned, it can be used without concern that the
2769 lisp thread might make it disappear while we are using it.
2771 NB. Walking the frame list in this thread is safe (as long as
2772 writes of Lisp_Object slots are atomic, which they are on Windows).
2773 Although delete-frame can destructively modify the frame list while
2774 we are walking it, a garbage collection cannot occur until after
2775 delete-frame has synchronized with this thread.
2777 It is also safe to use functions that make GDI calls, such as
2778 w32_clear_rect, because these functions must obtain a DC handle
2779 from the frame struct using get_frame_dc which is thread-aware. */
2781 switch (msg)
2783 case WM_ERASEBKGND:
2784 f = x_window_to_frame (dpyinfo, hwnd);
2785 if (f)
2787 HDC hdc = get_frame_dc (f);
2788 GetUpdateRect (hwnd, &wmsg.rect, FALSE);
2789 w32_clear_rect (f, hdc, &wmsg.rect);
2790 release_frame_dc (f, hdc);
2792 #if defined (W32_DEBUG_DISPLAY)
2793 DebPrint (("WM_ERASEBKGND (frame %p): erasing %d,%d-%d,%d\n",
2795 wmsg.rect.left, wmsg.rect.top,
2796 wmsg.rect.right, wmsg.rect.bottom));
2797 #endif /* W32_DEBUG_DISPLAY */
2799 return 1;
2800 case WM_PALETTECHANGED:
2801 /* ignore our own changes */
2802 if ((HWND)wParam != hwnd)
2804 f = x_window_to_frame (dpyinfo, hwnd);
2805 if (f)
2806 /* get_frame_dc will realize our palette and force all
2807 frames to be redrawn if needed. */
2808 release_frame_dc (f, get_frame_dc (f));
2810 return 0;
2811 case WM_PAINT:
2813 PAINTSTRUCT paintStruct;
2814 RECT update_rect;
2815 bzero (&update_rect, sizeof (update_rect));
2817 f = x_window_to_frame (dpyinfo, hwnd);
2818 if (f == 0)
2820 DebPrint (("WM_PAINT received for unknown window %p\n", hwnd));
2821 return 0;
2824 /* MSDN Docs say not to call BeginPaint if GetUpdateRect
2825 fails. Apparently this can happen under some
2826 circumstances. */
2827 if (GetUpdateRect (hwnd, &update_rect, FALSE) || !w32_strict_painting)
2829 enter_crit ();
2830 BeginPaint (hwnd, &paintStruct);
2832 /* The rectangles returned by GetUpdateRect and BeginPaint
2833 do not always match. Play it safe by assuming both areas
2834 are invalid. */
2835 UnionRect (&(wmsg.rect), &update_rect, &(paintStruct.rcPaint));
2837 #if defined (W32_DEBUG_DISPLAY)
2838 DebPrint (("WM_PAINT (frame %p): painting %d,%d-%d,%d\n",
2840 wmsg.rect.left, wmsg.rect.top,
2841 wmsg.rect.right, wmsg.rect.bottom));
2842 DebPrint ((" [update region is %d,%d-%d,%d]\n",
2843 update_rect.left, update_rect.top,
2844 update_rect.right, update_rect.bottom));
2845 #endif
2846 EndPaint (hwnd, &paintStruct);
2847 leave_crit ();
2849 /* Change the message type to prevent Windows from
2850 combining WM_PAINT messages in the Lisp thread's queue,
2851 since Windows assumes that each message queue is
2852 dedicated to one frame and does not bother checking
2853 that hwnd matches before combining them. */
2854 my_post_msg (&wmsg, hwnd, WM_EMACS_PAINT, wParam, lParam);
2856 return 0;
2859 /* If GetUpdateRect returns 0 (meaning there is no update
2860 region), assume the whole window needs to be repainted. */
2861 GetClientRect (hwnd, &wmsg.rect);
2862 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
2863 return 0;
2866 case WM_INPUTLANGCHANGE:
2867 /* Inform lisp thread of keyboard layout changes. */
2868 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
2870 /* Clear dead keys in the keyboard state; for simplicity only
2871 preserve modifier key states. */
2873 int i;
2874 BYTE keystate[256];
2876 GetKeyboardState (keystate);
2877 for (i = 0; i < 256; i++)
2878 if (1
2879 && i != VK_SHIFT
2880 && i != VK_LSHIFT
2881 && i != VK_RSHIFT
2882 && i != VK_CAPITAL
2883 && i != VK_NUMLOCK
2884 && i != VK_SCROLL
2885 && i != VK_CONTROL
2886 && i != VK_LCONTROL
2887 && i != VK_RCONTROL
2888 && i != VK_MENU
2889 && i != VK_LMENU
2890 && i != VK_RMENU
2891 && i != VK_LWIN
2892 && i != VK_RWIN)
2893 keystate[i] = 0;
2894 SetKeyboardState (keystate);
2896 goto dflt;
2898 case WM_HOTKEY:
2899 /* Synchronize hot keys with normal input. */
2900 PostMessage (hwnd, WM_KEYDOWN, HIWORD (lParam), 0);
2901 return (0);
2903 case WM_KEYUP:
2904 case WM_SYSKEYUP:
2905 record_keyup (wParam, lParam);
2906 goto dflt;
2908 case WM_KEYDOWN:
2909 case WM_SYSKEYDOWN:
2910 /* Ignore keystrokes we fake ourself; see below. */
2911 if (dpyinfo->faked_key == wParam)
2913 dpyinfo->faked_key = 0;
2914 /* Make sure TranslateMessage sees them though (as long as
2915 they don't produce WM_CHAR messages). This ensures that
2916 indicator lights are toggled promptly on Windows 9x, for
2917 example. */
2918 if (wParam < 256 && lispy_function_keys[wParam])
2920 windows_translate = 1;
2921 goto translate;
2923 return 0;
2926 /* Synchronize modifiers with current keystroke. */
2927 sync_modifiers ();
2928 record_keydown (wParam, lParam);
2929 wParam = map_keypad_keys (wParam, (lParam & 0x1000000L) != 0);
2931 windows_translate = 0;
2933 switch (wParam)
2935 case VK_LWIN:
2936 if (NILP (Vw32_pass_lwindow_to_system))
2938 /* Prevent system from acting on keyup (which opens the
2939 Start menu if no other key was pressed) by simulating a
2940 press of Space which we will ignore. */
2941 if (GetAsyncKeyState (wParam) & 1)
2943 if (NUMBERP (Vw32_phantom_key_code))
2944 key = XUINT (Vw32_phantom_key_code) & 255;
2945 else
2946 key = VK_SPACE;
2947 dpyinfo->faked_key = key;
2948 keybd_event (key, (BYTE) MapVirtualKey (key, 0), 0, 0);
2951 if (!NILP (Vw32_lwindow_modifier))
2952 return 0;
2953 break;
2954 case VK_RWIN:
2955 if (NILP (Vw32_pass_rwindow_to_system))
2957 if (GetAsyncKeyState (wParam) & 1)
2959 if (NUMBERP (Vw32_phantom_key_code))
2960 key = XUINT (Vw32_phantom_key_code) & 255;
2961 else
2962 key = VK_SPACE;
2963 dpyinfo->faked_key = key;
2964 keybd_event (key, (BYTE) MapVirtualKey (key, 0), 0, 0);
2967 if (!NILP (Vw32_rwindow_modifier))
2968 return 0;
2969 break;
2970 case VK_APPS:
2971 if (!NILP (Vw32_apps_modifier))
2972 return 0;
2973 break;
2974 case VK_MENU:
2975 if (NILP (Vw32_pass_alt_to_system))
2976 /* Prevent DefWindowProc from activating the menu bar if an
2977 Alt key is pressed and released by itself. */
2978 return 0;
2979 windows_translate = 1;
2980 break;
2981 case VK_CAPITAL:
2982 /* Decide whether to treat as modifier or function key. */
2983 if (NILP (Vw32_enable_caps_lock))
2984 goto disable_lock_key;
2985 windows_translate = 1;
2986 break;
2987 case VK_NUMLOCK:
2988 /* Decide whether to treat as modifier or function key. */
2989 if (NILP (Vw32_enable_num_lock))
2990 goto disable_lock_key;
2991 windows_translate = 1;
2992 break;
2993 case VK_SCROLL:
2994 /* Decide whether to treat as modifier or function key. */
2995 if (NILP (Vw32_scroll_lock_modifier))
2996 goto disable_lock_key;
2997 windows_translate = 1;
2998 break;
2999 disable_lock_key:
3000 /* Ensure the appropriate lock key state (and indicator light)
3001 remains in the same state. We do this by faking another
3002 press of the relevant key. Apparently, this really is the
3003 only way to toggle the state of the indicator lights. */
3004 dpyinfo->faked_key = wParam;
3005 keybd_event ((BYTE) wParam, (BYTE) MapVirtualKey (wParam, 0),
3006 KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
3007 keybd_event ((BYTE) wParam, (BYTE) MapVirtualKey (wParam, 0),
3008 KEYEVENTF_EXTENDEDKEY | 0, 0);
3009 keybd_event ((BYTE) wParam, (BYTE) MapVirtualKey (wParam, 0),
3010 KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
3011 /* Ensure indicator lights are updated promptly on Windows 9x
3012 (TranslateMessage apparently does this), after forwarding
3013 input event. */
3014 post_character_message (hwnd, msg, wParam, lParam,
3015 w32_get_key_modifiers (wParam, lParam));
3016 windows_translate = 1;
3017 break;
3018 case VK_CONTROL:
3019 case VK_SHIFT:
3020 case VK_PROCESSKEY: /* Generated by IME. */
3021 windows_translate = 1;
3022 break;
3023 case VK_CANCEL:
3024 /* Windows maps Ctrl-Pause (aka Ctrl-Break) into VK_CANCEL,
3025 which is confusing for purposes of key binding; convert
3026 VK_CANCEL events into VK_PAUSE events. */
3027 wParam = VK_PAUSE;
3028 break;
3029 case VK_PAUSE:
3030 /* Windows maps Ctrl-NumLock into VK_PAUSE, which is confusing
3031 for purposes of key binding; convert these back into
3032 VK_NUMLOCK events, at least when we want to see NumLock key
3033 presses. (Note that there is never any possibility that
3034 VK_PAUSE with Ctrl really is C-Pause as per above.) */
3035 if (NILP (Vw32_enable_num_lock) && modifier_set (VK_CONTROL))
3036 wParam = VK_NUMLOCK;
3037 break;
3038 default:
3039 /* If not defined as a function key, change it to a WM_CHAR message. */
3040 if (wParam > 255 || !lispy_function_keys[wParam])
3042 DWORD modifiers = construct_console_modifiers ();
3044 if (!NILP (Vw32_recognize_altgr)
3045 && modifier_set (VK_LCONTROL) && modifier_set (VK_RMENU))
3047 /* Always let TranslateMessage handle AltGr key chords;
3048 for some reason, ToAscii doesn't always process AltGr
3049 chords correctly. */
3050 windows_translate = 1;
3052 else if ((modifiers & (~SHIFT_PRESSED & ~CAPSLOCK_ON)) != 0)
3054 /* Handle key chords including any modifiers other
3055 than shift directly, in order to preserve as much
3056 modifier information as possible. */
3057 if ('A' <= wParam && wParam <= 'Z')
3059 /* Don't translate modified alphabetic keystrokes,
3060 so the user doesn't need to constantly switch
3061 layout to type control or meta keystrokes when
3062 the normal layout translates alphabetic
3063 characters to non-ascii characters. */
3064 if (!modifier_set (VK_SHIFT))
3065 wParam += ('a' - 'A');
3066 msg = WM_CHAR;
3068 else
3070 /* Try to handle other keystrokes by determining the
3071 base character (ie. translating the base key plus
3072 shift modifier). */
3073 int add;
3074 int isdead = 0;
3075 KEY_EVENT_RECORD key;
3077 key.bKeyDown = TRUE;
3078 key.wRepeatCount = 1;
3079 key.wVirtualKeyCode = wParam;
3080 key.wVirtualScanCode = (lParam & 0xFF0000) >> 16;
3081 key.uChar.AsciiChar = 0;
3082 key.dwControlKeyState = modifiers;
3084 add = w32_kbd_patch_key (&key);
3085 /* 0 means an unrecognised keycode, negative means
3086 dead key. Ignore both. */
3087 while (--add >= 0)
3089 /* Forward asciified character sequence. */
3090 post_character_message
3091 (hwnd, WM_CHAR,
3092 (unsigned char) key.uChar.AsciiChar, lParam,
3093 w32_get_key_modifiers (wParam, lParam));
3094 w32_kbd_patch_key (&key);
3096 return 0;
3099 else
3101 /* Let TranslateMessage handle everything else. */
3102 windows_translate = 1;
3107 translate:
3108 if (windows_translate)
3110 MSG windows_msg = { hwnd, msg, wParam, lParam, 0, {0,0} };
3111 windows_msg.time = GetMessageTime ();
3112 TranslateMessage (&windows_msg);
3113 goto dflt;
3116 /* Fall through */
3118 case WM_SYSCHAR:
3119 case WM_CHAR:
3120 post_character_message (hwnd, msg, wParam, lParam,
3121 w32_get_key_modifiers (wParam, lParam));
3122 break;
3124 case WM_UNICHAR:
3125 /* WM_UNICHAR looks promising from the docs, but the exact
3126 circumstances in which TranslateMessage sends it is one of those
3127 Microsoft secret API things that EU and US courts are supposed
3128 to have put a stop to already. Spy++ shows it being sent to Notepad
3129 and other MS apps, but never to Emacs.
3131 Some third party IMEs send it in accordance with the official
3132 documentation though, so handle it here.
3134 UNICODE_NOCHAR is used to test for support for this message.
3135 TRUE indicates that the message is supported. */
3136 if (wParam == UNICODE_NOCHAR)
3137 return TRUE;
3140 W32Msg wmsg;
3141 wmsg.dwModifiers = w32_get_key_modifiers (wParam, lParam);
3142 signal_user_input ();
3143 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3145 break;
3147 case WM_IME_CHAR:
3148 /* If we can't get the IME result as unicode, use default processing,
3149 which will at least allow characters decodable in the system locale
3150 get through. */
3151 if (!get_composition_string_fn)
3152 goto dflt;
3154 else if (!ignore_ime_char)
3156 wchar_t * buffer;
3157 int size, i;
3158 W32Msg wmsg;
3159 HIMC context = get_ime_context_fn (hwnd);
3160 wmsg.dwModifiers = w32_get_key_modifiers (wParam, lParam);
3161 /* Get buffer size. */
3162 size = get_composition_string_fn (context, GCS_RESULTSTR, buffer, 0);
3163 buffer = alloca(size);
3164 size = get_composition_string_fn (context, GCS_RESULTSTR,
3165 buffer, size);
3166 release_ime_context_fn (hwnd, context);
3168 signal_user_input ();
3169 for (i = 0; i < size / sizeof (wchar_t); i++)
3171 my_post_msg (&wmsg, hwnd, WM_UNICHAR, (WPARAM) buffer[i],
3172 lParam);
3174 /* Ignore the messages for the rest of the
3175 characters in the string that was output above. */
3176 ignore_ime_char = (size / sizeof (wchar_t)) - 1;
3178 else
3179 ignore_ime_char--;
3181 break;
3183 case WM_IME_STARTCOMPOSITION:
3184 if (!set_ime_composition_window_fn)
3185 goto dflt;
3186 else
3188 COMPOSITIONFORM form;
3189 HIMC context;
3190 struct window *w;
3192 if (!context)
3193 break;
3195 f = x_window_to_frame (dpyinfo, hwnd);
3196 w = XWINDOW (FRAME_SELECTED_WINDOW (f));
3198 form.dwStyle = CFS_RECT;
3199 form.ptCurrentPos.x = w32_system_caret_x;
3200 form.ptCurrentPos.y = w32_system_caret_y;
3202 form.rcArea.left = WINDOW_TEXT_TO_FRAME_PIXEL_X (w, 0);
3203 form.rcArea.top = (WINDOW_TOP_EDGE_Y (w)
3204 + WINDOW_HEADER_LINE_HEIGHT (w));
3205 form.rcArea.right = (WINDOW_BOX_RIGHT_EDGE_X (w)
3206 - WINDOW_RIGHT_MARGIN_WIDTH (w)
3207 - WINDOW_RIGHT_FRINGE_WIDTH (w));
3208 form.rcArea.bottom = (WINDOW_BOTTOM_EDGE_Y (w)
3209 - WINDOW_MODE_LINE_HEIGHT (w));
3211 context = get_ime_context_fn (hwnd);
3212 set_ime_composition_window_fn (context, &form);
3213 release_ime_context_fn (hwnd, context);
3215 break;
3217 case WM_IME_ENDCOMPOSITION:
3218 ignore_ime_char = 0;
3219 goto dflt;
3221 /* Simulate middle mouse button events when left and right buttons
3222 are used together, but only if user has two button mouse. */
3223 case WM_LBUTTONDOWN:
3224 case WM_RBUTTONDOWN:
3225 if (w32_num_mouse_buttons > 2)
3226 goto handle_plain_button;
3229 int this = (msg == WM_LBUTTONDOWN) ? LMOUSE : RMOUSE;
3230 int other = (msg == WM_LBUTTONDOWN) ? RMOUSE : LMOUSE;
3232 if (button_state & this)
3233 return 0;
3235 if (button_state == 0)
3236 SetCapture (hwnd);
3238 button_state |= this;
3240 if (button_state & other)
3242 if (mouse_button_timer)
3244 KillTimer (hwnd, mouse_button_timer);
3245 mouse_button_timer = 0;
3247 /* Generate middle mouse event instead. */
3248 msg = WM_MBUTTONDOWN;
3249 button_state |= MMOUSE;
3251 else if (button_state & MMOUSE)
3253 /* Ignore button event if we've already generated a
3254 middle mouse down event. This happens if the
3255 user releases and press one of the two buttons
3256 after we've faked a middle mouse event. */
3257 return 0;
3259 else
3261 /* Flush out saved message. */
3262 post_msg (&saved_mouse_button_msg);
3264 wmsg.dwModifiers = w32_get_modifiers ();
3265 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3266 signal_user_input ();
3268 /* Clear message buffer. */
3269 saved_mouse_button_msg.msg.hwnd = 0;
3271 else
3273 /* Hold onto message for now. */
3274 mouse_button_timer =
3275 SetTimer (hwnd, MOUSE_BUTTON_ID,
3276 w32_mouse_button_tolerance, NULL);
3277 saved_mouse_button_msg.msg.hwnd = hwnd;
3278 saved_mouse_button_msg.msg.message = msg;
3279 saved_mouse_button_msg.msg.wParam = wParam;
3280 saved_mouse_button_msg.msg.lParam = lParam;
3281 saved_mouse_button_msg.msg.time = GetMessageTime ();
3282 saved_mouse_button_msg.dwModifiers = w32_get_modifiers ();
3285 return 0;
3287 case WM_LBUTTONUP:
3288 case WM_RBUTTONUP:
3289 if (w32_num_mouse_buttons > 2)
3290 goto handle_plain_button;
3293 int this = (msg == WM_LBUTTONUP) ? LMOUSE : RMOUSE;
3294 int other = (msg == WM_LBUTTONUP) ? RMOUSE : LMOUSE;
3296 if ((button_state & this) == 0)
3297 return 0;
3299 button_state &= ~this;
3301 if (button_state & MMOUSE)
3303 /* Only generate event when second button is released. */
3304 if ((button_state & other) == 0)
3306 msg = WM_MBUTTONUP;
3307 button_state &= ~MMOUSE;
3309 if (button_state) abort ();
3311 else
3312 return 0;
3314 else
3316 /* Flush out saved message if necessary. */
3317 if (saved_mouse_button_msg.msg.hwnd)
3319 post_msg (&saved_mouse_button_msg);
3322 wmsg.dwModifiers = w32_get_modifiers ();
3323 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3324 signal_user_input ();
3326 /* Always clear message buffer and cancel timer. */
3327 saved_mouse_button_msg.msg.hwnd = 0;
3328 KillTimer (hwnd, mouse_button_timer);
3329 mouse_button_timer = 0;
3331 if (button_state == 0)
3332 ReleaseCapture ();
3334 return 0;
3336 case WM_XBUTTONDOWN:
3337 case WM_XBUTTONUP:
3338 if (w32_pass_extra_mouse_buttons_to_system)
3339 goto dflt;
3340 /* else fall through and process them. */
3341 case WM_MBUTTONDOWN:
3342 case WM_MBUTTONUP:
3343 handle_plain_button:
3345 BOOL up;
3346 int button;
3348 /* Ignore middle and extra buttons as long as the menu is active. */
3349 f = x_window_to_frame (dpyinfo, hwnd);
3350 if (f && f->output_data.w32->menubar_active)
3351 return 0;
3353 if (parse_button (msg, HIWORD (wParam), &button, &up))
3355 if (up) ReleaseCapture ();
3356 else SetCapture (hwnd);
3357 button = (button == 0) ? LMOUSE :
3358 ((button == 1) ? MMOUSE : RMOUSE);
3359 if (up)
3360 button_state &= ~button;
3361 else
3362 button_state |= button;
3366 wmsg.dwModifiers = w32_get_modifiers ();
3367 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3368 signal_user_input ();
3370 /* Need to return true for XBUTTON messages, false for others,
3371 to indicate that we processed the message. */
3372 return (msg == WM_XBUTTONDOWN || msg == WM_XBUTTONUP);
3374 case WM_MOUSEMOVE:
3375 /* Ignore mouse movements as long as the menu is active. These
3376 movements are processed by the window manager anyway, and
3377 it's wrong to handle them as if they happened on the
3378 underlying frame. */
3379 f = x_window_to_frame (dpyinfo, hwnd);
3380 if (f && f->output_data.w32->menubar_active)
3381 return 0;
3383 /* If the mouse has just moved into the frame, start tracking
3384 it, so we will be notified when it leaves the frame. Mouse
3385 tracking only works under W98 and NT4 and later. On earlier
3386 versions, there is no way of telling when the mouse leaves the
3387 frame, so we just have to put up with help-echo and mouse
3388 highlighting remaining while the frame is not active. */
3389 if (track_mouse_event_fn && !track_mouse_window)
3391 TRACKMOUSEEVENT tme;
3392 tme.cbSize = sizeof (tme);
3393 tme.dwFlags = TME_LEAVE;
3394 tme.hwndTrack = hwnd;
3396 track_mouse_event_fn (&tme);
3397 track_mouse_window = hwnd;
3399 case WM_VSCROLL:
3400 if (w32_mouse_move_interval <= 0
3401 || (msg == WM_MOUSEMOVE && button_state == 0))
3403 wmsg.dwModifiers = w32_get_modifiers ();
3404 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3405 return 0;
3408 /* Hang onto mouse move and scroll messages for a bit, to avoid
3409 sending such events to Emacs faster than it can process them.
3410 If we get more events before the timer from the first message
3411 expires, we just replace the first message. */
3413 if (saved_mouse_move_msg.msg.hwnd == 0)
3414 mouse_move_timer =
3415 SetTimer (hwnd, MOUSE_MOVE_ID,
3416 w32_mouse_move_interval, NULL);
3418 /* Hold onto message for now. */
3419 saved_mouse_move_msg.msg.hwnd = hwnd;
3420 saved_mouse_move_msg.msg.message = msg;
3421 saved_mouse_move_msg.msg.wParam = wParam;
3422 saved_mouse_move_msg.msg.lParam = lParam;
3423 saved_mouse_move_msg.msg.time = GetMessageTime ();
3424 saved_mouse_move_msg.dwModifiers = w32_get_modifiers ();
3426 return 0;
3428 case WM_MOUSEWHEEL:
3429 case WM_DROPFILES:
3430 wmsg.dwModifiers = w32_get_modifiers ();
3431 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3432 signal_user_input ();
3433 return 0;
3435 case WM_APPCOMMAND:
3436 if (w32_pass_multimedia_buttons_to_system)
3437 goto dflt;
3438 /* Otherwise, pass to lisp, the same way we do with mousehwheel. */
3439 case WM_MOUSEHWHEEL:
3440 wmsg.dwModifiers = w32_get_modifiers ();
3441 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3442 signal_user_input ();
3443 /* Non-zero must be returned when WM_MOUSEHWHEEL messages are
3444 handled, to prevent the system trying to handle it by faking
3445 scroll bar events. */
3446 return 1;
3448 case WM_TIMER:
3449 /* Flush out saved messages if necessary. */
3450 if (wParam == mouse_button_timer)
3452 if (saved_mouse_button_msg.msg.hwnd)
3454 post_msg (&saved_mouse_button_msg);
3455 signal_user_input ();
3456 saved_mouse_button_msg.msg.hwnd = 0;
3458 KillTimer (hwnd, mouse_button_timer);
3459 mouse_button_timer = 0;
3461 else if (wParam == mouse_move_timer)
3463 if (saved_mouse_move_msg.msg.hwnd)
3465 post_msg (&saved_mouse_move_msg);
3466 saved_mouse_move_msg.msg.hwnd = 0;
3468 KillTimer (hwnd, mouse_move_timer);
3469 mouse_move_timer = 0;
3471 else if (wParam == menu_free_timer)
3473 KillTimer (hwnd, menu_free_timer);
3474 menu_free_timer = 0;
3475 f = x_window_to_frame (dpyinfo, hwnd);
3476 /* If a popup menu is active, don't wipe its strings. */
3477 if (menubar_in_use
3478 && current_popup_menu == NULL)
3480 /* Free memory used by owner-drawn and help-echo strings. */
3481 w32_free_menu_strings (hwnd);
3482 f->output_data.w32->menubar_active = 0;
3483 menubar_in_use = 0;
3486 else if (wParam == hourglass_timer)
3488 KillTimer (hwnd, hourglass_timer);
3489 hourglass_timer = 0;
3490 w32_show_hourglass (x_window_to_frame (dpyinfo, hwnd));
3492 return 0;
3494 case WM_NCACTIVATE:
3495 /* Windows doesn't send us focus messages when putting up and
3496 taking down a system popup dialog as for Ctrl-Alt-Del on Windows 95.
3497 The only indication we get that something happened is receiving
3498 this message afterwards. So this is a good time to reset our
3499 keyboard modifiers' state. */
3500 reset_modifiers ();
3501 goto dflt;
3503 case WM_INITMENU:
3504 button_state = 0;
3505 ReleaseCapture ();
3506 /* We must ensure menu bar is fully constructed and up to date
3507 before allowing user interaction with it. To achieve this
3508 we send this message to the lisp thread and wait for a
3509 reply (whose value is not actually needed) to indicate that
3510 the menu bar is now ready for use, so we can now return.
3512 To remain responsive in the meantime, we enter a nested message
3513 loop that can process all other messages.
3515 However, we skip all this if the message results from calling
3516 TrackPopupMenu - in fact, we must NOT attempt to send the lisp
3517 thread a message because it is blocked on us at this point. We
3518 set menubar_active before calling TrackPopupMenu to indicate
3519 this (there is no possibility of confusion with real menubar
3520 being active). */
3522 f = x_window_to_frame (dpyinfo, hwnd);
3523 if (f
3524 && (f->output_data.w32->menubar_active
3525 /* We can receive this message even in the absence of a
3526 menubar (ie. when the system menu is activated) - in this
3527 case we do NOT want to forward the message, otherwise it
3528 will cause the menubar to suddenly appear when the user
3529 had requested it to be turned off! */
3530 || f->output_data.w32->menubar_widget == NULL))
3531 return 0;
3534 deferred_msg msg_buf;
3536 /* Detect if message has already been deferred; in this case
3537 we cannot return any sensible value to ignore this. */
3538 if (find_deferred_msg (hwnd, msg) != NULL)
3539 abort ();
3541 menubar_in_use = 1;
3543 return send_deferred_msg (&msg_buf, hwnd, msg, wParam, lParam);
3546 case WM_EXITMENULOOP:
3547 f = x_window_to_frame (dpyinfo, hwnd);
3549 /* If a menu is still active, check again after a short delay,
3550 since Windows often (always?) sends the WM_EXITMENULOOP
3551 before the corresponding WM_COMMAND message.
3552 Don't do this if a popup menu is active, since it is only
3553 menubar menus that require cleaning up in this way.
3555 if (f && menubar_in_use && current_popup_menu == NULL)
3556 menu_free_timer = SetTimer (hwnd, MENU_FREE_ID, MENU_FREE_DELAY, NULL);
3558 /* If hourglass cursor should be displayed, display it now. */
3559 if (f && f->output_data.w32->hourglass_p)
3560 SetCursor (f->output_data.w32->hourglass_cursor);
3562 goto dflt;
3564 case WM_MENUSELECT:
3565 /* Direct handling of help_echo in menus. Should be safe now
3566 that we generate the help_echo by placing a help event in the
3567 keyboard buffer. */
3569 HMENU menu = (HMENU) lParam;
3570 UINT menu_item = (UINT) LOWORD (wParam);
3571 UINT flags = (UINT) HIWORD (wParam);
3573 w32_menu_display_help (hwnd, menu, menu_item, flags);
3575 return 0;
3577 case WM_MEASUREITEM:
3578 f = x_window_to_frame (dpyinfo, hwnd);
3579 if (f)
3581 MEASUREITEMSTRUCT * pMis = (MEASUREITEMSTRUCT *) lParam;
3583 if (pMis->CtlType == ODT_MENU)
3585 /* Work out dimensions for popup menu titles. */
3586 char * title = (char *) pMis->itemData;
3587 HDC hdc = GetDC (hwnd);
3588 HFONT menu_font = GetCurrentObject (hdc, OBJ_FONT);
3589 LOGFONT menu_logfont;
3590 HFONT old_font;
3591 SIZE size;
3593 GetObject (menu_font, sizeof (menu_logfont), &menu_logfont);
3594 menu_logfont.lfWeight = FW_BOLD;
3595 menu_font = CreateFontIndirect (&menu_logfont);
3596 old_font = SelectObject (hdc, menu_font);
3598 pMis->itemHeight = GetSystemMetrics (SM_CYMENUSIZE);
3599 if (title)
3601 if (unicode_append_menu)
3602 GetTextExtentPoint32W (hdc, (WCHAR *) title,
3603 wcslen ((WCHAR *) title),
3604 &size);
3605 else
3606 GetTextExtentPoint32 (hdc, title, strlen (title), &size);
3608 pMis->itemWidth = size.cx;
3609 if (pMis->itemHeight < size.cy)
3610 pMis->itemHeight = size.cy;
3612 else
3613 pMis->itemWidth = 0;
3615 SelectObject (hdc, old_font);
3616 DeleteObject (menu_font);
3617 ReleaseDC (hwnd, hdc);
3618 return TRUE;
3621 return 0;
3623 case WM_DRAWITEM:
3624 f = x_window_to_frame (dpyinfo, hwnd);
3625 if (f)
3627 DRAWITEMSTRUCT * pDis = (DRAWITEMSTRUCT *) lParam;
3629 if (pDis->CtlType == ODT_MENU)
3631 /* Draw popup menu title. */
3632 char * title = (char *) pDis->itemData;
3633 if (title)
3635 HDC hdc = pDis->hDC;
3636 HFONT menu_font = GetCurrentObject (hdc, OBJ_FONT);
3637 LOGFONT menu_logfont;
3638 HFONT old_font;
3640 GetObject (menu_font, sizeof (menu_logfont), &menu_logfont);
3641 menu_logfont.lfWeight = FW_BOLD;
3642 menu_font = CreateFontIndirect (&menu_logfont);
3643 old_font = SelectObject (hdc, menu_font);
3645 /* Always draw title as if not selected. */
3646 if (unicode_append_menu)
3647 ExtTextOutW (hdc,
3648 pDis->rcItem.left
3649 + GetSystemMetrics (SM_CXMENUCHECK),
3650 pDis->rcItem.top,
3651 ETO_OPAQUE, &pDis->rcItem,
3652 (WCHAR *) title,
3653 wcslen ((WCHAR *) title), NULL);
3654 else
3655 ExtTextOut (hdc,
3656 pDis->rcItem.left
3657 + GetSystemMetrics (SM_CXMENUCHECK),
3658 pDis->rcItem.top,
3659 ETO_OPAQUE, &pDis->rcItem,
3660 title, strlen (title), NULL);
3662 SelectObject (hdc, old_font);
3663 DeleteObject (menu_font);
3665 return TRUE;
3668 return 0;
3670 #if 0
3671 /* Still not right - can't distinguish between clicks in the
3672 client area of the frame from clicks forwarded from the scroll
3673 bars - may have to hook WM_NCHITTEST to remember the mouse
3674 position and then check if it is in the client area ourselves. */
3675 case WM_MOUSEACTIVATE:
3676 /* Discard the mouse click that activates a frame, allowing the
3677 user to click anywhere without changing point (or worse!).
3678 Don't eat mouse clicks on scrollbars though!! */
3679 if (LOWORD (lParam) == HTCLIENT )
3680 return MA_ACTIVATEANDEAT;
3681 goto dflt;
3682 #endif
3684 case WM_MOUSELEAVE:
3685 /* No longer tracking mouse. */
3686 track_mouse_window = NULL;
3688 case WM_ACTIVATEAPP:
3689 case WM_ACTIVATE:
3690 case WM_WINDOWPOSCHANGED:
3691 case WM_SHOWWINDOW:
3692 /* Inform lisp thread that a frame might have just been obscured
3693 or exposed, so should recheck visibility of all frames. */
3694 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3695 goto dflt;
3697 case WM_SETFOCUS:
3698 dpyinfo->faked_key = 0;
3699 reset_modifiers ();
3700 register_hot_keys (hwnd);
3701 goto command;
3702 case WM_KILLFOCUS:
3703 unregister_hot_keys (hwnd);
3704 button_state = 0;
3705 ReleaseCapture ();
3706 /* Relinquish the system caret. */
3707 if (w32_system_caret_hwnd)
3709 w32_visible_system_caret_hwnd = NULL;
3710 w32_system_caret_hwnd = NULL;
3711 DestroyCaret ();
3713 goto command;
3714 case WM_COMMAND:
3715 menubar_in_use = 0;
3716 f = x_window_to_frame (dpyinfo, hwnd);
3717 if (f && HIWORD (wParam) == 0)
3719 if (menu_free_timer)
3721 KillTimer (hwnd, menu_free_timer);
3722 menu_free_timer = 0;
3725 case WM_MOVE:
3726 case WM_SIZE:
3727 command:
3728 wmsg.dwModifiers = w32_get_modifiers ();
3729 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3730 goto dflt;
3732 case WM_DESTROY:
3733 CoUninitialize ();
3734 return 0;
3736 case WM_CLOSE:
3737 wmsg.dwModifiers = w32_get_modifiers ();
3738 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3739 return 0;
3741 case WM_WINDOWPOSCHANGING:
3742 /* Don't restrict the sizing of tip frames. */
3743 if (hwnd == tip_window)
3744 return 0;
3746 WINDOWPLACEMENT wp;
3747 LPWINDOWPOS lppos = (WINDOWPOS *) lParam;
3749 wp.length = sizeof (WINDOWPLACEMENT);
3750 GetWindowPlacement (hwnd, &wp);
3752 if (wp.showCmd != SW_SHOWMINIMIZED && (lppos->flags & SWP_NOSIZE) == 0)
3754 RECT rect;
3755 int wdiff;
3756 int hdiff;
3757 DWORD font_width;
3758 DWORD line_height;
3759 DWORD internal_border;
3760 DWORD scrollbar_extra;
3761 RECT wr;
3763 wp.length = sizeof (wp);
3764 GetWindowRect (hwnd, &wr);
3766 enter_crit ();
3768 font_width = GetWindowLong (hwnd, WND_FONTWIDTH_INDEX);
3769 line_height = GetWindowLong (hwnd, WND_LINEHEIGHT_INDEX);
3770 internal_border = GetWindowLong (hwnd, WND_BORDER_INDEX);
3771 scrollbar_extra = GetWindowLong (hwnd, WND_SCROLLBAR_INDEX);
3773 leave_crit ();
3775 memset (&rect, 0, sizeof (rect));
3776 AdjustWindowRect (&rect, GetWindowLong (hwnd, GWL_STYLE),
3777 GetMenu (hwnd) != NULL);
3779 /* Force width and height of client area to be exact
3780 multiples of the character cell dimensions. */
3781 wdiff = (lppos->cx - (rect.right - rect.left)
3782 - 2 * internal_border - scrollbar_extra)
3783 % font_width;
3784 hdiff = (lppos->cy - (rect.bottom - rect.top)
3785 - 2 * internal_border)
3786 % line_height;
3788 if (wdiff || hdiff)
3790 /* For right/bottom sizing we can just fix the sizes.
3791 However for top/left sizing we will need to fix the X
3792 and Y positions as well. */
3794 int cx_mintrack = GetSystemMetrics (SM_CXMINTRACK);
3795 int cy_mintrack = GetSystemMetrics (SM_CYMINTRACK);
3797 lppos->cx = max (lppos->cx - wdiff, cx_mintrack);
3798 lppos->cy = max (lppos->cy - hdiff, cy_mintrack);
3800 if (wp.showCmd != SW_SHOWMAXIMIZED
3801 && (lppos->flags & SWP_NOMOVE) == 0)
3803 if (lppos->x != wr.left || lppos->y != wr.top)
3805 lppos->x += wdiff;
3806 lppos->y += hdiff;
3808 else
3810 lppos->flags |= SWP_NOMOVE;
3814 return 0;
3819 goto dflt;
3821 case WM_GETMINMAXINFO:
3822 /* Hack to allow resizing the Emacs frame above the screen size.
3823 Note that Windows 9x limits coordinates to 16-bits. */
3824 ((LPMINMAXINFO) lParam)->ptMaxTrackSize.x = 32767;
3825 ((LPMINMAXINFO) lParam)->ptMaxTrackSize.y = 32767;
3826 return 0;
3828 case WM_SETCURSOR:
3829 if (LOWORD (lParam) == HTCLIENT)
3831 f = x_window_to_frame (dpyinfo, hwnd);
3832 if (f->output_data.w32->hourglass_p && !menubar_in_use
3833 && !current_popup_menu)
3834 SetCursor (f->output_data.w32->hourglass_cursor);
3835 else
3836 SetCursor (f->output_data.w32->current_cursor);
3837 return 0;
3839 goto dflt;
3841 case WM_EMACS_SETCURSOR:
3843 Cursor cursor = (Cursor) wParam;
3844 f = x_window_to_frame (dpyinfo, hwnd);
3845 if (f && cursor)
3847 f->output_data.w32->current_cursor = cursor;
3848 if (!f->output_data.w32->hourglass_p)
3849 SetCursor (cursor);
3851 return 0;
3854 case WM_EMACS_CREATESCROLLBAR:
3855 return (LRESULT) w32_createscrollbar ((struct frame *) wParam,
3856 (struct scroll_bar *) lParam);
3858 case WM_EMACS_SHOWWINDOW:
3859 return ShowWindow ((HWND) wParam, (WPARAM) lParam);
3861 case WM_EMACS_SETFOREGROUND:
3863 HWND foreground_window;
3864 DWORD foreground_thread, retval;
3866 /* On NT 5.0, and apparently Windows 98, it is necessary to
3867 attach to the thread that currently has focus in order to
3868 pull the focus away from it. */
3869 foreground_window = GetForegroundWindow ();
3870 foreground_thread = GetWindowThreadProcessId (foreground_window, NULL);
3871 if (!foreground_window
3872 || foreground_thread == GetCurrentThreadId ()
3873 || !AttachThreadInput (GetCurrentThreadId (),
3874 foreground_thread, TRUE))
3875 foreground_thread = 0;
3877 retval = SetForegroundWindow ((HWND) wParam);
3879 /* Detach from the previous foreground thread. */
3880 if (foreground_thread)
3881 AttachThreadInput (GetCurrentThreadId (),
3882 foreground_thread, FALSE);
3884 return retval;
3887 case WM_EMACS_SETWINDOWPOS:
3889 WINDOWPOS * pos = (WINDOWPOS *) wParam;
3890 return SetWindowPos (hwnd, pos->hwndInsertAfter,
3891 pos->x, pos->y, pos->cx, pos->cy, pos->flags);
3894 case WM_EMACS_DESTROYWINDOW:
3895 DragAcceptFiles ((HWND) wParam, FALSE);
3896 return DestroyWindow ((HWND) wParam);
3898 case WM_EMACS_HIDE_CARET:
3899 return HideCaret (hwnd);
3901 case WM_EMACS_SHOW_CARET:
3902 return ShowCaret (hwnd);
3904 case WM_EMACS_DESTROY_CARET:
3905 w32_system_caret_hwnd = NULL;
3906 w32_visible_system_caret_hwnd = NULL;
3907 return DestroyCaret ();
3909 case WM_EMACS_TRACK_CARET:
3910 /* If there is currently no system caret, create one. */
3911 if (w32_system_caret_hwnd == NULL)
3913 /* Use the default caret width, and avoid changing it
3914 unneccesarily, as it confuses screen reader software. */
3915 w32_system_caret_hwnd = hwnd;
3916 CreateCaret (hwnd, NULL, 0,
3917 w32_system_caret_height);
3920 if (!SetCaretPos (w32_system_caret_x, w32_system_caret_y))
3921 return 0;
3922 /* Ensure visible caret gets turned on when requested. */
3923 else if (w32_use_visible_system_caret
3924 && w32_visible_system_caret_hwnd != hwnd)
3926 w32_visible_system_caret_hwnd = hwnd;
3927 return ShowCaret (hwnd);
3929 /* Ensure visible caret gets turned off when requested. */
3930 else if (!w32_use_visible_system_caret
3931 && w32_visible_system_caret_hwnd)
3933 w32_visible_system_caret_hwnd = NULL;
3934 return HideCaret (hwnd);
3936 else
3937 return 1;
3939 case WM_EMACS_TRACKPOPUPMENU:
3941 UINT flags;
3942 POINT *pos;
3943 int retval;
3944 pos = (POINT *)lParam;
3945 flags = TPM_CENTERALIGN;
3946 if (button_state & LMOUSE)
3947 flags |= TPM_LEFTBUTTON;
3948 else if (button_state & RMOUSE)
3949 flags |= TPM_RIGHTBUTTON;
3951 /* Remember we did a SetCapture on the initial mouse down event,
3952 so for safety, we make sure the capture is cancelled now. */
3953 ReleaseCapture ();
3954 button_state = 0;
3956 /* Use menubar_active to indicate that WM_INITMENU is from
3957 TrackPopupMenu below, and should be ignored. */
3958 f = x_window_to_frame (dpyinfo, hwnd);
3959 if (f)
3960 f->output_data.w32->menubar_active = 1;
3962 if (TrackPopupMenu ((HMENU)wParam, flags, pos->x, pos->y,
3963 0, hwnd, NULL))
3965 MSG amsg;
3966 /* Eat any mouse messages during popupmenu */
3967 while (PeekMessage (&amsg, hwnd, WM_MOUSEFIRST, WM_MOUSELAST,
3968 PM_REMOVE));
3969 /* Get the menu selection, if any */
3970 if (PeekMessage (&amsg, hwnd, WM_COMMAND, WM_COMMAND, PM_REMOVE))
3972 retval = LOWORD (amsg.wParam);
3974 else
3976 retval = 0;
3979 else
3981 retval = -1;
3984 return retval;
3987 default:
3988 /* Check for messages registered at runtime. */
3989 if (msg == msh_mousewheel)
3991 wmsg.dwModifiers = w32_get_modifiers ();
3992 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3993 signal_user_input ();
3994 return 0;
3997 dflt:
3998 return DefWindowProc (hwnd, msg, wParam, lParam);
4002 /* The most common default return code for handled messages is 0. */
4003 return 0;
4006 static void
4007 my_create_window (f)
4008 struct frame * f;
4010 MSG msg;
4012 if (!PostThreadMessage (dwWindowsThreadId, WM_EMACS_CREATEWINDOW, (WPARAM)f, 0))
4013 abort ();
4014 GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE);
4018 /* Create a tooltip window. Unlike my_create_window, we do not do this
4019 indirectly via the Window thread, as we do not need to process Window
4020 messages for the tooltip. Creating tooltips indirectly also creates
4021 deadlocks when tooltips are created for menu items. */
4022 static void
4023 my_create_tip_window (f)
4024 struct frame *f;
4026 RECT rect;
4028 rect.left = rect.top = 0;
4029 rect.right = FRAME_PIXEL_WIDTH (f);
4030 rect.bottom = FRAME_PIXEL_HEIGHT (f);
4032 AdjustWindowRect (&rect, f->output_data.w32->dwStyle,
4033 FRAME_EXTERNAL_MENU_BAR (f));
4035 tip_window = FRAME_W32_WINDOW (f)
4036 = CreateWindow (EMACS_CLASS,
4037 f->namebuf,
4038 f->output_data.w32->dwStyle,
4039 f->left_pos,
4040 f->top_pos,
4041 rect.right - rect.left,
4042 rect.bottom - rect.top,
4043 FRAME_W32_WINDOW (SELECTED_FRAME ()), /* owner */
4044 NULL,
4045 hinst,
4046 NULL);
4048 if (tip_window)
4050 SetWindowLong (tip_window, WND_FONTWIDTH_INDEX, FRAME_COLUMN_WIDTH (f));
4051 SetWindowLong (tip_window, WND_LINEHEIGHT_INDEX, FRAME_LINE_HEIGHT (f));
4052 SetWindowLong (tip_window, WND_BORDER_INDEX, FRAME_INTERNAL_BORDER_WIDTH (f));
4053 SetWindowLong (tip_window, WND_BACKGROUND_INDEX, FRAME_BACKGROUND_PIXEL (f));
4055 /* Tip frames have no scrollbars. */
4056 SetWindowLong (tip_window, WND_SCROLLBAR_INDEX, 0);
4058 /* Do this to discard the default setting specified by our parent. */
4059 ShowWindow (tip_window, SW_HIDE);
4064 /* Create and set up the w32 window for frame F. */
4066 static void
4067 w32_window (f, window_prompting, minibuffer_only)
4068 struct frame *f;
4069 long window_prompting;
4070 int minibuffer_only;
4072 BLOCK_INPUT;
4074 /* Use the resource name as the top-level window name
4075 for looking up resources. Make a non-Lisp copy
4076 for the window manager, so GC relocation won't bother it.
4078 Elsewhere we specify the window name for the window manager. */
4081 char *str = (char *) SDATA (Vx_resource_name);
4082 f->namebuf = (char *) xmalloc (strlen (str) + 1);
4083 strcpy (f->namebuf, str);
4086 my_create_window (f);
4088 validate_x_resource_name ();
4090 /* x_set_name normally ignores requests to set the name if the
4091 requested name is the same as the current name. This is the one
4092 place where that assumption isn't correct; f->name is set, but
4093 the server hasn't been told. */
4095 Lisp_Object name;
4096 int explicit = f->explicit_name;
4098 f->explicit_name = 0;
4099 name = f->name;
4100 f->name = Qnil;
4101 x_set_name (f, name, explicit);
4104 UNBLOCK_INPUT;
4106 if (!minibuffer_only && FRAME_EXTERNAL_MENU_BAR (f))
4107 initialize_frame_menubar (f);
4109 if (FRAME_W32_WINDOW (f) == 0)
4110 error ("Unable to create window");
4113 /* Handle the icon stuff for this window. Perhaps later we might
4114 want an x_set_icon_position which can be called interactively as
4115 well. */
4117 static void
4118 x_icon (f, parms)
4119 struct frame *f;
4120 Lisp_Object parms;
4122 Lisp_Object icon_x, icon_y;
4123 struct w32_display_info *dpyinfo = &one_w32_display_info;
4125 /* Set the position of the icon. Note that Windows 95 groups all
4126 icons in the tray. */
4127 icon_x = x_get_arg (dpyinfo, parms, Qicon_left, 0, 0, RES_TYPE_NUMBER);
4128 icon_y = x_get_arg (dpyinfo, parms, Qicon_top, 0, 0, RES_TYPE_NUMBER);
4129 if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
4131 CHECK_NUMBER (icon_x);
4132 CHECK_NUMBER (icon_y);
4134 else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
4135 error ("Both left and top icon corners of icon must be specified");
4137 BLOCK_INPUT;
4139 if (! EQ (icon_x, Qunbound))
4140 x_wm_set_icon_position (f, XINT (icon_x), XINT (icon_y));
4142 #if 0 /* TODO */
4143 /* Start up iconic or window? */
4144 x_wm_set_window_state
4145 (f, (EQ (x_get_arg (dpyinfo, parms, Qvisibility, 0, 0, RES_TYPE_SYMBOL), Qicon)
4146 ? IconicState
4147 : NormalState));
4149 x_text_icon (f, (char *) SDATA ((!NILP (f->icon_name)
4150 ? f->icon_name
4151 : f->name)));
4152 #endif
4154 UNBLOCK_INPUT;
4158 static void
4159 x_make_gc (f)
4160 struct frame *f;
4162 XGCValues gc_values;
4164 BLOCK_INPUT;
4166 /* Create the GC's of this frame.
4167 Note that many default values are used. */
4169 /* Normal video */
4170 gc_values.font = FRAME_FONT (f);
4172 /* Cursor has cursor-color background, background-color foreground. */
4173 gc_values.foreground = FRAME_BACKGROUND_PIXEL (f);
4174 gc_values.background = f->output_data.w32->cursor_pixel;
4175 f->output_data.w32->cursor_gc
4176 = XCreateGC (NULL, FRAME_W32_WINDOW (f),
4177 (GCFont | GCForeground | GCBackground),
4178 &gc_values);
4180 /* Reliefs. */
4181 f->output_data.w32->white_relief.gc = 0;
4182 f->output_data.w32->black_relief.gc = 0;
4184 UNBLOCK_INPUT;
4188 /* Handler for signals raised during x_create_frame and
4189 x_create_top_frame. FRAME is the frame which is partially
4190 constructed. */
4192 static Lisp_Object
4193 unwind_create_frame (frame)
4194 Lisp_Object frame;
4196 struct frame *f = XFRAME (frame);
4198 /* If frame is ``official'', nothing to do. */
4199 if (!CONSP (Vframe_list) || !EQ (XCAR (Vframe_list), frame))
4201 #ifdef GLYPH_DEBUG
4202 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
4203 #endif
4205 x_free_frame_resources (f);
4207 #if GLYPH_DEBUG
4208 /* Check that reference counts are indeed correct. */
4209 xassert (dpyinfo->reference_count == dpyinfo_refcount);
4210 xassert (dpyinfo->image_cache->refcount == image_cache_refcount);
4211 #endif
4212 return Qt;
4215 return Qnil;
4218 static void
4219 x_default_font_parameter (f, parms)
4220 struct frame *f;
4221 Lisp_Object parms;
4223 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
4224 Lisp_Object font_param = x_get_arg (dpyinfo, parms, Qfont, NULL, NULL,
4225 RES_TYPE_STRING);
4226 Lisp_Object font;
4227 if (EQ (font_param, Qunbound))
4228 font_param = Qnil;
4229 font = !NILP (font_param) ? font_param
4230 : x_get_arg (dpyinfo, parms, Qfont, "font", "Font", RES_TYPE_STRING);
4232 if (!STRINGP (font))
4234 int i;
4235 static char *names[]
4236 = { "Courier New-10",
4237 "-*-Courier-normal-r-*-*-13-*-*-*-c-*-iso8859-1",
4238 "-*-Fixedsys-normal-r-*-*-12-*-*-*-c-*-iso8859-1",
4239 "Fixedsys",
4240 NULL };
4242 for (i = 0; names[i]; i++)
4244 font = font_open_by_name (f, names[i]);
4245 if (! NILP (font))
4246 break;
4248 if (NILP (font))
4249 error ("No suitable font was found");
4251 else if (!NILP (font_param))
4253 /* Remember the explicit font parameter, so we can re-apply it after
4254 we've applied the `default' face settings. */
4255 x_set_frame_parameters (f, Fcons (Fcons (Qfont_param, font_param), Qnil));
4257 x_default_parameter (f, parms, Qfont, font, "font", "Font", RES_TYPE_STRING);
4260 DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
4261 1, 1, 0,
4262 doc: /* Make a new window, which is called a \"frame\" in Emacs terms.
4263 Return an Emacs frame object.
4264 PARAMETERS is an alist of frame parameters.
4265 If the parameters specify that the frame should not have a minibuffer,
4266 and do not specify a specific minibuffer window to use,
4267 then `default-minibuffer-frame' must be a frame whose minibuffer can
4268 be shared by the new frame.
4270 This function is an internal primitive--use `make-frame' instead. */)
4271 (parameters)
4272 Lisp_Object parameters;
4274 struct frame *f;
4275 Lisp_Object frame, tem;
4276 Lisp_Object name;
4277 int minibuffer_only = 0;
4278 long window_prompting = 0;
4279 int width, height;
4280 int count = SPECPDL_INDEX ();
4281 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
4282 Lisp_Object display;
4283 struct w32_display_info *dpyinfo = NULL;
4284 Lisp_Object parent;
4285 struct kboard *kb;
4287 /* Make copy of frame parameters because the original is in pure
4288 storage now. */
4289 parameters = Fcopy_alist (parameters);
4291 /* Use this general default value to start with
4292 until we know if this frame has a specified name. */
4293 Vx_resource_name = Vinvocation_name;
4295 display = x_get_arg (dpyinfo, parameters, Qterminal, 0, 0, RES_TYPE_NUMBER);
4296 if (EQ (display, Qunbound))
4297 display = x_get_arg (dpyinfo, parameters, Qdisplay, 0, 0, RES_TYPE_STRING);
4298 if (EQ (display, Qunbound))
4299 display = Qnil;
4300 dpyinfo = check_x_display_info (display);
4301 kb = dpyinfo->terminal->kboard;
4303 if (!dpyinfo->terminal->name)
4304 error ("Terminal is not live, can't create new frames on it");
4306 name = x_get_arg (dpyinfo, parameters, Qname, "name", "Name", RES_TYPE_STRING);
4307 if (!STRINGP (name)
4308 && ! EQ (name, Qunbound)
4309 && ! NILP (name))
4310 error ("Invalid frame name--not a string or nil");
4312 if (STRINGP (name))
4313 Vx_resource_name = name;
4315 /* See if parent window is specified. */
4316 parent = x_get_arg (dpyinfo, parameters, Qparent_id, NULL, NULL, RES_TYPE_NUMBER);
4317 if (EQ (parent, Qunbound))
4318 parent = Qnil;
4319 if (! NILP (parent))
4320 CHECK_NUMBER (parent);
4322 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
4323 /* No need to protect DISPLAY because that's not used after passing
4324 it to make_frame_without_minibuffer. */
4325 frame = Qnil;
4326 GCPRO4 (parameters, parent, name, frame);
4327 tem = x_get_arg (dpyinfo, parameters, Qminibuffer, "minibuffer", "Minibuffer",
4328 RES_TYPE_SYMBOL);
4329 if (EQ (tem, Qnone) || NILP (tem))
4330 f = make_frame_without_minibuffer (Qnil, kb, display);
4331 else if (EQ (tem, Qonly))
4333 f = make_minibuffer_frame ();
4334 minibuffer_only = 1;
4336 else if (WINDOWP (tem))
4337 f = make_frame_without_minibuffer (tem, kb, display);
4338 else
4339 f = make_frame (1);
4341 XSETFRAME (frame, f);
4343 /* Note that Windows does support scroll bars. */
4344 FRAME_CAN_HAVE_SCROLL_BARS (f) = 1;
4346 /* By default, make scrollbars the system standard width. */
4347 FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = GetSystemMetrics (SM_CXVSCROLL);
4349 f->terminal = dpyinfo->terminal;
4350 f->terminal->reference_count++;
4352 f->output_method = output_w32;
4353 f->output_data.w32 =
4354 (struct w32_output *) xmalloc (sizeof (struct w32_output));
4355 bzero (f->output_data.w32, sizeof (struct w32_output));
4356 FRAME_FONTSET (f) = -1;
4358 f->icon_name
4359 = x_get_arg (dpyinfo, parameters, Qicon_name, "iconName", "Title",
4360 RES_TYPE_STRING);
4361 if (! STRINGP (f->icon_name))
4362 f->icon_name = Qnil;
4364 /* FRAME_W32_DISPLAY_INFO (f) = dpyinfo; */
4366 /* With FRAME_X_DISPLAY_INFO set up, this unwind-protect is safe. */
4367 record_unwind_protect (unwind_create_frame, frame);
4368 #if GLYPH_DEBUG
4369 image_cache_refcount = FRAME_IMAGE_CACHE (f)->refcount;
4370 dpyinfo_refcount = dpyinfo->reference_count;
4371 #endif /* GLYPH_DEBUG */
4373 /* Specify the parent under which to make this window. */
4375 if (!NILP (parent))
4377 f->output_data.w32->parent_desc = (Window) XFASTINT (parent);
4378 f->output_data.w32->explicit_parent = 1;
4380 else
4382 f->output_data.w32->parent_desc = FRAME_W32_DISPLAY_INFO (f)->root_window;
4383 f->output_data.w32->explicit_parent = 0;
4386 /* Set the name; the functions to which we pass f expect the name to
4387 be set. */
4388 if (EQ (name, Qunbound) || NILP (name))
4390 f->name = build_string (dpyinfo->w32_id_name);
4391 f->explicit_name = 0;
4393 else
4395 f->name = name;
4396 f->explicit_name = 1;
4397 /* use the frame's title when getting resources for this frame. */
4398 specbind (Qx_resource_name, name);
4401 f->resx = dpyinfo->resx;
4402 f->resy = dpyinfo->resy;
4404 if (uniscribe_available)
4405 register_font_driver (&uniscribe_font_driver, f);
4406 register_font_driver (&w32font_driver, f);
4408 x_default_parameter (f, parameters, Qfont_backend, Qnil,
4409 "fontBackend", "FontBackend", RES_TYPE_STRING);
4410 /* Extract the window parameters from the supplied values
4411 that are needed to determine window geometry. */
4412 x_default_font_parameter (f, parameters);
4413 x_default_parameter (f, parameters, Qborder_width, make_number (2),
4414 "borderWidth", "BorderWidth", RES_TYPE_NUMBER);
4416 /* We recognize either internalBorderWidth or internalBorder
4417 (which is what xterm calls it). */
4418 if (NILP (Fassq (Qinternal_border_width, parameters)))
4420 Lisp_Object value;
4422 value = x_get_arg (dpyinfo, parameters, Qinternal_border_width,
4423 "internalBorder", "InternalBorder", RES_TYPE_NUMBER);
4424 if (! EQ (value, Qunbound))
4425 parameters = Fcons (Fcons (Qinternal_border_width, value),
4426 parameters);
4428 /* Default internalBorderWidth to 0 on Windows to match other programs. */
4429 x_default_parameter (f, parameters, Qinternal_border_width, make_number (0),
4430 "internalBorderWidth", "InternalBorder", RES_TYPE_NUMBER);
4431 x_default_parameter (f, parameters, Qvertical_scroll_bars, Qright,
4432 "verticalScrollBars", "ScrollBars", RES_TYPE_SYMBOL);
4434 /* Also do the stuff which must be set before the window exists. */
4435 x_default_parameter (f, parameters, Qforeground_color, build_string ("black"),
4436 "foreground", "Foreground", RES_TYPE_STRING);
4437 x_default_parameter (f, parameters, Qbackground_color, build_string ("white"),
4438 "background", "Background", RES_TYPE_STRING);
4439 x_default_parameter (f, parameters, Qmouse_color, build_string ("black"),
4440 "pointerColor", "Foreground", RES_TYPE_STRING);
4441 x_default_parameter (f, parameters, Qcursor_color, build_string ("black"),
4442 "cursorColor", "Foreground", RES_TYPE_STRING);
4443 x_default_parameter (f, parameters, Qborder_color, build_string ("black"),
4444 "borderColor", "BorderColor", RES_TYPE_STRING);
4445 x_default_parameter (f, parameters, Qscreen_gamma, Qnil,
4446 "screenGamma", "ScreenGamma", RES_TYPE_FLOAT);
4447 x_default_parameter (f, parameters, Qline_spacing, Qnil,
4448 "lineSpacing", "LineSpacing", RES_TYPE_NUMBER);
4449 x_default_parameter (f, parameters, Qleft_fringe, Qnil,
4450 "leftFringe", "LeftFringe", RES_TYPE_NUMBER);
4451 x_default_parameter (f, parameters, Qright_fringe, Qnil,
4452 "rightFringe", "RightFringe", RES_TYPE_NUMBER);
4455 /* Init faces before x_default_parameter is called for scroll-bar
4456 parameters because that function calls x_set_scroll_bar_width,
4457 which calls change_frame_size, which calls Fset_window_buffer,
4458 which runs hooks, which call Fvertical_motion. At the end, we
4459 end up in init_iterator with a null face cache, which should not
4460 happen. */
4461 init_frame_faces (f);
4463 x_default_parameter (f, parameters, Qmenu_bar_lines, make_number (1),
4464 "menuBar", "MenuBar", RES_TYPE_NUMBER);
4465 x_default_parameter (f, parameters, Qtool_bar_lines, make_number (1),
4466 "toolBar", "ToolBar", RES_TYPE_NUMBER);
4468 x_default_parameter (f, parameters, Qbuffer_predicate, Qnil,
4469 "bufferPredicate", "BufferPredicate", RES_TYPE_SYMBOL);
4470 x_default_parameter (f, parameters, Qtitle, Qnil,
4471 "title", "Title", RES_TYPE_STRING);
4472 x_default_parameter (f, parameters, Qfullscreen, Qnil,
4473 "fullscreen", "Fullscreen", RES_TYPE_SYMBOL);
4475 f->output_data.w32->dwStyle = WS_OVERLAPPEDWINDOW;
4476 f->output_data.w32->parent_desc = FRAME_W32_DISPLAY_INFO (f)->root_window;
4478 f->output_data.w32->text_cursor = w32_load_cursor (IDC_IBEAM);
4479 f->output_data.w32->nontext_cursor = w32_load_cursor (IDC_ARROW);
4480 f->output_data.w32->modeline_cursor = w32_load_cursor (IDC_ARROW);
4481 f->output_data.w32->hand_cursor = w32_load_cursor (IDC_HAND);
4482 f->output_data.w32->hourglass_cursor = w32_load_cursor (IDC_WAIT);
4483 f->output_data.w32->horizontal_drag_cursor = w32_load_cursor (IDC_SIZEWE);
4485 f->output_data.w32->current_cursor = f->output_data.w32->nontext_cursor;
4487 window_prompting = x_figure_window_size (f, parameters, 1);
4489 tem = x_get_arg (dpyinfo, parameters, Qunsplittable, 0, 0, RES_TYPE_BOOLEAN);
4490 f->no_split = minibuffer_only || EQ (tem, Qt);
4492 w32_window (f, window_prompting, minibuffer_only);
4493 x_icon (f, parameters);
4495 x_make_gc (f);
4497 /* Now consider the frame official. */
4498 FRAME_W32_DISPLAY_INFO (f)->reference_count++;
4499 Vframe_list = Fcons (frame, Vframe_list);
4501 /* We need to do this after creating the window, so that the
4502 icon-creation functions can say whose icon they're describing. */
4503 x_default_parameter (f, parameters, Qicon_type, Qnil,
4504 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL);
4506 x_default_parameter (f, parameters, Qauto_raise, Qnil,
4507 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN);
4508 x_default_parameter (f, parameters, Qauto_lower, Qnil,
4509 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN);
4510 x_default_parameter (f, parameters, Qcursor_type, Qbox,
4511 "cursorType", "CursorType", RES_TYPE_SYMBOL);
4512 x_default_parameter (f, parameters, Qscroll_bar_width, Qnil,
4513 "scrollBarWidth", "ScrollBarWidth", RES_TYPE_NUMBER);
4514 x_default_parameter (f, parameters, Qalpha, Qnil,
4515 "alpha", "Alpha", RES_TYPE_NUMBER);
4517 /* Dimensions, especially FRAME_LINES (f), must be done via change_frame_size.
4518 Change will not be effected unless different from the current
4519 FRAME_LINES (f). */
4520 width = FRAME_COLS (f);
4521 height = FRAME_LINES (f);
4523 FRAME_LINES (f) = 0;
4524 SET_FRAME_COLS (f, 0);
4525 change_frame_size (f, height, width, 1, 0, 0);
4527 /* Tell the server what size and position, etc, we want, and how
4528 badly we want them. This should be done after we have the menu
4529 bar so that its size can be taken into account. */
4530 BLOCK_INPUT;
4531 x_wm_set_size_hint (f, window_prompting, 0);
4532 UNBLOCK_INPUT;
4534 /* Make the window appear on the frame and enable display, unless
4535 the caller says not to. However, with explicit parent, Emacs
4536 cannot control visibility, so don't try. */
4537 if (! f->output_data.w32->explicit_parent)
4539 Lisp_Object visibility;
4541 visibility = x_get_arg (dpyinfo, parameters, Qvisibility, 0, 0, RES_TYPE_SYMBOL);
4542 if (EQ (visibility, Qunbound))
4543 visibility = Qt;
4545 if (EQ (visibility, Qicon))
4546 x_iconify_frame (f);
4547 else if (! NILP (visibility))
4548 x_make_frame_visible (f);
4549 else
4550 /* Must have been Qnil. */
4554 /* Initialize `default-minibuffer-frame' in case this is the first
4555 frame on this terminal. */
4556 if (FRAME_HAS_MINIBUF_P (f)
4557 && (!FRAMEP (kb->Vdefault_minibuffer_frame)
4558 || !FRAME_LIVE_P (XFRAME (kb->Vdefault_minibuffer_frame))))
4559 kb->Vdefault_minibuffer_frame = frame;
4561 /* All remaining specified parameters, which have not been "used"
4562 by x_get_arg and friends, now go in the misc. alist of the frame. */
4563 for (tem = parameters; CONSP (tem); tem = XCDR (tem))
4564 if (CONSP (XCAR (tem)) && !NILP (XCAR (XCAR (tem))))
4565 f->param_alist = Fcons (XCAR (tem), f->param_alist);
4567 UNGCPRO;
4569 /* Make sure windows on this frame appear in calls to next-window
4570 and similar functions. */
4571 Vwindow_list = Qnil;
4573 return unbind_to (count, frame);
4576 /* FRAME is used only to get a handle on the X display. We don't pass the
4577 display info directly because we're called from frame.c, which doesn't
4578 know about that structure. */
4579 Lisp_Object
4580 x_get_focus_frame (frame)
4581 struct frame *frame;
4583 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (frame);
4584 Lisp_Object xfocus;
4585 if (! dpyinfo->w32_focus_frame)
4586 return Qnil;
4588 XSETFRAME (xfocus, dpyinfo->w32_focus_frame);
4589 return xfocus;
4592 DEFUN ("x-focus-frame", Fx_focus_frame, Sx_focus_frame, 1, 1, 0,
4593 doc: /* Give FRAME input focus, raising to foreground if necessary. */)
4594 (frame)
4595 Lisp_Object frame;
4597 x_focus_on_frame (check_x_frame (frame));
4598 return Qnil;
4602 DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1, 2, 0,
4603 doc: /* Internal function called by `color-defined-p', which see. */)
4604 (color, frame)
4605 Lisp_Object color, frame;
4607 XColor foo;
4608 FRAME_PTR f = check_x_frame (frame);
4610 CHECK_STRING (color);
4612 if (w32_defined_color (f, SDATA (color), &foo, 0))
4613 return Qt;
4614 else
4615 return Qnil;
4618 DEFUN ("xw-color-values", Fxw_color_values, Sxw_color_values, 1, 2, 0,
4619 doc: /* Internal function called by `color-values', which see. */)
4620 (color, frame)
4621 Lisp_Object color, frame;
4623 XColor foo;
4624 FRAME_PTR f = check_x_frame (frame);
4626 CHECK_STRING (color);
4628 if (w32_defined_color (f, SDATA (color), &foo, 0))
4629 return list3 (make_number ((GetRValue (foo.pixel) << 8)
4630 | GetRValue (foo.pixel)),
4631 make_number ((GetGValue (foo.pixel) << 8)
4632 | GetGValue (foo.pixel)),
4633 make_number ((GetBValue (foo.pixel) << 8)
4634 | GetBValue (foo.pixel)));
4635 else
4636 return Qnil;
4639 DEFUN ("xw-display-color-p", Fxw_display_color_p, Sxw_display_color_p, 0, 1, 0,
4640 doc: /* Internal function called by `display-color-p', which see. */)
4641 (display)
4642 Lisp_Object display;
4644 struct w32_display_info *dpyinfo = check_x_display_info (display);
4646 if ((dpyinfo->n_planes * dpyinfo->n_cbits) <= 2)
4647 return Qnil;
4649 return Qt;
4652 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p,
4653 Sx_display_grayscale_p, 0, 1, 0,
4654 doc: /* Return t if DISPLAY supports shades of gray.
4655 Note that color displays do support shades of gray.
4656 The optional argument DISPLAY specifies which display to ask about.
4657 DISPLAY should be either a frame or a display name (a string).
4658 If omitted or nil, that stands for the selected frame's display. */)
4659 (display)
4660 Lisp_Object display;
4662 struct w32_display_info *dpyinfo = check_x_display_info (display);
4664 if ((dpyinfo->n_planes * dpyinfo->n_cbits) <= 1)
4665 return Qnil;
4667 return Qt;
4670 DEFUN ("x-display-pixel-width", Fx_display_pixel_width,
4671 Sx_display_pixel_width, 0, 1, 0,
4672 doc: /* Return the width in pixels of DISPLAY.
4673 The optional argument DISPLAY specifies which display to ask about.
4674 DISPLAY should be either a frame or a display name (a string).
4675 If omitted or nil, that stands for the selected frame's display. */)
4676 (display)
4677 Lisp_Object display;
4679 struct w32_display_info *dpyinfo = check_x_display_info (display);
4681 return make_number (x_display_pixel_width (dpyinfo));
4684 DEFUN ("x-display-pixel-height", Fx_display_pixel_height,
4685 Sx_display_pixel_height, 0, 1, 0,
4686 doc: /* Return the height in pixels of DISPLAY.
4687 The optional argument DISPLAY specifies which display to ask about.
4688 DISPLAY should be either a frame or a display name (a string).
4689 If omitted or nil, that stands for the selected frame's display. */)
4690 (display)
4691 Lisp_Object display;
4693 struct w32_display_info *dpyinfo = check_x_display_info (display);
4695 return make_number (x_display_pixel_height (dpyinfo));
4698 DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes,
4699 0, 1, 0,
4700 doc: /* Return the number of bitplanes of DISPLAY.
4701 The optional argument DISPLAY specifies which display to ask about.
4702 DISPLAY should be either a frame or a display name (a string).
4703 If omitted or nil, that stands for the selected frame's display. */)
4704 (display)
4705 Lisp_Object display;
4707 struct w32_display_info *dpyinfo = check_x_display_info (display);
4709 return make_number (dpyinfo->n_planes * dpyinfo->n_cbits);
4712 DEFUN ("x-display-color-cells", Fx_display_color_cells, Sx_display_color_cells,
4713 0, 1, 0,
4714 doc: /* Return the number of color cells of DISPLAY.
4715 The optional argument DISPLAY specifies which display to ask about.
4716 DISPLAY should be either a frame or a display name (a string).
4717 If omitted or nil, that stands for the selected frame's display. */)
4718 (display)
4719 Lisp_Object display;
4721 struct w32_display_info *dpyinfo = check_x_display_info (display);
4722 HDC hdc;
4723 int cap;
4725 hdc = GetDC (dpyinfo->root_window);
4726 if (dpyinfo->has_palette)
4727 cap = GetDeviceCaps (hdc, SIZEPALETTE);
4728 else
4729 cap = GetDeviceCaps (hdc, NUMCOLORS);
4731 /* We force 24+ bit depths to 24-bit, both to prevent an overflow
4732 and because probably is more meaningful on Windows anyway */
4733 if (cap < 0)
4734 cap = 1 << min (dpyinfo->n_planes * dpyinfo->n_cbits, 24);
4736 ReleaseDC (dpyinfo->root_window, hdc);
4738 return make_number (cap);
4741 DEFUN ("x-server-max-request-size", Fx_server_max_request_size,
4742 Sx_server_max_request_size,
4743 0, 1, 0,
4744 doc: /* Return the maximum request size of the server of DISPLAY.
4745 The optional argument DISPLAY specifies which display to ask about.
4746 DISPLAY should be either a frame or a display name (a string).
4747 If omitted or nil, that stands for the selected frame's display. */)
4748 (display)
4749 Lisp_Object display;
4751 struct w32_display_info *dpyinfo = check_x_display_info (display);
4753 return make_number (1);
4756 DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0,
4757 doc: /* Return the "vendor ID" string of the W32 system (Microsoft).
4758 The optional argument DISPLAY specifies which display to ask about.
4759 DISPLAY should be either a frame or a display name (a string).
4760 If omitted or nil, that stands for the selected frame's display. */)
4761 (display)
4762 Lisp_Object display;
4764 return build_string ("Microsoft Corp.");
4767 DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0,
4768 doc: /* Return the version numbers of the server of DISPLAY.
4769 The value is a list of three integers: the major and minor
4770 version numbers of the X Protocol in use, and the distributor-specific
4771 release number. See also the function `x-server-vendor'.
4773 The optional argument DISPLAY specifies which display to ask about.
4774 DISPLAY should be either a frame or a display name (a string).
4775 If omitted or nil, that stands for the selected frame's display. */)
4776 (display)
4777 Lisp_Object display;
4779 return Fcons (make_number (w32_major_version),
4780 Fcons (make_number (w32_minor_version),
4781 Fcons (make_number (w32_build_number), Qnil)));
4784 DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0,
4785 doc: /* Return the number of screens on the server of DISPLAY.
4786 The optional argument DISPLAY specifies which display to ask about.
4787 DISPLAY should be either a frame or a display name (a string).
4788 If omitted or nil, that stands for the selected frame's display. */)
4789 (display)
4790 Lisp_Object display;
4792 return make_number (1);
4795 DEFUN ("x-display-mm-height", Fx_display_mm_height,
4796 Sx_display_mm_height, 0, 1, 0,
4797 doc: /* Return the height in millimeters of DISPLAY.
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 (display)
4802 Lisp_Object display;
4804 struct w32_display_info *dpyinfo = check_x_display_info (display);
4805 HDC hdc;
4806 int cap;
4808 hdc = GetDC (dpyinfo->root_window);
4810 cap = GetDeviceCaps (hdc, VERTSIZE);
4812 ReleaseDC (dpyinfo->root_window, hdc);
4814 return make_number (cap);
4817 DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0,
4818 doc: /* Return the width in millimeters of DISPLAY.
4819 The optional argument DISPLAY specifies which display to ask about.
4820 DISPLAY should be either a frame or a display name (a string).
4821 If omitted or nil, that stands for the selected frame's display. */)
4822 (display)
4823 Lisp_Object display;
4825 struct w32_display_info *dpyinfo = check_x_display_info (display);
4827 HDC hdc;
4828 int cap;
4830 hdc = GetDC (dpyinfo->root_window);
4832 cap = GetDeviceCaps (hdc, HORZSIZE);
4834 ReleaseDC (dpyinfo->root_window, hdc);
4836 return make_number (cap);
4839 DEFUN ("x-display-backing-store", Fx_display_backing_store,
4840 Sx_display_backing_store, 0, 1, 0,
4841 doc: /* Return an indication of whether DISPLAY does backing store.
4842 The value may be `always', `when-mapped', or `not-useful'.
4843 The optional argument DISPLAY specifies which display to ask about.
4844 DISPLAY should be either a frame or a display name (a string).
4845 If omitted or nil, that stands for the selected frame's display. */)
4846 (display)
4847 Lisp_Object display;
4849 return intern ("not-useful");
4852 DEFUN ("x-display-visual-class", Fx_display_visual_class,
4853 Sx_display_visual_class, 0, 1, 0,
4854 doc: /* Return the visual class of DISPLAY.
4855 The value is one of the symbols `static-gray', `gray-scale',
4856 `static-color', `pseudo-color', `true-color', or `direct-color'.
4858 The optional argument DISPLAY specifies which display to ask about.
4859 DISPLAY should be either a frame or a display name (a string).
4860 If omitted or nil, that stands for the selected frame's display. */)
4861 (display)
4862 Lisp_Object display;
4864 struct w32_display_info *dpyinfo = check_x_display_info (display);
4865 Lisp_Object result = Qnil;
4867 if (dpyinfo->has_palette)
4868 result = intern ("pseudo-color");
4869 else if (dpyinfo->n_planes * dpyinfo->n_cbits == 1)
4870 result = intern ("static-grey");
4871 else if (dpyinfo->n_planes * dpyinfo->n_cbits == 4)
4872 result = intern ("static-color");
4873 else if (dpyinfo->n_planes * dpyinfo->n_cbits > 8)
4874 result = intern ("true-color");
4876 return result;
4879 DEFUN ("x-display-save-under", Fx_display_save_under,
4880 Sx_display_save_under, 0, 1, 0,
4881 doc: /* Return t if DISPLAY supports the save-under feature.
4882 The optional argument DISPLAY specifies which display to ask about.
4883 DISPLAY should be either a frame or a display name (a string).
4884 If omitted or nil, that stands for the selected frame's display. */)
4885 (display)
4886 Lisp_Object display;
4888 return Qnil;
4892 x_pixel_width (f)
4893 register struct frame *f;
4895 return FRAME_PIXEL_WIDTH (f);
4899 x_pixel_height (f)
4900 register struct frame *f;
4902 return FRAME_PIXEL_HEIGHT (f);
4906 x_char_width (f)
4907 register struct frame *f;
4909 return FRAME_COLUMN_WIDTH (f);
4913 x_char_height (f)
4914 register struct frame *f;
4916 return FRAME_LINE_HEIGHT (f);
4920 x_screen_planes (f)
4921 register struct frame *f;
4923 return FRAME_W32_DISPLAY_INFO (f)->n_planes;
4926 /* Return the display structure for the display named NAME.
4927 Open a new connection if necessary. */
4929 struct w32_display_info *
4930 x_display_info_for_name (name)
4931 Lisp_Object name;
4933 Lisp_Object names;
4934 struct w32_display_info *dpyinfo;
4936 CHECK_STRING (name);
4938 for (dpyinfo = &one_w32_display_info, names = w32_display_name_list;
4939 dpyinfo;
4940 dpyinfo = dpyinfo->next, names = XCDR (names))
4942 Lisp_Object tem;
4943 tem = Fstring_equal (XCAR (XCAR (names)), name);
4944 if (!NILP (tem))
4945 return dpyinfo;
4948 /* Use this general default value to start with. */
4949 Vx_resource_name = Vinvocation_name;
4951 validate_x_resource_name ();
4953 dpyinfo = w32_term_init (name, (unsigned char *)0,
4954 (char *) SDATA (Vx_resource_name));
4956 if (dpyinfo == 0)
4957 error ("Cannot connect to server %s", SDATA (name));
4959 w32_in_use = 1;
4960 XSETFASTINT (Vwindow_system_version, w32_major_version);
4962 return dpyinfo;
4965 DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
4966 1, 3, 0, doc: /* Open a connection to a server.
4967 DISPLAY is the name of the display to connect to.
4968 Optional second arg XRM-STRING is a string of resources in xrdb format.
4969 If the optional third arg MUST-SUCCEED is non-nil,
4970 terminate Emacs if we can't open the connection. */)
4971 (display, xrm_string, must_succeed)
4972 Lisp_Object display, xrm_string, must_succeed;
4974 unsigned char *xrm_option;
4975 struct w32_display_info *dpyinfo;
4977 /* If initialization has already been done, return now to avoid
4978 overwriting critical parts of one_w32_display_info. */
4979 if (w32_in_use)
4980 return Qnil;
4982 CHECK_STRING (display);
4983 if (! NILP (xrm_string))
4984 CHECK_STRING (xrm_string);
4986 #if 0
4987 if (! EQ (Vwindow_system, intern ("w32")))
4988 error ("Not using Microsoft Windows");
4989 #endif
4991 /* Allow color mapping to be defined externally; first look in user's
4992 HOME directory, then in Emacs etc dir for a file called rgb.txt. */
4994 Lisp_Object color_file;
4995 struct gcpro gcpro1;
4997 color_file = build_string ("~/rgb.txt");
4999 GCPRO1 (color_file);
5001 if (NILP (Ffile_readable_p (color_file)))
5002 color_file =
5003 Fexpand_file_name (build_string ("rgb.txt"),
5004 Fsymbol_value (intern ("data-directory")));
5006 Vw32_color_map = Fx_load_color_file (color_file);
5008 UNGCPRO;
5010 if (NILP (Vw32_color_map))
5011 Vw32_color_map = Fw32_default_color_map ();
5013 /* Merge in system logical colors. */
5014 add_system_logical_colors_to_map (&Vw32_color_map);
5016 if (! NILP (xrm_string))
5017 xrm_option = (unsigned char *) SDATA (xrm_string);
5018 else
5019 xrm_option = (unsigned char *) 0;
5021 /* Use this general default value to start with. */
5022 /* First remove .exe suffix from invocation-name - it looks ugly. */
5024 char basename[ MAX_PATH ], *str;
5026 strcpy (basename, SDATA (Vinvocation_name));
5027 str = strrchr (basename, '.');
5028 if (str) *str = 0;
5029 Vinvocation_name = build_string (basename);
5031 Vx_resource_name = Vinvocation_name;
5033 validate_x_resource_name ();
5035 /* This is what opens the connection and sets x_current_display.
5036 This also initializes many symbols, such as those used for input. */
5037 dpyinfo = w32_term_init (display, xrm_option,
5038 (char *) SDATA (Vx_resource_name));
5040 if (dpyinfo == 0)
5042 if (!NILP (must_succeed))
5043 fatal ("Cannot connect to server %s.\n",
5044 SDATA (display));
5045 else
5046 error ("Cannot connect to server %s", SDATA (display));
5049 w32_in_use = 1;
5051 XSETFASTINT (Vwindow_system_version, w32_major_version);
5052 return Qnil;
5055 DEFUN ("x-close-connection", Fx_close_connection,
5056 Sx_close_connection, 1, 1, 0,
5057 doc: /* Close the connection to DISPLAY's server.
5058 For DISPLAY, specify either a frame or a display name (a string).
5059 If DISPLAY is nil, that stands for the selected frame's display. */)
5060 (display)
5061 Lisp_Object display;
5063 struct w32_display_info *dpyinfo = check_x_display_info (display);
5064 int i;
5066 if (dpyinfo->reference_count > 0)
5067 error ("Display still has frames on it");
5069 BLOCK_INPUT;
5070 x_destroy_all_bitmaps (dpyinfo);
5072 x_delete_display (dpyinfo);
5073 UNBLOCK_INPUT;
5075 return Qnil;
5078 DEFUN ("x-display-list", Fx_display_list, Sx_display_list, 0, 0, 0,
5079 doc: /* Return the list of display names that Emacs has connections to. */)
5082 Lisp_Object tail, result;
5084 result = Qnil;
5085 for (tail = w32_display_name_list; CONSP (tail); tail = XCDR (tail))
5086 result = Fcons (XCAR (XCAR (tail)), result);
5088 return result;
5091 DEFUN ("x-synchronize", Fx_synchronize, Sx_synchronize, 1, 2, 0,
5092 doc: /* This is a noop on W32 systems. */)
5093 (on, display)
5094 Lisp_Object display, on;
5096 return Qnil;
5101 /***********************************************************************
5102 Window properties
5103 ***********************************************************************/
5105 DEFUN ("x-change-window-property", Fx_change_window_property,
5106 Sx_change_window_property, 2, 6, 0,
5107 doc: /* Change window property PROP to VALUE on the X window of FRAME.
5108 VALUE may be a string or a list of conses, numbers and/or strings.
5109 If an element in the list is a string, it is converted to
5110 an Atom and the value of the Atom is used. If an element is a cons,
5111 it is converted to a 32 bit number where the car is the 16 top bits and the
5112 cdr is the lower 16 bits.
5113 FRAME nil or omitted means use the selected frame.
5114 If TYPE is given and non-nil, it is the name of the type of VALUE.
5115 If TYPE is not given or nil, the type is STRING.
5116 FORMAT gives the size in bits of each element if VALUE is a list.
5117 It must be one of 8, 16 or 32.
5118 If VALUE is a string or FORMAT is nil or not given, FORMAT defaults to 8.
5119 If OUTER_P is non-nil, the property is changed for the outer X window of
5120 FRAME. Default is to change on the edit X window.
5122 Value is VALUE. */)
5123 (prop, value, frame, type, format, outer_p)
5124 Lisp_Object prop, value, frame, type, format, outer_p;
5126 #if 0 /* TODO : port window properties to W32 */
5127 struct frame *f = check_x_frame (frame);
5128 Atom prop_atom;
5130 CHECK_STRING (prop);
5131 CHECK_STRING (value);
5133 BLOCK_INPUT;
5134 prop_atom = XInternAtom (FRAME_W32_DISPLAY (f), SDATA (prop), False);
5135 XChangeProperty (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f),
5136 prop_atom, XA_STRING, 8, PropModeReplace,
5137 SDATA (value), SCHARS (value));
5139 /* Make sure the property is set when we return. */
5140 XFlush (FRAME_W32_DISPLAY (f));
5141 UNBLOCK_INPUT;
5143 #endif /* TODO */
5145 return value;
5149 DEFUN ("x-delete-window-property", Fx_delete_window_property,
5150 Sx_delete_window_property, 1, 2, 0,
5151 doc: /* Remove window property PROP from X window of FRAME.
5152 FRAME nil or omitted means use the selected frame. Value is PROP. */)
5153 (prop, frame)
5154 Lisp_Object prop, frame;
5156 #if 0 /* TODO : port window properties to W32 */
5158 struct frame *f = check_x_frame (frame);
5159 Atom prop_atom;
5161 CHECK_STRING (prop);
5162 BLOCK_INPUT;
5163 prop_atom = XInternAtom (FRAME_W32_DISPLAY (f), SDATA (prop), False);
5164 XDeleteProperty (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f), prop_atom);
5166 /* Make sure the property is removed when we return. */
5167 XFlush (FRAME_W32_DISPLAY (f));
5168 UNBLOCK_INPUT;
5169 #endif /* TODO */
5171 return prop;
5175 DEFUN ("x-window-property", Fx_window_property, Sx_window_property,
5176 1, 2, 0,
5177 doc: /* Value is the value of window property PROP on FRAME.
5178 If FRAME is nil or omitted, use the selected frame. Value is nil
5179 if FRAME hasn't a property with name PROP or if PROP has no string
5180 value. */)
5181 (prop, frame)
5182 Lisp_Object prop, frame;
5184 #if 0 /* TODO : port window properties to W32 */
5186 struct frame *f = check_x_frame (frame);
5187 Atom prop_atom;
5188 int rc;
5189 Lisp_Object prop_value = Qnil;
5190 char *tmp_data = NULL;
5191 Atom actual_type;
5192 int actual_format;
5193 unsigned long actual_size, bytes_remaining;
5195 CHECK_STRING (prop);
5196 BLOCK_INPUT;
5197 prop_atom = XInternAtom (FRAME_W32_DISPLAY (f), SDATA (prop), False);
5198 rc = XGetWindowProperty (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f),
5199 prop_atom, 0, 0, False, XA_STRING,
5200 &actual_type, &actual_format, &actual_size,
5201 &bytes_remaining, (unsigned char **) &tmp_data);
5202 if (rc == Success)
5204 int size = bytes_remaining;
5206 XFree (tmp_data);
5207 tmp_data = NULL;
5209 rc = XGetWindowProperty (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f),
5210 prop_atom, 0, bytes_remaining,
5211 False, XA_STRING,
5212 &actual_type, &actual_format,
5213 &actual_size, &bytes_remaining,
5214 (unsigned char **) &tmp_data);
5215 if (rc == Success)
5216 prop_value = make_string (tmp_data, size);
5218 XFree (tmp_data);
5221 UNBLOCK_INPUT;
5223 return prop_value;
5225 #endif /* TODO */
5226 return Qnil;
5231 /***********************************************************************
5232 Busy cursor
5233 ***********************************************************************/
5235 /* Default number of seconds to wait before displaying an hourglass
5236 cursor. Duplicated from xdisp.c, but cannot use the version there
5237 due to lack of atimers on w32. */
5238 #define DEFAULT_HOURGLASS_DELAY 1
5239 extern Lisp_Object Vhourglass_delay;
5241 /* Return non-zero if houglass timer has been started or hourglass is shown. */
5242 /* PENDING: if W32 can use atimers (atimer.[hc]) then the common impl in
5243 xdisp.c could be used. */
5246 hourglass_started ()
5248 return hourglass_shown_p || hourglass_timer;
5251 /* Cancel a currently active hourglass timer, and start a new one. */
5253 void
5254 start_hourglass ()
5256 DWORD delay;
5257 int secs, msecs = 0;
5258 struct frame * f = SELECTED_FRAME ();
5260 /* No cursors on non GUI frames. */
5261 if (!FRAME_W32_P (f))
5262 return;
5264 cancel_hourglass ();
5266 if (INTEGERP (Vhourglass_delay)
5267 && XINT (Vhourglass_delay) > 0)
5268 secs = XFASTINT (Vhourglass_delay);
5269 else if (FLOATP (Vhourglass_delay)
5270 && XFLOAT_DATA (Vhourglass_delay) > 0)
5272 Lisp_Object tem;
5273 tem = Ftruncate (Vhourglass_delay, Qnil);
5274 secs = XFASTINT (tem);
5275 msecs = (XFLOAT_DATA (Vhourglass_delay) - secs) * 1000;
5277 else
5278 secs = DEFAULT_HOURGLASS_DELAY;
5280 delay = secs * 1000 + msecs;
5281 hourglass_hwnd = FRAME_W32_WINDOW (f);
5282 hourglass_timer = SetTimer (hourglass_hwnd, HOURGLASS_ID, delay, NULL);
5286 /* Cancel the hourglass cursor timer if active, hide an hourglass
5287 cursor if shown. */
5289 void
5290 cancel_hourglass ()
5292 if (hourglass_timer)
5294 KillTimer (hourglass_hwnd, hourglass_timer);
5295 hourglass_timer = 0;
5298 if (hourglass_shown_p)
5299 w32_hide_hourglass ();
5303 /* Timer function of hourglass_timer.
5305 Display an hourglass cursor. Set the hourglass_p flag in display info
5306 to indicate that an hourglass cursor is shown. */
5308 static void
5309 w32_show_hourglass (f)
5310 struct frame *f;
5312 if (!hourglass_shown_p)
5314 f->output_data.w32->hourglass_p = 1;
5315 if (!menubar_in_use && !current_popup_menu)
5316 SetCursor (f->output_data.w32->hourglass_cursor);
5317 hourglass_shown_p = 1;
5322 /* Hide the hourglass cursor on all frames, if it is currently shown. */
5324 static void
5325 w32_hide_hourglass ()
5327 if (hourglass_shown_p)
5329 struct frame *f = x_window_to_frame (&one_w32_display_info,
5330 hourglass_hwnd);
5331 if (f)
5332 f->output_data.w32->hourglass_p = 0;
5333 else
5334 /* If frame was deleted, restore to selected frame's cursor. */
5335 f = SELECTED_FRAME ();
5337 if (FRAME_W32_P (f))
5338 SetCursor (f->output_data.w32->current_cursor);
5339 else
5340 /* No cursors on non GUI frames - restore to stock arrow cursor. */
5341 SetCursor (w32_load_cursor (IDC_ARROW));
5343 hourglass_shown_p = 0;
5349 /***********************************************************************
5350 Tool tips
5351 ***********************************************************************/
5353 static Lisp_Object x_create_tip_frame P_ ((struct w32_display_info *,
5354 Lisp_Object, Lisp_Object));
5355 static void compute_tip_xy P_ ((struct frame *, Lisp_Object, Lisp_Object,
5356 Lisp_Object, int, int, int *, int *));
5358 /* The frame of a currently visible tooltip. */
5360 Lisp_Object tip_frame;
5362 /* If non-nil, a timer started that hides the last tooltip when it
5363 fires. */
5365 Lisp_Object tip_timer;
5366 Window tip_window;
5368 /* If non-nil, a vector of 3 elements containing the last args
5369 with which x-show-tip was called. See there. */
5371 Lisp_Object last_show_tip_args;
5373 /* Maximum size for tooltips; a cons (COLUMNS . ROWS). */
5375 Lisp_Object Vx_max_tooltip_size;
5378 static Lisp_Object
5379 unwind_create_tip_frame (frame)
5380 Lisp_Object frame;
5382 Lisp_Object deleted;
5384 deleted = unwind_create_frame (frame);
5385 if (EQ (deleted, Qt))
5387 tip_window = NULL;
5388 tip_frame = Qnil;
5391 return deleted;
5395 /* Create a frame for a tooltip on the display described by DPYINFO.
5396 PARMS is a list of frame parameters. TEXT is the string to
5397 display in the tip frame. Value is the frame.
5399 Note that functions called here, esp. x_default_parameter can
5400 signal errors, for instance when a specified color name is
5401 undefined. We have to make sure that we're in a consistent state
5402 when this happens. */
5404 static Lisp_Object
5405 x_create_tip_frame (dpyinfo, parms, text)
5406 struct w32_display_info *dpyinfo;
5407 Lisp_Object parms, text;
5409 struct frame *f;
5410 Lisp_Object frame, tem;
5411 Lisp_Object name;
5412 long window_prompting = 0;
5413 int width, height;
5414 int count = SPECPDL_INDEX ();
5415 struct gcpro gcpro1, gcpro2, gcpro3;
5416 struct kboard *kb;
5417 int face_change_count_before = face_change_count;
5418 Lisp_Object buffer;
5419 struct buffer *old_buffer;
5421 check_w32 ();
5423 /* Use this general default value to start with until we know if
5424 this frame has a specified name. */
5425 Vx_resource_name = Vinvocation_name;
5427 kb = dpyinfo->terminal->kboard;
5429 /* Get the name of the frame to use for resource lookup. */
5430 name = x_get_arg (dpyinfo, parms, Qname, "name", "Name", RES_TYPE_STRING);
5431 if (!STRINGP (name)
5432 && !EQ (name, Qunbound)
5433 && !NILP (name))
5434 error ("Invalid frame name--not a string or nil");
5435 Vx_resource_name = name;
5437 frame = Qnil;
5438 GCPRO3 (parms, name, frame);
5439 /* Make a frame without minibuffer nor mode-line. */
5440 f = make_frame (0);
5441 f->wants_modeline = 0;
5442 XSETFRAME (frame, f);
5444 buffer = Fget_buffer_create (build_string (" *tip*"));
5445 Fset_window_buffer (FRAME_ROOT_WINDOW (f), buffer, Qnil);
5446 old_buffer = current_buffer;
5447 set_buffer_internal_1 (XBUFFER (buffer));
5448 current_buffer->truncate_lines = Qnil;
5449 specbind (Qinhibit_read_only, Qt);
5450 specbind (Qinhibit_modification_hooks, Qt);
5451 Ferase_buffer ();
5452 Finsert (1, &text);
5453 set_buffer_internal_1 (old_buffer);
5455 FRAME_CAN_HAVE_SCROLL_BARS (f) = 0;
5456 record_unwind_protect (unwind_create_tip_frame, frame);
5458 /* By setting the output method, we're essentially saying that
5459 the frame is live, as per FRAME_LIVE_P. If we get a signal
5460 from this point on, x_destroy_window might screw up reference
5461 counts etc. */
5462 f->terminal = dpyinfo->terminal;
5463 f->terminal->reference_count++;
5464 f->output_method = output_w32;
5465 f->output_data.w32 =
5466 (struct w32_output *) xmalloc (sizeof (struct w32_output));
5467 bzero (f->output_data.w32, sizeof (struct w32_output));
5469 FRAME_FONTSET (f) = -1;
5470 f->icon_name = Qnil;
5472 #if GLYPH_DEBUG
5473 image_cache_refcount = FRAME_IMAGE_CACHE (f)->refcount;
5474 dpyinfo_refcount = dpyinfo->reference_count;
5475 #endif /* GLYPH_DEBUG */
5476 FRAME_KBOARD (f) = kb;
5477 f->output_data.w32->parent_desc = FRAME_W32_DISPLAY_INFO (f)->root_window;
5478 f->output_data.w32->explicit_parent = 0;
5480 /* Set the name; the functions to which we pass f expect the name to
5481 be set. */
5482 if (EQ (name, Qunbound) || NILP (name))
5484 f->name = build_string (dpyinfo->w32_id_name);
5485 f->explicit_name = 0;
5487 else
5489 f->name = name;
5490 f->explicit_name = 1;
5491 /* use the frame's title when getting resources for this frame. */
5492 specbind (Qx_resource_name, name);
5495 f->resx = dpyinfo->resx;
5496 f->resy = dpyinfo->resy;
5498 if (uniscribe_available)
5499 register_font_driver (&uniscribe_font_driver, f);
5500 register_font_driver (&w32font_driver, f);
5502 x_default_parameter (f, parms, Qfont_backend, Qnil,
5503 "fontBackend", "FontBackend", RES_TYPE_STRING);
5505 /* Extract the window parameters from the supplied values
5506 that are needed to determine window geometry. */
5507 x_default_font_parameter (f, parms);
5509 x_default_parameter (f, parms, Qborder_width, make_number (2),
5510 "borderWidth", "BorderWidth", RES_TYPE_NUMBER);
5511 /* This defaults to 2 in order to match xterm. We recognize either
5512 internalBorderWidth or internalBorder (which is what xterm calls
5513 it). */
5514 if (NILP (Fassq (Qinternal_border_width, parms)))
5516 Lisp_Object value;
5518 value = x_get_arg (dpyinfo, parms, Qinternal_border_width,
5519 "internalBorder", "internalBorder", RES_TYPE_NUMBER);
5520 if (! EQ (value, Qunbound))
5521 parms = Fcons (Fcons (Qinternal_border_width, value),
5522 parms);
5524 x_default_parameter (f, parms, Qinternal_border_width, make_number (1),
5525 "internalBorderWidth", "internalBorderWidth",
5526 RES_TYPE_NUMBER);
5528 /* Also do the stuff which must be set before the window exists. */
5529 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
5530 "foreground", "Foreground", RES_TYPE_STRING);
5531 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
5532 "background", "Background", RES_TYPE_STRING);
5533 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
5534 "pointerColor", "Foreground", RES_TYPE_STRING);
5535 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
5536 "cursorColor", "Foreground", RES_TYPE_STRING);
5537 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
5538 "borderColor", "BorderColor", RES_TYPE_STRING);
5540 /* Init faces before x_default_parameter is called for scroll-bar
5541 parameters because that function calls x_set_scroll_bar_width,
5542 which calls change_frame_size, which calls Fset_window_buffer,
5543 which runs hooks, which call Fvertical_motion. At the end, we
5544 end up in init_iterator with a null face cache, which should not
5545 happen. */
5546 init_frame_faces (f);
5548 f->output_data.w32->dwStyle = WS_BORDER | WS_POPUP | WS_DISABLED;
5549 f->output_data.w32->parent_desc = FRAME_W32_DISPLAY_INFO (f)->root_window;
5551 window_prompting = x_figure_window_size (f, parms, 0);
5553 /* No fringes on tip frame. */
5554 f->fringe_cols = 0;
5555 f->left_fringe_width = 0;
5556 f->right_fringe_width = 0;
5558 BLOCK_INPUT;
5559 my_create_tip_window (f);
5560 UNBLOCK_INPUT;
5562 x_make_gc (f);
5564 x_default_parameter (f, parms, Qauto_raise, Qnil,
5565 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN);
5566 x_default_parameter (f, parms, Qauto_lower, Qnil,
5567 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN);
5568 x_default_parameter (f, parms, Qcursor_type, Qbox,
5569 "cursorType", "CursorType", RES_TYPE_SYMBOL);
5571 /* Dimensions, especially FRAME_LINES (f), must be done via change_frame_size.
5572 Change will not be effected unless different from the current
5573 FRAME_LINES (f). */
5574 width = FRAME_COLS (f);
5575 height = FRAME_LINES (f);
5576 FRAME_LINES (f) = 0;
5577 SET_FRAME_COLS (f, 0);
5578 change_frame_size (f, height, width, 1, 0, 0);
5580 /* Add `tooltip' frame parameter's default value. */
5581 if (NILP (Fframe_parameter (frame, intern ("tooltip"))))
5582 Fmodify_frame_parameters (frame, Fcons (Fcons (intern ("tooltip"), Qt),
5583 Qnil));
5585 /* Set up faces after all frame parameters are known. This call
5586 also merges in face attributes specified for new frames.
5588 Frame parameters may be changed if .Xdefaults contains
5589 specifications for the default font. For example, if there is an
5590 `Emacs.default.attributeBackground: pink', the `background-color'
5591 attribute of the frame get's set, which let's the internal border
5592 of the tooltip frame appear in pink. Prevent this. */
5594 Lisp_Object bg = Fframe_parameter (frame, Qbackground_color);
5595 Lisp_Object fg = Fframe_parameter (frame, Qforeground_color);
5596 Lisp_Object colors = Qnil;
5598 /* Set tip_frame here, so that */
5599 tip_frame = frame;
5600 call2 (Qface_set_after_frame_default, frame, Qnil);
5602 if (!EQ (bg, Fframe_parameter (frame, Qbackground_color)))
5603 colors = Fcons (Fcons (Qbackground_color, bg), colors);
5604 if (!EQ (fg, Fframe_parameter (frame, Qforeground_color)))
5605 colors = Fcons (Fcons (Qforeground_color, fg), colors);
5607 if (!NILP (colors))
5608 Fmodify_frame_parameters (frame, colors);
5611 f->no_split = 1;
5613 UNGCPRO;
5615 /* It is now ok to make the frame official even if we get an error
5616 below. And the frame needs to be on Vframe_list or making it
5617 visible won't work. */
5618 Vframe_list = Fcons (frame, Vframe_list);
5620 /* Now that the frame is official, it counts as a reference to
5621 its display. */
5622 FRAME_W32_DISPLAY_INFO (f)->reference_count++;
5624 /* Setting attributes of faces of the tooltip frame from resources
5625 and similar will increment face_change_count, which leads to the
5626 clearing of all current matrices. Since this isn't necessary
5627 here, avoid it by resetting face_change_count to the value it
5628 had before we created the tip frame. */
5629 face_change_count = face_change_count_before;
5631 /* Discard the unwind_protect. */
5632 return unbind_to (count, frame);
5636 /* Compute where to display tip frame F. PARMS is the list of frame
5637 parameters for F. DX and DY are specified offsets from the current
5638 location of the mouse. WIDTH and HEIGHT are the width and height
5639 of the tooltip. Return coordinates relative to the root window of
5640 the display in *ROOT_X, and *ROOT_Y. */
5642 static void
5643 compute_tip_xy (f, parms, dx, dy, width, height, root_x, root_y)
5644 struct frame *f;
5645 Lisp_Object parms, dx, dy;
5646 int width, height;
5647 int *root_x, *root_y;
5649 Lisp_Object left, top;
5650 int min_x, min_y, max_x, max_y;
5652 /* User-specified position? */
5653 left = Fcdr (Fassq (Qleft, parms));
5654 top = Fcdr (Fassq (Qtop, parms));
5656 /* Move the tooltip window where the mouse pointer is. Resize and
5657 show it. */
5658 if (!INTEGERP (left) || !INTEGERP (top))
5660 POINT pt;
5662 /* Default min and max values. */
5663 min_x = 0;
5664 min_y = 0;
5665 max_x = x_display_pixel_width (FRAME_W32_DISPLAY_INFO (f));
5666 max_y = x_display_pixel_height (FRAME_W32_DISPLAY_INFO (f));
5668 BLOCK_INPUT;
5669 GetCursorPos (&pt);
5670 *root_x = pt.x;
5671 *root_y = pt.y;
5672 UNBLOCK_INPUT;
5674 /* If multiple monitor support is available, constrain the tip onto
5675 the current monitor. This improves the above by allowing negative
5676 co-ordinates if monitor positions are such that they are valid, and
5677 snaps a tooltip onto a single monitor if we are close to the edge
5678 where it would otherwise flow onto the other monitor (or into
5679 nothingness if there is a gap in the overlap). */
5680 if (monitor_from_point_fn && get_monitor_info_fn)
5682 struct MONITOR_INFO info;
5683 HMONITOR monitor
5684 = monitor_from_point_fn (pt, MONITOR_DEFAULT_TO_NEAREST);
5685 info.cbSize = sizeof (info);
5687 if (get_monitor_info_fn (monitor, &info))
5689 min_x = info.rcWork.left;
5690 min_y = info.rcWork.top;
5691 max_x = info.rcWork.right;
5692 max_y = info.rcWork.bottom;
5697 if (INTEGERP (top))
5698 *root_y = XINT (top);
5699 else if (*root_y + XINT (dy) <= min_y)
5700 *root_y = min_y; /* Can happen for negative dy */
5701 else if (*root_y + XINT (dy) + height <= max_y)
5702 /* It fits below the pointer */
5703 *root_y += XINT (dy);
5704 else if (height + XINT (dy) + min_y <= *root_y)
5705 /* It fits above the pointer. */
5706 *root_y -= height + XINT (dy);
5707 else
5708 /* Put it on the top. */
5709 *root_y = min_y;
5711 if (INTEGERP (left))
5712 *root_x = XINT (left);
5713 else if (*root_x + XINT (dx) <= min_x)
5714 *root_x = 0; /* Can happen for negative dx */
5715 else if (*root_x + XINT (dx) + width <= max_x)
5716 /* It fits to the right of the pointer. */
5717 *root_x += XINT (dx);
5718 else if (width + XINT (dx) + min_x <= *root_x)
5719 /* It fits to the left of the pointer. */
5720 *root_x -= width + XINT (dx);
5721 else
5722 /* Put it left justified on the screen -- it ought to fit that way. */
5723 *root_x = min_x;
5727 DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0,
5728 doc: /* Show STRING in a \"tooltip\" window on frame FRAME.
5729 A tooltip window is a small window displaying a string.
5731 This is an internal function; Lisp code should call `tooltip-show'.
5733 FRAME nil or omitted means use the selected frame.
5735 PARMS is an optional list of frame parameters which can be
5736 used to change the tooltip's appearance.
5738 Automatically hide the tooltip after TIMEOUT seconds. TIMEOUT nil
5739 means use the default timeout of 5 seconds.
5741 If the list of frame parameters PARMS contains a `left' parameter,
5742 the tooltip is displayed at that x-position. Otherwise it is
5743 displayed at the mouse position, with offset DX added (default is 5 if
5744 DX isn't specified). Likewise for the y-position; if a `top' frame
5745 parameter is specified, it determines the y-position of the tooltip
5746 window, otherwise it is displayed at the mouse position, with offset
5747 DY added (default is -10).
5749 A tooltip's maximum size is specified by `x-max-tooltip-size'.
5750 Text larger than the specified size is clipped. */)
5751 (string, frame, parms, timeout, dx, dy)
5752 Lisp_Object string, frame, parms, timeout, dx, dy;
5754 struct frame *f;
5755 struct window *w;
5756 int root_x, root_y;
5757 struct buffer *old_buffer;
5758 struct text_pos pos;
5759 int i, width, height;
5760 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
5761 int old_windows_or_buffers_changed = windows_or_buffers_changed;
5762 int count = SPECPDL_INDEX ();
5764 specbind (Qinhibit_redisplay, Qt);
5766 GCPRO4 (string, parms, frame, timeout);
5768 CHECK_STRING (string);
5769 f = check_x_frame (frame);
5770 if (NILP (timeout))
5771 timeout = make_number (5);
5772 else
5773 CHECK_NATNUM (timeout);
5775 if (NILP (dx))
5776 dx = make_number (5);
5777 else
5778 CHECK_NUMBER (dx);
5780 if (NILP (dy))
5781 dy = make_number (-10);
5782 else
5783 CHECK_NUMBER (dy);
5785 if (NILP (last_show_tip_args))
5786 last_show_tip_args = Fmake_vector (make_number (3), Qnil);
5788 if (!NILP (tip_frame))
5790 Lisp_Object last_string = AREF (last_show_tip_args, 0);
5791 Lisp_Object last_frame = AREF (last_show_tip_args, 1);
5792 Lisp_Object last_parms = AREF (last_show_tip_args, 2);
5794 if (EQ (frame, last_frame)
5795 && !NILP (Fequal (last_string, string))
5796 && !NILP (Fequal (last_parms, parms)))
5798 struct frame *f = XFRAME (tip_frame);
5800 /* Only DX and DY have changed. */
5801 if (!NILP (tip_timer))
5803 Lisp_Object timer = tip_timer;
5804 tip_timer = Qnil;
5805 call1 (Qcancel_timer, timer);
5808 BLOCK_INPUT;
5809 compute_tip_xy (f, parms, dx, dy, FRAME_PIXEL_WIDTH (f),
5810 FRAME_PIXEL_HEIGHT (f), &root_x, &root_y);
5812 /* Put tooltip in topmost group and in position. */
5813 SetWindowPos (FRAME_W32_WINDOW (f), HWND_TOPMOST,
5814 root_x, root_y, 0, 0,
5815 SWP_NOSIZE | SWP_NOACTIVATE);
5817 /* Ensure tooltip is on top of other topmost windows (eg menus). */
5818 SetWindowPos (FRAME_W32_WINDOW (f), HWND_TOP,
5819 0, 0, 0, 0,
5820 SWP_NOMOVE | SWP_NOSIZE | SWP_NOACTIVATE);
5822 UNBLOCK_INPUT;
5823 goto start_timer;
5827 /* Hide a previous tip, if any. */
5828 Fx_hide_tip ();
5830 ASET (last_show_tip_args, 0, string);
5831 ASET (last_show_tip_args, 1, frame);
5832 ASET (last_show_tip_args, 2, parms);
5834 /* Add default values to frame parameters. */
5835 if (NILP (Fassq (Qname, parms)))
5836 parms = Fcons (Fcons (Qname, build_string ("tooltip")), parms);
5837 if (NILP (Fassq (Qinternal_border_width, parms)))
5838 parms = Fcons (Fcons (Qinternal_border_width, make_number (3)), parms);
5839 if (NILP (Fassq (Qborder_width, parms)))
5840 parms = Fcons (Fcons (Qborder_width, make_number (1)), parms);
5841 if (NILP (Fassq (Qborder_color, parms)))
5842 parms = Fcons (Fcons (Qborder_color, build_string ("lightyellow")), parms);
5843 if (NILP (Fassq (Qbackground_color, parms)))
5844 parms = Fcons (Fcons (Qbackground_color, build_string ("lightyellow")),
5845 parms);
5847 /* Block input until the tip has been fully drawn, to avoid crashes
5848 when drawing tips in menus. */
5849 BLOCK_INPUT;
5851 /* Create a frame for the tooltip, and record it in the global
5852 variable tip_frame. */
5853 frame = x_create_tip_frame (FRAME_W32_DISPLAY_INFO (f), parms, string);
5854 f = XFRAME (frame);
5856 /* Set up the frame's root window. */
5857 w = XWINDOW (FRAME_ROOT_WINDOW (f));
5858 w->left_col = w->top_line = make_number (0);
5860 if (CONSP (Vx_max_tooltip_size)
5861 && INTEGERP (XCAR (Vx_max_tooltip_size))
5862 && XINT (XCAR (Vx_max_tooltip_size)) > 0
5863 && INTEGERP (XCDR (Vx_max_tooltip_size))
5864 && XINT (XCDR (Vx_max_tooltip_size)) > 0)
5866 w->total_cols = XCAR (Vx_max_tooltip_size);
5867 w->total_lines = XCDR (Vx_max_tooltip_size);
5869 else
5871 w->total_cols = make_number (80);
5872 w->total_lines = make_number (40);
5875 FRAME_TOTAL_COLS (f) = XINT (w->total_cols);
5876 adjust_glyphs (f);
5877 w->pseudo_window_p = 1;
5879 /* Display the tooltip text in a temporary buffer. */
5880 old_buffer = current_buffer;
5881 set_buffer_internal_1 (XBUFFER (XWINDOW (FRAME_ROOT_WINDOW (f))->buffer));
5882 current_buffer->truncate_lines = Qnil;
5883 clear_glyph_matrix (w->desired_matrix);
5884 clear_glyph_matrix (w->current_matrix);
5885 SET_TEXT_POS (pos, BEGV, BEGV_BYTE);
5886 try_window (FRAME_ROOT_WINDOW (f), pos, 0);
5888 /* Compute width and height of the tooltip. */
5889 width = height = 0;
5890 for (i = 0; i < w->desired_matrix->nrows; ++i)
5892 struct glyph_row *row = &w->desired_matrix->rows[i];
5893 struct glyph *last;
5894 int row_width;
5896 /* Stop at the first empty row at the end. */
5897 if (!row->enabled_p || !row->displays_text_p)
5898 break;
5900 /* Let the row go over the full width of the frame. */
5901 row->full_width_p = 1;
5903 #ifdef TODO /* Investigate why some fonts need more width than is
5904 calculated for some tooltips. */
5905 /* There's a glyph at the end of rows that is use to place
5906 the cursor there. Don't include the width of this glyph. */
5907 if (row->used[TEXT_AREA])
5909 last = &row->glyphs[TEXT_AREA][row->used[TEXT_AREA] - 1];
5910 row_width = row->pixel_width - last->pixel_width;
5912 else
5913 #endif
5914 row_width = row->pixel_width;
5916 /* TODO: find why tips do not draw along baseline as instructed. */
5917 height += row->height;
5918 width = max (width, row_width);
5921 /* Add the frame's internal border to the width and height the X
5922 window should have. */
5923 height += 2 * FRAME_INTERNAL_BORDER_WIDTH (f);
5924 width += 2 * FRAME_INTERNAL_BORDER_WIDTH (f);
5926 /* Move the tooltip window where the mouse pointer is. Resize and
5927 show it. */
5928 compute_tip_xy (f, parms, dx, dy, width, height, &root_x, &root_y);
5931 /* Adjust Window size to take border into account. */
5932 RECT rect;
5933 rect.left = rect.top = 0;
5934 rect.right = width;
5935 rect.bottom = height;
5936 AdjustWindowRect (&rect, f->output_data.w32->dwStyle,
5937 FRAME_EXTERNAL_MENU_BAR (f));
5939 /* Position and size tooltip, and put it in the topmost group.
5940 The add-on of 3 to the 5th argument is a kludge: without it,
5941 some fonts cause the last character of the tip to be truncated,
5942 for some obscure reason. */
5943 SetWindowPos (FRAME_W32_WINDOW (f), HWND_TOPMOST,
5944 root_x, root_y, rect.right - rect.left + 3,
5945 rect.bottom - rect.top, SWP_NOACTIVATE);
5947 /* Ensure tooltip is on top of other topmost windows (eg menus). */
5948 SetWindowPos (FRAME_W32_WINDOW (f), HWND_TOP,
5949 0, 0, 0, 0,
5950 SWP_NOMOVE | SWP_NOSIZE | SWP_NOACTIVATE);
5952 /* Let redisplay know that we have made the frame visible already. */
5953 f->async_visible = 1;
5955 ShowWindow (FRAME_W32_WINDOW (f), SW_SHOWNOACTIVATE);
5958 /* Draw into the window. */
5959 w->must_be_updated_p = 1;
5960 update_single_window (w, 1);
5962 UNBLOCK_INPUT;
5964 /* Restore original current buffer. */
5965 set_buffer_internal_1 (old_buffer);
5966 windows_or_buffers_changed = old_windows_or_buffers_changed;
5968 start_timer:
5969 /* Let the tip disappear after timeout seconds. */
5970 tip_timer = call3 (intern ("run-at-time"), timeout, Qnil,
5971 intern ("x-hide-tip"));
5973 UNGCPRO;
5974 return unbind_to (count, Qnil);
5978 DEFUN ("x-hide-tip", Fx_hide_tip, Sx_hide_tip, 0, 0, 0,
5979 doc: /* Hide the current tooltip window, if there is any.
5980 Value is t if tooltip was open, nil otherwise. */)
5983 int count;
5984 Lisp_Object deleted, frame, timer;
5985 struct gcpro gcpro1, gcpro2;
5987 /* Return quickly if nothing to do. */
5988 if (NILP (tip_timer) && NILP (tip_frame))
5989 return Qnil;
5991 frame = tip_frame;
5992 timer = tip_timer;
5993 GCPRO2 (frame, timer);
5994 tip_frame = tip_timer = deleted = Qnil;
5996 count = SPECPDL_INDEX ();
5997 specbind (Qinhibit_redisplay, Qt);
5998 specbind (Qinhibit_quit, Qt);
6000 if (!NILP (timer))
6001 call1 (Qcancel_timer, timer);
6003 if (FRAMEP (frame))
6005 delete_frame (frame, Qnil);
6006 deleted = Qt;
6009 UNGCPRO;
6010 return unbind_to (count, deleted);
6015 /***********************************************************************
6016 File selection dialog
6017 ***********************************************************************/
6018 extern Lisp_Object Qfile_name_history;
6020 /* Callback for altering the behavior of the Open File dialog.
6021 Makes the Filename text field contain "Current Directory" and be
6022 read-only when "Directories" is selected in the filter. This
6023 allows us to work around the fact that the standard Open File
6024 dialog does not support directories. */
6025 UINT CALLBACK
6026 file_dialog_callback (hwnd, msg, wParam, lParam)
6027 HWND hwnd;
6028 UINT msg;
6029 WPARAM wParam;
6030 LPARAM lParam;
6032 if (msg == WM_NOTIFY)
6034 OFNOTIFY * notify = (OFNOTIFY *)lParam;
6035 /* Detect when the Filter dropdown is changed. */
6036 if (notify->hdr.code == CDN_TYPECHANGE
6037 || notify->hdr.code == CDN_INITDONE)
6039 HWND dialog = GetParent (hwnd);
6040 HWND edit_control = GetDlgItem (dialog, FILE_NAME_TEXT_FIELD);
6042 /* Directories is in index 2. */
6043 if (notify->lpOFN->nFilterIndex == 2)
6045 CommDlg_OpenSave_SetControlText (dialog, FILE_NAME_TEXT_FIELD,
6046 "Current Directory");
6047 EnableWindow (edit_control, FALSE);
6049 else
6051 /* Don't override default filename on init done. */
6052 if (notify->hdr.code == CDN_TYPECHANGE)
6053 CommDlg_OpenSave_SetControlText (dialog,
6054 FILE_NAME_TEXT_FIELD, "");
6055 EnableWindow (edit_control, TRUE);
6059 return 0;
6062 /* Since we compile with _WIN32_WINNT set to 0x0400 (for NT4 compatibility)
6063 we end up with the old file dialogs. Define a big enough struct for the
6064 new dialog to trick GetOpenFileName into giving us the new dialogs on
6065 Windows 2000 and XP. */
6066 typedef struct
6068 OPENFILENAME real_details;
6069 void * pReserved;
6070 DWORD dwReserved;
6071 DWORD FlagsEx;
6072 } NEWOPENFILENAME;
6075 DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 5, 0,
6076 doc: /* Read file name, prompting with PROMPT in directory DIR.
6077 Use a file selection dialog.
6078 Select DEFAULT-FILENAME in the dialog's file selection box, if
6079 specified. Ensure that file exists if MUSTMATCH is non-nil.
6080 If ONLY-DIR-P is non-nil, the user can only select directories. */)
6081 (prompt, dir, default_filename, mustmatch, only_dir_p)
6082 Lisp_Object prompt, dir, default_filename, mustmatch, only_dir_p;
6084 struct frame *f = SELECTED_FRAME ();
6085 Lisp_Object file = Qnil;
6086 int count = SPECPDL_INDEX ();
6087 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
6088 char filename[MAX_PATH + 1];
6089 char init_dir[MAX_PATH + 1];
6090 int default_filter_index = 1; /* 1: All Files, 2: Directories only */
6092 GCPRO6 (prompt, dir, default_filename, mustmatch, only_dir_p, file);
6093 CHECK_STRING (prompt);
6094 CHECK_STRING (dir);
6096 /* Create the dialog with PROMPT as title, using DIR as initial
6097 directory and using "*" as pattern. */
6098 dir = Fexpand_file_name (dir, Qnil);
6099 strncpy (init_dir, SDATA (ENCODE_FILE (dir)), MAX_PATH);
6100 init_dir[MAX_PATH] = '\0';
6101 unixtodos_filename (init_dir);
6103 if (STRINGP (default_filename))
6105 char *file_name_only;
6106 char *full_path_name = SDATA (ENCODE_FILE (default_filename));
6108 unixtodos_filename (full_path_name);
6110 file_name_only = strrchr (full_path_name, '\\');
6111 if (!file_name_only)
6112 file_name_only = full_path_name;
6113 else
6114 file_name_only++;
6116 strncpy (filename, file_name_only, MAX_PATH);
6117 filename[MAX_PATH] = '\0';
6119 else
6120 filename[0] = '\0';
6123 NEWOPENFILENAME new_file_details;
6124 BOOL file_opened = FALSE;
6125 OPENFILENAME * file_details = &new_file_details.real_details;
6127 /* Prevent redisplay. */
6128 specbind (Qinhibit_redisplay, Qt);
6129 BLOCK_INPUT;
6131 bzero (&new_file_details, sizeof (new_file_details));
6132 /* Apparently NT4 crashes if you give it an unexpected size.
6133 I'm not sure about Windows 9x, so play it safe. */
6134 if (w32_major_version > 4 && w32_major_version < 95)
6135 file_details->lStructSize = sizeof (NEWOPENFILENAME);
6136 else
6137 file_details->lStructSize = sizeof (OPENFILENAME);
6139 file_details->hwndOwner = FRAME_W32_WINDOW (f);
6140 /* Undocumented Bug in Common File Dialog:
6141 If a filter is not specified, shell links are not resolved. */
6142 file_details->lpstrFilter = "All Files (*.*)\0*.*\0Directories\0*|*\0\0";
6143 file_details->lpstrFile = filename;
6144 file_details->nMaxFile = sizeof (filename);
6145 file_details->lpstrInitialDir = init_dir;
6146 file_details->lpstrTitle = SDATA (prompt);
6148 if (! NILP (only_dir_p))
6149 default_filter_index = 2;
6151 file_details->nFilterIndex = default_filter_index;
6153 file_details->Flags = (OFN_HIDEREADONLY | OFN_NOCHANGEDIR
6154 | OFN_EXPLORER | OFN_ENABLEHOOK);
6155 if (!NILP (mustmatch))
6157 /* Require that the path to the parent directory exists. */
6158 file_details->Flags |= OFN_PATHMUSTEXIST;
6159 /* If we are looking for a file, require that it exists. */
6160 if (NILP (only_dir_p))
6161 file_details->Flags |= OFN_FILEMUSTEXIST;
6164 file_details->lpfnHook = (LPOFNHOOKPROC) file_dialog_callback;
6166 file_opened = GetOpenFileName (file_details);
6168 UNBLOCK_INPUT;
6170 if (file_opened)
6172 dostounix_filename (filename);
6174 if (file_details->nFilterIndex == 2)
6176 /* "Directories" selected - strip dummy file name. */
6177 char * last = strrchr (filename, '/');
6178 *last = '\0';
6181 file = DECODE_FILE (build_string (filename));
6183 /* User cancelled the dialog without making a selection. */
6184 else if (!CommDlgExtendedError ())
6185 file = Qnil;
6186 /* An error occurred, fallback on reading from the mini-buffer. */
6187 else
6188 file = Fcompleting_read (prompt, intern ("read-file-name-internal"),
6189 dir, mustmatch, dir, Qfile_name_history,
6190 default_filename, Qnil);
6192 file = unbind_to (count, file);
6195 UNGCPRO;
6197 /* Make "Cancel" equivalent to C-g. */
6198 if (NILP (file))
6199 Fsignal (Qquit, Qnil);
6201 return unbind_to (count, file);
6205 /* Moving files to the system recycle bin.
6206 Used by `move-file-to-trash' instead of the default moving to ~/.Trash */
6207 DEFUN ("system-move-file-to-trash", Fsystem_move_file_to_trash,
6208 Ssystem_move_file_to_trash, 1, 1, 0,
6209 doc: /* Move file or directory named FILENAME to the recycle bin. */)
6210 (filename)
6211 Lisp_Object filename;
6213 Lisp_Object handler;
6214 Lisp_Object encoded_file;
6215 Lisp_Object operation;
6217 operation = Qdelete_file;
6218 if (!NILP (Ffile_directory_p (filename))
6219 && NILP (Ffile_symlink_p (filename)))
6221 operation = intern ("delete-directory");
6222 filename = Fdirectory_file_name (filename);
6224 filename = Fexpand_file_name (filename, Qnil);
6226 handler = Ffind_file_name_handler (filename, operation);
6227 if (!NILP (handler))
6228 return call2 (handler, operation, filename);
6230 encoded_file = ENCODE_FILE (filename);
6233 const char * path;
6234 SHFILEOPSTRUCT file_op;
6235 char tmp_path[MAX_PATH + 1];
6237 path = map_w32_filename (SDATA (encoded_file), NULL);
6239 /* On Windows, write permission is required to delete/move files. */
6240 _chmod (path, 0666);
6242 bzero (tmp_path, sizeof (tmp_path));
6243 strcpy (tmp_path, path);
6245 bzero (&file_op, sizeof (file_op));
6246 file_op.hwnd = HWND_DESKTOP;
6247 file_op.wFunc = FO_DELETE;
6248 file_op.pFrom = tmp_path;
6249 file_op.fFlags = FOF_SILENT | FOF_NOCONFIRMATION | FOF_ALLOWUNDO
6250 | FOF_NOERRORUI | FOF_NO_CONNECTED_ELEMENTS;
6251 file_op.fAnyOperationsAborted = FALSE;
6253 if (SHFileOperation (&file_op) != 0)
6254 report_file_error ("Removing old name", list1 (filename));
6256 return Qnil;
6260 /***********************************************************************
6261 w32 specialized functions
6262 ***********************************************************************/
6264 DEFUN ("w32-send-sys-command", Fw32_send_sys_command,
6265 Sw32_send_sys_command, 1, 2, 0,
6266 doc: /* Send frame a Windows WM_SYSCOMMAND message of type COMMAND.
6267 Some useful values for COMMAND are #xf030 to maximize frame (#xf020
6268 to minimize), #xf120 to restore frame to original size, and #xf100
6269 to activate the menubar for keyboard access. #xf140 activates the
6270 screen saver if defined.
6272 If optional parameter FRAME is not specified, use selected frame. */)
6273 (command, frame)
6274 Lisp_Object command, frame;
6276 FRAME_PTR f = check_x_frame (frame);
6278 CHECK_NUMBER (command);
6280 PostMessage (FRAME_W32_WINDOW (f), WM_SYSCOMMAND, XINT (command), 0);
6282 return Qnil;
6285 DEFUN ("w32-shell-execute", Fw32_shell_execute, Sw32_shell_execute, 2, 4, 0,
6286 doc: /* Get Windows to perform OPERATION on DOCUMENT.
6287 This is a wrapper around the ShellExecute system function, which
6288 invokes the application registered to handle OPERATION for DOCUMENT.
6290 OPERATION is either nil or a string that names a supported operation.
6291 What operations can be used depends on the particular DOCUMENT and its
6292 handler application, but typically it is one of the following common
6293 operations:
6295 \"open\" - open DOCUMENT, which could be a file, a directory, or an
6296 executable program. If it is an application, that
6297 application is launched in the current buffer's default
6298 directory. Otherwise, the application associated with
6299 DOCUMENT is launched in the buffer's default directory.
6300 \"print\" - print DOCUMENT, which must be a file
6301 \"explore\" - start the Windows Explorer on DOCUMENT
6302 \"edit\" - launch an editor and open DOCUMENT for editing; which
6303 editor is launched depends on the association for the
6304 specified DOCUMENT
6305 \"find\" - initiate search starting from DOCUMENT which must specify
6306 a directory
6307 nil - invoke the default OPERATION, or \"open\" if default is
6308 not defined or unavailable
6310 DOCUMENT is typically the name of a document file or a URL, but can
6311 also be a program executable to run, or a directory to open in the
6312 Windows Explorer.
6314 If DOCUMENT is a program executable, the optional third arg PARAMETERS
6315 can be a string containing command line parameters that will be passed
6316 to the program; otherwise, PARAMETERS should be nil or unspecified.
6318 Optional fourth argument SHOW-FLAG can be used to control how the
6319 application will be displayed when it is invoked. If SHOW-FLAG is nil
6320 or unspecified, the application is displayed normally, otherwise it is
6321 an integer representing a ShowWindow flag:
6323 0 - start hidden
6324 1 - start normally
6325 3 - start maximized
6326 6 - start minimized */)
6327 (operation, document, parameters, show_flag)
6328 Lisp_Object operation, document, parameters, show_flag;
6330 Lisp_Object current_dir;
6332 CHECK_STRING (document);
6334 /* Encode filename, current directory and parameters. */
6335 current_dir = ENCODE_FILE (current_buffer->directory);
6336 document = ENCODE_FILE (document);
6337 if (STRINGP (parameters))
6338 parameters = ENCODE_SYSTEM (parameters);
6340 if ((int) ShellExecute (NULL,
6341 (STRINGP (operation) ?
6342 SDATA (operation) : NULL),
6343 SDATA (document),
6344 (STRINGP (parameters) ?
6345 SDATA (parameters) : NULL),
6346 SDATA (current_dir),
6347 (INTEGERP (show_flag) ?
6348 XINT (show_flag) : SW_SHOWDEFAULT))
6349 > 32)
6350 return Qt;
6351 error ("ShellExecute failed: %s", w32_strerror (0));
6354 /* Lookup virtual keycode from string representing the name of a
6355 non-ascii keystroke into the corresponding virtual key, using
6356 lispy_function_keys. */
6357 static int
6358 lookup_vk_code (char *key)
6360 int i;
6362 for (i = 0; i < 256; i++)
6363 if (lispy_function_keys[i]
6364 && strcmp (lispy_function_keys[i], key) == 0)
6365 return i;
6367 return -1;
6370 /* Convert a one-element vector style key sequence to a hot key
6371 definition. */
6372 static Lisp_Object
6373 w32_parse_hot_key (key)
6374 Lisp_Object key;
6376 /* Copied from Fdefine_key and store_in_keymap. */
6377 register Lisp_Object c;
6378 int vk_code;
6379 int lisp_modifiers;
6380 int w32_modifiers;
6381 struct gcpro gcpro1;
6383 CHECK_VECTOR (key);
6385 if (XFASTINT (Flength (key)) != 1)
6386 return Qnil;
6388 GCPRO1 (key);
6390 c = Faref (key, make_number (0));
6392 if (CONSP (c) && lucid_event_type_list_p (c))
6393 c = Fevent_convert_list (c);
6395 UNGCPRO;
6397 if (! INTEGERP (c) && ! SYMBOLP (c))
6398 error ("Key definition is invalid");
6400 /* Work out the base key and the modifiers. */
6401 if (SYMBOLP (c))
6403 c = parse_modifiers (c);
6404 lisp_modifiers = XINT (Fcar (Fcdr (c)));
6405 c = Fcar (c);
6406 if (!SYMBOLP (c))
6407 abort ();
6408 vk_code = lookup_vk_code (SDATA (SYMBOL_NAME (c)));
6410 else if (INTEGERP (c))
6412 lisp_modifiers = XINT (c) & ~CHARACTERBITS;
6413 /* Many ascii characters are their own virtual key code. */
6414 vk_code = XINT (c) & CHARACTERBITS;
6417 if (vk_code < 0 || vk_code > 255)
6418 return Qnil;
6420 if ((lisp_modifiers & meta_modifier) != 0
6421 && !NILP (Vw32_alt_is_meta))
6422 lisp_modifiers |= alt_modifier;
6424 /* Supply defs missing from mingw32. */
6425 #ifndef MOD_ALT
6426 #define MOD_ALT 0x0001
6427 #define MOD_CONTROL 0x0002
6428 #define MOD_SHIFT 0x0004
6429 #define MOD_WIN 0x0008
6430 #endif
6432 /* Convert lisp modifiers to Windows hot-key form. */
6433 w32_modifiers = (lisp_modifiers & hyper_modifier) ? MOD_WIN : 0;
6434 w32_modifiers |= (lisp_modifiers & alt_modifier) ? MOD_ALT : 0;
6435 w32_modifiers |= (lisp_modifiers & ctrl_modifier) ? MOD_CONTROL : 0;
6436 w32_modifiers |= (lisp_modifiers & shift_modifier) ? MOD_SHIFT : 0;
6438 return HOTKEY (vk_code, w32_modifiers);
6441 DEFUN ("w32-register-hot-key", Fw32_register_hot_key,
6442 Sw32_register_hot_key, 1, 1, 0,
6443 doc: /* Register KEY as a hot-key combination.
6444 Certain key combinations like Alt-Tab are reserved for system use on
6445 Windows, and therefore are normally intercepted by the system. However,
6446 most of these key combinations can be received by registering them as
6447 hot-keys, overriding their special meaning.
6449 KEY must be a one element key definition in vector form that would be
6450 acceptable to `define-key' (e.g. [A-tab] for Alt-Tab). The meta
6451 modifier is interpreted as Alt if `w32-alt-is-meta' is t, and hyper
6452 is always interpreted as the Windows modifier keys.
6454 The return value is the hotkey-id if registered, otherwise nil. */)
6455 (key)
6456 Lisp_Object key;
6458 key = w32_parse_hot_key (key);
6460 if (!NILP (key) && NILP (Fmemq (key, w32_grabbed_keys)))
6462 /* Reuse an empty slot if possible. */
6463 Lisp_Object item = Fmemq (Qnil, w32_grabbed_keys);
6465 /* Safe to add new key to list, even if we have focus. */
6466 if (NILP (item))
6467 w32_grabbed_keys = Fcons (key, w32_grabbed_keys);
6468 else
6469 XSETCAR (item, key);
6471 /* Notify input thread about new hot-key definition, so that it
6472 takes effect without needing to switch focus. */
6473 #ifdef USE_LISP_UNION_TYPE
6474 PostThreadMessage (dwWindowsThreadId, WM_EMACS_REGISTER_HOT_KEY,
6475 (WPARAM) key.i, 0);
6476 #else
6477 PostThreadMessage (dwWindowsThreadId, WM_EMACS_REGISTER_HOT_KEY,
6478 (WPARAM) key, 0);
6479 #endif
6482 return key;
6485 DEFUN ("w32-unregister-hot-key", Fw32_unregister_hot_key,
6486 Sw32_unregister_hot_key, 1, 1, 0,
6487 doc: /* Unregister KEY as a hot-key combination. */)
6488 (key)
6489 Lisp_Object key;
6491 Lisp_Object item;
6493 if (!INTEGERP (key))
6494 key = w32_parse_hot_key (key);
6496 item = Fmemq (key, w32_grabbed_keys);
6498 if (!NILP (item))
6500 /* Notify input thread about hot-key definition being removed, so
6501 that it takes effect without needing focus switch. */
6502 #ifdef USE_LISP_UNION_TYPE
6503 if (PostThreadMessage (dwWindowsThreadId, WM_EMACS_UNREGISTER_HOT_KEY,
6504 (WPARAM) XINT (XCAR (item)), (LPARAM) item.i))
6505 #else
6506 if (PostThreadMessage (dwWindowsThreadId, WM_EMACS_UNREGISTER_HOT_KEY,
6507 (WPARAM) XINT (XCAR (item)), (LPARAM) item))
6508 #endif
6510 MSG msg;
6511 GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE);
6513 return Qt;
6515 return Qnil;
6518 DEFUN ("w32-registered-hot-keys", Fw32_registered_hot_keys,
6519 Sw32_registered_hot_keys, 0, 0, 0,
6520 doc: /* Return list of registered hot-key IDs. */)
6523 return Fdelq (Qnil, Fcopy_sequence (w32_grabbed_keys));
6526 DEFUN ("w32-reconstruct-hot-key", Fw32_reconstruct_hot_key,
6527 Sw32_reconstruct_hot_key, 1, 1, 0,
6528 doc: /* Convert hot-key ID to a lisp key combination.
6529 usage: (w32-reconstruct-hot-key ID) */)
6530 (hotkeyid)
6531 Lisp_Object hotkeyid;
6533 int vk_code, w32_modifiers;
6534 Lisp_Object key;
6536 CHECK_NUMBER (hotkeyid);
6538 vk_code = HOTKEY_VK_CODE (hotkeyid);
6539 w32_modifiers = HOTKEY_MODIFIERS (hotkeyid);
6541 if (vk_code < 256 && lispy_function_keys[vk_code])
6542 key = intern (lispy_function_keys[vk_code]);
6543 else
6544 key = make_number (vk_code);
6546 key = Fcons (key, Qnil);
6547 if (w32_modifiers & MOD_SHIFT)
6548 key = Fcons (Qshift, key);
6549 if (w32_modifiers & MOD_CONTROL)
6550 key = Fcons (Qctrl, key);
6551 if (w32_modifiers & MOD_ALT)
6552 key = Fcons (NILP (Vw32_alt_is_meta) ? Qalt : Qmeta, key);
6553 if (w32_modifiers & MOD_WIN)
6554 key = Fcons (Qhyper, key);
6556 return key;
6559 DEFUN ("w32-toggle-lock-key", Fw32_toggle_lock_key,
6560 Sw32_toggle_lock_key, 1, 2, 0,
6561 doc: /* Toggle the state of the lock key KEY.
6562 KEY can be `capslock', `kp-numlock', or `scroll'.
6563 If the optional parameter NEW-STATE is a number, then the state of KEY
6564 is set to off if the low bit of NEW-STATE is zero, otherwise on. */)
6565 (key, new_state)
6566 Lisp_Object key, new_state;
6568 int vk_code;
6570 if (EQ (key, intern ("capslock")))
6571 vk_code = VK_CAPITAL;
6572 else if (EQ (key, intern ("kp-numlock")))
6573 vk_code = VK_NUMLOCK;
6574 else if (EQ (key, intern ("scroll")))
6575 vk_code = VK_SCROLL;
6576 else
6577 return Qnil;
6579 if (!dwWindowsThreadId)
6580 return make_number (w32_console_toggle_lock_key (vk_code, new_state));
6582 #ifdef USE_LISP_UNION_TYPE
6583 if (PostThreadMessage (dwWindowsThreadId, WM_EMACS_TOGGLE_LOCK_KEY,
6584 (WPARAM) vk_code, (LPARAM) new_state.i))
6585 #else
6586 if (PostThreadMessage (dwWindowsThreadId, WM_EMACS_TOGGLE_LOCK_KEY,
6587 (WPARAM) vk_code, (LPARAM) new_state))
6588 #endif
6590 MSG msg;
6591 GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE);
6592 return make_number (msg.wParam);
6594 return Qnil;
6597 DEFUN ("w32-window-exists-p", Fw32_window_exists_p, Sw32_window_exists_p,
6598 2, 2, 0,
6599 doc: /* Return non-nil if a window exists with the specified CLASS and NAME.
6601 This is a direct interface to the Windows API FindWindow function. */)
6602 (class, name)
6603 Lisp_Object class, name;
6605 HWND hnd;
6607 if (!NILP (class))
6608 CHECK_STRING (class);
6609 if (!NILP (name))
6610 CHECK_STRING (name);
6612 hnd = FindWindow (STRINGP (class) ? ((LPCTSTR) SDATA (class)) : NULL,
6613 STRINGP (name) ? ((LPCTSTR) SDATA (name)) : NULL);
6614 if (!hnd)
6615 return Qnil;
6616 return Qt;
6619 DEFUN ("w32-battery-status", Fw32_battery_status, Sw32_battery_status, 0, 0, 0,
6620 doc: /* Get power status information from Windows system.
6622 The following %-sequences are provided:
6623 %L AC line status (verbose)
6624 %B Battery status (verbose)
6625 %b Battery status, empty means high, `-' means low,
6626 `!' means critical, and `+' means charging
6627 %p Battery load percentage
6628 %s Remaining time (to charge or discharge) in seconds
6629 %m Remaining time (to charge or discharge) in minutes
6630 %h Remaining time (to charge or discharge) in hours
6631 %t Remaining time (to charge or discharge) in the form `h:min' */)
6634 Lisp_Object status = Qnil;
6636 SYSTEM_POWER_STATUS system_status;
6637 if (GetSystemPowerStatus (&system_status))
6639 Lisp_Object line_status, battery_status, battery_status_symbol;
6640 Lisp_Object load_percentage, seconds, minutes, hours, remain;
6641 Lisp_Object sequences[8];
6643 long seconds_left = (long) system_status.BatteryLifeTime;
6645 if (system_status.ACLineStatus == 0)
6646 line_status = build_string ("off-line");
6647 else if (system_status.ACLineStatus == 1)
6648 line_status = build_string ("on-line");
6649 else
6650 line_status = build_string ("N/A");
6652 if (system_status.BatteryFlag & 128)
6654 battery_status = build_string ("N/A");
6655 battery_status_symbol = empty_unibyte_string;
6657 else if (system_status.BatteryFlag & 8)
6659 battery_status = build_string ("charging");
6660 battery_status_symbol = build_string ("+");
6661 if (system_status.BatteryFullLifeTime != -1L)
6662 seconds_left = system_status.BatteryFullLifeTime - seconds_left;
6664 else if (system_status.BatteryFlag & 4)
6666 battery_status = build_string ("critical");
6667 battery_status_symbol = build_string ("!");
6669 else if (system_status.BatteryFlag & 2)
6671 battery_status = build_string ("low");
6672 battery_status_symbol = build_string ("-");
6674 else if (system_status.BatteryFlag & 1)
6676 battery_status = build_string ("high");
6677 battery_status_symbol = empty_unibyte_string;
6679 else
6681 battery_status = build_string ("medium");
6682 battery_status_symbol = empty_unibyte_string;
6685 if (system_status.BatteryLifePercent > 100)
6686 load_percentage = build_string ("N/A");
6687 else
6689 char buffer[16];
6690 _snprintf (buffer, 16, "%d", system_status.BatteryLifePercent);
6691 load_percentage = build_string (buffer);
6694 if (seconds_left < 0)
6695 seconds = minutes = hours = remain = build_string ("N/A");
6696 else
6698 long m;
6699 float h;
6700 char buffer[16];
6701 _snprintf (buffer, 16, "%ld", seconds_left);
6702 seconds = build_string (buffer);
6704 m = seconds_left / 60;
6705 _snprintf (buffer, 16, "%ld", m);
6706 minutes = build_string (buffer);
6708 h = seconds_left / 3600.0;
6709 _snprintf (buffer, 16, "%3.1f", h);
6710 hours = build_string (buffer);
6712 _snprintf (buffer, 16, "%ld:%02ld", m / 60, m % 60);
6713 remain = build_string (buffer);
6715 sequences[0] = Fcons (make_number ('L'), line_status);
6716 sequences[1] = Fcons (make_number ('B'), battery_status);
6717 sequences[2] = Fcons (make_number ('b'), battery_status_symbol);
6718 sequences[3] = Fcons (make_number ('p'), load_percentage);
6719 sequences[4] = Fcons (make_number ('s'), seconds);
6720 sequences[5] = Fcons (make_number ('m'), minutes);
6721 sequences[6] = Fcons (make_number ('h'), hours);
6722 sequences[7] = Fcons (make_number ('t'), remain);
6724 status = Flist (8, sequences);
6726 return status;
6730 DEFUN ("file-system-info", Ffile_system_info, Sfile_system_info, 1, 1, 0,
6731 doc: /* Return storage information about the file system FILENAME is on.
6732 Value is a list of floats (TOTAL FREE AVAIL), where TOTAL is the total
6733 storage of the file system, FREE is the free storage, and AVAIL is the
6734 storage available to a non-superuser. All 3 numbers are in bytes.
6735 If the underlying system call fails, value is nil. */)
6736 (filename)
6737 Lisp_Object filename;
6739 Lisp_Object encoded, value;
6741 CHECK_STRING (filename);
6742 filename = Fexpand_file_name (filename, Qnil);
6743 encoded = ENCODE_FILE (filename);
6745 value = Qnil;
6747 /* Determining the required information on Windows turns out, sadly,
6748 to be more involved than one would hope. The original Win32 api
6749 call for this will return bogus information on some systems, but we
6750 must dynamically probe for the replacement api, since that was
6751 added rather late on. */
6753 HMODULE hKernel = GetModuleHandle ("kernel32");
6754 BOOL (*pfn_GetDiskFreeSpaceEx)
6755 (char *, PULARGE_INTEGER, PULARGE_INTEGER, PULARGE_INTEGER)
6756 = (void *) GetProcAddress (hKernel, "GetDiskFreeSpaceEx");
6758 /* On Windows, we may need to specify the root directory of the
6759 volume holding FILENAME. */
6760 char rootname[MAX_PATH];
6761 char *name = SDATA (encoded);
6763 /* find the root name of the volume if given */
6764 if (isalpha (name[0]) && name[1] == ':')
6766 rootname[0] = name[0];
6767 rootname[1] = name[1];
6768 rootname[2] = '\\';
6769 rootname[3] = 0;
6771 else if (IS_DIRECTORY_SEP (name[0]) && IS_DIRECTORY_SEP (name[1]))
6773 char *str = rootname;
6774 int slashes = 4;
6777 if (IS_DIRECTORY_SEP (*name) && --slashes == 0)
6778 break;
6779 *str++ = *name++;
6781 while ( *name );
6783 *str++ = '\\';
6784 *str = 0;
6787 if (pfn_GetDiskFreeSpaceEx)
6789 /* Unsigned large integers cannot be cast to double, so
6790 use signed ones instead. */
6791 LARGE_INTEGER availbytes;
6792 LARGE_INTEGER freebytes;
6793 LARGE_INTEGER totalbytes;
6795 if (pfn_GetDiskFreeSpaceEx (rootname,
6796 (ULARGE_INTEGER *)&availbytes,
6797 (ULARGE_INTEGER *)&totalbytes,
6798 (ULARGE_INTEGER *)&freebytes))
6799 value = list3 (make_float ((double) totalbytes.QuadPart),
6800 make_float ((double) freebytes.QuadPart),
6801 make_float ((double) availbytes.QuadPart));
6803 else
6805 DWORD sectors_per_cluster;
6806 DWORD bytes_per_sector;
6807 DWORD free_clusters;
6808 DWORD total_clusters;
6810 if (GetDiskFreeSpace (rootname,
6811 &sectors_per_cluster,
6812 &bytes_per_sector,
6813 &free_clusters,
6814 &total_clusters))
6815 value = list3 (make_float ((double) total_clusters
6816 * sectors_per_cluster * bytes_per_sector),
6817 make_float ((double) free_clusters
6818 * sectors_per_cluster * bytes_per_sector),
6819 make_float ((double) free_clusters
6820 * sectors_per_cluster * bytes_per_sector));
6824 return value;
6827 DEFUN ("default-printer-name", Fdefault_printer_name, Sdefault_printer_name,
6828 0, 0, 0, doc: /* Return the name of Windows default printer device. */)
6831 static char pname_buf[256];
6832 int err;
6833 HANDLE hPrn;
6834 PRINTER_INFO_2 *ppi2 = NULL;
6835 DWORD dwNeeded = 0, dwReturned = 0;
6837 /* Retrieve the default string from Win.ini (the registry).
6838 * String will be in form "printername,drivername,portname".
6839 * This is the most portable way to get the default printer. */
6840 if (GetProfileString ("windows", "device", ",,", pname_buf, sizeof (pname_buf)) <= 0)
6841 return Qnil;
6842 /* printername precedes first "," character */
6843 strtok (pname_buf, ",");
6844 /* We want to know more than the printer name */
6845 if (!OpenPrinter (pname_buf, &hPrn, NULL))
6846 return Qnil;
6847 GetPrinter (hPrn, 2, NULL, 0, &dwNeeded);
6848 if (dwNeeded == 0)
6850 ClosePrinter (hPrn);
6851 return Qnil;
6853 /* Allocate memory for the PRINTER_INFO_2 struct */
6854 ppi2 = (PRINTER_INFO_2 *) xmalloc (dwNeeded);
6855 if (!ppi2)
6857 ClosePrinter (hPrn);
6858 return Qnil;
6860 /* Call GetPrinter again with big enouth memory block */
6861 err = GetPrinter (hPrn, 2, (LPBYTE)ppi2, dwNeeded, &dwReturned);
6862 ClosePrinter (hPrn);
6863 if (!err)
6865 xfree (ppi2);
6866 return Qnil;
6869 if (ppi2)
6871 if (ppi2->Attributes & PRINTER_ATTRIBUTE_SHARED && ppi2->pServerName)
6873 /* a remote printer */
6874 if (*ppi2->pServerName == '\\')
6875 _snprintf (pname_buf, sizeof (pname_buf), "%s\\%s", ppi2->pServerName,
6876 ppi2->pShareName);
6877 else
6878 _snprintf (pname_buf, sizeof (pname_buf), "\\\\%s\\%s", ppi2->pServerName,
6879 ppi2->pShareName);
6880 pname_buf[sizeof (pname_buf) - 1] = '\0';
6882 else
6884 /* a local printer */
6885 strncpy (pname_buf, ppi2->pPortName, sizeof (pname_buf));
6886 pname_buf[sizeof (pname_buf) - 1] = '\0';
6887 /* `pPortName' can include several ports, delimited by ','.
6888 * we only use the first one. */
6889 strtok (pname_buf, ",");
6891 xfree (ppi2);
6894 return build_string (pname_buf);
6897 /***********************************************************************
6898 Initialization
6899 ***********************************************************************/
6901 /* Keep this list in the same order as frame_parms in frame.c.
6902 Use 0 for unsupported frame parameters. */
6904 frame_parm_handler w32_frame_parm_handlers[] =
6906 x_set_autoraise,
6907 x_set_autolower,
6908 x_set_background_color,
6909 x_set_border_color,
6910 x_set_border_width,
6911 x_set_cursor_color,
6912 x_set_cursor_type,
6913 x_set_font,
6914 x_set_foreground_color,
6915 x_set_icon_name,
6916 x_set_icon_type,
6917 x_set_internal_border_width,
6918 x_set_menu_bar_lines,
6919 x_set_mouse_color,
6920 x_explicitly_set_name,
6921 x_set_scroll_bar_width,
6922 x_set_title,
6923 x_set_unsplittable,
6924 x_set_vertical_scroll_bars,
6925 x_set_visibility,
6926 x_set_tool_bar_lines,
6927 0, /* x_set_scroll_bar_foreground, */
6928 0, /* x_set_scroll_bar_background, */
6929 x_set_screen_gamma,
6930 x_set_line_spacing,
6931 x_set_fringe_width,
6932 x_set_fringe_width,
6933 0, /* x_set_wait_for_wm, */
6934 x_set_fullscreen,
6935 x_set_font_backend,
6936 x_set_alpha,
6937 0, /* x_set_sticky */
6940 void
6941 syms_of_w32fns ()
6943 globals_of_w32fns ();
6944 /* This is zero if not using MS-Windows. */
6945 w32_in_use = 0;
6946 track_mouse_window = NULL;
6948 w32_visible_system_caret_hwnd = NULL;
6950 DEFSYM (Qnone, "none");
6951 DEFSYM (Qsuppress_icon, "suppress-icon");
6952 DEFSYM (Qundefined_color, "undefined-color");
6953 DEFSYM (Qcancel_timer, "cancel-timer");
6954 DEFSYM (Qhyper, "hyper");
6955 DEFSYM (Qsuper, "super");
6956 DEFSYM (Qmeta, "meta");
6957 DEFSYM (Qalt, "alt");
6958 DEFSYM (Qctrl, "ctrl");
6959 DEFSYM (Qcontrol, "control");
6960 DEFSYM (Qshift, "shift");
6961 DEFSYM (Qfont_param, "font-parameter");
6962 /* This is the end of symbol initialization. */
6964 /* Text property `display' should be nonsticky by default. */
6965 Vtext_property_default_nonsticky
6966 = Fcons (Fcons (Qdisplay, Qt), Vtext_property_default_nonsticky);
6969 Fput (Qundefined_color, Qerror_conditions,
6970 Fcons (Qundefined_color, Fcons (Qerror, Qnil)));
6971 Fput (Qundefined_color, Qerror_message,
6972 build_string ("Undefined color"));
6974 staticpro (&w32_grabbed_keys);
6975 w32_grabbed_keys = Qnil;
6977 DEFVAR_LISP ("w32-color-map", &Vw32_color_map,
6978 doc: /* An array of color name mappings for Windows. */);
6979 Vw32_color_map = Qnil;
6981 DEFVAR_LISP ("w32-pass-alt-to-system", &Vw32_pass_alt_to_system,
6982 doc: /* Non-nil if Alt key presses are passed on to Windows.
6983 When non-nil, for example, Alt pressed and released and then space will
6984 open the System menu. When nil, Emacs processes the Alt key events, and
6985 then silently swallows them. */);
6986 Vw32_pass_alt_to_system = Qnil;
6988 DEFVAR_LISP ("w32-alt-is-meta", &Vw32_alt_is_meta,
6989 doc: /* Non-nil if the Alt key is to be considered the same as the META key.
6990 When nil, Emacs will translate the Alt key to the ALT modifier, not to META. */);
6991 Vw32_alt_is_meta = Qt;
6993 DEFVAR_INT ("w32-quit-key", &w32_quit_key,
6994 doc: /* If non-zero, the virtual key code for an alternative quit key. */);
6995 w32_quit_key = 0;
6997 DEFVAR_LISP ("w32-pass-lwindow-to-system",
6998 &Vw32_pass_lwindow_to_system,
6999 doc: /* If non-nil, the left \"Windows\" key is passed on to Windows.
7001 When non-nil, the Start menu is opened by tapping the key.
7002 If you set this to nil, the left \"Windows\" key is processed by Emacs
7003 according to the value of `w32-lwindow-modifier', which see.
7005 Note that some combinations of the left \"Windows\" key with other keys are
7006 caught by Windows at low level, and so binding them in Emacs will have no
7007 effect. For example, <lwindow>-r always pops up the Windows Run dialog,
7008 <lwindow>-<Pause> pops up the "System Properties" dialog, etc. However, see
7009 the doc string of `w32-phantom-key-code'. */);
7010 Vw32_pass_lwindow_to_system = Qt;
7012 DEFVAR_LISP ("w32-pass-rwindow-to-system",
7013 &Vw32_pass_rwindow_to_system,
7014 doc: /* If non-nil, the right \"Windows\" key is passed on to Windows.
7016 When non-nil, the Start menu is opened by tapping the key.
7017 If you set this to nil, the right \"Windows\" key is processed by Emacs
7018 according to the value of `w32-rwindow-modifier', which see.
7020 Note that some combinations of the right \"Windows\" key with other keys are
7021 caught by Windows at low level, and so binding them in Emacs will have no
7022 effect. For example, <rwindow>-r always pops up the Windows Run dialog,
7023 <rwindow>-<Pause> pops up the "System Properties" dialog, etc. However, see
7024 the doc string of `w32-phantom-key-code'. */);
7025 Vw32_pass_rwindow_to_system = Qt;
7027 DEFVAR_LISP ("w32-phantom-key-code",
7028 &Vw32_phantom_key_code,
7029 doc: /* Virtual key code used to generate \"phantom\" key presses.
7030 Value is a number between 0 and 255.
7032 Phantom key presses are generated in order to stop the system from
7033 acting on \"Windows\" key events when `w32-pass-lwindow-to-system' or
7034 `w32-pass-rwindow-to-system' is nil. */);
7035 /* Although 255 is technically not a valid key code, it works and
7036 means that this hack won't interfere with any real key code. */
7037 XSETINT (Vw32_phantom_key_code, 255);
7039 DEFVAR_LISP ("w32-enable-num-lock",
7040 &Vw32_enable_num_lock,
7041 doc: /* If non-nil, the Num Lock key acts normally.
7042 Set to nil to handle Num Lock as the `kp-numlock' key. */);
7043 Vw32_enable_num_lock = Qt;
7045 DEFVAR_LISP ("w32-enable-caps-lock",
7046 &Vw32_enable_caps_lock,
7047 doc: /* If non-nil, the Caps Lock key acts normally.
7048 Set to nil to handle Caps Lock as the `capslock' key. */);
7049 Vw32_enable_caps_lock = Qt;
7051 DEFVAR_LISP ("w32-scroll-lock-modifier",
7052 &Vw32_scroll_lock_modifier,
7053 doc: /* Modifier to use for the Scroll Lock ON state.
7054 The value can be hyper, super, meta, alt, control or shift for the
7055 respective modifier, or nil to handle Scroll Lock as the `scroll' key.
7056 Any other value will cause the Scroll Lock key to be ignored. */);
7057 Vw32_scroll_lock_modifier = Qt;
7059 DEFVAR_LISP ("w32-lwindow-modifier",
7060 &Vw32_lwindow_modifier,
7061 doc: /* Modifier to use for the left \"Windows\" key.
7062 The value can be hyper, super, meta, alt, control or shift for the
7063 respective modifier, or nil to appear as the `lwindow' key.
7064 Any other value will cause the key to be ignored. */);
7065 Vw32_lwindow_modifier = Qnil;
7067 DEFVAR_LISP ("w32-rwindow-modifier",
7068 &Vw32_rwindow_modifier,
7069 doc: /* Modifier to use for the right \"Windows\" key.
7070 The value can be hyper, super, meta, alt, control or shift for the
7071 respective modifier, or nil to appear as the `rwindow' key.
7072 Any other value will cause the key to be ignored. */);
7073 Vw32_rwindow_modifier = Qnil;
7075 DEFVAR_LISP ("w32-apps-modifier",
7076 &Vw32_apps_modifier,
7077 doc: /* Modifier to use for the \"Apps\" key.
7078 The value can be hyper, super, meta, alt, control or shift for the
7079 respective modifier, or nil to appear as the `apps' key.
7080 Any other value will cause the key to be ignored. */);
7081 Vw32_apps_modifier = Qnil;
7083 DEFVAR_BOOL ("w32-enable-synthesized-fonts", &w32_enable_synthesized_fonts,
7084 doc: /* Non-nil enables selection of artificially italicized and bold fonts. */);
7085 w32_enable_synthesized_fonts = 0;
7087 DEFVAR_LISP ("w32-enable-palette", &Vw32_enable_palette,
7088 doc: /* Non-nil enables Windows palette management to map colors exactly. */);
7089 Vw32_enable_palette = Qt;
7091 DEFVAR_INT ("w32-mouse-button-tolerance",
7092 &w32_mouse_button_tolerance,
7093 doc: /* Analogue of double click interval for faking middle mouse events.
7094 The value is the minimum time in milliseconds that must elapse between
7095 left and right button down events before they are considered distinct events.
7096 If both mouse buttons are depressed within this interval, a middle mouse
7097 button down event is generated instead. */);
7098 w32_mouse_button_tolerance = GetDoubleClickTime () / 2;
7100 DEFVAR_INT ("w32-mouse-move-interval",
7101 &w32_mouse_move_interval,
7102 doc: /* Minimum interval between mouse move events.
7103 The value is the minimum time in milliseconds that must elapse between
7104 successive mouse move (or scroll bar drag) events before they are
7105 reported as lisp events. */);
7106 w32_mouse_move_interval = 0;
7108 DEFVAR_BOOL ("w32-pass-extra-mouse-buttons-to-system",
7109 &w32_pass_extra_mouse_buttons_to_system,
7110 doc: /* If non-nil, the fourth and fifth mouse buttons are passed to Windows.
7111 Recent versions of Windows support mice with up to five buttons.
7112 Since most applications don't support these extra buttons, most mouse
7113 drivers will allow you to map them to functions at the system level.
7114 If this variable is non-nil, Emacs will pass them on, allowing the
7115 system to handle them. */);
7116 w32_pass_extra_mouse_buttons_to_system = 0;
7118 DEFVAR_BOOL ("w32-pass-multimedia-buttons-to-system",
7119 &w32_pass_multimedia_buttons_to_system,
7120 doc: /* If non-nil, media buttons are passed to Windows.
7121 Some modern keyboards contain buttons for controlling media players, web
7122 browsers and other applications. Generally these buttons are handled on a
7123 system wide basis, but by setting this to nil they are made available
7124 to Emacs for binding. Depending on your keyboard, additional keys that
7125 may be available are:
7127 browser-back, browser-forward, browser-refresh, browser-stop,
7128 browser-search, browser-favorites, browser-home,
7129 mail, mail-reply, mail-forward, mail-send,
7130 app-1, app-2,
7131 help, find, new, open, close, save, print, undo, redo, copy, cut, paste,
7132 spell-check, correction-list, toggle-dictate-command,
7133 media-next, media-previous, media-stop, media-play-pause, media-select,
7134 media-play, media-pause, media-record, media-fast-forward, media-rewind,
7135 media-channel-up, media-channel-down,
7136 volume-mute, volume-up, volume-down,
7137 mic-volume-mute, mic-volume-down, mic-volume-up, mic-toggle,
7138 bass-down, bass-boost, bass-up, treble-down, treble-up */);
7139 w32_pass_multimedia_buttons_to_system = 1;
7141 #if 0 /* TODO: Mouse cursor customization. */
7142 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape,
7143 doc: /* The shape of the pointer when over text.
7144 Changing the value does not affect existing frames
7145 unless you set the mouse color. */);
7146 Vx_pointer_shape = Qnil;
7148 Vx_nontext_pointer_shape = Qnil;
7150 Vx_mode_pointer_shape = Qnil;
7152 DEFVAR_LISP ("x-hourglass-pointer-shape", &Vx_hourglass_pointer_shape,
7153 doc: /* The shape of the pointer when Emacs is busy.
7154 This variable takes effect when you create a new frame
7155 or when you set the mouse color. */);
7156 Vx_hourglass_pointer_shape = Qnil;
7158 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
7159 &Vx_sensitive_text_pointer_shape,
7160 doc: /* The shape of the pointer when over mouse-sensitive text.
7161 This variable takes effect when you create a new frame
7162 or when you set the mouse color. */);
7163 Vx_sensitive_text_pointer_shape = Qnil;
7165 DEFVAR_LISP ("x-window-horizontal-drag-cursor",
7166 &Vx_window_horizontal_drag_shape,
7167 doc: /* Pointer shape to use for indicating a window can be dragged horizontally.
7168 This variable takes effect when you create a new frame
7169 or when you set the mouse color. */);
7170 Vx_window_horizontal_drag_shape = Qnil;
7171 #endif
7173 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel,
7174 doc: /* A string indicating the foreground color of the cursor box. */);
7175 Vx_cursor_fore_pixel = Qnil;
7177 DEFVAR_LISP ("x-max-tooltip-size", &Vx_max_tooltip_size,
7178 doc: /* Maximum size for tooltips.
7179 Value is a pair (COLUMNS . ROWS). Text larger than this is clipped. */);
7180 Vx_max_tooltip_size = Fcons (make_number (80), make_number (40));
7182 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager,
7183 doc: /* Non-nil if no window manager is in use.
7184 Emacs doesn't try to figure this out; this is always nil
7185 unless you set it to something else. */);
7186 /* We don't have any way to find this out, so set it to nil
7187 and maybe the user would like to set it to t. */
7188 Vx_no_window_manager = Qnil;
7190 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
7191 &Vx_pixel_size_width_font_regexp,
7192 doc: /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'.
7194 Since Emacs gets width of a font matching with this regexp from
7195 PIXEL_SIZE field of the name, font finding mechanism gets faster for
7196 such a font. This is especially effective for such large fonts as
7197 Chinese, Japanese, and Korean. */);
7198 Vx_pixel_size_width_font_regexp = Qnil;
7200 DEFVAR_LISP ("w32-bdf-filename-alist",
7201 &Vw32_bdf_filename_alist,
7202 doc: /* List of bdf fonts and their corresponding filenames. */);
7203 Vw32_bdf_filename_alist = Qnil;
7205 DEFVAR_BOOL ("w32-strict-fontnames",
7206 &w32_strict_fontnames,
7207 doc: /* Non-nil means only use fonts that are exact matches for those requested.
7208 Default is nil, which allows old fontnames that are not XLFD compliant,
7209 and allows third-party CJK display to work by specifying false charset
7210 fields to trick Emacs into translating to Big5, SJIS etc.
7211 Setting this to t will prevent wrong fonts being selected when
7212 fontsets are automatically created. */);
7213 w32_strict_fontnames = 0;
7215 DEFVAR_BOOL ("w32-strict-painting",
7216 &w32_strict_painting,
7217 doc: /* Non-nil means use strict rules for repainting frames.
7218 Set this to nil to get the old behavior for repainting; this should
7219 only be necessary if the default setting causes problems. */);
7220 w32_strict_painting = 1;
7222 #if 0 /* TODO: Port to W32 */
7223 defsubr (&Sx_change_window_property);
7224 defsubr (&Sx_delete_window_property);
7225 defsubr (&Sx_window_property);
7226 #endif
7227 defsubr (&Sxw_display_color_p);
7228 defsubr (&Sx_display_grayscale_p);
7229 defsubr (&Sxw_color_defined_p);
7230 defsubr (&Sxw_color_values);
7231 defsubr (&Sx_server_max_request_size);
7232 defsubr (&Sx_server_vendor);
7233 defsubr (&Sx_server_version);
7234 defsubr (&Sx_display_pixel_width);
7235 defsubr (&Sx_display_pixel_height);
7236 defsubr (&Sx_display_mm_width);
7237 defsubr (&Sx_display_mm_height);
7238 defsubr (&Sx_display_screens);
7239 defsubr (&Sx_display_planes);
7240 defsubr (&Sx_display_color_cells);
7241 defsubr (&Sx_display_visual_class);
7242 defsubr (&Sx_display_backing_store);
7243 defsubr (&Sx_display_save_under);
7244 defsubr (&Sx_create_frame);
7245 defsubr (&Sx_open_connection);
7246 defsubr (&Sx_close_connection);
7247 defsubr (&Sx_display_list);
7248 defsubr (&Sx_synchronize);
7249 defsubr (&Sx_focus_frame);
7251 /* W32 specific functions */
7253 defsubr (&Sw32_define_rgb_color);
7254 defsubr (&Sw32_default_color_map);
7255 defsubr (&Sw32_send_sys_command);
7256 defsubr (&Sw32_shell_execute);
7257 defsubr (&Sw32_register_hot_key);
7258 defsubr (&Sw32_unregister_hot_key);
7259 defsubr (&Sw32_registered_hot_keys);
7260 defsubr (&Sw32_reconstruct_hot_key);
7261 defsubr (&Sw32_toggle_lock_key);
7262 defsubr (&Sw32_window_exists_p);
7263 defsubr (&Sw32_battery_status);
7265 defsubr (&Sfile_system_info);
7266 defsubr (&Sdefault_printer_name);
7268 check_window_system_func = check_w32;
7271 hourglass_timer = 0;
7272 hourglass_hwnd = NULL;
7274 defsubr (&Sx_show_tip);
7275 defsubr (&Sx_hide_tip);
7276 tip_timer = Qnil;
7277 staticpro (&tip_timer);
7278 tip_frame = Qnil;
7279 staticpro (&tip_frame);
7281 last_show_tip_args = Qnil;
7282 staticpro (&last_show_tip_args);
7284 defsubr (&Sx_file_dialog);
7285 defsubr (&Ssystem_move_file_to_trash);
7290 globals_of_w32fns is used to initialize those global variables that
7291 must always be initialized on startup even when the global variable
7292 initialized is non zero (see the function main in emacs.c).
7293 globals_of_w32fns is called from syms_of_w32fns when the global
7294 variable initialized is 0 and directly from main when initialized
7295 is non zero.
7297 void
7298 globals_of_w32fns ()
7300 HMODULE user32_lib = GetModuleHandle ("user32.dll");
7302 TrackMouseEvent not available in all versions of Windows, so must load
7303 it dynamically. Do it once, here, instead of every time it is used.
7305 track_mouse_event_fn = (TrackMouseEvent_Proc)
7306 GetProcAddress (user32_lib, "TrackMouseEvent");
7307 /* ditto for GetClipboardSequenceNumber. */
7308 clipboard_sequence_fn = (ClipboardSequence_Proc)
7309 GetProcAddress (user32_lib, "GetClipboardSequenceNumber");
7311 monitor_from_point_fn = (MonitorFromPoint_Proc)
7312 GetProcAddress (user32_lib, "MonitorFromPoint");
7313 get_monitor_info_fn = (GetMonitorInfo_Proc)
7314 GetProcAddress (user32_lib, "GetMonitorInfoA");
7317 HMODULE imm32_lib = GetModuleHandle ("imm32.dll");
7318 get_composition_string_fn = (ImmGetCompositionString_Proc)
7319 GetProcAddress (imm32_lib, "ImmGetCompositionStringW");
7320 get_ime_context_fn = (ImmGetContext_Proc)
7321 GetProcAddress (imm32_lib, "ImmGetContext");
7322 release_ime_context_fn = (ImmReleaseContext_Proc)
7323 GetProcAddress (imm32_lib, "ImmReleaseContext");
7324 set_ime_composition_window_fn = (ImmSetCompositionWindow_Proc)
7325 GetProcAddress (imm32_lib, "ImmSetCompositionWindow");
7327 DEFVAR_INT ("w32-ansi-code-page",
7328 &w32_ansi_code_page,
7329 doc: /* The ANSI code page used by the system. */);
7330 w32_ansi_code_page = GetACP ();
7332 /* MessageBox does not work without this when linked to comctl32.dll 6.0. */
7333 InitCommonControls ();
7335 syms_of_w32uniscribe ();
7338 #undef abort
7340 void
7341 w32_abort ()
7343 int button;
7344 button = MessageBox (NULL,
7345 "A fatal error has occurred!\n\n"
7346 "Would you like to attach a debugger?\n\n"
7347 "Select YES to debug, NO to abort Emacs"
7348 #if __GNUC__
7349 "\n\n(type \"gdb -p <emacs-PID>\" and\n"
7350 "\"continue\" inside GDB before clicking YES.)"
7351 #endif
7352 , "Emacs Abort Dialog",
7353 MB_ICONEXCLAMATION | MB_TASKMODAL
7354 | MB_SETFOREGROUND | MB_YESNO);
7355 switch (button)
7357 case IDYES:
7358 DebugBreak ();
7359 exit (2); /* tell the compiler we will never return */
7360 case IDNO:
7361 default:
7362 abort ();
7363 break;
7367 /* For convenience when debugging. */
7369 w32_last_error ()
7371 return GetLastError ();
7374 /* arch-tag: 707589ab-b9be-4638-8cdd-74629cc9b446
7375 (do not change this comment) */