* makefile.w32-in (INFO_TARGETS, DVI_TARGETS, clean): Add ns-emacs.
[emacs.git] / src / w32fns.c
bloba12c349e4cab77e5acf997799d4f9969e7599b94
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
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 /* The background and shape of the mouse pointer, and shape when not
160 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;
169 #ifndef IDC_HAND
170 #define IDC_HAND MAKEINTRESOURCE(32649)
171 #endif
173 /* 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 typedef BOOL (WINAPI * TrackMouseEvent_Proc)
246 (IN OUT LPTRACKMOUSEEVENT lpEventTrack);
247 typedef LONG (WINAPI * ImmGetCompositionString_Proc)
248 (IN HIMC context, IN DWORD index, OUT LPVOID buffer, IN DWORD bufLen);
249 typedef HIMC (WINAPI * ImmGetContext_Proc) (IN HWND window);
250 typedef HMONITOR (WINAPI * MonitorFromPoint_Proc) (IN POINT pt, IN DWORD flags);
251 typedef BOOL (WINAPI * GetMonitorInfo_Proc)
252 (IN HMONITOR monitor, OUT struct MONITOR_INFO* info);
254 TrackMouseEvent_Proc track_mouse_event_fn = NULL;
255 ClipboardSequence_Proc clipboard_sequence_fn = NULL;
256 ImmGetCompositionString_Proc get_composition_string_fn = NULL;
257 ImmGetContext_Proc get_ime_context_fn = NULL;
258 MonitorFromPoint_Proc monitor_from_point_fn = NULL;
259 GetMonitorInfo_Proc get_monitor_info_fn = NULL;
261 extern AppendMenuW_Proc unicode_append_menu;
263 /* Flag to selectively ignore WM_IME_CHAR messages. */
264 static int ignore_ime_char = 0;
266 /* W95 mousewheel handler */
267 unsigned int msh_mousewheel = 0;
269 /* Timers */
270 #define MOUSE_BUTTON_ID 1
271 #define MOUSE_MOVE_ID 2
272 #define MENU_FREE_ID 3
273 #define HOURGLASS_ID 4
274 /* The delay (milliseconds) before a menu is freed after WM_EXITMENULOOP
275 is received. */
276 #define MENU_FREE_DELAY 1000
277 static unsigned menu_free_timer = 0;
279 /* The below are defined in frame.c. */
281 extern Lisp_Object Vwindow_system_version;
283 #ifdef GLYPH_DEBUG
284 int image_cache_refcount, dpyinfo_refcount;
285 #endif
288 /* From w32term.c. */
289 extern int w32_num_mouse_buttons;
290 extern Lisp_Object Vw32_recognize_altgr;
292 extern HWND w32_system_caret_hwnd;
294 extern int w32_system_caret_height;
295 extern int w32_system_caret_x;
296 extern int w32_system_caret_y;
297 extern int w32_use_visible_system_caret;
299 static HWND w32_visible_system_caret_hwnd;
301 /* From w32menu.c */
302 extern HMENU current_popup_menu;
303 static int menubar_in_use = 0;
305 /* From w32uniscribe.c */
306 extern void syms_of_w32uniscribe ();
307 extern int uniscribe_available;
309 /* Function prototypes for hourglass support. */
310 static void w32_show_hourglass P_ ((struct frame *));
311 static void w32_hide_hourglass P_ ((void));
315 /* Error if we are not connected to MS-Windows. */
316 void
317 check_w32 ()
319 if (! w32_in_use)
320 error ("MS-Windows not in use or not initialized");
323 /* Nonzero if we can use mouse menus.
324 You should not call this unless HAVE_MENUS is defined. */
327 have_menus_p ()
329 return w32_in_use;
332 /* Extract a frame as a FRAME_PTR, defaulting to the selected frame
333 and checking validity for W32. */
335 FRAME_PTR
336 check_x_frame (frame)
337 Lisp_Object frame;
339 FRAME_PTR f;
341 if (NILP (frame))
342 frame = selected_frame;
343 CHECK_LIVE_FRAME (frame);
344 f = XFRAME (frame);
345 if (! FRAME_W32_P (f))
346 error ("Non-W32 frame used");
347 return f;
350 /* Let the user specify a display with a frame.
351 nil stands for the selected frame--or, if that is not a w32 frame,
352 the first display on the list. */
354 struct w32_display_info *
355 check_x_display_info (frame)
356 Lisp_Object frame;
358 if (NILP (frame))
360 struct frame *sf = XFRAME (selected_frame);
362 if (FRAME_W32_P (sf) && FRAME_LIVE_P (sf))
363 return FRAME_W32_DISPLAY_INFO (sf);
364 else
365 return &one_w32_display_info;
367 else if (STRINGP (frame))
368 return x_display_info_for_name (frame);
369 else
371 FRAME_PTR f;
373 CHECK_LIVE_FRAME (frame);
374 f = XFRAME (frame);
375 if (! FRAME_W32_P (f))
376 error ("Non-W32 frame used");
377 return FRAME_W32_DISPLAY_INFO (f);
381 /* Return the Emacs frame-object corresponding to an w32 window.
382 It could be the frame's main window or an icon window. */
384 /* This function can be called during GC, so use GC_xxx type test macros. */
386 struct frame *
387 x_window_to_frame (dpyinfo, wdesc)
388 struct w32_display_info *dpyinfo;
389 HWND wdesc;
391 Lisp_Object tail, frame;
392 struct frame *f;
394 for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
396 frame = XCAR (tail);
397 if (!FRAMEP (frame))
398 continue;
399 f = XFRAME (frame);
400 if (!FRAME_W32_P (f) || FRAME_W32_DISPLAY_INFO (f) != dpyinfo)
401 continue;
403 if (FRAME_W32_WINDOW (f) == wdesc)
404 return f;
406 return 0;
410 static Lisp_Object unwind_create_frame P_ ((Lisp_Object));
411 static Lisp_Object unwind_create_tip_frame P_ ((Lisp_Object));
412 static void my_create_window P_ ((struct frame *));
413 static void my_create_tip_window P_ ((struct frame *));
415 /* TODO: Native Input Method support; see x_create_im. */
416 void x_set_foreground_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
417 void x_set_background_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
418 void x_set_mouse_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
419 void x_set_cursor_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
420 void x_set_border_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
421 void x_set_cursor_type P_ ((struct frame *, Lisp_Object, Lisp_Object));
422 void x_set_icon_type P_ ((struct frame *, Lisp_Object, Lisp_Object));
423 void x_set_icon_name P_ ((struct frame *, Lisp_Object, Lisp_Object));
424 void x_explicitly_set_name P_ ((struct frame *, Lisp_Object, Lisp_Object));
425 void x_set_menu_bar_lines P_ ((struct frame *, Lisp_Object, Lisp_Object));
426 void x_set_title P_ ((struct frame *, Lisp_Object, Lisp_Object));
427 void x_set_tool_bar_lines P_ ((struct frame *, Lisp_Object, Lisp_Object));
428 static void x_edge_detection P_ ((struct frame *, struct image *, Lisp_Object,
429 Lisp_Object));
434 /* Store the screen positions of frame F into XPTR and YPTR.
435 These are the positions of the containing window manager window,
436 not Emacs's own window. */
438 void
439 x_real_positions (f, xptr, yptr)
440 FRAME_PTR f;
441 int *xptr, *yptr;
443 POINT pt;
444 RECT rect;
446 /* Get the bounds of the WM window. */
447 GetWindowRect (FRAME_W32_WINDOW (f), &rect);
449 pt.x = 0;
450 pt.y = 0;
452 /* Convert (0, 0) in the client area to screen co-ordinates. */
453 ClientToScreen (FRAME_W32_WINDOW (f), &pt);
455 /* Remember x_pixels_diff and y_pixels_diff. */
456 f->x_pixels_diff = pt.x - rect.left;
457 f->y_pixels_diff = pt.y - rect.top;
459 *xptr = rect.left;
460 *yptr = rect.top;
465 DEFUN ("w32-define-rgb-color", Fw32_define_rgb_color,
466 Sw32_define_rgb_color, 4, 4, 0,
467 doc: /* Convert RGB numbers to a Windows color reference and associate with NAME.
468 This adds or updates a named color to `w32-color-map', making it
469 available for use. The original entry's RGB ref is returned, or nil
470 if the entry is new. */)
471 (red, green, blue, name)
472 Lisp_Object red, green, blue, name;
474 Lisp_Object rgb;
475 Lisp_Object oldrgb = Qnil;
476 Lisp_Object entry;
478 CHECK_NUMBER (red);
479 CHECK_NUMBER (green);
480 CHECK_NUMBER (blue);
481 CHECK_STRING (name);
483 XSETINT (rgb, RGB (XUINT (red), XUINT (green), XUINT (blue)));
485 BLOCK_INPUT;
487 /* replace existing entry in w32-color-map or add new entry. */
488 entry = Fassoc (name, Vw32_color_map);
489 if (NILP (entry))
491 entry = Fcons (name, rgb);
492 Vw32_color_map = Fcons (entry, Vw32_color_map);
494 else
496 oldrgb = Fcdr (entry);
497 Fsetcdr (entry, rgb);
500 UNBLOCK_INPUT;
502 return (oldrgb);
505 DEFUN ("w32-load-color-file", Fw32_load_color_file,
506 Sw32_load_color_file, 1, 1, 0,
507 doc: /* Create an alist of color entries from an external file.
508 Assign this value to `w32-color-map' to replace the existing color map.
510 The file should define one named RGB color per line like so:
511 R G B name
512 where R,G,B are numbers between 0 and 255 and name is an arbitrary string. */)
513 (filename)
514 Lisp_Object filename;
516 FILE *fp;
517 Lisp_Object cmap = Qnil;
518 Lisp_Object abspath;
520 CHECK_STRING (filename);
521 abspath = Fexpand_file_name (filename, Qnil);
523 fp = fopen (SDATA (filename), "rt");
524 if (fp)
526 char buf[512];
527 int red, green, blue;
528 int num;
530 BLOCK_INPUT;
532 while (fgets (buf, sizeof (buf), fp) != NULL) {
533 if (sscanf (buf, "%u %u %u %n", &red, &green, &blue, &num) == 3)
535 char *name = buf + num;
536 num = strlen (name) - 1;
537 if (name[num] == '\n')
538 name[num] = 0;
539 cmap = Fcons (Fcons (build_string (name),
540 make_number (RGB (red, green, blue))),
541 cmap);
544 fclose (fp);
546 UNBLOCK_INPUT;
549 return cmap;
552 /* The default colors for the w32 color map */
553 typedef struct colormap_t
555 char *name;
556 COLORREF colorref;
557 } colormap_t;
559 colormap_t w32_color_map[] =
561 {"snow" , PALETTERGB (255,250,250)},
562 {"ghost white" , PALETTERGB (248,248,255)},
563 {"GhostWhite" , PALETTERGB (248,248,255)},
564 {"white smoke" , PALETTERGB (245,245,245)},
565 {"WhiteSmoke" , PALETTERGB (245,245,245)},
566 {"gainsboro" , PALETTERGB (220,220,220)},
567 {"floral white" , PALETTERGB (255,250,240)},
568 {"FloralWhite" , PALETTERGB (255,250,240)},
569 {"old lace" , PALETTERGB (253,245,230)},
570 {"OldLace" , PALETTERGB (253,245,230)},
571 {"linen" , PALETTERGB (250,240,230)},
572 {"antique white" , PALETTERGB (250,235,215)},
573 {"AntiqueWhite" , PALETTERGB (250,235,215)},
574 {"papaya whip" , PALETTERGB (255,239,213)},
575 {"PapayaWhip" , PALETTERGB (255,239,213)},
576 {"blanched almond" , PALETTERGB (255,235,205)},
577 {"BlanchedAlmond" , PALETTERGB (255,235,205)},
578 {"bisque" , PALETTERGB (255,228,196)},
579 {"peach puff" , PALETTERGB (255,218,185)},
580 {"PeachPuff" , PALETTERGB (255,218,185)},
581 {"navajo white" , PALETTERGB (255,222,173)},
582 {"NavajoWhite" , PALETTERGB (255,222,173)},
583 {"moccasin" , PALETTERGB (255,228,181)},
584 {"cornsilk" , PALETTERGB (255,248,220)},
585 {"ivory" , PALETTERGB (255,255,240)},
586 {"lemon chiffon" , PALETTERGB (255,250,205)},
587 {"LemonChiffon" , PALETTERGB (255,250,205)},
588 {"seashell" , PALETTERGB (255,245,238)},
589 {"honeydew" , PALETTERGB (240,255,240)},
590 {"mint cream" , PALETTERGB (245,255,250)},
591 {"MintCream" , PALETTERGB (245,255,250)},
592 {"azure" , PALETTERGB (240,255,255)},
593 {"alice blue" , PALETTERGB (240,248,255)},
594 {"AliceBlue" , PALETTERGB (240,248,255)},
595 {"lavender" , PALETTERGB (230,230,250)},
596 {"lavender blush" , PALETTERGB (255,240,245)},
597 {"LavenderBlush" , PALETTERGB (255,240,245)},
598 {"misty rose" , PALETTERGB (255,228,225)},
599 {"MistyRose" , PALETTERGB (255,228,225)},
600 {"white" , PALETTERGB (255,255,255)},
601 {"black" , PALETTERGB ( 0, 0, 0)},
602 {"dark slate gray" , PALETTERGB ( 47, 79, 79)},
603 {"DarkSlateGray" , PALETTERGB ( 47, 79, 79)},
604 {"dark slate grey" , PALETTERGB ( 47, 79, 79)},
605 {"DarkSlateGrey" , PALETTERGB ( 47, 79, 79)},
606 {"dim gray" , PALETTERGB (105,105,105)},
607 {"DimGray" , PALETTERGB (105,105,105)},
608 {"dim grey" , PALETTERGB (105,105,105)},
609 {"DimGrey" , PALETTERGB (105,105,105)},
610 {"slate gray" , PALETTERGB (112,128,144)},
611 {"SlateGray" , PALETTERGB (112,128,144)},
612 {"slate grey" , PALETTERGB (112,128,144)},
613 {"SlateGrey" , PALETTERGB (112,128,144)},
614 {"light slate gray" , PALETTERGB (119,136,153)},
615 {"LightSlateGray" , PALETTERGB (119,136,153)},
616 {"light slate grey" , PALETTERGB (119,136,153)},
617 {"LightSlateGrey" , PALETTERGB (119,136,153)},
618 {"gray" , PALETTERGB (190,190,190)},
619 {"grey" , PALETTERGB (190,190,190)},
620 {"light grey" , PALETTERGB (211,211,211)},
621 {"LightGrey" , PALETTERGB (211,211,211)},
622 {"light gray" , PALETTERGB (211,211,211)},
623 {"LightGray" , PALETTERGB (211,211,211)},
624 {"midnight blue" , PALETTERGB ( 25, 25,112)},
625 {"MidnightBlue" , PALETTERGB ( 25, 25,112)},
626 {"navy" , PALETTERGB ( 0, 0,128)},
627 {"navy blue" , PALETTERGB ( 0, 0,128)},
628 {"NavyBlue" , PALETTERGB ( 0, 0,128)},
629 {"cornflower blue" , PALETTERGB (100,149,237)},
630 {"CornflowerBlue" , PALETTERGB (100,149,237)},
631 {"dark slate blue" , PALETTERGB ( 72, 61,139)},
632 {"DarkSlateBlue" , PALETTERGB ( 72, 61,139)},
633 {"slate blue" , PALETTERGB (106, 90,205)},
634 {"SlateBlue" , PALETTERGB (106, 90,205)},
635 {"medium slate blue" , PALETTERGB (123,104,238)},
636 {"MediumSlateBlue" , PALETTERGB (123,104,238)},
637 {"light slate blue" , PALETTERGB (132,112,255)},
638 {"LightSlateBlue" , PALETTERGB (132,112,255)},
639 {"medium blue" , PALETTERGB ( 0, 0,205)},
640 {"MediumBlue" , PALETTERGB ( 0, 0,205)},
641 {"royal blue" , PALETTERGB ( 65,105,225)},
642 {"RoyalBlue" , PALETTERGB ( 65,105,225)},
643 {"blue" , PALETTERGB ( 0, 0,255)},
644 {"dodger blue" , PALETTERGB ( 30,144,255)},
645 {"DodgerBlue" , PALETTERGB ( 30,144,255)},
646 {"deep sky blue" , PALETTERGB ( 0,191,255)},
647 {"DeepSkyBlue" , PALETTERGB ( 0,191,255)},
648 {"sky blue" , PALETTERGB (135,206,235)},
649 {"SkyBlue" , PALETTERGB (135,206,235)},
650 {"light sky blue" , PALETTERGB (135,206,250)},
651 {"LightSkyBlue" , PALETTERGB (135,206,250)},
652 {"steel blue" , PALETTERGB ( 70,130,180)},
653 {"SteelBlue" , PALETTERGB ( 70,130,180)},
654 {"light steel blue" , PALETTERGB (176,196,222)},
655 {"LightSteelBlue" , PALETTERGB (176,196,222)},
656 {"light blue" , PALETTERGB (173,216,230)},
657 {"LightBlue" , PALETTERGB (173,216,230)},
658 {"powder blue" , PALETTERGB (176,224,230)},
659 {"PowderBlue" , PALETTERGB (176,224,230)},
660 {"pale turquoise" , PALETTERGB (175,238,238)},
661 {"PaleTurquoise" , PALETTERGB (175,238,238)},
662 {"dark turquoise" , PALETTERGB ( 0,206,209)},
663 {"DarkTurquoise" , PALETTERGB ( 0,206,209)},
664 {"medium turquoise" , PALETTERGB ( 72,209,204)},
665 {"MediumTurquoise" , PALETTERGB ( 72,209,204)},
666 {"turquoise" , PALETTERGB ( 64,224,208)},
667 {"cyan" , PALETTERGB ( 0,255,255)},
668 {"light cyan" , PALETTERGB (224,255,255)},
669 {"LightCyan" , PALETTERGB (224,255,255)},
670 {"cadet blue" , PALETTERGB ( 95,158,160)},
671 {"CadetBlue" , PALETTERGB ( 95,158,160)},
672 {"medium aquamarine" , PALETTERGB (102,205,170)},
673 {"MediumAquamarine" , PALETTERGB (102,205,170)},
674 {"aquamarine" , PALETTERGB (127,255,212)},
675 {"dark green" , PALETTERGB ( 0,100, 0)},
676 {"DarkGreen" , PALETTERGB ( 0,100, 0)},
677 {"dark olive green" , PALETTERGB ( 85,107, 47)},
678 {"DarkOliveGreen" , PALETTERGB ( 85,107, 47)},
679 {"dark sea green" , PALETTERGB (143,188,143)},
680 {"DarkSeaGreen" , PALETTERGB (143,188,143)},
681 {"sea green" , PALETTERGB ( 46,139, 87)},
682 {"SeaGreen" , PALETTERGB ( 46,139, 87)},
683 {"medium sea green" , PALETTERGB ( 60,179,113)},
684 {"MediumSeaGreen" , PALETTERGB ( 60,179,113)},
685 {"light sea green" , PALETTERGB ( 32,178,170)},
686 {"LightSeaGreen" , PALETTERGB ( 32,178,170)},
687 {"pale green" , PALETTERGB (152,251,152)},
688 {"PaleGreen" , PALETTERGB (152,251,152)},
689 {"spring green" , PALETTERGB ( 0,255,127)},
690 {"SpringGreen" , PALETTERGB ( 0,255,127)},
691 {"lawn green" , PALETTERGB (124,252, 0)},
692 {"LawnGreen" , PALETTERGB (124,252, 0)},
693 {"green" , PALETTERGB ( 0,255, 0)},
694 {"chartreuse" , PALETTERGB (127,255, 0)},
695 {"medium spring green" , PALETTERGB ( 0,250,154)},
696 {"MediumSpringGreen" , PALETTERGB ( 0,250,154)},
697 {"green yellow" , PALETTERGB (173,255, 47)},
698 {"GreenYellow" , PALETTERGB (173,255, 47)},
699 {"lime green" , PALETTERGB ( 50,205, 50)},
700 {"LimeGreen" , PALETTERGB ( 50,205, 50)},
701 {"yellow green" , PALETTERGB (154,205, 50)},
702 {"YellowGreen" , PALETTERGB (154,205, 50)},
703 {"forest green" , PALETTERGB ( 34,139, 34)},
704 {"ForestGreen" , PALETTERGB ( 34,139, 34)},
705 {"olive drab" , PALETTERGB (107,142, 35)},
706 {"OliveDrab" , PALETTERGB (107,142, 35)},
707 {"dark khaki" , PALETTERGB (189,183,107)},
708 {"DarkKhaki" , PALETTERGB (189,183,107)},
709 {"khaki" , PALETTERGB (240,230,140)},
710 {"pale goldenrod" , PALETTERGB (238,232,170)},
711 {"PaleGoldenrod" , PALETTERGB (238,232,170)},
712 {"light goldenrod yellow" , PALETTERGB (250,250,210)},
713 {"LightGoldenrodYellow" , PALETTERGB (250,250,210)},
714 {"light yellow" , PALETTERGB (255,255,224)},
715 {"LightYellow" , PALETTERGB (255,255,224)},
716 {"yellow" , PALETTERGB (255,255, 0)},
717 {"gold" , PALETTERGB (255,215, 0)},
718 {"light goldenrod" , PALETTERGB (238,221,130)},
719 {"LightGoldenrod" , PALETTERGB (238,221,130)},
720 {"goldenrod" , PALETTERGB (218,165, 32)},
721 {"dark goldenrod" , PALETTERGB (184,134, 11)},
722 {"DarkGoldenrod" , PALETTERGB (184,134, 11)},
723 {"rosy brown" , PALETTERGB (188,143,143)},
724 {"RosyBrown" , PALETTERGB (188,143,143)},
725 {"indian red" , PALETTERGB (205, 92, 92)},
726 {"IndianRed" , PALETTERGB (205, 92, 92)},
727 {"saddle brown" , PALETTERGB (139, 69, 19)},
728 {"SaddleBrown" , PALETTERGB (139, 69, 19)},
729 {"sienna" , PALETTERGB (160, 82, 45)},
730 {"peru" , PALETTERGB (205,133, 63)},
731 {"burlywood" , PALETTERGB (222,184,135)},
732 {"beige" , PALETTERGB (245,245,220)},
733 {"wheat" , PALETTERGB (245,222,179)},
734 {"sandy brown" , PALETTERGB (244,164, 96)},
735 {"SandyBrown" , PALETTERGB (244,164, 96)},
736 {"tan" , PALETTERGB (210,180,140)},
737 {"chocolate" , PALETTERGB (210,105, 30)},
738 {"firebrick" , PALETTERGB (178,34, 34)},
739 {"brown" , PALETTERGB (165,42, 42)},
740 {"dark salmon" , PALETTERGB (233,150,122)},
741 {"DarkSalmon" , PALETTERGB (233,150,122)},
742 {"salmon" , PALETTERGB (250,128,114)},
743 {"light salmon" , PALETTERGB (255,160,122)},
744 {"LightSalmon" , PALETTERGB (255,160,122)},
745 {"orange" , PALETTERGB (255,165, 0)},
746 {"dark orange" , PALETTERGB (255,140, 0)},
747 {"DarkOrange" , PALETTERGB (255,140, 0)},
748 {"coral" , PALETTERGB (255,127, 80)},
749 {"light coral" , PALETTERGB (240,128,128)},
750 {"LightCoral" , PALETTERGB (240,128,128)},
751 {"tomato" , PALETTERGB (255, 99, 71)},
752 {"orange red" , PALETTERGB (255, 69, 0)},
753 {"OrangeRed" , PALETTERGB (255, 69, 0)},
754 {"red" , PALETTERGB (255, 0, 0)},
755 {"hot pink" , PALETTERGB (255,105,180)},
756 {"HotPink" , PALETTERGB (255,105,180)},
757 {"deep pink" , PALETTERGB (255, 20,147)},
758 {"DeepPink" , PALETTERGB (255, 20,147)},
759 {"pink" , PALETTERGB (255,192,203)},
760 {"light pink" , PALETTERGB (255,182,193)},
761 {"LightPink" , PALETTERGB (255,182,193)},
762 {"pale violet red" , PALETTERGB (219,112,147)},
763 {"PaleVioletRed" , PALETTERGB (219,112,147)},
764 {"maroon" , PALETTERGB (176, 48, 96)},
765 {"medium violet red" , PALETTERGB (199, 21,133)},
766 {"MediumVioletRed" , PALETTERGB (199, 21,133)},
767 {"violet red" , PALETTERGB (208, 32,144)},
768 {"VioletRed" , PALETTERGB (208, 32,144)},
769 {"magenta" , PALETTERGB (255, 0,255)},
770 {"violet" , PALETTERGB (238,130,238)},
771 {"plum" , PALETTERGB (221,160,221)},
772 {"orchid" , PALETTERGB (218,112,214)},
773 {"medium orchid" , PALETTERGB (186, 85,211)},
774 {"MediumOrchid" , PALETTERGB (186, 85,211)},
775 {"dark orchid" , PALETTERGB (153, 50,204)},
776 {"DarkOrchid" , PALETTERGB (153, 50,204)},
777 {"dark violet" , PALETTERGB (148, 0,211)},
778 {"DarkViolet" , PALETTERGB (148, 0,211)},
779 {"blue violet" , PALETTERGB (138, 43,226)},
780 {"BlueViolet" , PALETTERGB (138, 43,226)},
781 {"purple" , PALETTERGB (160, 32,240)},
782 {"medium purple" , PALETTERGB (147,112,219)},
783 {"MediumPurple" , PALETTERGB (147,112,219)},
784 {"thistle" , PALETTERGB (216,191,216)},
785 {"gray0" , PALETTERGB ( 0, 0, 0)},
786 {"grey0" , PALETTERGB ( 0, 0, 0)},
787 {"dark grey" , PALETTERGB (169,169,169)},
788 {"DarkGrey" , PALETTERGB (169,169,169)},
789 {"dark gray" , PALETTERGB (169,169,169)},
790 {"DarkGray" , PALETTERGB (169,169,169)},
791 {"dark blue" , PALETTERGB ( 0, 0,139)},
792 {"DarkBlue" , PALETTERGB ( 0, 0,139)},
793 {"dark cyan" , PALETTERGB ( 0,139,139)},
794 {"DarkCyan" , PALETTERGB ( 0,139,139)},
795 {"dark magenta" , PALETTERGB (139, 0,139)},
796 {"DarkMagenta" , PALETTERGB (139, 0,139)},
797 {"dark red" , PALETTERGB (139, 0, 0)},
798 {"DarkRed" , PALETTERGB (139, 0, 0)},
799 {"light green" , PALETTERGB (144,238,144)},
800 {"LightGreen" , PALETTERGB (144,238,144)},
803 DEFUN ("w32-default-color-map", Fw32_default_color_map, Sw32_default_color_map,
804 0, 0, 0, doc: /* Return the default color map. */)
807 int i;
808 colormap_t *pc = w32_color_map;
809 Lisp_Object cmap;
811 BLOCK_INPUT;
813 cmap = Qnil;
815 for (i = 0; i < sizeof (w32_color_map) / sizeof (w32_color_map[0]);
816 pc++, i++)
817 cmap = Fcons (Fcons (build_string (pc->name),
818 make_number (pc->colorref)),
819 cmap);
821 UNBLOCK_INPUT;
823 return (cmap);
826 static Lisp_Object
827 w32_to_x_color (rgb)
828 Lisp_Object rgb;
830 Lisp_Object color;
832 CHECK_NUMBER (rgb);
834 BLOCK_INPUT;
836 color = Frassq (rgb, Vw32_color_map);
838 UNBLOCK_INPUT;
840 if (!NILP (color))
841 return (Fcar (color));
842 else
843 return Qnil;
846 static Lisp_Object
847 w32_color_map_lookup (colorname)
848 char *colorname;
850 Lisp_Object tail, ret = Qnil;
852 BLOCK_INPUT;
854 for (tail = Vw32_color_map; CONSP (tail); tail = XCDR (tail))
856 register Lisp_Object elt, tem;
858 elt = XCAR (tail);
859 if (!CONSP (elt)) continue;
861 tem = Fcar (elt);
863 if (lstrcmpi (SDATA (tem), colorname) == 0)
865 ret = Fcdr (elt);
866 break;
869 QUIT;
873 UNBLOCK_INPUT;
875 return ret;
879 static void
880 add_system_logical_colors_to_map (system_colors)
881 Lisp_Object *system_colors;
883 HKEY colors_key;
885 /* Other registry operations are done with input blocked. */
886 BLOCK_INPUT;
888 /* Look for "Control Panel/Colors" under User and Machine registry
889 settings. */
890 if (RegOpenKeyEx (HKEY_CURRENT_USER, "Control Panel\\Colors", 0,
891 KEY_READ, &colors_key) == ERROR_SUCCESS
892 || RegOpenKeyEx (HKEY_LOCAL_MACHINE, "Control Panel\\Colors", 0,
893 KEY_READ, &colors_key) == ERROR_SUCCESS)
895 /* List all keys. */
896 char color_buffer[64];
897 char full_name_buffer[MAX_PATH + SYSTEM_COLOR_PREFIX_LEN];
898 int index = 0;
899 DWORD name_size, color_size;
900 char *name_buffer = full_name_buffer + SYSTEM_COLOR_PREFIX_LEN;
902 name_size = sizeof (full_name_buffer) - SYSTEM_COLOR_PREFIX_LEN;
903 color_size = sizeof (color_buffer);
905 strcpy (full_name_buffer, SYSTEM_COLOR_PREFIX);
907 while (RegEnumValueA (colors_key, index, name_buffer, &name_size,
908 NULL, NULL, color_buffer, &color_size)
909 == ERROR_SUCCESS)
911 int r, g, b;
912 if (sscanf (color_buffer, " %u %u %u", &r, &g, &b) == 3)
913 *system_colors = Fcons (Fcons (build_string (full_name_buffer),
914 make_number (RGB (r, g, b))),
915 *system_colors);
917 name_size = sizeof (full_name_buffer) - SYSTEM_COLOR_PREFIX_LEN;
918 color_size = sizeof (color_buffer);
919 index++;
921 RegCloseKey (colors_key);
924 UNBLOCK_INPUT;
928 static Lisp_Object
929 x_to_w32_color (colorname)
930 char * colorname;
932 register Lisp_Object ret = Qnil;
934 BLOCK_INPUT;
936 if (colorname[0] == '#')
938 /* Could be an old-style RGB Device specification. */
939 char *color;
940 int size;
941 color = colorname + 1;
943 size = strlen (color);
944 if (size == 3 || size == 6 || size == 9 || size == 12)
946 UINT colorval;
947 int i, pos;
948 pos = 0;
949 size /= 3;
950 colorval = 0;
952 for (i = 0; i < 3; i++)
954 char *end;
955 char t;
956 unsigned long value;
958 /* The check for 'x' in the following conditional takes into
959 account the fact that strtol allows a "0x" in front of
960 our numbers, and we don't. */
961 if (!isxdigit (color[0]) || color[1] == 'x')
962 break;
963 t = color[size];
964 color[size] = '\0';
965 value = strtoul (color, &end, 16);
966 color[size] = t;
967 if (errno == ERANGE || end - color != size)
968 break;
969 switch (size)
971 case 1:
972 value = value * 0x10;
973 break;
974 case 2:
975 break;
976 case 3:
977 value /= 0x10;
978 break;
979 case 4:
980 value /= 0x100;
981 break;
983 colorval |= (value << pos);
984 pos += 0x8;
985 if (i == 2)
987 UNBLOCK_INPUT;
988 XSETINT (ret, colorval);
989 return ret;
991 color = end;
995 else if (strnicmp (colorname, "rgb:", 4) == 0)
997 char *color;
998 UINT colorval;
999 int i, pos;
1000 pos = 0;
1002 colorval = 0;
1003 color = colorname + 4;
1004 for (i = 0; i < 3; i++)
1006 char *end;
1007 unsigned long value;
1009 /* The check for 'x' in the following conditional takes into
1010 account the fact that strtol allows a "0x" in front of
1011 our numbers, and we don't. */
1012 if (!isxdigit (color[0]) || color[1] == 'x')
1013 break;
1014 value = strtoul (color, &end, 16);
1015 if (errno == ERANGE)
1016 break;
1017 switch (end - color)
1019 case 1:
1020 value = value * 0x10 + value;
1021 break;
1022 case 2:
1023 break;
1024 case 3:
1025 value /= 0x10;
1026 break;
1027 case 4:
1028 value /= 0x100;
1029 break;
1030 default:
1031 value = ULONG_MAX;
1033 if (value == ULONG_MAX)
1034 break;
1035 colorval |= (value << pos);
1036 pos += 0x8;
1037 if (i == 2)
1039 if (*end != '\0')
1040 break;
1041 UNBLOCK_INPUT;
1042 XSETINT (ret, colorval);
1043 return ret;
1045 if (*end != '/')
1046 break;
1047 color = end + 1;
1050 else if (strnicmp (colorname, "rgbi:", 5) == 0)
1052 /* This is an RGB Intensity specification. */
1053 char *color;
1054 UINT colorval;
1055 int i, pos;
1056 pos = 0;
1058 colorval = 0;
1059 color = colorname + 5;
1060 for (i = 0; i < 3; i++)
1062 char *end;
1063 double value;
1064 UINT val;
1066 value = strtod (color, &end);
1067 if (errno == ERANGE)
1068 break;
1069 if (value < 0.0 || value > 1.0)
1070 break;
1071 val = (UINT)(0x100 * value);
1072 /* We used 0x100 instead of 0xFF to give a continuous
1073 range between 0.0 and 1.0 inclusive. The next statement
1074 fixes the 1.0 case. */
1075 if (val == 0x100)
1076 val = 0xFF;
1077 colorval |= (val << pos);
1078 pos += 0x8;
1079 if (i == 2)
1081 if (*end != '\0')
1082 break;
1083 UNBLOCK_INPUT;
1084 XSETINT (ret, colorval);
1085 return ret;
1087 if (*end != '/')
1088 break;
1089 color = end + 1;
1092 /* I am not going to attempt to handle any of the CIE color schemes
1093 or TekHVC, since I don't know the algorithms for conversion to
1094 RGB. */
1096 /* If we fail to lookup the color name in w32_color_map, then check the
1097 colorname to see if it can be crudely approximated: If the X color
1098 ends in a number (e.g., "darkseagreen2"), strip the number and
1099 return the result of looking up the base color name. */
1100 ret = w32_color_map_lookup (colorname);
1101 if (NILP (ret))
1103 int len = strlen (colorname);
1105 if (isdigit (colorname[len - 1]))
1107 char *ptr, *approx = alloca (len + 1);
1109 strcpy (approx, colorname);
1110 ptr = &approx[len - 1];
1111 while (ptr > approx && isdigit (*ptr))
1112 *ptr-- = '\0';
1114 ret = w32_color_map_lookup (approx);
1118 UNBLOCK_INPUT;
1119 return ret;
1122 void
1123 w32_regenerate_palette (FRAME_PTR f)
1125 struct w32_palette_entry * list;
1126 LOGPALETTE * log_palette;
1127 HPALETTE new_palette;
1128 int i;
1130 /* don't bother trying to create palette if not supported */
1131 if (! FRAME_W32_DISPLAY_INFO (f)->has_palette)
1132 return;
1134 log_palette = (LOGPALETTE *)
1135 alloca (sizeof (LOGPALETTE) +
1136 FRAME_W32_DISPLAY_INFO (f)->num_colors * sizeof (PALETTEENTRY));
1137 log_palette->palVersion = 0x300;
1138 log_palette->palNumEntries = FRAME_W32_DISPLAY_INFO (f)->num_colors;
1140 list = FRAME_W32_DISPLAY_INFO (f)->color_list;
1141 for (i = 0;
1142 i < FRAME_W32_DISPLAY_INFO (f)->num_colors;
1143 i++, list = list->next)
1144 log_palette->palPalEntry[i] = list->entry;
1146 new_palette = CreatePalette (log_palette);
1148 enter_crit ();
1150 if (FRAME_W32_DISPLAY_INFO (f)->palette)
1151 DeleteObject (FRAME_W32_DISPLAY_INFO (f)->palette);
1152 FRAME_W32_DISPLAY_INFO (f)->palette = new_palette;
1154 /* Realize display palette and garbage all frames. */
1155 release_frame_dc (f, get_frame_dc (f));
1157 leave_crit ();
1160 #define W32_COLOR(pe) RGB (pe.peRed, pe.peGreen, pe.peBlue)
1161 #define SET_W32_COLOR(pe, color) \
1162 do \
1164 pe.peRed = GetRValue (color); \
1165 pe.peGreen = GetGValue (color); \
1166 pe.peBlue = GetBValue (color); \
1167 pe.peFlags = 0; \
1168 } while (0)
1170 #if 0
1171 /* Keep these around in case we ever want to track color usage. */
1172 void
1173 w32_map_color (FRAME_PTR f, COLORREF color)
1175 struct w32_palette_entry * list = FRAME_W32_DISPLAY_INFO (f)->color_list;
1177 if (NILP (Vw32_enable_palette))
1178 return;
1180 /* check if color is already mapped */
1181 while (list)
1183 if (W32_COLOR (list->entry) == color)
1185 ++list->refcount;
1186 return;
1188 list = list->next;
1191 /* not already mapped, so add to list and recreate Windows palette */
1192 list = (struct w32_palette_entry *)
1193 xmalloc (sizeof (struct w32_palette_entry));
1194 SET_W32_COLOR (list->entry, color);
1195 list->refcount = 1;
1196 list->next = FRAME_W32_DISPLAY_INFO (f)->color_list;
1197 FRAME_W32_DISPLAY_INFO (f)->color_list = list;
1198 FRAME_W32_DISPLAY_INFO (f)->num_colors++;
1200 /* set flag that palette must be regenerated */
1201 FRAME_W32_DISPLAY_INFO (f)->regen_palette = TRUE;
1204 void
1205 w32_unmap_color (FRAME_PTR f, COLORREF color)
1207 struct w32_palette_entry * list = FRAME_W32_DISPLAY_INFO (f)->color_list;
1208 struct w32_palette_entry **prev = &FRAME_W32_DISPLAY_INFO (f)->color_list;
1210 if (NILP (Vw32_enable_palette))
1211 return;
1213 /* check if color is already mapped */
1214 while (list)
1216 if (W32_COLOR (list->entry) == color)
1218 if (--list->refcount == 0)
1220 *prev = list->next;
1221 xfree (list);
1222 FRAME_W32_DISPLAY_INFO (f)->num_colors--;
1223 break;
1225 else
1226 return;
1228 prev = &list->next;
1229 list = list->next;
1232 /* set flag that palette must be regenerated */
1233 FRAME_W32_DISPLAY_INFO (f)->regen_palette = TRUE;
1235 #endif
1238 /* Gamma-correct COLOR on frame F. */
1240 void
1241 gamma_correct (f, color)
1242 struct frame *f;
1243 COLORREF *color;
1245 if (f->gamma)
1247 *color = PALETTERGB (
1248 pow (GetRValue (*color) / 255.0, f->gamma) * 255.0 + 0.5,
1249 pow (GetGValue (*color) / 255.0, f->gamma) * 255.0 + 0.5,
1250 pow (GetBValue (*color) / 255.0, f->gamma) * 255.0 + 0.5);
1255 /* Decide if color named COLOR is valid for the display associated with
1256 the selected frame; if so, return the rgb values in COLOR_DEF.
1257 If ALLOC is nonzero, allocate a new colormap cell. */
1260 w32_defined_color (f, color, color_def, alloc)
1261 FRAME_PTR f;
1262 char *color;
1263 XColor *color_def;
1264 int alloc;
1266 register Lisp_Object tem;
1267 COLORREF w32_color_ref;
1269 tem = x_to_w32_color (color);
1271 if (!NILP (tem))
1273 if (f)
1275 /* Apply gamma correction. */
1276 w32_color_ref = XUINT (tem);
1277 gamma_correct (f, &w32_color_ref);
1278 XSETINT (tem, w32_color_ref);
1281 /* Map this color to the palette if it is enabled. */
1282 if (!NILP (Vw32_enable_palette))
1284 struct w32_palette_entry * entry =
1285 one_w32_display_info.color_list;
1286 struct w32_palette_entry ** prev =
1287 &one_w32_display_info.color_list;
1289 /* check if color is already mapped */
1290 while (entry)
1292 if (W32_COLOR (entry->entry) == XUINT (tem))
1293 break;
1294 prev = &entry->next;
1295 entry = entry->next;
1298 if (entry == NULL && alloc)
1300 /* not already mapped, so add to list */
1301 entry = (struct w32_palette_entry *)
1302 xmalloc (sizeof (struct w32_palette_entry));
1303 SET_W32_COLOR (entry->entry, XUINT (tem));
1304 entry->next = NULL;
1305 *prev = entry;
1306 one_w32_display_info.num_colors++;
1308 /* set flag that palette must be regenerated */
1309 one_w32_display_info.regen_palette = TRUE;
1312 /* Ensure COLORREF value is snapped to nearest color in (default)
1313 palette by simulating the PALETTERGB macro. This works whether
1314 or not the display device has a palette. */
1315 w32_color_ref = XUINT (tem) | 0x2000000;
1317 color_def->pixel = w32_color_ref;
1318 color_def->red = GetRValue (w32_color_ref) * 256;
1319 color_def->green = GetGValue (w32_color_ref) * 256;
1320 color_def->blue = GetBValue (w32_color_ref) * 256;
1322 return 1;
1324 else
1326 return 0;
1330 /* Given a string ARG naming a color, compute a pixel value from it
1331 suitable for screen F.
1332 If F is not a color screen, return DEF (default) regardless of what
1333 ARG says. */
1336 x_decode_color (f, arg, def)
1337 FRAME_PTR f;
1338 Lisp_Object arg;
1339 int def;
1341 XColor cdef;
1343 CHECK_STRING (arg);
1345 if (strcmp (SDATA (arg), "black") == 0)
1346 return BLACK_PIX_DEFAULT (f);
1347 else if (strcmp (SDATA (arg), "white") == 0)
1348 return WHITE_PIX_DEFAULT (f);
1350 if ((FRAME_W32_DISPLAY_INFO (f)->n_planes * FRAME_W32_DISPLAY_INFO (f)->n_cbits) == 1)
1351 return def;
1353 /* w32_defined_color is responsible for coping with failures
1354 by looking for a near-miss. */
1355 if (w32_defined_color (f, SDATA (arg), &cdef, 1))
1356 return cdef.pixel;
1358 /* defined_color failed; return an ultimate default. */
1359 return def;
1364 /* Functions called only from `x_set_frame_param'
1365 to set individual parameters.
1367 If FRAME_W32_WINDOW (f) is 0,
1368 the frame is being created and its window does not exist yet.
1369 In that case, just record the parameter's new value
1370 in the standard place; do not attempt to change the window. */
1372 void
1373 x_set_foreground_color (f, arg, oldval)
1374 struct frame *f;
1375 Lisp_Object arg, oldval;
1377 struct w32_output *x = f->output_data.w32;
1378 PIX_TYPE fg, old_fg;
1380 fg = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1381 old_fg = FRAME_FOREGROUND_PIXEL (f);
1382 FRAME_FOREGROUND_PIXEL (f) = fg;
1384 if (FRAME_W32_WINDOW (f) != 0)
1386 if (x->cursor_pixel == old_fg)
1387 x->cursor_pixel = fg;
1389 update_face_from_frame_parameter (f, Qforeground_color, arg);
1390 if (FRAME_VISIBLE_P (f))
1391 redraw_frame (f);
1395 void
1396 x_set_background_color (f, arg, oldval)
1397 struct frame *f;
1398 Lisp_Object arg, oldval;
1400 FRAME_BACKGROUND_PIXEL (f)
1401 = x_decode_color (f, arg, WHITE_PIX_DEFAULT (f));
1403 if (FRAME_W32_WINDOW (f) != 0)
1405 SetWindowLong (FRAME_W32_WINDOW (f), WND_BACKGROUND_INDEX,
1406 FRAME_BACKGROUND_PIXEL (f));
1408 update_face_from_frame_parameter (f, Qbackground_color, arg);
1410 if (FRAME_VISIBLE_P (f))
1411 redraw_frame (f);
1415 void
1416 x_set_mouse_color (f, arg, oldval)
1417 struct frame *f;
1418 Lisp_Object arg, oldval;
1420 Cursor cursor, nontext_cursor, mode_cursor, hand_cursor;
1421 int count;
1422 int mask_color;
1424 if (!EQ (Qnil, arg))
1425 f->output_data.w32->mouse_pixel
1426 = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1427 mask_color = FRAME_BACKGROUND_PIXEL (f);
1429 /* Don't let pointers be invisible. */
1430 if (mask_color == f->output_data.w32->mouse_pixel
1431 && mask_color == FRAME_BACKGROUND_PIXEL (f))
1432 f->output_data.w32->mouse_pixel = FRAME_FOREGROUND_PIXEL (f);
1434 #if 0 /* TODO : cursor changes */
1435 BLOCK_INPUT;
1437 /* It's not okay to crash if the user selects a screwy cursor. */
1438 count = x_catch_errors (FRAME_W32_DISPLAY (f));
1440 if (!EQ (Qnil, Vx_pointer_shape))
1442 CHECK_NUMBER (Vx_pointer_shape);
1443 cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XINT (Vx_pointer_shape));
1445 else
1446 cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_xterm);
1447 x_check_errors (FRAME_W32_DISPLAY (f), "bad text pointer cursor: %s");
1449 if (!EQ (Qnil, Vx_nontext_pointer_shape))
1451 CHECK_NUMBER (Vx_nontext_pointer_shape);
1452 nontext_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f),
1453 XINT (Vx_nontext_pointer_shape));
1455 else
1456 nontext_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_left_ptr);
1457 x_check_errors (FRAME_W32_DISPLAY (f), "bad nontext pointer cursor: %s");
1459 if (!EQ (Qnil, Vx_hourglass_pointer_shape))
1461 CHECK_NUMBER (Vx_hourglass_pointer_shape);
1462 hourglass_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f),
1463 XINT (Vx_hourglass_pointer_shape));
1465 else
1466 hourglass_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_watch);
1467 x_check_errors (FRAME_W32_DISPLAY (f), "bad busy pointer cursor: %s");
1469 x_check_errors (FRAME_W32_DISPLAY (f), "bad nontext pointer cursor: %s");
1470 if (!EQ (Qnil, Vx_mode_pointer_shape))
1472 CHECK_NUMBER (Vx_mode_pointer_shape);
1473 mode_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f),
1474 XINT (Vx_mode_pointer_shape));
1476 else
1477 mode_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_xterm);
1478 x_check_errors (FRAME_W32_DISPLAY (f), "bad modeline pointer cursor: %s");
1480 if (!EQ (Qnil, Vx_sensitive_text_pointer_shape))
1482 CHECK_NUMBER (Vx_sensitive_text_pointer_shape);
1483 hand_cursor
1484 = XCreateFontCursor (FRAME_W32_DISPLAY (f),
1485 XINT (Vx_sensitive_text_pointer_shape));
1487 else
1488 hand_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_crosshair);
1490 if (!NILP (Vx_window_horizontal_drag_shape))
1492 CHECK_NUMBER (Vx_window_horizontal_drag_shape);
1493 horizontal_drag_cursor
1494 = XCreateFontCursor (FRAME_X_DISPLAY (f),
1495 XINT (Vx_window_horizontal_drag_shape));
1497 else
1498 horizontal_drag_cursor
1499 = XCreateFontCursor (FRAME_X_DISPLAY (f), XC_sb_h_double_arrow);
1501 /* Check and report errors with the above calls. */
1502 x_check_errors (FRAME_W32_DISPLAY (f), "can't set cursor shape: %s");
1503 x_uncatch_errors (FRAME_W32_DISPLAY (f), count);
1506 XColor fore_color, back_color;
1508 fore_color.pixel = f->output_data.w32->mouse_pixel;
1509 back_color.pixel = mask_color;
1510 XQueryColor (FRAME_W32_DISPLAY (f),
1511 DefaultColormap (FRAME_W32_DISPLAY (f),
1512 DefaultScreen (FRAME_W32_DISPLAY (f))),
1513 &fore_color);
1514 XQueryColor (FRAME_W32_DISPLAY (f),
1515 DefaultColormap (FRAME_W32_DISPLAY (f),
1516 DefaultScreen (FRAME_W32_DISPLAY (f))),
1517 &back_color);
1518 XRecolorCursor (FRAME_W32_DISPLAY (f), cursor,
1519 &fore_color, &back_color);
1520 XRecolorCursor (FRAME_W32_DISPLAY (f), nontext_cursor,
1521 &fore_color, &back_color);
1522 XRecolorCursor (FRAME_W32_DISPLAY (f), mode_cursor,
1523 &fore_color, &back_color);
1524 XRecolorCursor (FRAME_W32_DISPLAY (f), hand_cursor,
1525 &fore_color, &back_color);
1526 XRecolorCursor (FRAME_W32_DISPLAY (f), hourglass_cursor,
1527 &fore_color, &back_color);
1530 if (FRAME_W32_WINDOW (f) != 0)
1531 XDefineCursor (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f), cursor);
1533 if (cursor != f->output_data.w32->text_cursor && f->output_data.w32->text_cursor != 0)
1534 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->text_cursor);
1535 f->output_data.w32->text_cursor = cursor;
1537 if (nontext_cursor != f->output_data.w32->nontext_cursor
1538 && f->output_data.w32->nontext_cursor != 0)
1539 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->nontext_cursor);
1540 f->output_data.w32->nontext_cursor = nontext_cursor;
1542 if (hourglass_cursor != f->output_data.w32->hourglass_cursor
1543 && f->output_data.w32->hourglass_cursor != 0)
1544 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->hourglass_cursor);
1545 f->output_data.w32->hourglass_cursor = hourglass_cursor;
1547 if (mode_cursor != f->output_data.w32->modeline_cursor
1548 && f->output_data.w32->modeline_cursor != 0)
1549 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->modeline_cursor);
1550 f->output_data.w32->modeline_cursor = mode_cursor;
1552 if (hand_cursor != f->output_data.w32->hand_cursor
1553 && f->output_data.w32->hand_cursor != 0)
1554 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->hand_cursor);
1555 f->output_data.w32->hand_cursor = hand_cursor;
1557 XFlush (FRAME_W32_DISPLAY (f));
1558 UNBLOCK_INPUT;
1560 update_face_from_frame_parameter (f, Qmouse_color, arg);
1561 #endif /* TODO */
1564 void
1565 x_set_cursor_color (f, arg, oldval)
1566 struct frame *f;
1567 Lisp_Object arg, oldval;
1569 unsigned long fore_pixel, pixel;
1571 if (!NILP (Vx_cursor_fore_pixel))
1572 fore_pixel = x_decode_color (f, Vx_cursor_fore_pixel,
1573 WHITE_PIX_DEFAULT (f));
1574 else
1575 fore_pixel = FRAME_BACKGROUND_PIXEL (f);
1577 pixel = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1579 /* Make sure that the cursor color differs from the background color. */
1580 if (pixel == FRAME_BACKGROUND_PIXEL (f))
1582 pixel = f->output_data.w32->mouse_pixel;
1583 if (pixel == fore_pixel)
1584 fore_pixel = FRAME_BACKGROUND_PIXEL (f);
1587 f->output_data.w32->cursor_foreground_pixel = fore_pixel;
1588 f->output_data.w32->cursor_pixel = pixel;
1590 if (FRAME_W32_WINDOW (f) != 0)
1592 BLOCK_INPUT;
1593 /* Update frame's cursor_gc. */
1594 f->output_data.w32->cursor_gc->foreground = fore_pixel;
1595 f->output_data.w32->cursor_gc->background = pixel;
1597 UNBLOCK_INPUT;
1599 if (FRAME_VISIBLE_P (f))
1601 x_update_cursor (f, 0);
1602 x_update_cursor (f, 1);
1606 update_face_from_frame_parameter (f, Qcursor_color, arg);
1609 /* Set the border-color of frame F to pixel value PIX.
1610 Note that this does not fully take effect if done before
1611 F has a window. */
1613 void
1614 x_set_border_pixel (f, pix)
1615 struct frame *f;
1616 int pix;
1619 f->output_data.w32->border_pixel = pix;
1621 if (FRAME_W32_WINDOW (f) != 0 && f->border_width > 0)
1623 if (FRAME_VISIBLE_P (f))
1624 redraw_frame (f);
1628 /* Set the border-color of frame F to value described by ARG.
1629 ARG can be a string naming a color.
1630 The border-color is used for the border that is drawn by the server.
1631 Note that this does not fully take effect if done before
1632 F has a window; it must be redone when the window is created. */
1634 void
1635 x_set_border_color (f, arg, oldval)
1636 struct frame *f;
1637 Lisp_Object arg, oldval;
1639 int pix;
1641 CHECK_STRING (arg);
1642 pix = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1643 x_set_border_pixel (f, pix);
1644 update_face_from_frame_parameter (f, Qborder_color, arg);
1648 void
1649 x_set_cursor_type (f, arg, oldval)
1650 FRAME_PTR f;
1651 Lisp_Object arg, oldval;
1653 set_frame_cursor_types (f, arg);
1655 /* Make sure the cursor gets redrawn. */
1656 cursor_type_changed = 1;
1659 void
1660 x_set_icon_type (f, arg, oldval)
1661 struct frame *f;
1662 Lisp_Object arg, oldval;
1664 int result;
1666 if (NILP (arg) && NILP (oldval))
1667 return;
1669 if (STRINGP (arg) && STRINGP (oldval)
1670 && EQ (Fstring_equal (oldval, arg), Qt))
1671 return;
1673 if (SYMBOLP (arg) && SYMBOLP (oldval) && EQ (arg, oldval))
1674 return;
1676 BLOCK_INPUT;
1678 result = x_bitmap_icon (f, arg);
1679 if (result)
1681 UNBLOCK_INPUT;
1682 error ("No icon window available");
1685 UNBLOCK_INPUT;
1688 void
1689 x_set_icon_name (f, arg, oldval)
1690 struct frame *f;
1691 Lisp_Object arg, oldval;
1693 if (STRINGP (arg))
1695 if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
1696 return;
1698 else if (!NILP (arg) || NILP (oldval))
1699 return;
1701 f->icon_name = arg;
1703 #if 0
1704 if (f->output_data.w32->icon_bitmap != 0)
1705 return;
1707 BLOCK_INPUT;
1709 result = x_text_icon (f,
1710 (char *) SDATA ((!NILP (f->icon_name)
1711 ? f->icon_name
1712 : !NILP (f->title)
1713 ? f->title
1714 : f->name)));
1716 if (result)
1718 UNBLOCK_INPUT;
1719 error ("No icon window available");
1722 /* If the window was unmapped (and its icon was mapped),
1723 the new icon is not mapped, so map the window in its stead. */
1724 if (FRAME_VISIBLE_P (f))
1726 #ifdef USE_X_TOOLKIT
1727 XtPopup (f->output_data.w32->widget, XtGrabNone);
1728 #endif
1729 XMapWindow (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f));
1732 XFlush (FRAME_W32_DISPLAY (f));
1733 UNBLOCK_INPUT;
1734 #endif
1738 void
1739 x_set_menu_bar_lines (f, value, oldval)
1740 struct frame *f;
1741 Lisp_Object value, oldval;
1743 int nlines;
1744 int olines = FRAME_MENU_BAR_LINES (f);
1746 /* Right now, menu bars don't work properly in minibuf-only frames;
1747 most of the commands try to apply themselves to the minibuffer
1748 frame itself, and get an error because you can't switch buffers
1749 in or split the minibuffer window. */
1750 if (FRAME_MINIBUF_ONLY_P (f))
1751 return;
1753 if (INTEGERP (value))
1754 nlines = XINT (value);
1755 else
1756 nlines = 0;
1758 FRAME_MENU_BAR_LINES (f) = 0;
1759 if (nlines)
1760 FRAME_EXTERNAL_MENU_BAR (f) = 1;
1761 else
1763 if (FRAME_EXTERNAL_MENU_BAR (f) == 1)
1764 free_frame_menubar (f);
1765 FRAME_EXTERNAL_MENU_BAR (f) = 0;
1767 /* Adjust the frame size so that the client (text) dimensions
1768 remain the same. This depends on FRAME_EXTERNAL_MENU_BAR being
1769 set correctly. */
1770 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
1771 do_pending_window_change (0);
1773 adjust_glyphs (f);
1777 /* Set the number of lines used for the tool bar of frame F to VALUE.
1778 VALUE not an integer, or < 0 means set the lines to zero. OLDVAL
1779 is the old number of tool bar lines. This function changes the
1780 height of all windows on frame F to match the new tool bar height.
1781 The frame's height doesn't change. */
1783 void
1784 x_set_tool_bar_lines (f, value, oldval)
1785 struct frame *f;
1786 Lisp_Object value, oldval;
1788 int delta, nlines, root_height;
1789 Lisp_Object root_window;
1791 /* Treat tool bars like menu bars. */
1792 if (FRAME_MINIBUF_ONLY_P (f))
1793 return;
1795 /* Use VALUE only if an integer >= 0. */
1796 if (INTEGERP (value) && XINT (value) >= 0)
1797 nlines = XFASTINT (value);
1798 else
1799 nlines = 0;
1801 /* Make sure we redisplay all windows in this frame. */
1802 ++windows_or_buffers_changed;
1804 delta = nlines - FRAME_TOOL_BAR_LINES (f);
1806 /* Don't resize the tool-bar to more than we have room for. */
1807 root_window = FRAME_ROOT_WINDOW (f);
1808 root_height = WINDOW_TOTAL_LINES (XWINDOW (root_window));
1809 if (root_height - delta < 1)
1811 delta = root_height - 1;
1812 nlines = FRAME_TOOL_BAR_LINES (f) + delta;
1815 FRAME_TOOL_BAR_LINES (f) = nlines;
1816 change_window_heights (root_window, delta);
1817 adjust_glyphs (f);
1819 /* We also have to make sure that the internal border at the top of
1820 the frame, below the menu bar or tool bar, is redrawn when the
1821 tool bar disappears. This is so because the internal border is
1822 below the tool bar if one is displayed, but is below the menu bar
1823 if there isn't a tool bar. The tool bar draws into the area
1824 below the menu bar. */
1825 if (FRAME_W32_WINDOW (f) && FRAME_TOOL_BAR_LINES (f) == 0)
1827 clear_frame (f);
1828 clear_current_matrices (f);
1831 /* If the tool bar gets smaller, the internal border below it
1832 has to be cleared. It was formerly part of the display
1833 of the larger tool bar, and updating windows won't clear it. */
1834 if (delta < 0)
1836 int height = FRAME_INTERNAL_BORDER_WIDTH (f);
1837 int width = FRAME_PIXEL_WIDTH (f);
1838 int y = nlines * FRAME_LINE_HEIGHT (f);
1840 BLOCK_INPUT;
1842 HDC hdc = get_frame_dc (f);
1843 w32_clear_area (f, hdc, 0, y, width, height);
1844 release_frame_dc (f, hdc);
1846 UNBLOCK_INPUT;
1848 if (WINDOWP (f->tool_bar_window))
1849 clear_glyph_matrix (XWINDOW (f->tool_bar_window)->current_matrix);
1854 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
1855 w32_id_name.
1857 If EXPLICIT is non-zero, that indicates that lisp code is setting the
1858 name; if NAME is a string, set F's name to NAME and set
1859 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
1861 If EXPLICIT is zero, that indicates that Emacs redisplay code is
1862 suggesting a new name, which lisp code should override; if
1863 F->explicit_name is set, ignore the new name; otherwise, set it. */
1865 void
1866 x_set_name (f, name, explicit)
1867 struct frame *f;
1868 Lisp_Object name;
1869 int explicit;
1871 /* Make sure that requests from lisp code override requests from
1872 Emacs redisplay code. */
1873 if (explicit)
1875 /* If we're switching from explicit to implicit, we had better
1876 update the mode lines and thereby update the title. */
1877 if (f->explicit_name && NILP (name))
1878 update_mode_lines = 1;
1880 f->explicit_name = ! NILP (name);
1882 else if (f->explicit_name)
1883 return;
1885 /* If NAME is nil, set the name to the w32_id_name. */
1886 if (NILP (name))
1888 /* Check for no change needed in this very common case
1889 before we do any consing. */
1890 if (!strcmp (FRAME_W32_DISPLAY_INFO (f)->w32_id_name,
1891 SDATA (f->name)))
1892 return;
1893 name = build_string (FRAME_W32_DISPLAY_INFO (f)->w32_id_name);
1895 else
1896 CHECK_STRING (name);
1898 /* Don't change the name if it's already NAME. */
1899 if (! NILP (Fstring_equal (name, f->name)))
1900 return;
1902 f->name = name;
1904 /* For setting the frame title, the title parameter should override
1905 the name parameter. */
1906 if (! NILP (f->title))
1907 name = f->title;
1909 if (FRAME_W32_WINDOW (f))
1911 if (STRING_MULTIBYTE (name))
1912 name = ENCODE_SYSTEM (name);
1914 BLOCK_INPUT;
1915 SetWindowText (FRAME_W32_WINDOW (f), SDATA (name));
1916 UNBLOCK_INPUT;
1920 /* This function should be called when the user's lisp code has
1921 specified a name for the frame; the name will override any set by the
1922 redisplay code. */
1923 void
1924 x_explicitly_set_name (f, arg, oldval)
1925 FRAME_PTR f;
1926 Lisp_Object arg, oldval;
1928 x_set_name (f, arg, 1);
1931 /* This function should be called by Emacs redisplay code to set the
1932 name; names set this way will never override names set by the user's
1933 lisp code. */
1934 void
1935 x_implicitly_set_name (f, arg, oldval)
1936 FRAME_PTR f;
1937 Lisp_Object arg, oldval;
1939 x_set_name (f, arg, 0);
1942 /* Change the title of frame F to NAME.
1943 If NAME is nil, use the frame name as the title. */
1945 void
1946 x_set_title (f, name, old_name)
1947 struct frame *f;
1948 Lisp_Object name, old_name;
1950 /* Don't change the title if it's already NAME. */
1951 if (EQ (name, f->title))
1952 return;
1954 update_mode_lines = 1;
1956 f->title = name;
1958 if (NILP (name))
1959 name = f->name;
1961 if (FRAME_W32_WINDOW (f))
1963 if (STRING_MULTIBYTE (name))
1964 name = ENCODE_SYSTEM (name);
1966 BLOCK_INPUT;
1967 SetWindowText (FRAME_W32_WINDOW (f), SDATA (name));
1968 UNBLOCK_INPUT;
1973 void x_set_scroll_bar_default_width (f)
1974 struct frame *f;
1976 int wid = FRAME_COLUMN_WIDTH (f);
1978 FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = GetSystemMetrics (SM_CXVSCROLL);
1979 FRAME_CONFIG_SCROLL_BAR_COLS (f) = (FRAME_CONFIG_SCROLL_BAR_WIDTH (f) +
1980 wid - 1) / wid;
1984 /* Subroutines for creating a frame. */
1986 Cursor
1987 w32_load_cursor (LPCTSTR name)
1989 /* Try first to load cursor from application resource. */
1990 Cursor cursor = LoadImage ((HINSTANCE) GetModuleHandle (NULL),
1991 name, IMAGE_CURSOR, 0, 0,
1992 LR_DEFAULTCOLOR | LR_DEFAULTSIZE | LR_SHARED);
1993 if (!cursor)
1995 /* Then try to load a shared predefined cursor. */
1996 cursor = LoadImage (NULL, name, IMAGE_CURSOR, 0, 0,
1997 LR_DEFAULTCOLOR | LR_DEFAULTSIZE | LR_SHARED);
1999 return cursor;
2002 extern LRESULT CALLBACK w32_wnd_proc ();
2004 static BOOL
2005 w32_init_class (hinst)
2006 HINSTANCE hinst;
2008 WNDCLASS wc;
2010 wc.style = CS_HREDRAW | CS_VREDRAW;
2011 wc.lpfnWndProc = (WNDPROC) w32_wnd_proc;
2012 wc.cbClsExtra = 0;
2013 wc.cbWndExtra = WND_EXTRA_BYTES;
2014 wc.hInstance = hinst;
2015 wc.hIcon = LoadIcon (hinst, EMACS_CLASS);
2016 wc.hCursor = w32_load_cursor (IDC_ARROW);
2017 wc.hbrBackground = NULL; /* GetStockObject (WHITE_BRUSH); */
2018 wc.lpszMenuName = NULL;
2019 wc.lpszClassName = EMACS_CLASS;
2021 return (RegisterClass (&wc));
2024 static HWND
2025 w32_createscrollbar (f, bar)
2026 struct frame *f;
2027 struct scroll_bar * bar;
2029 return (CreateWindow ("SCROLLBAR", "", SBS_VERT | WS_CHILD | WS_VISIBLE,
2030 /* Position and size of scroll bar. */
2031 XINT (bar->left) + VERTICAL_SCROLL_BAR_WIDTH_TRIM,
2032 XINT (bar->top),
2033 XINT (bar->width) - VERTICAL_SCROLL_BAR_WIDTH_TRIM * 2,
2034 XINT (bar->height),
2035 FRAME_W32_WINDOW (f),
2036 NULL,
2037 hinst,
2038 NULL));
2041 static void
2042 w32_createwindow (f)
2043 struct frame *f;
2045 HWND hwnd;
2046 RECT rect;
2047 Lisp_Object top = Qunbound;
2048 Lisp_Object left = Qunbound;
2049 struct w32_display_info *dpyinfo = &one_w32_display_info;
2051 rect.left = rect.top = 0;
2052 rect.right = FRAME_PIXEL_WIDTH (f);
2053 rect.bottom = FRAME_PIXEL_HEIGHT (f);
2055 AdjustWindowRect (&rect, f->output_data.w32->dwStyle,
2056 FRAME_EXTERNAL_MENU_BAR (f));
2058 /* Do first time app init */
2060 if (!hprevinst)
2062 w32_init_class (hinst);
2065 if (f->size_hint_flags & USPosition || f->size_hint_flags & PPosition)
2067 XSETINT (left, f->left_pos);
2068 XSETINT (top, f->top_pos);
2070 else if (EQ (left, Qunbound) && EQ (top, Qunbound))
2072 /* When called with RES_TYPE_NUMBER, w32_get_arg will return zero
2073 for anything that is not a number and is not Qunbound. */
2074 left = x_get_arg (dpyinfo, Qnil, Qleft, "left", "Left", RES_TYPE_NUMBER);
2075 top = x_get_arg (dpyinfo, Qnil, Qtop, "top", "Top", RES_TYPE_NUMBER);
2078 FRAME_W32_WINDOW (f) = hwnd
2079 = CreateWindow (EMACS_CLASS,
2080 f->namebuf,
2081 f->output_data.w32->dwStyle | WS_CLIPCHILDREN,
2082 EQ (left, Qunbound) ? CW_USEDEFAULT : XINT (left),
2083 EQ (top, Qunbound) ? CW_USEDEFAULT : XINT (top),
2084 rect.right - rect.left,
2085 rect.bottom - rect.top,
2086 NULL,
2087 NULL,
2088 hinst,
2089 NULL);
2091 if (hwnd)
2093 SetWindowLong (hwnd, WND_FONTWIDTH_INDEX, FRAME_COLUMN_WIDTH (f));
2094 SetWindowLong (hwnd, WND_LINEHEIGHT_INDEX, FRAME_LINE_HEIGHT (f));
2095 SetWindowLong (hwnd, WND_BORDER_INDEX, FRAME_INTERNAL_BORDER_WIDTH (f));
2096 SetWindowLong (hwnd, WND_SCROLLBAR_INDEX, f->scroll_bar_actual_width);
2097 SetWindowLong (hwnd, WND_BACKGROUND_INDEX, FRAME_BACKGROUND_PIXEL (f));
2099 /* Enable drag-n-drop. */
2100 DragAcceptFiles (hwnd, TRUE);
2102 /* Do this to discard the default setting specified by our parent. */
2103 ShowWindow (hwnd, SW_HIDE);
2105 /* Update frame positions. */
2106 GetWindowRect (hwnd, &rect);
2107 f->left_pos = rect.left;
2108 f->top_pos = rect.top;
2112 static void
2113 my_post_msg (wmsg, hwnd, msg, wParam, lParam)
2114 W32Msg * wmsg;
2115 HWND hwnd;
2116 UINT msg;
2117 WPARAM wParam;
2118 LPARAM lParam;
2120 wmsg->msg.hwnd = hwnd;
2121 wmsg->msg.message = msg;
2122 wmsg->msg.wParam = wParam;
2123 wmsg->msg.lParam = lParam;
2124 wmsg->msg.time = GetMessageTime ();
2126 post_msg (wmsg);
2129 /* GetKeyState and MapVirtualKey on Windows 95 do not actually distinguish
2130 between left and right keys as advertised. We test for this
2131 support dynamically, and set a flag when the support is absent. If
2132 absent, we keep track of the left and right control and alt keys
2133 ourselves. This is particularly necessary on keyboards that rely
2134 upon the AltGr key, which is represented as having the left control
2135 and right alt keys pressed. For these keyboards, we need to know
2136 when the left alt key has been pressed in addition to the AltGr key
2137 so that we can properly support M-AltGr-key sequences (such as M-@
2138 on Swedish keyboards). */
2140 #define EMACS_LCONTROL 0
2141 #define EMACS_RCONTROL 1
2142 #define EMACS_LMENU 2
2143 #define EMACS_RMENU 3
2145 static int modifiers[4];
2146 static int modifiers_recorded;
2147 static int modifier_key_support_tested;
2149 static void
2150 test_modifier_support (unsigned int wparam)
2152 unsigned int l, r;
2154 if (wparam != VK_CONTROL && wparam != VK_MENU)
2155 return;
2156 if (wparam == VK_CONTROL)
2158 l = VK_LCONTROL;
2159 r = VK_RCONTROL;
2161 else
2163 l = VK_LMENU;
2164 r = VK_RMENU;
2166 if (!(GetKeyState (l) & 0x8000) && !(GetKeyState (r) & 0x8000))
2167 modifiers_recorded = 1;
2168 else
2169 modifiers_recorded = 0;
2170 modifier_key_support_tested = 1;
2173 static void
2174 record_keydown (unsigned int wparam, unsigned int lparam)
2176 int i;
2178 if (!modifier_key_support_tested)
2179 test_modifier_support (wparam);
2181 if ((wparam != VK_CONTROL && wparam != VK_MENU) || !modifiers_recorded)
2182 return;
2184 if (wparam == VK_CONTROL)
2185 i = (lparam & 0x1000000) ? EMACS_RCONTROL : EMACS_LCONTROL;
2186 else
2187 i = (lparam & 0x1000000) ? EMACS_RMENU : EMACS_LMENU;
2189 modifiers[i] = 1;
2192 static void
2193 record_keyup (unsigned int wparam, unsigned int lparam)
2195 int i;
2197 if ((wparam != VK_CONTROL && wparam != VK_MENU) || !modifiers_recorded)
2198 return;
2200 if (wparam == VK_CONTROL)
2201 i = (lparam & 0x1000000) ? EMACS_RCONTROL : EMACS_LCONTROL;
2202 else
2203 i = (lparam & 0x1000000) ? EMACS_RMENU : EMACS_LMENU;
2205 modifiers[i] = 0;
2208 /* Emacs can lose focus while a modifier key has been pressed. When
2209 it regains focus, be conservative and clear all modifiers since
2210 we cannot reconstruct the left and right modifier state. */
2211 static void
2212 reset_modifiers ()
2214 SHORT ctrl, alt;
2216 if (GetFocus () == NULL)
2217 /* Emacs doesn't have keyboard focus. Do nothing. */
2218 return;
2220 ctrl = GetAsyncKeyState (VK_CONTROL);
2221 alt = GetAsyncKeyState (VK_MENU);
2223 if (!(ctrl & 0x08000))
2224 /* Clear any recorded control modifier state. */
2225 modifiers[EMACS_RCONTROL] = modifiers[EMACS_LCONTROL] = 0;
2227 if (!(alt & 0x08000))
2228 /* Clear any recorded alt modifier state. */
2229 modifiers[EMACS_RMENU] = modifiers[EMACS_LMENU] = 0;
2231 /* Update the state of all modifier keys, because modifiers used in
2232 hot-key combinations can get stuck on if Emacs loses focus as a
2233 result of a hot-key being pressed. */
2235 BYTE keystate[256];
2237 #define CURRENT_STATE(key) ((GetAsyncKeyState (key) & 0x8000) >> 8)
2239 GetKeyboardState (keystate);
2240 keystate[VK_SHIFT] = CURRENT_STATE (VK_SHIFT);
2241 keystate[VK_CONTROL] = CURRENT_STATE (VK_CONTROL);
2242 keystate[VK_LCONTROL] = CURRENT_STATE (VK_LCONTROL);
2243 keystate[VK_RCONTROL] = CURRENT_STATE (VK_RCONTROL);
2244 keystate[VK_MENU] = CURRENT_STATE (VK_MENU);
2245 keystate[VK_LMENU] = CURRENT_STATE (VK_LMENU);
2246 keystate[VK_RMENU] = CURRENT_STATE (VK_RMENU);
2247 keystate[VK_LWIN] = CURRENT_STATE (VK_LWIN);
2248 keystate[VK_RWIN] = CURRENT_STATE (VK_RWIN);
2249 keystate[VK_APPS] = CURRENT_STATE (VK_APPS);
2250 SetKeyboardState (keystate);
2254 /* Synchronize modifier state with what is reported with the current
2255 keystroke. Even if we cannot distinguish between left and right
2256 modifier keys, we know that, if no modifiers are set, then neither
2257 the left or right modifier should be set. */
2258 static void
2259 sync_modifiers ()
2261 if (!modifiers_recorded)
2262 return;
2264 if (!(GetKeyState (VK_CONTROL) & 0x8000))
2265 modifiers[EMACS_RCONTROL] = modifiers[EMACS_LCONTROL] = 0;
2267 if (!(GetKeyState (VK_MENU) & 0x8000))
2268 modifiers[EMACS_RMENU] = modifiers[EMACS_LMENU] = 0;
2271 static int
2272 modifier_set (int vkey)
2274 if (vkey == VK_CAPITAL || vkey == VK_SCROLL)
2275 return (GetKeyState (vkey) & 0x1);
2276 if (!modifiers_recorded)
2277 return (GetKeyState (vkey) & 0x8000);
2279 switch (vkey)
2281 case VK_LCONTROL:
2282 return modifiers[EMACS_LCONTROL];
2283 case VK_RCONTROL:
2284 return modifiers[EMACS_RCONTROL];
2285 case VK_LMENU:
2286 return modifiers[EMACS_LMENU];
2287 case VK_RMENU:
2288 return modifiers[EMACS_RMENU];
2290 return (GetKeyState (vkey) & 0x8000);
2293 /* Convert between the modifier bits W32 uses and the modifier bits
2294 Emacs uses. */
2296 unsigned int
2297 w32_key_to_modifier (int key)
2299 Lisp_Object key_mapping;
2301 switch (key)
2303 case VK_LWIN:
2304 key_mapping = Vw32_lwindow_modifier;
2305 break;
2306 case VK_RWIN:
2307 key_mapping = Vw32_rwindow_modifier;
2308 break;
2309 case VK_APPS:
2310 key_mapping = Vw32_apps_modifier;
2311 break;
2312 case VK_SCROLL:
2313 key_mapping = Vw32_scroll_lock_modifier;
2314 break;
2315 default:
2316 key_mapping = Qnil;
2319 /* NB. This code runs in the input thread, asychronously to the lisp
2320 thread, so we must be careful to ensure access to lisp data is
2321 thread-safe. The following code is safe because the modifier
2322 variable values are updated atomically from lisp and symbols are
2323 not relocated by GC. Also, we don't have to worry about seeing GC
2324 markbits here. */
2325 if (EQ (key_mapping, Qhyper))
2326 return hyper_modifier;
2327 if (EQ (key_mapping, Qsuper))
2328 return super_modifier;
2329 if (EQ (key_mapping, Qmeta))
2330 return meta_modifier;
2331 if (EQ (key_mapping, Qalt))
2332 return alt_modifier;
2333 if (EQ (key_mapping, Qctrl))
2334 return ctrl_modifier;
2335 if (EQ (key_mapping, Qcontrol)) /* synonym for ctrl */
2336 return ctrl_modifier;
2337 if (EQ (key_mapping, Qshift))
2338 return shift_modifier;
2340 /* Don't generate any modifier if not explicitly requested. */
2341 return 0;
2344 static unsigned int
2345 w32_get_modifiers ()
2347 return ((modifier_set (VK_SHIFT) ? shift_modifier : 0) |
2348 (modifier_set (VK_CONTROL) ? ctrl_modifier : 0) |
2349 (modifier_set (VK_LWIN) ? w32_key_to_modifier (VK_LWIN) : 0) |
2350 (modifier_set (VK_RWIN) ? w32_key_to_modifier (VK_RWIN) : 0) |
2351 (modifier_set (VK_APPS) ? w32_key_to_modifier (VK_APPS) : 0) |
2352 (modifier_set (VK_SCROLL) ? w32_key_to_modifier (VK_SCROLL) : 0) |
2353 (modifier_set (VK_MENU) ?
2354 ((NILP (Vw32_alt_is_meta)) ? alt_modifier : meta_modifier) : 0));
2357 /* We map the VK_* modifiers into console modifier constants
2358 so that we can use the same routines to handle both console
2359 and window input. */
2361 static int
2362 construct_console_modifiers ()
2364 int mods;
2366 mods = 0;
2367 mods |= (modifier_set (VK_SHIFT)) ? SHIFT_PRESSED : 0;
2368 mods |= (modifier_set (VK_CAPITAL)) ? CAPSLOCK_ON : 0;
2369 mods |= (modifier_set (VK_SCROLL)) ? SCROLLLOCK_ON : 0;
2370 mods |= (modifier_set (VK_NUMLOCK)) ? NUMLOCK_ON : 0;
2371 mods |= (modifier_set (VK_LCONTROL)) ? LEFT_CTRL_PRESSED : 0;
2372 mods |= (modifier_set (VK_RCONTROL)) ? RIGHT_CTRL_PRESSED : 0;
2373 mods |= (modifier_set (VK_LMENU)) ? LEFT_ALT_PRESSED : 0;
2374 mods |= (modifier_set (VK_RMENU)) ? RIGHT_ALT_PRESSED : 0;
2375 mods |= (modifier_set (VK_LWIN)) ? LEFT_WIN_PRESSED : 0;
2376 mods |= (modifier_set (VK_RWIN)) ? RIGHT_WIN_PRESSED : 0;
2377 mods |= (modifier_set (VK_APPS)) ? APPS_PRESSED : 0;
2379 return mods;
2382 static int
2383 w32_get_key_modifiers (unsigned int wparam, unsigned int lparam)
2385 int mods;
2387 /* Convert to emacs modifiers. */
2388 mods = w32_kbd_mods_to_emacs (construct_console_modifiers (), wparam);
2390 return mods;
2393 unsigned int
2394 map_keypad_keys (unsigned int virt_key, unsigned int extended)
2396 if (virt_key < VK_CLEAR || virt_key > VK_DELETE)
2397 return virt_key;
2399 if (virt_key == VK_RETURN)
2400 return (extended ? VK_NUMPAD_ENTER : VK_RETURN);
2402 if (virt_key >= VK_PRIOR && virt_key <= VK_DOWN)
2403 return (!extended ? (VK_NUMPAD_PRIOR + (virt_key - VK_PRIOR)) : virt_key);
2405 if (virt_key == VK_INSERT || virt_key == VK_DELETE)
2406 return (!extended ? (VK_NUMPAD_INSERT + (virt_key - VK_INSERT)) : virt_key);
2408 if (virt_key == VK_CLEAR)
2409 return (!extended ? VK_NUMPAD_CLEAR : virt_key);
2411 return virt_key;
2414 /* List of special key combinations which w32 would normally capture,
2415 but Emacs should grab instead. Not directly visible to lisp, to
2416 simplify synchronization. Each item is an integer encoding a virtual
2417 key code and modifier combination to capture. */
2418 static Lisp_Object w32_grabbed_keys;
2420 #define HOTKEY(vk, mods) make_number (((vk) & 255) | ((mods) << 8))
2421 #define HOTKEY_ID(k) (XFASTINT (k) & 0xbfff)
2422 #define HOTKEY_VK_CODE(k) (XFASTINT (k) & 255)
2423 #define HOTKEY_MODIFIERS(k) (XFASTINT (k) >> 8)
2425 #define RAW_HOTKEY_ID(k) ((k) & 0xbfff)
2426 #define RAW_HOTKEY_VK_CODE(k) ((k) & 255)
2427 #define RAW_HOTKEY_MODIFIERS(k) ((k) >> 8)
2429 /* Register hot-keys for reserved key combinations when Emacs has
2430 keyboard focus, since this is the only way Emacs can receive key
2431 combinations like Alt-Tab which are used by the system. */
2433 static void
2434 register_hot_keys (hwnd)
2435 HWND hwnd;
2437 Lisp_Object keylist;
2439 /* Use CONSP, since we are called asynchronously. */
2440 for (keylist = w32_grabbed_keys; CONSP (keylist); keylist = XCDR (keylist))
2442 Lisp_Object key = XCAR (keylist);
2444 /* Deleted entries get set to nil. */
2445 if (!INTEGERP (key))
2446 continue;
2448 RegisterHotKey (hwnd, HOTKEY_ID (key),
2449 HOTKEY_MODIFIERS (key), HOTKEY_VK_CODE (key));
2453 static void
2454 unregister_hot_keys (hwnd)
2455 HWND hwnd;
2457 Lisp_Object keylist;
2459 for (keylist = w32_grabbed_keys; CONSP (keylist); keylist = XCDR (keylist))
2461 Lisp_Object key = XCAR (keylist);
2463 if (!INTEGERP (key))
2464 continue;
2466 UnregisterHotKey (hwnd, HOTKEY_ID (key));
2470 /* Main message dispatch loop. */
2472 static void
2473 w32_msg_pump (deferred_msg * msg_buf)
2475 MSG msg;
2476 int result;
2477 HWND focus_window;
2479 msh_mousewheel = RegisterWindowMessage (MSH_MOUSEWHEEL);
2481 while (GetMessage (&msg, NULL, 0, 0))
2483 if (msg.hwnd == NULL)
2485 switch (msg.message)
2487 case WM_NULL:
2488 /* Produced by complete_deferred_msg; just ignore. */
2489 break;
2490 case WM_EMACS_CREATEWINDOW:
2491 /* Initialize COM for this window. Even though we don't use it,
2492 some third party shell extensions can cause it to be used in
2493 system dialogs, which causes a crash if it is not initialized.
2494 This is a known bug in Windows, which was fixed long ago, but
2495 the patch for XP is not publically available until XP SP3,
2496 and older versions will never be patched. */
2497 CoInitialize (NULL);
2498 w32_createwindow ((struct frame *) msg.wParam);
2499 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE, 0, 0))
2500 abort ();
2501 break;
2502 case WM_EMACS_SETLOCALE:
2503 SetThreadLocale (msg.wParam);
2504 /* Reply is not expected. */
2505 break;
2506 case WM_EMACS_SETKEYBOARDLAYOUT:
2507 result = (int) ActivateKeyboardLayout ((HKL) msg.wParam, 0);
2508 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE,
2509 result, 0))
2510 abort ();
2511 break;
2512 case WM_EMACS_REGISTER_HOT_KEY:
2513 focus_window = GetFocus ();
2514 if (focus_window != NULL)
2515 RegisterHotKey (focus_window,
2516 RAW_HOTKEY_ID (msg.wParam),
2517 RAW_HOTKEY_MODIFIERS (msg.wParam),
2518 RAW_HOTKEY_VK_CODE (msg.wParam));
2519 /* Reply is not expected. */
2520 break;
2521 case WM_EMACS_UNREGISTER_HOT_KEY:
2522 focus_window = GetFocus ();
2523 if (focus_window != NULL)
2524 UnregisterHotKey (focus_window, RAW_HOTKEY_ID (msg.wParam));
2525 /* Mark item as erased. NB: this code must be
2526 thread-safe. The next line is okay because the cons
2527 cell is never made into garbage and is not relocated by
2528 GC. */
2529 XSETCAR ((Lisp_Object) ((EMACS_INT) msg.lParam), Qnil);
2530 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE, 0, 0))
2531 abort ();
2532 break;
2533 case WM_EMACS_TOGGLE_LOCK_KEY:
2535 int vk_code = (int) msg.wParam;
2536 int cur_state = (GetKeyState (vk_code) & 1);
2537 Lisp_Object new_state = (Lisp_Object) ((EMACS_INT) msg.lParam);
2539 /* NB: This code must be thread-safe. It is safe to
2540 call NILP because symbols are not relocated by GC,
2541 and pointer here is not touched by GC (so the markbit
2542 can't be set). Numbers are safe because they are
2543 immediate values. */
2544 if (NILP (new_state)
2545 || (NUMBERP (new_state)
2546 && ((XUINT (new_state)) & 1) != cur_state))
2548 one_w32_display_info.faked_key = vk_code;
2550 keybd_event ((BYTE) vk_code,
2551 (BYTE) MapVirtualKey (vk_code, 0),
2552 KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
2553 keybd_event ((BYTE) vk_code,
2554 (BYTE) MapVirtualKey (vk_code, 0),
2555 KEYEVENTF_EXTENDEDKEY | 0, 0);
2556 keybd_event ((BYTE) vk_code,
2557 (BYTE) MapVirtualKey (vk_code, 0),
2558 KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
2559 cur_state = !cur_state;
2561 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE,
2562 cur_state, 0))
2563 abort ();
2565 break;
2566 #ifdef MSG_DEBUG
2567 /* Broadcast messages make it here, so you need to be looking
2568 for something in particular for this to be useful. */
2569 default:
2570 DebPrint (("msg %x not expected by w32_msg_pump\n", msg.message));
2571 #endif
2574 else
2576 DispatchMessage (&msg);
2579 /* Exit nested loop when our deferred message has completed. */
2580 if (msg_buf->completed)
2581 break;
2585 deferred_msg * deferred_msg_head;
2587 static deferred_msg *
2588 find_deferred_msg (HWND hwnd, UINT msg)
2590 deferred_msg * item;
2592 /* Don't actually need synchronization for read access, since
2593 modification of single pointer is always atomic. */
2594 /* enter_crit (); */
2596 for (item = deferred_msg_head; item != NULL; item = item->next)
2597 if (item->w32msg.msg.hwnd == hwnd
2598 && item->w32msg.msg.message == msg)
2599 break;
2601 /* leave_crit (); */
2603 return item;
2606 static LRESULT
2607 send_deferred_msg (deferred_msg * msg_buf,
2608 HWND hwnd,
2609 UINT msg,
2610 WPARAM wParam,
2611 LPARAM lParam)
2613 /* Only input thread can send deferred messages. */
2614 if (GetCurrentThreadId () != dwWindowsThreadId)
2615 abort ();
2617 /* It is an error to send a message that is already deferred. */
2618 if (find_deferred_msg (hwnd, msg) != NULL)
2619 abort ();
2621 /* Enforced synchronization is not needed because this is the only
2622 function that alters deferred_msg_head, and the following critical
2623 section is guaranteed to only be serially reentered (since only the
2624 input thread can call us). */
2626 /* enter_crit (); */
2628 msg_buf->completed = 0;
2629 msg_buf->next = deferred_msg_head;
2630 deferred_msg_head = msg_buf;
2631 my_post_msg (&msg_buf->w32msg, hwnd, msg, wParam, lParam);
2633 /* leave_crit (); */
2635 /* Start a new nested message loop to process other messages until
2636 this one is completed. */
2637 w32_msg_pump (msg_buf);
2639 deferred_msg_head = msg_buf->next;
2641 return msg_buf->result;
2644 void
2645 complete_deferred_msg (HWND hwnd, UINT msg, LRESULT result)
2647 deferred_msg * msg_buf = find_deferred_msg (hwnd, msg);
2649 if (msg_buf == NULL)
2650 /* Message may have been cancelled, so don't abort. */
2651 return;
2653 msg_buf->result = result;
2654 msg_buf->completed = 1;
2656 /* Ensure input thread is woken so it notices the completion. */
2657 PostThreadMessage (dwWindowsThreadId, WM_NULL, 0, 0);
2660 static void
2661 cancel_all_deferred_msgs ()
2663 deferred_msg * item;
2665 /* Don't actually need synchronization for read access, since
2666 modification of single pointer is always atomic. */
2667 /* enter_crit (); */
2669 for (item = deferred_msg_head; item != NULL; item = item->next)
2671 item->result = 0;
2672 item->completed = 1;
2675 /* leave_crit (); */
2677 /* Ensure input thread is woken so it notices the completion. */
2678 PostThreadMessage (dwWindowsThreadId, WM_NULL, 0, 0);
2681 DWORD WINAPI
2682 w32_msg_worker (void *arg)
2684 MSG msg;
2685 deferred_msg dummy_buf;
2687 /* Ensure our message queue is created */
2689 PeekMessage (&msg, NULL, 0, 0, PM_NOREMOVE);
2691 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE, 0, 0))
2692 abort ();
2694 memset (&dummy_buf, 0, sizeof (dummy_buf));
2695 dummy_buf.w32msg.msg.hwnd = NULL;
2696 dummy_buf.w32msg.msg.message = WM_NULL;
2698 /* This is the initial message loop which should only exit when the
2699 application quits. */
2700 w32_msg_pump (&dummy_buf);
2702 return 0;
2705 static void
2706 signal_user_input ()
2708 /* Interrupt any lisp that wants to be interrupted by input. */
2709 if (!NILP (Vthrow_on_input))
2711 Vquit_flag = Vthrow_on_input;
2712 /* If we're inside a function that wants immediate quits,
2713 do it now. */
2714 if (immediate_quit && NILP (Vinhibit_quit))
2716 immediate_quit = 0;
2717 QUIT;
2723 static void
2724 post_character_message (hwnd, msg, wParam, lParam, modifiers)
2725 HWND hwnd;
2726 UINT msg;
2727 WPARAM wParam;
2728 LPARAM lParam;
2729 DWORD modifiers;
2732 W32Msg wmsg;
2734 wmsg.dwModifiers = modifiers;
2736 /* Detect quit_char and set quit-flag directly. Note that we
2737 still need to post a message to ensure the main thread will be
2738 woken up if blocked in sys_select, but we do NOT want to post
2739 the quit_char message itself (because it will usually be as if
2740 the user had typed quit_char twice). Instead, we post a dummy
2741 message that has no particular effect. */
2743 int c = wParam;
2744 if (isalpha (c) && wmsg.dwModifiers == ctrl_modifier)
2745 c = make_ctrl_char (c) & 0377;
2746 if (c == quit_char
2747 || (wmsg.dwModifiers == 0 &&
2748 w32_quit_key && wParam == w32_quit_key))
2750 Vquit_flag = Qt;
2752 /* The choice of message is somewhat arbitrary, as long as
2753 the main thread handler just ignores it. */
2754 msg = WM_NULL;
2756 /* Interrupt any blocking system calls. */
2757 signal_quit ();
2759 /* As a safety precaution, forcibly complete any deferred
2760 messages. This is a kludge, but I don't see any particularly
2761 clean way to handle the situation where a deferred message is
2762 "dropped" in the lisp thread, and will thus never be
2763 completed, eg. by the user trying to activate the menubar
2764 when the lisp thread is busy, and then typing C-g when the
2765 menubar doesn't open promptly (with the result that the
2766 menubar never responds at all because the deferred
2767 WM_INITMENU message is never completed). Another problem
2768 situation is when the lisp thread calls SendMessage (to send
2769 a window manager command) when a message has been deferred;
2770 the lisp thread gets blocked indefinitely waiting for the
2771 deferred message to be completed, which itself is waiting for
2772 the lisp thread to respond.
2774 Note that we don't want to block the input thread waiting for
2775 a reponse from the lisp thread (although that would at least
2776 solve the deadlock problem above), because we want to be able
2777 to receive C-g to interrupt the lisp thread. */
2778 cancel_all_deferred_msgs ();
2780 else
2781 signal_user_input ();
2784 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
2787 /* Main window procedure */
2789 LRESULT CALLBACK
2790 w32_wnd_proc (hwnd, msg, wParam, lParam)
2791 HWND hwnd;
2792 UINT msg;
2793 WPARAM wParam;
2794 LPARAM lParam;
2796 struct frame *f;
2797 struct w32_display_info *dpyinfo = &one_w32_display_info;
2798 W32Msg wmsg;
2799 int windows_translate;
2800 int key;
2802 /* Note that it is okay to call x_window_to_frame, even though we are
2803 not running in the main lisp thread, because frame deletion
2804 requires the lisp thread to synchronize with this thread. Thus, if
2805 a frame struct is returned, it can be used without concern that the
2806 lisp thread might make it disappear while we are using it.
2808 NB. Walking the frame list in this thread is safe (as long as
2809 writes of Lisp_Object slots are atomic, which they are on Windows).
2810 Although delete-frame can destructively modify the frame list while
2811 we are walking it, a garbage collection cannot occur until after
2812 delete-frame has synchronized with this thread.
2814 It is also safe to use functions that make GDI calls, such as
2815 w32_clear_rect, because these functions must obtain a DC handle
2816 from the frame struct using get_frame_dc which is thread-aware. */
2818 switch (msg)
2820 case WM_ERASEBKGND:
2821 f = x_window_to_frame (dpyinfo, hwnd);
2822 if (f)
2824 HDC hdc = get_frame_dc (f);
2825 GetUpdateRect (hwnd, &wmsg.rect, FALSE);
2826 w32_clear_rect (f, hdc, &wmsg.rect);
2827 release_frame_dc (f, hdc);
2829 #if defined (W32_DEBUG_DISPLAY)
2830 DebPrint (("WM_ERASEBKGND (frame %p): erasing %d,%d-%d,%d\n",
2832 wmsg.rect.left, wmsg.rect.top,
2833 wmsg.rect.right, wmsg.rect.bottom));
2834 #endif /* W32_DEBUG_DISPLAY */
2836 return 1;
2837 case WM_PALETTECHANGED:
2838 /* ignore our own changes */
2839 if ((HWND)wParam != hwnd)
2841 f = x_window_to_frame (dpyinfo, hwnd);
2842 if (f)
2843 /* get_frame_dc will realize our palette and force all
2844 frames to be redrawn if needed. */
2845 release_frame_dc (f, get_frame_dc (f));
2847 return 0;
2848 case WM_PAINT:
2850 PAINTSTRUCT paintStruct;
2851 RECT update_rect;
2852 bzero (&update_rect, sizeof (update_rect));
2854 f = x_window_to_frame (dpyinfo, hwnd);
2855 if (f == 0)
2857 DebPrint (("WM_PAINT received for unknown window %p\n", hwnd));
2858 return 0;
2861 /* MSDN Docs say not to call BeginPaint if GetUpdateRect
2862 fails. Apparently this can happen under some
2863 circumstances. */
2864 if (GetUpdateRect (hwnd, &update_rect, FALSE) || !w32_strict_painting)
2866 enter_crit ();
2867 BeginPaint (hwnd, &paintStruct);
2869 /* The rectangles returned by GetUpdateRect and BeginPaint
2870 do not always match. Play it safe by assuming both areas
2871 are invalid. */
2872 UnionRect (&(wmsg.rect), &update_rect, &(paintStruct.rcPaint));
2874 #if defined (W32_DEBUG_DISPLAY)
2875 DebPrint (("WM_PAINT (frame %p): painting %d,%d-%d,%d\n",
2877 wmsg.rect.left, wmsg.rect.top,
2878 wmsg.rect.right, wmsg.rect.bottom));
2879 DebPrint ((" [update region is %d,%d-%d,%d]\n",
2880 update_rect.left, update_rect.top,
2881 update_rect.right, update_rect.bottom));
2882 #endif
2883 EndPaint (hwnd, &paintStruct);
2884 leave_crit ();
2886 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
2888 return 0;
2891 /* If GetUpdateRect returns 0 (meaning there is no update
2892 region), assume the whole window needs to be repainted. */
2893 GetClientRect (hwnd, &wmsg.rect);
2894 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
2895 return 0;
2898 case WM_INPUTLANGCHANGE:
2899 /* Inform lisp thread of keyboard layout changes. */
2900 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
2902 /* Clear dead keys in the keyboard state; for simplicity only
2903 preserve modifier key states. */
2905 int i;
2906 BYTE keystate[256];
2908 GetKeyboardState (keystate);
2909 for (i = 0; i < 256; i++)
2910 if (1
2911 && i != VK_SHIFT
2912 && i != VK_LSHIFT
2913 && i != VK_RSHIFT
2914 && i != VK_CAPITAL
2915 && i != VK_NUMLOCK
2916 && i != VK_SCROLL
2917 && i != VK_CONTROL
2918 && i != VK_LCONTROL
2919 && i != VK_RCONTROL
2920 && i != VK_MENU
2921 && i != VK_LMENU
2922 && i != VK_RMENU
2923 && i != VK_LWIN
2924 && i != VK_RWIN)
2925 keystate[i] = 0;
2926 SetKeyboardState (keystate);
2928 goto dflt;
2930 case WM_HOTKEY:
2931 /* Synchronize hot keys with normal input. */
2932 PostMessage (hwnd, WM_KEYDOWN, HIWORD (lParam), 0);
2933 return (0);
2935 case WM_KEYUP:
2936 case WM_SYSKEYUP:
2937 record_keyup (wParam, lParam);
2938 goto dflt;
2940 case WM_KEYDOWN:
2941 case WM_SYSKEYDOWN:
2942 /* Ignore keystrokes we fake ourself; see below. */
2943 if (dpyinfo->faked_key == wParam)
2945 dpyinfo->faked_key = 0;
2946 /* Make sure TranslateMessage sees them though (as long as
2947 they don't produce WM_CHAR messages). This ensures that
2948 indicator lights are toggled promptly on Windows 9x, for
2949 example. */
2950 if (wParam < 256 && lispy_function_keys[wParam])
2952 windows_translate = 1;
2953 goto translate;
2955 return 0;
2958 /* Synchronize modifiers with current keystroke. */
2959 sync_modifiers ();
2960 record_keydown (wParam, lParam);
2961 wParam = map_keypad_keys (wParam, (lParam & 0x1000000L) != 0);
2963 windows_translate = 0;
2965 switch (wParam)
2967 case VK_LWIN:
2968 if (NILP (Vw32_pass_lwindow_to_system))
2970 /* Prevent system from acting on keyup (which opens the
2971 Start menu if no other key was pressed) by simulating a
2972 press of Space which we will ignore. */
2973 if (GetAsyncKeyState (wParam) & 1)
2975 if (NUMBERP (Vw32_phantom_key_code))
2976 key = XUINT (Vw32_phantom_key_code) & 255;
2977 else
2978 key = VK_SPACE;
2979 dpyinfo->faked_key = key;
2980 keybd_event (key, (BYTE) MapVirtualKey (key, 0), 0, 0);
2983 if (!NILP (Vw32_lwindow_modifier))
2984 return 0;
2985 break;
2986 case VK_RWIN:
2987 if (NILP (Vw32_pass_rwindow_to_system))
2989 if (GetAsyncKeyState (wParam) & 1)
2991 if (NUMBERP (Vw32_phantom_key_code))
2992 key = XUINT (Vw32_phantom_key_code) & 255;
2993 else
2994 key = VK_SPACE;
2995 dpyinfo->faked_key = key;
2996 keybd_event (key, (BYTE) MapVirtualKey (key, 0), 0, 0);
2999 if (!NILP (Vw32_rwindow_modifier))
3000 return 0;
3001 break;
3002 case VK_APPS:
3003 if (!NILP (Vw32_apps_modifier))
3004 return 0;
3005 break;
3006 case VK_MENU:
3007 if (NILP (Vw32_pass_alt_to_system))
3008 /* Prevent DefWindowProc from activating the menu bar if an
3009 Alt key is pressed and released by itself. */
3010 return 0;
3011 windows_translate = 1;
3012 break;
3013 case VK_CAPITAL:
3014 /* Decide whether to treat as modifier or function key. */
3015 if (NILP (Vw32_enable_caps_lock))
3016 goto disable_lock_key;
3017 windows_translate = 1;
3018 break;
3019 case VK_NUMLOCK:
3020 /* Decide whether to treat as modifier or function key. */
3021 if (NILP (Vw32_enable_num_lock))
3022 goto disable_lock_key;
3023 windows_translate = 1;
3024 break;
3025 case VK_SCROLL:
3026 /* Decide whether to treat as modifier or function key. */
3027 if (NILP (Vw32_scroll_lock_modifier))
3028 goto disable_lock_key;
3029 windows_translate = 1;
3030 break;
3031 disable_lock_key:
3032 /* Ensure the appropriate lock key state (and indicator light)
3033 remains in the same state. We do this by faking another
3034 press of the relevant key. Apparently, this really is the
3035 only way to toggle the state of the indicator lights. */
3036 dpyinfo->faked_key = wParam;
3037 keybd_event ((BYTE) wParam, (BYTE) MapVirtualKey (wParam, 0),
3038 KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
3039 keybd_event ((BYTE) wParam, (BYTE) MapVirtualKey (wParam, 0),
3040 KEYEVENTF_EXTENDEDKEY | 0, 0);
3041 keybd_event ((BYTE) wParam, (BYTE) MapVirtualKey (wParam, 0),
3042 KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
3043 /* Ensure indicator lights are updated promptly on Windows 9x
3044 (TranslateMessage apparently does this), after forwarding
3045 input event. */
3046 post_character_message (hwnd, msg, wParam, lParam,
3047 w32_get_key_modifiers (wParam, lParam));
3048 windows_translate = 1;
3049 break;
3050 case VK_CONTROL:
3051 case VK_SHIFT:
3052 case VK_PROCESSKEY: /* Generated by IME. */
3053 windows_translate = 1;
3054 break;
3055 case VK_CANCEL:
3056 /* Windows maps Ctrl-Pause (aka Ctrl-Break) into VK_CANCEL,
3057 which is confusing for purposes of key binding; convert
3058 VK_CANCEL events into VK_PAUSE events. */
3059 wParam = VK_PAUSE;
3060 break;
3061 case VK_PAUSE:
3062 /* Windows maps Ctrl-NumLock into VK_PAUSE, which is confusing
3063 for purposes of key binding; convert these back into
3064 VK_NUMLOCK events, at least when we want to see NumLock key
3065 presses. (Note that there is never any possibility that
3066 VK_PAUSE with Ctrl really is C-Pause as per above.) */
3067 if (NILP (Vw32_enable_num_lock) && modifier_set (VK_CONTROL))
3068 wParam = VK_NUMLOCK;
3069 break;
3070 default:
3071 /* If not defined as a function key, change it to a WM_CHAR message. */
3072 if (wParam > 255 || !lispy_function_keys[wParam])
3074 DWORD modifiers = construct_console_modifiers ();
3076 if (!NILP (Vw32_recognize_altgr)
3077 && modifier_set (VK_LCONTROL) && modifier_set (VK_RMENU))
3079 /* Always let TranslateMessage handle AltGr key chords;
3080 for some reason, ToAscii doesn't always process AltGr
3081 chords correctly. */
3082 windows_translate = 1;
3084 else if ((modifiers & (~SHIFT_PRESSED & ~CAPSLOCK_ON)) != 0)
3086 /* Handle key chords including any modifiers other
3087 than shift directly, in order to preserve as much
3088 modifier information as possible. */
3089 if ('A' <= wParam && wParam <= 'Z')
3091 /* Don't translate modified alphabetic keystrokes,
3092 so the user doesn't need to constantly switch
3093 layout to type control or meta keystrokes when
3094 the normal layout translates alphabetic
3095 characters to non-ascii characters. */
3096 if (!modifier_set (VK_SHIFT))
3097 wParam += ('a' - 'A');
3098 msg = WM_CHAR;
3100 else
3102 /* Try to handle other keystrokes by determining the
3103 base character (ie. translating the base key plus
3104 shift modifier). */
3105 int add;
3106 int isdead = 0;
3107 KEY_EVENT_RECORD key;
3109 key.bKeyDown = TRUE;
3110 key.wRepeatCount = 1;
3111 key.wVirtualKeyCode = wParam;
3112 key.wVirtualScanCode = (lParam & 0xFF0000) >> 16;
3113 key.uChar.AsciiChar = 0;
3114 key.dwControlKeyState = modifiers;
3116 add = w32_kbd_patch_key (&key);
3117 /* 0 means an unrecognised keycode, negative means
3118 dead key. Ignore both. */
3119 while (--add >= 0)
3121 /* Forward asciified character sequence. */
3122 post_character_message
3123 (hwnd, WM_CHAR,
3124 (unsigned char) key.uChar.AsciiChar, lParam,
3125 w32_get_key_modifiers (wParam, lParam));
3126 w32_kbd_patch_key (&key);
3128 return 0;
3131 else
3133 /* Let TranslateMessage handle everything else. */
3134 windows_translate = 1;
3139 translate:
3140 if (windows_translate)
3142 MSG windows_msg = { hwnd, msg, wParam, lParam, 0, {0,0} };
3143 windows_msg.time = GetMessageTime ();
3144 TranslateMessage (&windows_msg);
3145 goto dflt;
3148 /* Fall through */
3150 case WM_SYSCHAR:
3151 case WM_CHAR:
3152 post_character_message (hwnd, msg, wParam, lParam,
3153 w32_get_key_modifiers (wParam, lParam));
3154 break;
3156 case WM_UNICHAR:
3157 /* WM_UNICHAR looks promising from the docs, but the exact
3158 circumstances in which TranslateMessage sends it is one of those
3159 Microsoft secret API things that EU and US courts are supposed
3160 to have put a stop to already. Spy++ shows it being sent to Notepad
3161 and other MS apps, but never to Emacs.
3163 Some third party IMEs send it in accordance with the official
3164 documentation though, so handle it here.
3166 UNICODE_NOCHAR is used to test for support for this message.
3167 TRUE indicates that the message is supported. */
3168 if (wParam == UNICODE_NOCHAR)
3169 return TRUE;
3172 W32Msg wmsg;
3173 wmsg.dwModifiers = w32_get_key_modifiers (wParam, lParam);
3174 signal_user_input ();
3175 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3177 break;
3179 case WM_IME_CHAR:
3180 /* If we can't get the IME result as unicode, use default processing,
3181 which will at least allow characters decodable in the system locale
3182 get through. */
3183 if (!get_composition_string_fn)
3184 goto dflt;
3186 else if (!ignore_ime_char)
3188 wchar_t * buffer;
3189 int size, i;
3190 W32Msg wmsg;
3191 HIMC context = get_ime_context_fn (hwnd);
3192 wmsg.dwModifiers = w32_get_key_modifiers (wParam, lParam);
3193 /* Get buffer size. */
3194 size = get_composition_string_fn (context, GCS_RESULTSTR, buffer, 0);
3195 buffer = alloca(size);
3196 size = get_composition_string_fn (context, GCS_RESULTSTR,
3197 buffer, size);
3198 signal_user_input ();
3199 for (i = 0; i < size / sizeof (wchar_t); i++)
3201 my_post_msg (&wmsg, hwnd, WM_UNICHAR, (WPARAM) buffer[i],
3202 lParam);
3204 /* We output the whole string above, so ignore following ones
3205 until we are notified of the end of composition. */
3206 ignore_ime_char = 1;
3208 break;
3210 case WM_IME_ENDCOMPOSITION:
3211 ignore_ime_char = 0;
3212 goto dflt;
3214 /* Simulate middle mouse button events when left and right buttons
3215 are used together, but only if user has two button mouse. */
3216 case WM_LBUTTONDOWN:
3217 case WM_RBUTTONDOWN:
3218 if (w32_num_mouse_buttons > 2)
3219 goto handle_plain_button;
3222 int this = (msg == WM_LBUTTONDOWN) ? LMOUSE : RMOUSE;
3223 int other = (msg == WM_LBUTTONDOWN) ? RMOUSE : LMOUSE;
3225 if (button_state & this)
3226 return 0;
3228 if (button_state == 0)
3229 SetCapture (hwnd);
3231 button_state |= this;
3233 if (button_state & other)
3235 if (mouse_button_timer)
3237 KillTimer (hwnd, mouse_button_timer);
3238 mouse_button_timer = 0;
3240 /* Generate middle mouse event instead. */
3241 msg = WM_MBUTTONDOWN;
3242 button_state |= MMOUSE;
3244 else if (button_state & MMOUSE)
3246 /* Ignore button event if we've already generated a
3247 middle mouse down event. This happens if the
3248 user releases and press one of the two buttons
3249 after we've faked a middle mouse event. */
3250 return 0;
3252 else
3254 /* Flush out saved message. */
3255 post_msg (&saved_mouse_button_msg);
3257 wmsg.dwModifiers = w32_get_modifiers ();
3258 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3259 signal_user_input ();
3261 /* Clear message buffer. */
3262 saved_mouse_button_msg.msg.hwnd = 0;
3264 else
3266 /* Hold onto message for now. */
3267 mouse_button_timer =
3268 SetTimer (hwnd, MOUSE_BUTTON_ID,
3269 w32_mouse_button_tolerance, NULL);
3270 saved_mouse_button_msg.msg.hwnd = hwnd;
3271 saved_mouse_button_msg.msg.message = msg;
3272 saved_mouse_button_msg.msg.wParam = wParam;
3273 saved_mouse_button_msg.msg.lParam = lParam;
3274 saved_mouse_button_msg.msg.time = GetMessageTime ();
3275 saved_mouse_button_msg.dwModifiers = w32_get_modifiers ();
3278 return 0;
3280 case WM_LBUTTONUP:
3281 case WM_RBUTTONUP:
3282 if (w32_num_mouse_buttons > 2)
3283 goto handle_plain_button;
3286 int this = (msg == WM_LBUTTONUP) ? LMOUSE : RMOUSE;
3287 int other = (msg == WM_LBUTTONUP) ? RMOUSE : LMOUSE;
3289 if ((button_state & this) == 0)
3290 return 0;
3292 button_state &= ~this;
3294 if (button_state & MMOUSE)
3296 /* Only generate event when second button is released. */
3297 if ((button_state & other) == 0)
3299 msg = WM_MBUTTONUP;
3300 button_state &= ~MMOUSE;
3302 if (button_state) abort ();
3304 else
3305 return 0;
3307 else
3309 /* Flush out saved message if necessary. */
3310 if (saved_mouse_button_msg.msg.hwnd)
3312 post_msg (&saved_mouse_button_msg);
3315 wmsg.dwModifiers = w32_get_modifiers ();
3316 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3317 signal_user_input ();
3319 /* Always clear message buffer and cancel timer. */
3320 saved_mouse_button_msg.msg.hwnd = 0;
3321 KillTimer (hwnd, mouse_button_timer);
3322 mouse_button_timer = 0;
3324 if (button_state == 0)
3325 ReleaseCapture ();
3327 return 0;
3329 case WM_XBUTTONDOWN:
3330 case WM_XBUTTONUP:
3331 if (w32_pass_extra_mouse_buttons_to_system)
3332 goto dflt;
3333 /* else fall through and process them. */
3334 case WM_MBUTTONDOWN:
3335 case WM_MBUTTONUP:
3336 handle_plain_button:
3338 BOOL up;
3339 int button;
3341 /* Ignore middle and extra buttons as long as the menu is active. */
3342 f = x_window_to_frame (dpyinfo, hwnd);
3343 if (f && f->output_data.w32->menubar_active)
3344 return 0;
3346 if (parse_button (msg, HIWORD (wParam), &button, &up))
3348 if (up) ReleaseCapture ();
3349 else SetCapture (hwnd);
3350 button = (button == 0) ? LMOUSE :
3351 ((button == 1) ? MMOUSE : RMOUSE);
3352 if (up)
3353 button_state &= ~button;
3354 else
3355 button_state |= button;
3359 wmsg.dwModifiers = w32_get_modifiers ();
3360 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3361 signal_user_input ();
3363 /* Need to return true for XBUTTON messages, false for others,
3364 to indicate that we processed the message. */
3365 return (msg == WM_XBUTTONDOWN || msg == WM_XBUTTONUP);
3367 case WM_MOUSEMOVE:
3368 /* Ignore mouse movements as long as the menu is active. These
3369 movements are processed by the window manager anyway, and
3370 it's wrong to handle them as if they happened on the
3371 underlying frame. */
3372 f = x_window_to_frame (dpyinfo, hwnd);
3373 if (f && f->output_data.w32->menubar_active)
3374 return 0;
3376 /* If the mouse has just moved into the frame, start tracking
3377 it, so we will be notified when it leaves the frame. Mouse
3378 tracking only works under W98 and NT4 and later. On earlier
3379 versions, there is no way of telling when the mouse leaves the
3380 frame, so we just have to put up with help-echo and mouse
3381 highlighting remaining while the frame is not active. */
3382 if (track_mouse_event_fn && !track_mouse_window)
3384 TRACKMOUSEEVENT tme;
3385 tme.cbSize = sizeof (tme);
3386 tme.dwFlags = TME_LEAVE;
3387 tme.hwndTrack = hwnd;
3389 track_mouse_event_fn (&tme);
3390 track_mouse_window = hwnd;
3392 case WM_VSCROLL:
3393 if (w32_mouse_move_interval <= 0
3394 || (msg == WM_MOUSEMOVE && button_state == 0))
3396 wmsg.dwModifiers = w32_get_modifiers ();
3397 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3398 return 0;
3401 /* Hang onto mouse move and scroll messages for a bit, to avoid
3402 sending such events to Emacs faster than it can process them.
3403 If we get more events before the timer from the first message
3404 expires, we just replace the first message. */
3406 if (saved_mouse_move_msg.msg.hwnd == 0)
3407 mouse_move_timer =
3408 SetTimer (hwnd, MOUSE_MOVE_ID,
3409 w32_mouse_move_interval, NULL);
3411 /* Hold onto message for now. */
3412 saved_mouse_move_msg.msg.hwnd = hwnd;
3413 saved_mouse_move_msg.msg.message = msg;
3414 saved_mouse_move_msg.msg.wParam = wParam;
3415 saved_mouse_move_msg.msg.lParam = lParam;
3416 saved_mouse_move_msg.msg.time = GetMessageTime ();
3417 saved_mouse_move_msg.dwModifiers = w32_get_modifiers ();
3419 return 0;
3421 case WM_MOUSEWHEEL:
3422 case WM_DROPFILES:
3423 wmsg.dwModifiers = w32_get_modifiers ();
3424 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3425 signal_user_input ();
3426 return 0;
3428 case WM_APPCOMMAND:
3429 if (w32_pass_multimedia_buttons_to_system)
3430 goto dflt;
3431 /* Otherwise, pass to lisp, the same way we do with mousehwheel. */
3432 case WM_MOUSEHWHEEL:
3433 wmsg.dwModifiers = w32_get_modifiers ();
3434 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3435 signal_user_input ();
3436 /* Non-zero must be returned when WM_MOUSEHWHEEL messages are
3437 handled, to prevent the system trying to handle it by faking
3438 scroll bar events. */
3439 return 1;
3441 case WM_TIMER:
3442 /* Flush out saved messages if necessary. */
3443 if (wParam == mouse_button_timer)
3445 if (saved_mouse_button_msg.msg.hwnd)
3447 post_msg (&saved_mouse_button_msg);
3448 signal_user_input ();
3449 saved_mouse_button_msg.msg.hwnd = 0;
3451 KillTimer (hwnd, mouse_button_timer);
3452 mouse_button_timer = 0;
3454 else if (wParam == mouse_move_timer)
3456 if (saved_mouse_move_msg.msg.hwnd)
3458 post_msg (&saved_mouse_move_msg);
3459 saved_mouse_move_msg.msg.hwnd = 0;
3461 KillTimer (hwnd, mouse_move_timer);
3462 mouse_move_timer = 0;
3464 else if (wParam == menu_free_timer)
3466 KillTimer (hwnd, menu_free_timer);
3467 menu_free_timer = 0;
3468 f = x_window_to_frame (dpyinfo, hwnd);
3469 /* If a popup menu is active, don't wipe its strings. */
3470 if (menubar_in_use
3471 && current_popup_menu == NULL)
3473 /* Free memory used by owner-drawn and help-echo strings. */
3474 w32_free_menu_strings (hwnd);
3475 f->output_data.w32->menubar_active = 0;
3476 menubar_in_use = 0;
3479 else if (wParam == hourglass_timer)
3481 KillTimer (hwnd, hourglass_timer);
3482 hourglass_timer = 0;
3483 w32_show_hourglass (x_window_to_frame (dpyinfo, hwnd));
3485 return 0;
3487 case WM_NCACTIVATE:
3488 /* Windows doesn't send us focus messages when putting up and
3489 taking down a system popup dialog as for Ctrl-Alt-Del on Windows 95.
3490 The only indication we get that something happened is receiving
3491 this message afterwards. So this is a good time to reset our
3492 keyboard modifiers' state. */
3493 reset_modifiers ();
3494 goto dflt;
3496 case WM_INITMENU:
3497 button_state = 0;
3498 ReleaseCapture ();
3499 /* We must ensure menu bar is fully constructed and up to date
3500 before allowing user interaction with it. To achieve this
3501 we send this message to the lisp thread and wait for a
3502 reply (whose value is not actually needed) to indicate that
3503 the menu bar is now ready for use, so we can now return.
3505 To remain responsive in the meantime, we enter a nested message
3506 loop that can process all other messages.
3508 However, we skip all this if the message results from calling
3509 TrackPopupMenu - in fact, we must NOT attempt to send the lisp
3510 thread a message because it is blocked on us at this point. We
3511 set menubar_active before calling TrackPopupMenu to indicate
3512 this (there is no possibility of confusion with real menubar
3513 being active). */
3515 f = x_window_to_frame (dpyinfo, hwnd);
3516 if (f
3517 && (f->output_data.w32->menubar_active
3518 /* We can receive this message even in the absence of a
3519 menubar (ie. when the system menu is activated) - in this
3520 case we do NOT want to forward the message, otherwise it
3521 will cause the menubar to suddenly appear when the user
3522 had requested it to be turned off! */
3523 || f->output_data.w32->menubar_widget == NULL))
3524 return 0;
3527 deferred_msg msg_buf;
3529 /* Detect if message has already been deferred; in this case
3530 we cannot return any sensible value to ignore this. */
3531 if (find_deferred_msg (hwnd, msg) != NULL)
3532 abort ();
3534 menubar_in_use = 1;
3536 return send_deferred_msg (&msg_buf, hwnd, msg, wParam, lParam);
3539 case WM_EXITMENULOOP:
3540 f = x_window_to_frame (dpyinfo, hwnd);
3542 /* If a menu is still active, check again after a short delay,
3543 since Windows often (always?) sends the WM_EXITMENULOOP
3544 before the corresponding WM_COMMAND message.
3545 Don't do this if a popup menu is active, since it is only
3546 menubar menus that require cleaning up in this way.
3548 if (f && menubar_in_use && current_popup_menu == NULL)
3549 menu_free_timer = SetTimer (hwnd, MENU_FREE_ID, MENU_FREE_DELAY, NULL);
3551 /* If hourglass cursor should be displayed, display it now. */
3552 if (f && f->output_data.w32->hourglass_p)
3553 SetCursor (f->output_data.w32->hourglass_cursor);
3555 goto dflt;
3557 case WM_MENUSELECT:
3558 /* Direct handling of help_echo in menus. Should be safe now
3559 that we generate the help_echo by placing a help event in the
3560 keyboard buffer. */
3562 HMENU menu = (HMENU) lParam;
3563 UINT menu_item = (UINT) LOWORD (wParam);
3564 UINT flags = (UINT) HIWORD (wParam);
3566 w32_menu_display_help (hwnd, menu, menu_item, flags);
3568 return 0;
3570 case WM_MEASUREITEM:
3571 f = x_window_to_frame (dpyinfo, hwnd);
3572 if (f)
3574 MEASUREITEMSTRUCT * pMis = (MEASUREITEMSTRUCT *) lParam;
3576 if (pMis->CtlType == ODT_MENU)
3578 /* Work out dimensions for popup menu titles. */
3579 char * title = (char *) pMis->itemData;
3580 HDC hdc = GetDC (hwnd);
3581 HFONT menu_font = GetCurrentObject (hdc, OBJ_FONT);
3582 LOGFONT menu_logfont;
3583 HFONT old_font;
3584 SIZE size;
3586 GetObject (menu_font, sizeof (menu_logfont), &menu_logfont);
3587 menu_logfont.lfWeight = FW_BOLD;
3588 menu_font = CreateFontIndirect (&menu_logfont);
3589 old_font = SelectObject (hdc, menu_font);
3591 pMis->itemHeight = GetSystemMetrics (SM_CYMENUSIZE);
3592 if (title)
3594 if (unicode_append_menu)
3595 GetTextExtentPoint32W (hdc, (WCHAR *) title,
3596 wcslen ((WCHAR *) title),
3597 &size);
3598 else
3599 GetTextExtentPoint32 (hdc, title, strlen (title), &size);
3601 pMis->itemWidth = size.cx;
3602 if (pMis->itemHeight < size.cy)
3603 pMis->itemHeight = size.cy;
3605 else
3606 pMis->itemWidth = 0;
3608 SelectObject (hdc, old_font);
3609 DeleteObject (menu_font);
3610 ReleaseDC (hwnd, hdc);
3611 return TRUE;
3614 return 0;
3616 case WM_DRAWITEM:
3617 f = x_window_to_frame (dpyinfo, hwnd);
3618 if (f)
3620 DRAWITEMSTRUCT * pDis = (DRAWITEMSTRUCT *) lParam;
3622 if (pDis->CtlType == ODT_MENU)
3624 /* Draw popup menu title. */
3625 char * title = (char *) pDis->itemData;
3626 if (title)
3628 HDC hdc = pDis->hDC;
3629 HFONT menu_font = GetCurrentObject (hdc, OBJ_FONT);
3630 LOGFONT menu_logfont;
3631 HFONT old_font;
3633 GetObject (menu_font, sizeof (menu_logfont), &menu_logfont);
3634 menu_logfont.lfWeight = FW_BOLD;
3635 menu_font = CreateFontIndirect (&menu_logfont);
3636 old_font = SelectObject (hdc, menu_font);
3638 /* Always draw title as if not selected. */
3639 if (unicode_append_menu)
3640 ExtTextOutW (hdc,
3641 pDis->rcItem.left
3642 + GetSystemMetrics (SM_CXMENUCHECK),
3643 pDis->rcItem.top,
3644 ETO_OPAQUE, &pDis->rcItem,
3645 (WCHAR *) title,
3646 wcslen ((WCHAR *) title), NULL);
3647 else
3648 ExtTextOut (hdc,
3649 pDis->rcItem.left
3650 + GetSystemMetrics (SM_CXMENUCHECK),
3651 pDis->rcItem.top,
3652 ETO_OPAQUE, &pDis->rcItem,
3653 title, strlen (title), NULL);
3655 SelectObject (hdc, old_font);
3656 DeleteObject (menu_font);
3658 return TRUE;
3661 return 0;
3663 #if 0
3664 /* Still not right - can't distinguish between clicks in the
3665 client area of the frame from clicks forwarded from the scroll
3666 bars - may have to hook WM_NCHITTEST to remember the mouse
3667 position and then check if it is in the client area ourselves. */
3668 case WM_MOUSEACTIVATE:
3669 /* Discard the mouse click that activates a frame, allowing the
3670 user to click anywhere without changing point (or worse!).
3671 Don't eat mouse clicks on scrollbars though!! */
3672 if (LOWORD (lParam) == HTCLIENT )
3673 return MA_ACTIVATEANDEAT;
3674 goto dflt;
3675 #endif
3677 case WM_MOUSELEAVE:
3678 /* No longer tracking mouse. */
3679 track_mouse_window = NULL;
3681 case WM_ACTIVATEAPP:
3682 case WM_ACTIVATE:
3683 case WM_WINDOWPOSCHANGED:
3684 case WM_SHOWWINDOW:
3685 /* Inform lisp thread that a frame might have just been obscured
3686 or exposed, so should recheck visibility of all frames. */
3687 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3688 goto dflt;
3690 case WM_SETFOCUS:
3691 dpyinfo->faked_key = 0;
3692 reset_modifiers ();
3693 register_hot_keys (hwnd);
3694 goto command;
3695 case WM_KILLFOCUS:
3696 unregister_hot_keys (hwnd);
3697 button_state = 0;
3698 ReleaseCapture ();
3699 /* Relinquish the system caret. */
3700 if (w32_system_caret_hwnd)
3702 w32_visible_system_caret_hwnd = NULL;
3703 w32_system_caret_hwnd = NULL;
3704 DestroyCaret ();
3706 goto command;
3707 case WM_COMMAND:
3708 menubar_in_use = 0;
3709 f = x_window_to_frame (dpyinfo, hwnd);
3710 if (f && HIWORD (wParam) == 0)
3712 if (menu_free_timer)
3714 KillTimer (hwnd, menu_free_timer);
3715 menu_free_timer = 0;
3718 case WM_MOVE:
3719 case WM_SIZE:
3720 command:
3721 wmsg.dwModifiers = w32_get_modifiers ();
3722 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3723 goto dflt;
3725 case WM_DESTROY:
3726 CoUninitialize ();
3727 return 0;
3729 case WM_CLOSE:
3730 wmsg.dwModifiers = w32_get_modifiers ();
3731 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3732 return 0;
3734 case WM_WINDOWPOSCHANGING:
3735 /* Don't restrict the sizing of tip frames. */
3736 if (hwnd == tip_window)
3737 return 0;
3739 WINDOWPLACEMENT wp;
3740 LPWINDOWPOS lppos = (WINDOWPOS *) lParam;
3742 wp.length = sizeof (WINDOWPLACEMENT);
3743 GetWindowPlacement (hwnd, &wp);
3745 if (wp.showCmd != SW_SHOWMINIMIZED && (lppos->flags & SWP_NOSIZE) == 0)
3747 RECT rect;
3748 int wdiff;
3749 int hdiff;
3750 DWORD font_width;
3751 DWORD line_height;
3752 DWORD internal_border;
3753 DWORD scrollbar_extra;
3754 RECT wr;
3756 wp.length = sizeof (wp);
3757 GetWindowRect (hwnd, &wr);
3759 enter_crit ();
3761 font_width = GetWindowLong (hwnd, WND_FONTWIDTH_INDEX);
3762 line_height = GetWindowLong (hwnd, WND_LINEHEIGHT_INDEX);
3763 internal_border = GetWindowLong (hwnd, WND_BORDER_INDEX);
3764 scrollbar_extra = GetWindowLong (hwnd, WND_SCROLLBAR_INDEX);
3766 leave_crit ();
3768 memset (&rect, 0, sizeof (rect));
3769 AdjustWindowRect (&rect, GetWindowLong (hwnd, GWL_STYLE),
3770 GetMenu (hwnd) != NULL);
3772 /* Force width and height of client area to be exact
3773 multiples of the character cell dimensions. */
3774 wdiff = (lppos->cx - (rect.right - rect.left)
3775 - 2 * internal_border - scrollbar_extra)
3776 % font_width;
3777 hdiff = (lppos->cy - (rect.bottom - rect.top)
3778 - 2 * internal_border)
3779 % line_height;
3781 if (wdiff || hdiff)
3783 /* For right/bottom sizing we can just fix the sizes.
3784 However for top/left sizing we will need to fix the X
3785 and Y positions as well. */
3787 int cx_mintrack = GetSystemMetrics (SM_CXMINTRACK);
3788 int cy_mintrack = GetSystemMetrics (SM_CYMINTRACK);
3790 lppos->cx = max (lppos->cx - wdiff, cx_mintrack);
3791 lppos->cy = max (lppos->cy - hdiff, cy_mintrack);
3793 if (wp.showCmd != SW_SHOWMAXIMIZED
3794 && (lppos->flags & SWP_NOMOVE) == 0)
3796 if (lppos->x != wr.left || lppos->y != wr.top)
3798 lppos->x += wdiff;
3799 lppos->y += hdiff;
3801 else
3803 lppos->flags |= SWP_NOMOVE;
3807 return 0;
3812 goto dflt;
3814 case WM_GETMINMAXINFO:
3815 /* Hack to allow resizing the Emacs frame above the screen size.
3816 Note that Windows 9x limits coordinates to 16-bits. */
3817 ((LPMINMAXINFO) lParam)->ptMaxTrackSize.x = 32767;
3818 ((LPMINMAXINFO) lParam)->ptMaxTrackSize.y = 32767;
3819 return 0;
3821 case WM_SETCURSOR:
3822 if (LOWORD (lParam) == HTCLIENT)
3824 f = x_window_to_frame (dpyinfo, hwnd);
3825 if (f->output_data.w32->hourglass_p && !menubar_in_use
3826 && !current_popup_menu)
3827 SetCursor (f->output_data.w32->hourglass_cursor);
3828 else
3829 SetCursor (f->output_data.w32->current_cursor);
3830 return 0;
3832 goto dflt;
3834 case WM_EMACS_SETCURSOR:
3836 Cursor cursor = (Cursor) wParam;
3837 f = x_window_to_frame (dpyinfo, hwnd);
3838 if (f && cursor)
3840 f->output_data.w32->current_cursor = cursor;
3841 if (!f->output_data.w32->hourglass_p)
3842 SetCursor (cursor);
3844 return 0;
3847 case WM_EMACS_CREATESCROLLBAR:
3848 return (LRESULT) w32_createscrollbar ((struct frame *) wParam,
3849 (struct scroll_bar *) lParam);
3851 case WM_EMACS_SHOWWINDOW:
3852 return ShowWindow ((HWND) wParam, (WPARAM) lParam);
3854 case WM_EMACS_SETFOREGROUND:
3856 HWND foreground_window;
3857 DWORD foreground_thread, retval;
3859 /* On NT 5.0, and apparently Windows 98, it is necessary to
3860 attach to the thread that currently has focus in order to
3861 pull the focus away from it. */
3862 foreground_window = GetForegroundWindow ();
3863 foreground_thread = GetWindowThreadProcessId (foreground_window, NULL);
3864 if (!foreground_window
3865 || foreground_thread == GetCurrentThreadId ()
3866 || !AttachThreadInput (GetCurrentThreadId (),
3867 foreground_thread, TRUE))
3868 foreground_thread = 0;
3870 retval = SetForegroundWindow ((HWND) wParam);
3872 /* Detach from the previous foreground thread. */
3873 if (foreground_thread)
3874 AttachThreadInput (GetCurrentThreadId (),
3875 foreground_thread, FALSE);
3877 return retval;
3880 case WM_EMACS_SETWINDOWPOS:
3882 WINDOWPOS * pos = (WINDOWPOS *) wParam;
3883 return SetWindowPos (hwnd, pos->hwndInsertAfter,
3884 pos->x, pos->y, pos->cx, pos->cy, pos->flags);
3887 case WM_EMACS_DESTROYWINDOW:
3888 DragAcceptFiles ((HWND) wParam, FALSE);
3889 return DestroyWindow ((HWND) wParam);
3891 case WM_EMACS_HIDE_CARET:
3892 return HideCaret (hwnd);
3894 case WM_EMACS_SHOW_CARET:
3895 return ShowCaret (hwnd);
3897 case WM_EMACS_DESTROY_CARET:
3898 w32_system_caret_hwnd = NULL;
3899 w32_visible_system_caret_hwnd = NULL;
3900 return DestroyCaret ();
3902 case WM_EMACS_TRACK_CARET:
3903 /* If there is currently no system caret, create one. */
3904 if (w32_system_caret_hwnd == NULL)
3906 /* Use the default caret width, and avoid changing it
3907 unneccesarily, as it confuses screen reader software. */
3908 w32_system_caret_hwnd = hwnd;
3909 CreateCaret (hwnd, NULL, 0,
3910 w32_system_caret_height);
3913 if (!SetCaretPos (w32_system_caret_x, w32_system_caret_y))
3914 return 0;
3915 /* Ensure visible caret gets turned on when requested. */
3916 else if (w32_use_visible_system_caret
3917 && w32_visible_system_caret_hwnd != hwnd)
3919 w32_visible_system_caret_hwnd = hwnd;
3920 return ShowCaret (hwnd);
3922 /* Ensure visible caret gets turned off when requested. */
3923 else if (!w32_use_visible_system_caret
3924 && w32_visible_system_caret_hwnd)
3926 w32_visible_system_caret_hwnd = NULL;
3927 return HideCaret (hwnd);
3929 else
3930 return 1;
3932 case WM_EMACS_TRACKPOPUPMENU:
3934 UINT flags;
3935 POINT *pos;
3936 int retval;
3937 pos = (POINT *)lParam;
3938 flags = TPM_CENTERALIGN;
3939 if (button_state & LMOUSE)
3940 flags |= TPM_LEFTBUTTON;
3941 else if (button_state & RMOUSE)
3942 flags |= TPM_RIGHTBUTTON;
3944 /* Remember we did a SetCapture on the initial mouse down event,
3945 so for safety, we make sure the capture is cancelled now. */
3946 ReleaseCapture ();
3947 button_state = 0;
3949 /* Use menubar_active to indicate that WM_INITMENU is from
3950 TrackPopupMenu below, and should be ignored. */
3951 f = x_window_to_frame (dpyinfo, hwnd);
3952 if (f)
3953 f->output_data.w32->menubar_active = 1;
3955 if (TrackPopupMenu ((HMENU)wParam, flags, pos->x, pos->y,
3956 0, hwnd, NULL))
3958 MSG amsg;
3959 /* Eat any mouse messages during popupmenu */
3960 while (PeekMessage (&amsg, hwnd, WM_MOUSEFIRST, WM_MOUSELAST,
3961 PM_REMOVE));
3962 /* Get the menu selection, if any */
3963 if (PeekMessage (&amsg, hwnd, WM_COMMAND, WM_COMMAND, PM_REMOVE))
3965 retval = LOWORD (amsg.wParam);
3967 else
3969 retval = 0;
3972 else
3974 retval = -1;
3977 return retval;
3980 default:
3981 /* Check for messages registered at runtime. */
3982 if (msg == msh_mousewheel)
3984 wmsg.dwModifiers = w32_get_modifiers ();
3985 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3986 signal_user_input ();
3987 return 0;
3990 dflt:
3991 return DefWindowProc (hwnd, msg, wParam, lParam);
3995 /* The most common default return code for handled messages is 0. */
3996 return 0;
3999 static void
4000 my_create_window (f)
4001 struct frame * f;
4003 MSG msg;
4005 if (!PostThreadMessage (dwWindowsThreadId, WM_EMACS_CREATEWINDOW, (WPARAM)f, 0))
4006 abort ();
4007 GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE);
4011 /* Create a tooltip window. Unlike my_create_window, we do not do this
4012 indirectly via the Window thread, as we do not need to process Window
4013 messages for the tooltip. Creating tooltips indirectly also creates
4014 deadlocks when tooltips are created for menu items. */
4015 static void
4016 my_create_tip_window (f)
4017 struct frame *f;
4019 RECT rect;
4021 rect.left = rect.top = 0;
4022 rect.right = FRAME_PIXEL_WIDTH (f);
4023 rect.bottom = FRAME_PIXEL_HEIGHT (f);
4025 AdjustWindowRect (&rect, f->output_data.w32->dwStyle,
4026 FRAME_EXTERNAL_MENU_BAR (f));
4028 tip_window = FRAME_W32_WINDOW (f)
4029 = CreateWindow (EMACS_CLASS,
4030 f->namebuf,
4031 f->output_data.w32->dwStyle,
4032 f->left_pos,
4033 f->top_pos,
4034 rect.right - rect.left,
4035 rect.bottom - rect.top,
4036 FRAME_W32_WINDOW (SELECTED_FRAME ()), /* owner */
4037 NULL,
4038 hinst,
4039 NULL);
4041 if (tip_window)
4043 SetWindowLong (tip_window, WND_FONTWIDTH_INDEX, FRAME_COLUMN_WIDTH (f));
4044 SetWindowLong (tip_window, WND_LINEHEIGHT_INDEX, FRAME_LINE_HEIGHT (f));
4045 SetWindowLong (tip_window, WND_BORDER_INDEX, FRAME_INTERNAL_BORDER_WIDTH (f));
4046 SetWindowLong (tip_window, WND_BACKGROUND_INDEX, FRAME_BACKGROUND_PIXEL (f));
4048 /* Tip frames have no scrollbars. */
4049 SetWindowLong (tip_window, WND_SCROLLBAR_INDEX, 0);
4051 /* Do this to discard the default setting specified by our parent. */
4052 ShowWindow (tip_window, SW_HIDE);
4057 /* Create and set up the w32 window for frame F. */
4059 static void
4060 w32_window (f, window_prompting, minibuffer_only)
4061 struct frame *f;
4062 long window_prompting;
4063 int minibuffer_only;
4065 BLOCK_INPUT;
4067 /* Use the resource name as the top-level window name
4068 for looking up resources. Make a non-Lisp copy
4069 for the window manager, so GC relocation won't bother it.
4071 Elsewhere we specify the window name for the window manager. */
4074 char *str = (char *) SDATA (Vx_resource_name);
4075 f->namebuf = (char *) xmalloc (strlen (str) + 1);
4076 strcpy (f->namebuf, str);
4079 my_create_window (f);
4081 validate_x_resource_name ();
4083 /* x_set_name normally ignores requests to set the name if the
4084 requested name is the same as the current name. This is the one
4085 place where that assumption isn't correct; f->name is set, but
4086 the server hasn't been told. */
4088 Lisp_Object name;
4089 int explicit = f->explicit_name;
4091 f->explicit_name = 0;
4092 name = f->name;
4093 f->name = Qnil;
4094 x_set_name (f, name, explicit);
4097 UNBLOCK_INPUT;
4099 if (!minibuffer_only && FRAME_EXTERNAL_MENU_BAR (f))
4100 initialize_frame_menubar (f);
4102 if (FRAME_W32_WINDOW (f) == 0)
4103 error ("Unable to create window");
4106 /* Handle the icon stuff for this window. Perhaps later we might
4107 want an x_set_icon_position which can be called interactively as
4108 well. */
4110 static void
4111 x_icon (f, parms)
4112 struct frame *f;
4113 Lisp_Object parms;
4115 Lisp_Object icon_x, icon_y;
4116 struct w32_display_info *dpyinfo = &one_w32_display_info;
4118 /* Set the position of the icon. Note that Windows 95 groups all
4119 icons in the tray. */
4120 icon_x = x_get_arg (dpyinfo, parms, Qicon_left, 0, 0, RES_TYPE_NUMBER);
4121 icon_y = x_get_arg (dpyinfo, parms, Qicon_top, 0, 0, RES_TYPE_NUMBER);
4122 if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
4124 CHECK_NUMBER (icon_x);
4125 CHECK_NUMBER (icon_y);
4127 else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
4128 error ("Both left and top icon corners of icon must be specified");
4130 BLOCK_INPUT;
4132 if (! EQ (icon_x, Qunbound))
4133 x_wm_set_icon_position (f, XINT (icon_x), XINT (icon_y));
4135 #if 0 /* TODO */
4136 /* Start up iconic or window? */
4137 x_wm_set_window_state
4138 (f, (EQ (x_get_arg (dpyinfo, parms, Qvisibility, 0, 0, RES_TYPE_SYMBOL), Qicon)
4139 ? IconicState
4140 : NormalState));
4142 x_text_icon (f, (char *) SDATA ((!NILP (f->icon_name)
4143 ? f->icon_name
4144 : f->name)));
4145 #endif
4147 UNBLOCK_INPUT;
4151 static void
4152 x_make_gc (f)
4153 struct frame *f;
4155 XGCValues gc_values;
4157 BLOCK_INPUT;
4159 /* Create the GC's of this frame.
4160 Note that many default values are used. */
4162 /* Normal video */
4163 gc_values.font = FRAME_FONT (f);
4165 /* Cursor has cursor-color background, background-color foreground. */
4166 gc_values.foreground = FRAME_BACKGROUND_PIXEL (f);
4167 gc_values.background = f->output_data.w32->cursor_pixel;
4168 f->output_data.w32->cursor_gc
4169 = XCreateGC (NULL, FRAME_W32_WINDOW (f),
4170 (GCFont | GCForeground | GCBackground),
4171 &gc_values);
4173 /* Reliefs. */
4174 f->output_data.w32->white_relief.gc = 0;
4175 f->output_data.w32->black_relief.gc = 0;
4177 UNBLOCK_INPUT;
4181 /* Handler for signals raised during x_create_frame and
4182 x_create_top_frame. FRAME is the frame which is partially
4183 constructed. */
4185 static Lisp_Object
4186 unwind_create_frame (frame)
4187 Lisp_Object frame;
4189 struct frame *f = XFRAME (frame);
4191 /* If frame is ``official'', nothing to do. */
4192 if (!CONSP (Vframe_list) || !EQ (XCAR (Vframe_list), frame))
4194 #ifdef GLYPH_DEBUG
4195 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
4196 #endif
4198 x_free_frame_resources (f);
4200 /* Check that reference counts are indeed correct. */
4201 xassert (dpyinfo->reference_count == dpyinfo_refcount);
4202 xassert (dpyinfo->image_cache->refcount == image_cache_refcount);
4204 return Qt;
4207 return Qnil;
4210 static void
4211 x_default_font_parameter (f, parms)
4212 struct frame *f;
4213 Lisp_Object parms;
4215 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
4216 Lisp_Object font_param = x_get_arg (dpyinfo, parms, Qfont, NULL, NULL,
4217 RES_TYPE_STRING);
4218 Lisp_Object font;
4219 if (EQ (font_param, Qunbound))
4220 font_param = Qnil;
4221 font = !NILP (font_param) ? font_param
4222 : x_get_arg (dpyinfo, parms, Qfont, "font", "Font", RES_TYPE_STRING);
4224 if (!STRINGP (font))
4226 int i;
4227 static char *names[]
4228 = { "Courier New-10",
4229 "-*-Courier-normal-r-*-*-13-*-*-*-c-*-iso8859-1",
4230 "-*-Fixedsys-normal-r-*-*-12-*-*-*-c-*-iso8859-1",
4231 "Fixedsys",
4232 NULL };
4234 for (i = 0; names[i]; i++)
4236 font = font_open_by_name (f, names[i]);
4237 if (! NILP (font))
4238 break;
4240 if (NILP (font))
4241 error ("No suitable font was found");
4243 else if (!NILP (font_param))
4245 /* Remember the explicit font parameter, so we can re-apply it after
4246 we've applied the `default' face settings. */
4247 x_set_frame_parameters (f, Fcons (Fcons (Qfont_param, font_param), Qnil));
4249 x_default_parameter (f, parms, Qfont, font, "font", "Font", RES_TYPE_STRING);
4252 DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
4253 1, 1, 0,
4254 doc: /* Make a new window, which is called a \"frame\" in Emacs terms.
4255 Return an Emacs frame object.
4256 PARAMETERS is an alist of frame parameters.
4257 If the parameters specify that the frame should not have a minibuffer,
4258 and do not specify a specific minibuffer window to use,
4259 then `default-minibuffer-frame' must be a frame whose minibuffer can
4260 be shared by the new frame.
4262 This function is an internal primitive--use `make-frame' instead. */)
4263 (parameters)
4264 Lisp_Object parameters;
4266 struct frame *f;
4267 Lisp_Object frame, tem;
4268 Lisp_Object name;
4269 int minibuffer_only = 0;
4270 long window_prompting = 0;
4271 int width, height;
4272 int count = SPECPDL_INDEX ();
4273 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
4274 Lisp_Object display;
4275 struct w32_display_info *dpyinfo = NULL;
4276 Lisp_Object parent;
4277 struct kboard *kb;
4279 /* Make copy of frame parameters because the original is in pure
4280 storage now. */
4281 parameters = Fcopy_alist (parameters);
4283 /* Use this general default value to start with
4284 until we know if this frame has a specified name. */
4285 Vx_resource_name = Vinvocation_name;
4287 display = x_get_arg (dpyinfo, parameters, Qterminal, 0, 0, RES_TYPE_NUMBER);
4288 if (EQ (display, Qunbound))
4289 display = x_get_arg (dpyinfo, parameters, Qdisplay, 0, 0, RES_TYPE_STRING);
4290 if (EQ (display, Qunbound))
4291 display = Qnil;
4292 dpyinfo = check_x_display_info (display);
4293 #ifdef MULTI_KBOARD
4294 kb = dpyinfo->terminal->kboard;
4295 #else
4296 kb = &the_only_kboard;
4297 #endif
4299 if (!dpyinfo->terminal->name)
4300 error ("Terminal is not live, can't create new frames on it");
4302 name = x_get_arg (dpyinfo, parameters, Qname, "name", "Name", RES_TYPE_STRING);
4303 if (!STRINGP (name)
4304 && ! EQ (name, Qunbound)
4305 && ! NILP (name))
4306 error ("Invalid frame name--not a string or nil");
4308 if (STRINGP (name))
4309 Vx_resource_name = name;
4311 /* See if parent window is specified. */
4312 parent = x_get_arg (dpyinfo, parameters, Qparent_id, NULL, NULL, RES_TYPE_NUMBER);
4313 if (EQ (parent, Qunbound))
4314 parent = Qnil;
4315 if (! NILP (parent))
4316 CHECK_NUMBER (parent);
4318 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
4319 /* No need to protect DISPLAY because that's not used after passing
4320 it to make_frame_without_minibuffer. */
4321 frame = Qnil;
4322 GCPRO4 (parameters, parent, name, frame);
4323 tem = x_get_arg (dpyinfo, parameters, Qminibuffer, "minibuffer", "Minibuffer",
4324 RES_TYPE_SYMBOL);
4325 if (EQ (tem, Qnone) || NILP (tem))
4326 f = make_frame_without_minibuffer (Qnil, kb, display);
4327 else if (EQ (tem, Qonly))
4329 f = make_minibuffer_frame ();
4330 minibuffer_only = 1;
4332 else if (WINDOWP (tem))
4333 f = make_frame_without_minibuffer (tem, kb, display);
4334 else
4335 f = make_frame (1);
4337 XSETFRAME (frame, f);
4339 /* Note that Windows does support scroll bars. */
4340 FRAME_CAN_HAVE_SCROLL_BARS (f) = 1;
4342 /* By default, make scrollbars the system standard width. */
4343 FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = GetSystemMetrics (SM_CXVSCROLL);
4345 f->terminal = dpyinfo->terminal;
4346 f->terminal->reference_count++;
4348 f->output_method = output_w32;
4349 f->output_data.w32 =
4350 (struct w32_output *) xmalloc (sizeof (struct w32_output));
4351 bzero (f->output_data.w32, sizeof (struct w32_output));
4352 FRAME_FONTSET (f) = -1;
4354 f->icon_name
4355 = x_get_arg (dpyinfo, parameters, Qicon_name, "iconName", "Title",
4356 RES_TYPE_STRING);
4357 if (! STRINGP (f->icon_name))
4358 f->icon_name = Qnil;
4360 /* FRAME_W32_DISPLAY_INFO (f) = dpyinfo; */
4362 /* With FRAME_X_DISPLAY_INFO set up, this unwind-protect is safe. */
4363 record_unwind_protect (unwind_create_frame, frame);
4364 #if GLYPH_DEBUG
4365 image_cache_refcount = FRAME_IMAGE_CACHE (f)->refcount;
4366 dpyinfo_refcount = dpyinfo->reference_count;
4367 #endif /* GLYPH_DEBUG */
4369 /* Specify the parent under which to make this window. */
4371 if (!NILP (parent))
4373 f->output_data.w32->parent_desc = (Window) XFASTINT (parent);
4374 f->output_data.w32->explicit_parent = 1;
4376 else
4378 f->output_data.w32->parent_desc = FRAME_W32_DISPLAY_INFO (f)->root_window;
4379 f->output_data.w32->explicit_parent = 0;
4382 /* Set the name; the functions to which we pass f expect the name to
4383 be set. */
4384 if (EQ (name, Qunbound) || NILP (name))
4386 f->name = build_string (dpyinfo->w32_id_name);
4387 f->explicit_name = 0;
4389 else
4391 f->name = name;
4392 f->explicit_name = 1;
4393 /* use the frame's title when getting resources for this frame. */
4394 specbind (Qx_resource_name, name);
4397 f->resx = dpyinfo->resx;
4398 f->resy = dpyinfo->resy;
4400 if (uniscribe_available)
4401 register_font_driver (&uniscribe_font_driver, f);
4402 register_font_driver (&w32font_driver, f);
4404 x_default_parameter (f, parameters, Qfont_backend, Qnil,
4405 "fontBackend", "FontBackend", RES_TYPE_STRING);
4406 /* Extract the window parameters from the supplied values
4407 that are needed to determine window geometry. */
4408 x_default_font_parameter (f, parameters);
4409 x_default_parameter (f, parameters, Qborder_width, make_number (2),
4410 "borderWidth", "BorderWidth", RES_TYPE_NUMBER);
4412 /* We recognize either internalBorderWidth or internalBorder
4413 (which is what xterm calls it). */
4414 if (NILP (Fassq (Qinternal_border_width, parameters)))
4416 Lisp_Object value;
4418 value = x_get_arg (dpyinfo, parameters, Qinternal_border_width,
4419 "internalBorder", "InternalBorder", RES_TYPE_NUMBER);
4420 if (! EQ (value, Qunbound))
4421 parameters = Fcons (Fcons (Qinternal_border_width, value),
4422 parameters);
4424 /* Default internalBorderWidth to 0 on Windows to match other programs. */
4425 x_default_parameter (f, parameters, Qinternal_border_width, make_number (0),
4426 "internalBorderWidth", "InternalBorder", RES_TYPE_NUMBER);
4427 x_default_parameter (f, parameters, Qvertical_scroll_bars, Qright,
4428 "verticalScrollBars", "ScrollBars", RES_TYPE_SYMBOL);
4430 /* Also do the stuff which must be set before the window exists. */
4431 x_default_parameter (f, parameters, Qforeground_color, build_string ("black"),
4432 "foreground", "Foreground", RES_TYPE_STRING);
4433 x_default_parameter (f, parameters, Qbackground_color, build_string ("white"),
4434 "background", "Background", RES_TYPE_STRING);
4435 x_default_parameter (f, parameters, Qmouse_color, build_string ("black"),
4436 "pointerColor", "Foreground", RES_TYPE_STRING);
4437 x_default_parameter (f, parameters, Qcursor_color, build_string ("black"),
4438 "cursorColor", "Foreground", RES_TYPE_STRING);
4439 x_default_parameter (f, parameters, Qborder_color, build_string ("black"),
4440 "borderColor", "BorderColor", RES_TYPE_STRING);
4441 x_default_parameter (f, parameters, Qscreen_gamma, Qnil,
4442 "screenGamma", "ScreenGamma", RES_TYPE_FLOAT);
4443 x_default_parameter (f, parameters, Qline_spacing, Qnil,
4444 "lineSpacing", "LineSpacing", RES_TYPE_NUMBER);
4445 x_default_parameter (f, parameters, Qleft_fringe, Qnil,
4446 "leftFringe", "LeftFringe", RES_TYPE_NUMBER);
4447 x_default_parameter (f, parameters, Qright_fringe, Qnil,
4448 "rightFringe", "RightFringe", RES_TYPE_NUMBER);
4451 /* Init faces before x_default_parameter is called for scroll-bar
4452 parameters because that function calls x_set_scroll_bar_width,
4453 which calls change_frame_size, which calls Fset_window_buffer,
4454 which runs hooks, which call Fvertical_motion. At the end, we
4455 end up in init_iterator with a null face cache, which should not
4456 happen. */
4457 init_frame_faces (f);
4459 x_default_parameter (f, parameters, Qmenu_bar_lines, make_number (1),
4460 "menuBar", "MenuBar", RES_TYPE_NUMBER);
4461 x_default_parameter (f, parameters, Qtool_bar_lines, make_number (1),
4462 "toolBar", "ToolBar", RES_TYPE_NUMBER);
4464 x_default_parameter (f, parameters, Qbuffer_predicate, Qnil,
4465 "bufferPredicate", "BufferPredicate", RES_TYPE_SYMBOL);
4466 x_default_parameter (f, parameters, Qtitle, Qnil,
4467 "title", "Title", RES_TYPE_STRING);
4468 x_default_parameter (f, parameters, Qfullscreen, Qnil,
4469 "fullscreen", "Fullscreen", RES_TYPE_SYMBOL);
4471 f->output_data.w32->dwStyle = WS_OVERLAPPEDWINDOW;
4472 f->output_data.w32->parent_desc = FRAME_W32_DISPLAY_INFO (f)->root_window;
4474 f->output_data.w32->text_cursor = w32_load_cursor (IDC_IBEAM);
4475 f->output_data.w32->nontext_cursor = w32_load_cursor (IDC_ARROW);
4476 f->output_data.w32->modeline_cursor = w32_load_cursor (IDC_ARROW);
4477 f->output_data.w32->hand_cursor = w32_load_cursor (IDC_HAND);
4478 f->output_data.w32->hourglass_cursor = w32_load_cursor (IDC_WAIT);
4479 f->output_data.w32->horizontal_drag_cursor = w32_load_cursor (IDC_SIZEWE);
4481 f->output_data.w32->current_cursor = f->output_data.w32->nontext_cursor;
4483 window_prompting = x_figure_window_size (f, parameters, 1);
4485 tem = x_get_arg (dpyinfo, parameters, Qunsplittable, 0, 0, RES_TYPE_BOOLEAN);
4486 f->no_split = minibuffer_only || EQ (tem, Qt);
4488 w32_window (f, window_prompting, minibuffer_only);
4489 x_icon (f, parameters);
4491 x_make_gc (f);
4493 /* Now consider the frame official. */
4494 FRAME_W32_DISPLAY_INFO (f)->reference_count++;
4495 Vframe_list = Fcons (frame, Vframe_list);
4497 /* We need to do this after creating the window, so that the
4498 icon-creation functions can say whose icon they're describing. */
4499 x_default_parameter (f, parameters, Qicon_type, Qnil,
4500 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL);
4502 x_default_parameter (f, parameters, Qauto_raise, Qnil,
4503 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN);
4504 x_default_parameter (f, parameters, Qauto_lower, Qnil,
4505 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN);
4506 x_default_parameter (f, parameters, Qcursor_type, Qbox,
4507 "cursorType", "CursorType", RES_TYPE_SYMBOL);
4508 x_default_parameter (f, parameters, Qscroll_bar_width, Qnil,
4509 "scrollBarWidth", "ScrollBarWidth", RES_TYPE_NUMBER);
4510 x_default_parameter (f, parameters, Qalpha, Qnil,
4511 "alpha", "Alpha", RES_TYPE_NUMBER);
4513 /* Dimensions, especially FRAME_LINES (f), must be done via change_frame_size.
4514 Change will not be effected unless different from the current
4515 FRAME_LINES (f). */
4516 width = FRAME_COLS (f);
4517 height = FRAME_LINES (f);
4519 FRAME_LINES (f) = 0;
4520 SET_FRAME_COLS (f, 0);
4521 change_frame_size (f, height, width, 1, 0, 0);
4523 /* Tell the server what size and position, etc, we want, and how
4524 badly we want them. This should be done after we have the menu
4525 bar so that its size can be taken into account. */
4526 BLOCK_INPUT;
4527 x_wm_set_size_hint (f, window_prompting, 0);
4528 UNBLOCK_INPUT;
4530 /* Make the window appear on the frame and enable display, unless
4531 the caller says not to. However, with explicit parent, Emacs
4532 cannot control visibility, so don't try. */
4533 if (! f->output_data.w32->explicit_parent)
4535 Lisp_Object visibility;
4537 visibility = x_get_arg (dpyinfo, parameters, Qvisibility, 0, 0, RES_TYPE_SYMBOL);
4538 if (EQ (visibility, Qunbound))
4539 visibility = Qt;
4541 if (EQ (visibility, Qicon))
4542 x_iconify_frame (f);
4543 else if (! NILP (visibility))
4544 x_make_frame_visible (f);
4545 else
4546 /* Must have been Qnil. */
4550 /* Initialize `default-minibuffer-frame' in case this is the first
4551 frame on this terminal. */
4552 if (FRAME_HAS_MINIBUF_P (f)
4553 && (!FRAMEP (kb->Vdefault_minibuffer_frame)
4554 || !FRAME_LIVE_P (XFRAME (kb->Vdefault_minibuffer_frame))))
4555 kb->Vdefault_minibuffer_frame = frame;
4557 /* All remaining specified parameters, which have not been "used"
4558 by x_get_arg and friends, now go in the misc. alist of the frame. */
4559 for (tem = parameters; CONSP (tem); tem = XCDR (tem))
4560 if (CONSP (XCAR (tem)) && !NILP (XCAR (XCAR (tem))))
4561 f->param_alist = Fcons (XCAR (tem), f->param_alist);
4563 UNGCPRO;
4565 /* Make sure windows on this frame appear in calls to next-window
4566 and similar functions. */
4567 Vwindow_list = Qnil;
4569 return unbind_to (count, frame);
4572 /* FRAME is used only to get a handle on the X display. We don't pass the
4573 display info directly because we're called from frame.c, which doesn't
4574 know about that structure. */
4575 Lisp_Object
4576 x_get_focus_frame (frame)
4577 struct frame *frame;
4579 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (frame);
4580 Lisp_Object xfocus;
4581 if (! dpyinfo->w32_focus_frame)
4582 return Qnil;
4584 XSETFRAME (xfocus, dpyinfo->w32_focus_frame);
4585 return xfocus;
4588 DEFUN ("x-focus-frame", Fx_focus_frame, Sx_focus_frame, 1, 1, 0,
4589 doc: /* Give FRAME input focus, raising to foreground if necessary. */)
4590 (frame)
4591 Lisp_Object frame;
4593 x_focus_on_frame (check_x_frame (frame));
4594 return Qnil;
4598 DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1, 2, 0,
4599 doc: /* Internal function called by `color-defined-p', which see. */)
4600 (color, frame)
4601 Lisp_Object color, frame;
4603 XColor foo;
4604 FRAME_PTR f = check_x_frame (frame);
4606 CHECK_STRING (color);
4608 if (w32_defined_color (f, SDATA (color), &foo, 0))
4609 return Qt;
4610 else
4611 return Qnil;
4614 DEFUN ("xw-color-values", Fxw_color_values, Sxw_color_values, 1, 2, 0,
4615 doc: /* Internal function called by `color-values', which see. */)
4616 (color, frame)
4617 Lisp_Object color, frame;
4619 XColor foo;
4620 FRAME_PTR f = check_x_frame (frame);
4622 CHECK_STRING (color);
4624 if (w32_defined_color (f, SDATA (color), &foo, 0))
4625 return list3 (make_number ((GetRValue (foo.pixel) << 8)
4626 | GetRValue (foo.pixel)),
4627 make_number ((GetGValue (foo.pixel) << 8)
4628 | GetGValue (foo.pixel)),
4629 make_number ((GetBValue (foo.pixel) << 8)
4630 | GetBValue (foo.pixel)));
4631 else
4632 return Qnil;
4635 DEFUN ("xw-display-color-p", Fxw_display_color_p, Sxw_display_color_p, 0, 1, 0,
4636 doc: /* Internal function called by `display-color-p', which see. */)
4637 (display)
4638 Lisp_Object display;
4640 struct w32_display_info *dpyinfo = check_x_display_info (display);
4642 if ((dpyinfo->n_planes * dpyinfo->n_cbits) <= 2)
4643 return Qnil;
4645 return Qt;
4648 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p,
4649 Sx_display_grayscale_p, 0, 1, 0,
4650 doc: /* Return t if DISPLAY supports shades of gray.
4651 Note that color displays do support shades of gray.
4652 The optional argument DISPLAY specifies which display to ask about.
4653 DISPLAY should be either a frame or a display name (a string).
4654 If omitted or nil, that stands for the selected frame's display. */)
4655 (display)
4656 Lisp_Object display;
4658 struct w32_display_info *dpyinfo = check_x_display_info (display);
4660 if ((dpyinfo->n_planes * dpyinfo->n_cbits) <= 1)
4661 return Qnil;
4663 return Qt;
4666 DEFUN ("x-display-pixel-width", Fx_display_pixel_width,
4667 Sx_display_pixel_width, 0, 1, 0,
4668 doc: /* Return the width in pixels of DISPLAY.
4669 The optional argument DISPLAY specifies which display to ask about.
4670 DISPLAY should be either a frame or a display name (a string).
4671 If omitted or nil, that stands for the selected frame's display. */)
4672 (display)
4673 Lisp_Object display;
4675 struct w32_display_info *dpyinfo = check_x_display_info (display);
4677 return make_number (dpyinfo->width);
4680 DEFUN ("x-display-pixel-height", Fx_display_pixel_height,
4681 Sx_display_pixel_height, 0, 1, 0,
4682 doc: /* Return the height in pixels of DISPLAY.
4683 The optional argument DISPLAY specifies which display to ask about.
4684 DISPLAY should be either a frame or a display name (a string).
4685 If omitted or nil, that stands for the selected frame's display. */)
4686 (display)
4687 Lisp_Object display;
4689 struct w32_display_info *dpyinfo = check_x_display_info (display);
4691 return make_number (dpyinfo->height);
4694 DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes,
4695 0, 1, 0,
4696 doc: /* Return the number of bitplanes of DISPLAY.
4697 The optional argument DISPLAY specifies which display to ask about.
4698 DISPLAY should be either a frame or a display name (a string).
4699 If omitted or nil, that stands for the selected frame's display. */)
4700 (display)
4701 Lisp_Object display;
4703 struct w32_display_info *dpyinfo = check_x_display_info (display);
4705 return make_number (dpyinfo->n_planes * dpyinfo->n_cbits);
4708 DEFUN ("x-display-color-cells", Fx_display_color_cells, Sx_display_color_cells,
4709 0, 1, 0,
4710 doc: /* Return the number of color cells of DISPLAY.
4711 The optional argument DISPLAY specifies which display to ask about.
4712 DISPLAY should be either a frame or a display name (a string).
4713 If omitted or nil, that stands for the selected frame's display. */)
4714 (display)
4715 Lisp_Object display;
4717 struct w32_display_info *dpyinfo = check_x_display_info (display);
4718 HDC hdc;
4719 int cap;
4721 hdc = GetDC (dpyinfo->root_window);
4722 if (dpyinfo->has_palette)
4723 cap = GetDeviceCaps (hdc, SIZEPALETTE);
4724 else
4725 cap = GetDeviceCaps (hdc, NUMCOLORS);
4727 /* We force 24+ bit depths to 24-bit, both to prevent an overflow
4728 and because probably is more meaningful on Windows anyway */
4729 if (cap < 0)
4730 cap = 1 << min (dpyinfo->n_planes * dpyinfo->n_cbits, 24);
4732 ReleaseDC (dpyinfo->root_window, hdc);
4734 return make_number (cap);
4737 DEFUN ("x-server-max-request-size", Fx_server_max_request_size,
4738 Sx_server_max_request_size,
4739 0, 1, 0,
4740 doc: /* Return the maximum request size of the server of DISPLAY.
4741 The optional argument DISPLAY specifies which display to ask about.
4742 DISPLAY should be either a frame or a display name (a string).
4743 If omitted or nil, that stands for the selected frame's display. */)
4744 (display)
4745 Lisp_Object display;
4747 struct w32_display_info *dpyinfo = check_x_display_info (display);
4749 return make_number (1);
4752 DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0,
4753 doc: /* Return the "vendor ID" string of the W32 system (Microsoft).
4754 The optional argument DISPLAY specifies which display to ask about.
4755 DISPLAY should be either a frame or a display name (a string).
4756 If omitted or nil, that stands for the selected frame's display. */)
4757 (display)
4758 Lisp_Object display;
4760 return build_string ("Microsoft Corp.");
4763 DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0,
4764 doc: /* Return the version numbers of the server of DISPLAY.
4765 The value is a list of three integers: the major and minor
4766 version numbers of the X Protocol in use, and the distributor-specific
4767 release number. See also the function `x-server-vendor'.
4769 The optional argument DISPLAY specifies which display to ask about.
4770 DISPLAY should be either a frame or a display name (a string).
4771 If omitted or nil, that stands for the selected frame's display. */)
4772 (display)
4773 Lisp_Object display;
4775 return Fcons (make_number (w32_major_version),
4776 Fcons (make_number (w32_minor_version),
4777 Fcons (make_number (w32_build_number), Qnil)));
4780 DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0,
4781 doc: /* Return the number of screens on the server of DISPLAY.
4782 The optional argument DISPLAY specifies which display to ask about.
4783 DISPLAY should be either a frame or a display name (a string).
4784 If omitted or nil, that stands for the selected frame's display. */)
4785 (display)
4786 Lisp_Object display;
4788 return make_number (1);
4791 DEFUN ("x-display-mm-height", Fx_display_mm_height,
4792 Sx_display_mm_height, 0, 1, 0,
4793 doc: /* Return the height in millimeters of DISPLAY.
4794 The optional argument DISPLAY specifies which display to ask about.
4795 DISPLAY should be either a frame or a display name (a string).
4796 If omitted or nil, that stands for the selected frame's display. */)
4797 (display)
4798 Lisp_Object display;
4800 struct w32_display_info *dpyinfo = check_x_display_info (display);
4801 HDC hdc;
4802 int cap;
4804 hdc = GetDC (dpyinfo->root_window);
4806 cap = GetDeviceCaps (hdc, VERTSIZE);
4808 ReleaseDC (dpyinfo->root_window, hdc);
4810 return make_number (cap);
4813 DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0,
4814 doc: /* Return the width in millimeters of DISPLAY.
4815 The optional argument DISPLAY specifies which display to ask about.
4816 DISPLAY should be either a frame or a display name (a string).
4817 If omitted or nil, that stands for the selected frame's display. */)
4818 (display)
4819 Lisp_Object display;
4821 struct w32_display_info *dpyinfo = check_x_display_info (display);
4823 HDC hdc;
4824 int cap;
4826 hdc = GetDC (dpyinfo->root_window);
4828 cap = GetDeviceCaps (hdc, HORZSIZE);
4830 ReleaseDC (dpyinfo->root_window, hdc);
4832 return make_number (cap);
4835 DEFUN ("x-display-backing-store", Fx_display_backing_store,
4836 Sx_display_backing_store, 0, 1, 0,
4837 doc: /* Return an indication of whether DISPLAY does backing store.
4838 The value may be `always', `when-mapped', or `not-useful'.
4839 The optional argument DISPLAY specifies which display to ask about.
4840 DISPLAY should be either a frame or a display name (a string).
4841 If omitted or nil, that stands for the selected frame's display. */)
4842 (display)
4843 Lisp_Object display;
4845 return intern ("not-useful");
4848 DEFUN ("x-display-visual-class", Fx_display_visual_class,
4849 Sx_display_visual_class, 0, 1, 0,
4850 doc: /* Return the visual class of DISPLAY.
4851 The value is one of the symbols `static-gray', `gray-scale',
4852 `static-color', `pseudo-color', `true-color', or `direct-color'.
4854 The optional argument DISPLAY specifies which display to ask about.
4855 DISPLAY should be either a frame or a display name (a string).
4856 If omitted or nil, that stands for the selected frame's display. */)
4857 (display)
4858 Lisp_Object display;
4860 struct w32_display_info *dpyinfo = check_x_display_info (display);
4861 Lisp_Object result = Qnil;
4863 if (dpyinfo->has_palette)
4864 result = intern ("pseudo-color");
4865 else if (dpyinfo->n_planes * dpyinfo->n_cbits == 1)
4866 result = intern ("static-grey");
4867 else if (dpyinfo->n_planes * dpyinfo->n_cbits == 4)
4868 result = intern ("static-color");
4869 else if (dpyinfo->n_planes * dpyinfo->n_cbits > 8)
4870 result = intern ("true-color");
4872 return result;
4875 DEFUN ("x-display-save-under", Fx_display_save_under,
4876 Sx_display_save_under, 0, 1, 0,
4877 doc: /* Return t if DISPLAY supports the save-under feature.
4878 The optional argument DISPLAY specifies which display to ask about.
4879 DISPLAY should be either a frame or a display name (a string).
4880 If omitted or nil, that stands for the selected frame's display. */)
4881 (display)
4882 Lisp_Object display;
4884 return Qnil;
4888 x_pixel_width (f)
4889 register struct frame *f;
4891 return FRAME_PIXEL_WIDTH (f);
4895 x_pixel_height (f)
4896 register struct frame *f;
4898 return FRAME_PIXEL_HEIGHT (f);
4902 x_char_width (f)
4903 register struct frame *f;
4905 return FRAME_COLUMN_WIDTH (f);
4909 x_char_height (f)
4910 register struct frame *f;
4912 return FRAME_LINE_HEIGHT (f);
4916 x_screen_planes (f)
4917 register struct frame *f;
4919 return FRAME_W32_DISPLAY_INFO (f)->n_planes;
4922 /* Return the display structure for the display named NAME.
4923 Open a new connection if necessary. */
4925 struct w32_display_info *
4926 x_display_info_for_name (name)
4927 Lisp_Object name;
4929 Lisp_Object names;
4930 struct w32_display_info *dpyinfo;
4932 CHECK_STRING (name);
4934 for (dpyinfo = &one_w32_display_info, names = w32_display_name_list;
4935 dpyinfo;
4936 dpyinfo = dpyinfo->next, names = XCDR (names))
4938 Lisp_Object tem;
4939 tem = Fstring_equal (XCAR (XCAR (names)), name);
4940 if (!NILP (tem))
4941 return dpyinfo;
4944 /* Use this general default value to start with. */
4945 Vx_resource_name = Vinvocation_name;
4947 validate_x_resource_name ();
4949 dpyinfo = w32_term_init (name, (unsigned char *)0,
4950 (char *) SDATA (Vx_resource_name));
4952 if (dpyinfo == 0)
4953 error ("Cannot connect to server %s", SDATA (name));
4955 w32_in_use = 1;
4956 XSETFASTINT (Vwindow_system_version, 3);
4958 return dpyinfo;
4961 DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
4962 1, 3, 0, doc: /* Open a connection to a server.
4963 DISPLAY is the name of the display to connect to.
4964 Optional second arg XRM-STRING is a string of resources in xrdb format.
4965 If the optional third arg MUST-SUCCEED is non-nil,
4966 terminate Emacs if we can't open the connection. */)
4967 (display, xrm_string, must_succeed)
4968 Lisp_Object display, xrm_string, must_succeed;
4970 unsigned char *xrm_option;
4971 struct w32_display_info *dpyinfo;
4973 /* If initialization has already been done, return now to avoid
4974 overwriting critical parts of one_w32_display_info. */
4975 if (w32_in_use)
4976 return Qnil;
4978 CHECK_STRING (display);
4979 if (! NILP (xrm_string))
4980 CHECK_STRING (xrm_string);
4982 #if 0
4983 if (! EQ (Vwindow_system, intern ("w32")))
4984 error ("Not using Microsoft Windows");
4985 #endif
4987 /* Allow color mapping to be defined externally; first look in user's
4988 HOME directory, then in Emacs etc dir for a file called rgb.txt. */
4990 Lisp_Object color_file;
4991 struct gcpro gcpro1;
4993 color_file = build_string ("~/rgb.txt");
4995 GCPRO1 (color_file);
4997 if (NILP (Ffile_readable_p (color_file)))
4998 color_file =
4999 Fexpand_file_name (build_string ("rgb.txt"),
5000 Fsymbol_value (intern ("data-directory")));
5002 Vw32_color_map = Fw32_load_color_file (color_file);
5004 UNGCPRO;
5006 if (NILP (Vw32_color_map))
5007 Vw32_color_map = Fw32_default_color_map ();
5009 /* Merge in system logical colors. */
5010 add_system_logical_colors_to_map (&Vw32_color_map);
5012 if (! NILP (xrm_string))
5013 xrm_option = (unsigned char *) SDATA (xrm_string);
5014 else
5015 xrm_option = (unsigned char *) 0;
5017 /* Use this general default value to start with. */
5018 /* First remove .exe suffix from invocation-name - it looks ugly. */
5020 char basename[ MAX_PATH ], *str;
5022 strcpy (basename, SDATA (Vinvocation_name));
5023 str = strrchr (basename, '.');
5024 if (str) *str = 0;
5025 Vinvocation_name = build_string (basename);
5027 Vx_resource_name = Vinvocation_name;
5029 validate_x_resource_name ();
5031 /* This is what opens the connection and sets x_current_display.
5032 This also initializes many symbols, such as those used for input. */
5033 dpyinfo = w32_term_init (display, xrm_option,
5034 (char *) SDATA (Vx_resource_name));
5036 if (dpyinfo == 0)
5038 if (!NILP (must_succeed))
5039 fatal ("Cannot connect to server %s.\n",
5040 SDATA (display));
5041 else
5042 error ("Cannot connect to server %s", SDATA (display));
5045 w32_in_use = 1;
5047 XSETFASTINT (Vwindow_system_version, 3);
5048 return Qnil;
5051 DEFUN ("x-close-connection", Fx_close_connection,
5052 Sx_close_connection, 1, 1, 0,
5053 doc: /* Close the connection to DISPLAY's server.
5054 For DISPLAY, specify either a frame or a display name (a string).
5055 If DISPLAY is nil, that stands for the selected frame's display. */)
5056 (display)
5057 Lisp_Object display;
5059 struct w32_display_info *dpyinfo = check_x_display_info (display);
5060 int i;
5062 if (dpyinfo->reference_count > 0)
5063 error ("Display still has frames on it");
5065 BLOCK_INPUT;
5066 x_destroy_all_bitmaps (dpyinfo);
5068 x_delete_display (dpyinfo);
5069 UNBLOCK_INPUT;
5071 return Qnil;
5074 DEFUN ("x-display-list", Fx_display_list, Sx_display_list, 0, 0, 0,
5075 doc: /* Return the list of display names that Emacs has connections to. */)
5078 Lisp_Object tail, result;
5080 result = Qnil;
5081 for (tail = w32_display_name_list; CONSP (tail); tail = XCDR (tail))
5082 result = Fcons (XCAR (XCAR (tail)), result);
5084 return result;
5087 DEFUN ("x-synchronize", Fx_synchronize, Sx_synchronize, 1, 2, 0,
5088 doc: /* This is a noop on W32 systems. */)
5089 (on, display)
5090 Lisp_Object display, on;
5092 return Qnil;
5097 /***********************************************************************
5098 Window properties
5099 ***********************************************************************/
5101 DEFUN ("x-change-window-property", Fx_change_window_property,
5102 Sx_change_window_property, 2, 6, 0,
5103 doc: /* Change window property PROP to VALUE on the X window of FRAME.
5104 VALUE may be a string or a list of conses, numbers and/or strings.
5105 If an element in the list is a string, it is converted to
5106 an Atom and the value of the Atom is used. If an element is a cons,
5107 it is converted to a 32 bit number where the car is the 16 top bits and the
5108 cdr is the lower 16 bits.
5109 FRAME nil or omitted means use the selected frame.
5110 If TYPE is given and non-nil, it is the name of the type of VALUE.
5111 If TYPE is not given or nil, the type is STRING.
5112 FORMAT gives the size in bits of each element if VALUE is a list.
5113 It must be one of 8, 16 or 32.
5114 If VALUE is a string or FORMAT is nil or not given, FORMAT defaults to 8.
5115 If OUTER_P is non-nil, the property is changed for the outer X window of
5116 FRAME. Default is to change on the edit X window.
5118 Value is VALUE. */)
5119 (prop, value, frame, type, format, outer_p)
5120 Lisp_Object prop, value, frame, type, format, outer_p;
5122 #if 0 /* TODO : port window properties to W32 */
5123 struct frame *f = check_x_frame (frame);
5124 Atom prop_atom;
5126 CHECK_STRING (prop);
5127 CHECK_STRING (value);
5129 BLOCK_INPUT;
5130 prop_atom = XInternAtom (FRAME_W32_DISPLAY (f), SDATA (prop), False);
5131 XChangeProperty (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f),
5132 prop_atom, XA_STRING, 8, PropModeReplace,
5133 SDATA (value), SCHARS (value));
5135 /* Make sure the property is set when we return. */
5136 XFlush (FRAME_W32_DISPLAY (f));
5137 UNBLOCK_INPUT;
5139 #endif /* TODO */
5141 return value;
5145 DEFUN ("x-delete-window-property", Fx_delete_window_property,
5146 Sx_delete_window_property, 1, 2, 0,
5147 doc: /* Remove window property PROP from X window of FRAME.
5148 FRAME nil or omitted means use the selected frame. Value is PROP. */)
5149 (prop, frame)
5150 Lisp_Object prop, frame;
5152 #if 0 /* TODO : port window properties to W32 */
5154 struct frame *f = check_x_frame (frame);
5155 Atom prop_atom;
5157 CHECK_STRING (prop);
5158 BLOCK_INPUT;
5159 prop_atom = XInternAtom (FRAME_W32_DISPLAY (f), SDATA (prop), False);
5160 XDeleteProperty (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f), prop_atom);
5162 /* Make sure the property is removed when we return. */
5163 XFlush (FRAME_W32_DISPLAY (f));
5164 UNBLOCK_INPUT;
5165 #endif /* TODO */
5167 return prop;
5171 DEFUN ("x-window-property", Fx_window_property, Sx_window_property,
5172 1, 2, 0,
5173 doc: /* Value is the value of window property PROP on FRAME.
5174 If FRAME is nil or omitted, use the selected frame. Value is nil
5175 if FRAME hasn't a property with name PROP or if PROP has no string
5176 value. */)
5177 (prop, frame)
5178 Lisp_Object prop, frame;
5180 #if 0 /* TODO : port window properties to W32 */
5182 struct frame *f = check_x_frame (frame);
5183 Atom prop_atom;
5184 int rc;
5185 Lisp_Object prop_value = Qnil;
5186 char *tmp_data = NULL;
5187 Atom actual_type;
5188 int actual_format;
5189 unsigned long actual_size, bytes_remaining;
5191 CHECK_STRING (prop);
5192 BLOCK_INPUT;
5193 prop_atom = XInternAtom (FRAME_W32_DISPLAY (f), SDATA (prop), False);
5194 rc = XGetWindowProperty (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f),
5195 prop_atom, 0, 0, False, XA_STRING,
5196 &actual_type, &actual_format, &actual_size,
5197 &bytes_remaining, (unsigned char **) &tmp_data);
5198 if (rc == Success)
5200 int size = bytes_remaining;
5202 XFree (tmp_data);
5203 tmp_data = NULL;
5205 rc = XGetWindowProperty (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f),
5206 prop_atom, 0, bytes_remaining,
5207 False, XA_STRING,
5208 &actual_type, &actual_format,
5209 &actual_size, &bytes_remaining,
5210 (unsigned char **) &tmp_data);
5211 if (rc == Success)
5212 prop_value = make_string (tmp_data, size);
5214 XFree (tmp_data);
5217 UNBLOCK_INPUT;
5219 return prop_value;
5221 #endif /* TODO */
5222 return Qnil;
5227 /***********************************************************************
5228 Busy cursor
5229 ***********************************************************************/
5231 /* Default number of seconds to wait before displaying an hourglass
5232 cursor. Duplicated from xdisp.c, but cannot use the version there
5233 due to lack of atimers on w32. */
5234 #define DEFAULT_HOURGLASS_DELAY 1
5235 extern Lisp_Object Vhourglass_delay;
5237 /* Return non-zero if houglass timer has been started or hourglass is shown. */
5238 /* PENDING: if W32 can use atimers (atimer.[hc]) then the common impl in
5239 xdisp.c could be used. */
5242 hourglass_started ()
5244 return hourglass_shown_p || hourglass_timer;
5247 /* Cancel a currently active hourglass timer, and start a new one. */
5249 void
5250 start_hourglass ()
5252 DWORD delay;
5253 int secs, msecs = 0;
5254 struct frame * f = SELECTED_FRAME ();
5256 /* No cursors on non GUI frames. */
5257 if (!FRAME_W32_P (f))
5258 return;
5260 cancel_hourglass ();
5262 if (INTEGERP (Vhourglass_delay)
5263 && XINT (Vhourglass_delay) > 0)
5264 secs = XFASTINT (Vhourglass_delay);
5265 else if (FLOATP (Vhourglass_delay)
5266 && XFLOAT_DATA (Vhourglass_delay) > 0)
5268 Lisp_Object tem;
5269 tem = Ftruncate (Vhourglass_delay, Qnil);
5270 secs = XFASTINT (tem);
5271 msecs = (XFLOAT_DATA (Vhourglass_delay) - secs) * 1000;
5273 else
5274 secs = DEFAULT_HOURGLASS_DELAY;
5276 delay = secs * 1000 + msecs;
5277 hourglass_hwnd = FRAME_W32_WINDOW (f);
5278 hourglass_timer = SetTimer (hourglass_hwnd, HOURGLASS_ID, delay, NULL);
5282 /* Cancel the hourglass cursor timer if active, hide an hourglass
5283 cursor if shown. */
5285 void
5286 cancel_hourglass ()
5288 if (hourglass_timer)
5290 KillTimer (hourglass_hwnd, hourglass_timer);
5291 hourglass_timer = 0;
5294 if (hourglass_shown_p)
5295 w32_hide_hourglass ();
5299 /* Timer function of hourglass_timer.
5301 Display an hourglass cursor. Set the hourglass_p flag in display info
5302 to indicate that an hourglass cursor is shown. */
5304 static void
5305 w32_show_hourglass (f)
5306 struct frame *f;
5308 if (!hourglass_shown_p)
5310 f->output_data.w32->hourglass_p = 1;
5311 if (!menubar_in_use && !current_popup_menu)
5312 SetCursor (f->output_data.w32->hourglass_cursor);
5313 hourglass_shown_p = 1;
5318 /* Hide the hourglass cursor on all frames, if it is currently shown. */
5320 static void
5321 w32_hide_hourglass ()
5323 if (hourglass_shown_p)
5325 struct frame *f = x_window_to_frame (&one_w32_display_info,
5326 hourglass_hwnd);
5328 f->output_data.w32->hourglass_p = 0;
5329 SetCursor (f->output_data.w32->current_cursor);
5330 hourglass_shown_p = 0;
5336 /***********************************************************************
5337 Tool tips
5338 ***********************************************************************/
5340 static Lisp_Object x_create_tip_frame P_ ((struct w32_display_info *,
5341 Lisp_Object, Lisp_Object));
5342 static void compute_tip_xy P_ ((struct frame *, Lisp_Object, Lisp_Object,
5343 Lisp_Object, int, int, int *, int *));
5345 /* The frame of a currently visible tooltip. */
5347 Lisp_Object tip_frame;
5349 /* If non-nil, a timer started that hides the last tooltip when it
5350 fires. */
5352 Lisp_Object tip_timer;
5353 Window tip_window;
5355 /* If non-nil, a vector of 3 elements containing the last args
5356 with which x-show-tip was called. See there. */
5358 Lisp_Object last_show_tip_args;
5360 /* Maximum size for tooltips; a cons (COLUMNS . ROWS). */
5362 Lisp_Object Vx_max_tooltip_size;
5365 static Lisp_Object
5366 unwind_create_tip_frame (frame)
5367 Lisp_Object frame;
5369 Lisp_Object deleted;
5371 deleted = unwind_create_frame (frame);
5372 if (EQ (deleted, Qt))
5374 tip_window = NULL;
5375 tip_frame = Qnil;
5378 return deleted;
5382 /* Create a frame for a tooltip on the display described by DPYINFO.
5383 PARMS is a list of frame parameters. TEXT is the string to
5384 display in the tip frame. Value is the frame.
5386 Note that functions called here, esp. x_default_parameter can
5387 signal errors, for instance when a specified color name is
5388 undefined. We have to make sure that we're in a consistent state
5389 when this happens. */
5391 static Lisp_Object
5392 x_create_tip_frame (dpyinfo, parms, text)
5393 struct w32_display_info *dpyinfo;
5394 Lisp_Object parms, text;
5396 struct frame *f;
5397 Lisp_Object frame, tem;
5398 Lisp_Object name;
5399 long window_prompting = 0;
5400 int width, height;
5401 int count = SPECPDL_INDEX ();
5402 struct gcpro gcpro1, gcpro2, gcpro3;
5403 struct kboard *kb;
5404 int face_change_count_before = face_change_count;
5405 Lisp_Object buffer;
5406 struct buffer *old_buffer;
5408 check_w32 ();
5410 /* Use this general default value to start with until we know if
5411 this frame has a specified name. */
5412 Vx_resource_name = Vinvocation_name;
5414 #ifdef MULTI_KBOARD
5415 kb = dpyinfo->terminal->kboard;
5416 #else
5417 kb = &the_only_kboard;
5418 #endif
5420 /* Get the name of the frame to use for resource lookup. */
5421 name = x_get_arg (dpyinfo, parms, Qname, "name", "Name", RES_TYPE_STRING);
5422 if (!STRINGP (name)
5423 && !EQ (name, Qunbound)
5424 && !NILP (name))
5425 error ("Invalid frame name--not a string or nil");
5426 Vx_resource_name = name;
5428 frame = Qnil;
5429 GCPRO3 (parms, name, frame);
5430 /* Make a frame without minibuffer nor mode-line. */
5431 f = make_frame (0);
5432 f->wants_modeline = 0;
5433 XSETFRAME (frame, f);
5435 buffer = Fget_buffer_create (build_string (" *tip*"));
5436 Fset_window_buffer (FRAME_ROOT_WINDOW (f), buffer, Qnil);
5437 old_buffer = current_buffer;
5438 set_buffer_internal_1 (XBUFFER (buffer));
5439 current_buffer->truncate_lines = Qnil;
5440 specbind (Qinhibit_read_only, Qt);
5441 specbind (Qinhibit_modification_hooks, Qt);
5442 Ferase_buffer ();
5443 Finsert (1, &text);
5444 set_buffer_internal_1 (old_buffer);
5446 FRAME_CAN_HAVE_SCROLL_BARS (f) = 0;
5447 record_unwind_protect (unwind_create_tip_frame, frame);
5449 /* By setting the output method, we're essentially saying that
5450 the frame is live, as per FRAME_LIVE_P. If we get a signal
5451 from this point on, x_destroy_window might screw up reference
5452 counts etc. */
5453 f->terminal = dpyinfo->terminal;
5454 f->terminal->reference_count++;
5455 f->output_method = output_w32;
5456 f->output_data.w32 =
5457 (struct w32_output *) xmalloc (sizeof (struct w32_output));
5458 bzero (f->output_data.w32, sizeof (struct w32_output));
5460 FRAME_FONTSET (f) = -1;
5461 f->icon_name = Qnil;
5463 #if 0 /* GLYPH_DEBUG TODO: image support. */
5464 image_cache_refcount = FRAME_IMAGE_CACHE (f)->refcount;
5465 dpyinfo_refcount = dpyinfo->reference_count;
5466 #endif /* GLYPH_DEBUG */
5467 #ifdef MULTI_KBOARD
5468 FRAME_KBOARD (f) = kb;
5469 #endif
5470 f->output_data.w32->parent_desc = FRAME_W32_DISPLAY_INFO (f)->root_window;
5471 f->output_data.w32->explicit_parent = 0;
5473 /* Set the name; the functions to which we pass f expect the name to
5474 be set. */
5475 if (EQ (name, Qunbound) || NILP (name))
5477 f->name = build_string (dpyinfo->w32_id_name);
5478 f->explicit_name = 0;
5480 else
5482 f->name = name;
5483 f->explicit_name = 1;
5484 /* use the frame's title when getting resources for this frame. */
5485 specbind (Qx_resource_name, name);
5488 f->resx = dpyinfo->resx;
5489 f->resy = dpyinfo->resy;
5491 /* Perhaps, we must allow frame parameter, say `font-backend',
5492 to specify which font backends to use. */
5493 register_font_driver (&w32font_driver, f);
5495 x_default_parameter (f, parms, Qfont_backend, Qnil,
5496 "fontBackend", "FontBackend", RES_TYPE_STRING);
5498 /* Extract the window parameters from the supplied values
5499 that are needed to determine window geometry. */
5500 x_default_font_parameter (f, parms);
5502 x_default_parameter (f, parms, Qborder_width, make_number (2),
5503 "borderWidth", "BorderWidth", RES_TYPE_NUMBER);
5504 /* This defaults to 2 in order to match xterm. We recognize either
5505 internalBorderWidth or internalBorder (which is what xterm calls
5506 it). */
5507 if (NILP (Fassq (Qinternal_border_width, parms)))
5509 Lisp_Object value;
5511 value = x_get_arg (dpyinfo, parms, Qinternal_border_width,
5512 "internalBorder", "internalBorder", RES_TYPE_NUMBER);
5513 if (! EQ (value, Qunbound))
5514 parms = Fcons (Fcons (Qinternal_border_width, value),
5515 parms);
5517 x_default_parameter (f, parms, Qinternal_border_width, make_number (1),
5518 "internalBorderWidth", "internalBorderWidth",
5519 RES_TYPE_NUMBER);
5521 /* Also do the stuff which must be set before the window exists. */
5522 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
5523 "foreground", "Foreground", RES_TYPE_STRING);
5524 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
5525 "background", "Background", RES_TYPE_STRING);
5526 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
5527 "pointerColor", "Foreground", RES_TYPE_STRING);
5528 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
5529 "cursorColor", "Foreground", RES_TYPE_STRING);
5530 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
5531 "borderColor", "BorderColor", RES_TYPE_STRING);
5533 /* Init faces before x_default_parameter is called for scroll-bar
5534 parameters because that function calls x_set_scroll_bar_width,
5535 which calls change_frame_size, which calls Fset_window_buffer,
5536 which runs hooks, which call Fvertical_motion. At the end, we
5537 end up in init_iterator with a null face cache, which should not
5538 happen. */
5539 init_frame_faces (f);
5541 f->output_data.w32->dwStyle = WS_BORDER | WS_POPUP | WS_DISABLED;
5542 f->output_data.w32->parent_desc = FRAME_W32_DISPLAY_INFO (f)->root_window;
5544 window_prompting = x_figure_window_size (f, parms, 0);
5546 /* No fringes on tip frame. */
5547 f->fringe_cols = 0;
5548 f->left_fringe_width = 0;
5549 f->right_fringe_width = 0;
5551 BLOCK_INPUT;
5552 my_create_tip_window (f);
5553 UNBLOCK_INPUT;
5555 x_make_gc (f);
5557 x_default_parameter (f, parms, Qauto_raise, Qnil,
5558 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN);
5559 x_default_parameter (f, parms, Qauto_lower, Qnil,
5560 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN);
5561 x_default_parameter (f, parms, Qcursor_type, Qbox,
5562 "cursorType", "CursorType", RES_TYPE_SYMBOL);
5564 /* Dimensions, especially FRAME_LINES (f), must be done via change_frame_size.
5565 Change will not be effected unless different from the current
5566 FRAME_LINES (f). */
5567 width = FRAME_COLS (f);
5568 height = FRAME_LINES (f);
5569 FRAME_LINES (f) = 0;
5570 SET_FRAME_COLS (f, 0);
5571 change_frame_size (f, height, width, 1, 0, 0);
5573 /* Add `tooltip' frame parameter's default value. */
5574 if (NILP (Fframe_parameter (frame, intern ("tooltip"))))
5575 Fmodify_frame_parameters (frame, Fcons (Fcons (intern ("tooltip"), Qt),
5576 Qnil));
5578 /* Set up faces after all frame parameters are known. This call
5579 also merges in face attributes specified for new frames.
5581 Frame parameters may be changed if .Xdefaults contains
5582 specifications for the default font. For example, if there is an
5583 `Emacs.default.attributeBackground: pink', the `background-color'
5584 attribute of the frame get's set, which let's the internal border
5585 of the tooltip frame appear in pink. Prevent this. */
5587 Lisp_Object bg = Fframe_parameter (frame, Qbackground_color);
5589 /* Set tip_frame here, so that */
5590 tip_frame = frame;
5591 call2 (Qface_set_after_frame_default, frame, Qnil);
5593 if (!EQ (bg, Fframe_parameter (frame, Qbackground_color)))
5594 Fmodify_frame_parameters (frame, Fcons (Fcons (Qbackground_color, bg),
5595 Qnil));
5598 f->no_split = 1;
5600 UNGCPRO;
5602 /* It is now ok to make the frame official even if we get an error
5603 below. And the frame needs to be on Vframe_list or making it
5604 visible won't work. */
5605 Vframe_list = Fcons (frame, Vframe_list);
5607 /* Now that the frame is official, it counts as a reference to
5608 its display. */
5609 FRAME_W32_DISPLAY_INFO (f)->reference_count++;
5611 /* Setting attributes of faces of the tooltip frame from resources
5612 and similar will increment face_change_count, which leads to the
5613 clearing of all current matrices. Since this isn't necessary
5614 here, avoid it by resetting face_change_count to the value it
5615 had before we created the tip frame. */
5616 face_change_count = face_change_count_before;
5618 /* Discard the unwind_protect. */
5619 return unbind_to (count, frame);
5623 /* Compute where to display tip frame F. PARMS is the list of frame
5624 parameters for F. DX and DY are specified offsets from the current
5625 location of the mouse. WIDTH and HEIGHT are the width and height
5626 of the tooltip. Return coordinates relative to the root window of
5627 the display in *ROOT_X, and *ROOT_Y. */
5629 static void
5630 compute_tip_xy (f, parms, dx, dy, width, height, root_x, root_y)
5631 struct frame *f;
5632 Lisp_Object parms, dx, dy;
5633 int width, height;
5634 int *root_x, *root_y;
5636 Lisp_Object left, top;
5637 int min_x, min_y, max_x, max_y;
5639 /* User-specified position? */
5640 left = Fcdr (Fassq (Qleft, parms));
5641 top = Fcdr (Fassq (Qtop, parms));
5643 /* Move the tooltip window where the mouse pointer is. Resize and
5644 show it. */
5645 if (!INTEGERP (left) || !INTEGERP (top))
5647 POINT pt;
5649 /* Default min and max values. */
5650 min_x = 0;
5651 min_y = 0;
5652 max_x = FRAME_W32_DISPLAY_INFO (f)->width;
5653 max_y = FRAME_W32_DISPLAY_INFO (f)->height;
5655 BLOCK_INPUT;
5656 GetCursorPos (&pt);
5657 *root_x = pt.x;
5658 *root_y = pt.y;
5659 UNBLOCK_INPUT;
5661 /* If multiple monitor support is available, constrain the tip onto
5662 the current monitor. This improves the above by allowing negative
5663 co-ordinates if monitor positions are such that they are valid, and
5664 snaps a tooltip onto a single monitor if we are close to the edge
5665 where it would otherwise flow onto the other monitor (or into
5666 nothingness if there is a gap in the overlap). */
5667 if (monitor_from_point_fn && get_monitor_info_fn)
5669 struct MONITOR_INFO info;
5670 HMONITOR monitor
5671 = monitor_from_point_fn (pt, MONITOR_DEFAULT_TO_NEAREST);
5672 info.cbSize = sizeof (info);
5674 if (get_monitor_info_fn (monitor, &info))
5676 min_x = info.rcWork.left;
5677 min_y = info.rcWork.top;
5678 max_x = info.rcWork.right;
5679 max_y = info.rcWork.bottom;
5684 if (INTEGERP (top))
5685 *root_y = XINT (top);
5686 else if (*root_y + XINT (dy) <= min_y)
5687 *root_y = min_y; /* Can happen for negative dy */
5688 else if (*root_y + XINT (dy) + height <= max_y)
5689 /* It fits below the pointer */
5690 *root_y += XINT (dy);
5691 else if (height + XINT (dy) + min_y <= *root_y)
5692 /* It fits above the pointer. */
5693 *root_y -= height + XINT (dy);
5694 else
5695 /* Put it on the top. */
5696 *root_y = min_y;
5698 if (INTEGERP (left))
5699 *root_x = XINT (left);
5700 else if (*root_x + XINT (dx) <= min_x)
5701 *root_x = 0; /* Can happen for negative dx */
5702 else if (*root_x + XINT (dx) + width <= max_x)
5703 /* It fits to the right of the pointer. */
5704 *root_x += XINT (dx);
5705 else if (width + XINT (dx) + min_x <= *root_x)
5706 /* It fits to the left of the pointer. */
5707 *root_x -= width + XINT (dx);
5708 else
5709 /* Put it left justified on the screen -- it ought to fit that way. */
5710 *root_x = min_x;
5714 DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0,
5715 doc: /* Show STRING in a \"tooltip\" window on frame FRAME.
5716 A tooltip window is a small window displaying a string.
5718 This is an internal function; Lisp code should call `tooltip-show'.
5720 FRAME nil or omitted means use the selected frame.
5722 PARMS is an optional list of frame parameters which can be
5723 used to change the tooltip's appearance.
5725 Automatically hide the tooltip after TIMEOUT seconds. TIMEOUT nil
5726 means use the default timeout of 5 seconds.
5728 If the list of frame parameters PARMS contains a `left' parameter,
5729 the tooltip is displayed at that x-position. Otherwise it is
5730 displayed at the mouse position, with offset DX added (default is 5 if
5731 DX isn't specified). Likewise for the y-position; if a `top' frame
5732 parameter is specified, it determines the y-position of the tooltip
5733 window, otherwise it is displayed at the mouse position, with offset
5734 DY added (default is -10).
5736 A tooltip's maximum size is specified by `x-max-tooltip-size'.
5737 Text larger than the specified size is clipped. */)
5738 (string, frame, parms, timeout, dx, dy)
5739 Lisp_Object string, frame, parms, timeout, dx, dy;
5741 struct frame *f;
5742 struct window *w;
5743 int root_x, root_y;
5744 struct buffer *old_buffer;
5745 struct text_pos pos;
5746 int i, width, height;
5747 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
5748 int old_windows_or_buffers_changed = windows_or_buffers_changed;
5749 int count = SPECPDL_INDEX ();
5751 specbind (Qinhibit_redisplay, Qt);
5753 GCPRO4 (string, parms, frame, timeout);
5755 CHECK_STRING (string);
5756 f = check_x_frame (frame);
5757 if (NILP (timeout))
5758 timeout = make_number (5);
5759 else
5760 CHECK_NATNUM (timeout);
5762 if (NILP (dx))
5763 dx = make_number (5);
5764 else
5765 CHECK_NUMBER (dx);
5767 if (NILP (dy))
5768 dy = make_number (-10);
5769 else
5770 CHECK_NUMBER (dy);
5772 if (NILP (last_show_tip_args))
5773 last_show_tip_args = Fmake_vector (make_number (3), Qnil);
5775 if (!NILP (tip_frame))
5777 Lisp_Object last_string = AREF (last_show_tip_args, 0);
5778 Lisp_Object last_frame = AREF (last_show_tip_args, 1);
5779 Lisp_Object last_parms = AREF (last_show_tip_args, 2);
5781 if (EQ (frame, last_frame)
5782 && !NILP (Fequal (last_string, string))
5783 && !NILP (Fequal (last_parms, parms)))
5785 struct frame *f = XFRAME (tip_frame);
5787 /* Only DX and DY have changed. */
5788 if (!NILP (tip_timer))
5790 Lisp_Object timer = tip_timer;
5791 tip_timer = Qnil;
5792 call1 (Qcancel_timer, timer);
5795 BLOCK_INPUT;
5796 compute_tip_xy (f, parms, dx, dy, FRAME_PIXEL_WIDTH (f),
5797 FRAME_PIXEL_HEIGHT (f), &root_x, &root_y);
5799 /* Put tooltip in topmost group and in position. */
5800 SetWindowPos (FRAME_W32_WINDOW (f), HWND_TOPMOST,
5801 root_x, root_y, 0, 0,
5802 SWP_NOSIZE | SWP_NOACTIVATE);
5804 /* Ensure tooltip is on top of other topmost windows (eg menus). */
5805 SetWindowPos (FRAME_W32_WINDOW (f), HWND_TOP,
5806 0, 0, 0, 0,
5807 SWP_NOMOVE | SWP_NOSIZE | SWP_NOACTIVATE);
5809 UNBLOCK_INPUT;
5810 goto start_timer;
5814 /* Hide a previous tip, if any. */
5815 Fx_hide_tip ();
5817 ASET (last_show_tip_args, 0, string);
5818 ASET (last_show_tip_args, 1, frame);
5819 ASET (last_show_tip_args, 2, parms);
5821 /* Add default values to frame parameters. */
5822 if (NILP (Fassq (Qname, parms)))
5823 parms = Fcons (Fcons (Qname, build_string ("tooltip")), parms);
5824 if (NILP (Fassq (Qinternal_border_width, parms)))
5825 parms = Fcons (Fcons (Qinternal_border_width, make_number (3)), parms);
5826 if (NILP (Fassq (Qborder_width, parms)))
5827 parms = Fcons (Fcons (Qborder_width, make_number (1)), parms);
5828 if (NILP (Fassq (Qborder_color, parms)))
5829 parms = Fcons (Fcons (Qborder_color, build_string ("lightyellow")), parms);
5830 if (NILP (Fassq (Qbackground_color, parms)))
5831 parms = Fcons (Fcons (Qbackground_color, build_string ("lightyellow")),
5832 parms);
5834 /* Block input until the tip has been fully drawn, to avoid crashes
5835 when drawing tips in menus. */
5836 BLOCK_INPUT;
5838 /* Create a frame for the tooltip, and record it in the global
5839 variable tip_frame. */
5840 frame = x_create_tip_frame (FRAME_W32_DISPLAY_INFO (f), parms, string);
5841 f = XFRAME (frame);
5843 /* Set up the frame's root window. */
5844 w = XWINDOW (FRAME_ROOT_WINDOW (f));
5845 w->left_col = w->top_line = make_number (0);
5847 if (CONSP (Vx_max_tooltip_size)
5848 && INTEGERP (XCAR (Vx_max_tooltip_size))
5849 && XINT (XCAR (Vx_max_tooltip_size)) > 0
5850 && INTEGERP (XCDR (Vx_max_tooltip_size))
5851 && XINT (XCDR (Vx_max_tooltip_size)) > 0)
5853 w->total_cols = XCAR (Vx_max_tooltip_size);
5854 w->total_lines = XCDR (Vx_max_tooltip_size);
5856 else
5858 w->total_cols = make_number (80);
5859 w->total_lines = make_number (40);
5862 FRAME_TOTAL_COLS (f) = XINT (w->total_cols);
5863 adjust_glyphs (f);
5864 w->pseudo_window_p = 1;
5866 /* Display the tooltip text in a temporary buffer. */
5867 old_buffer = current_buffer;
5868 set_buffer_internal_1 (XBUFFER (XWINDOW (FRAME_ROOT_WINDOW (f))->buffer));
5869 current_buffer->truncate_lines = Qnil;
5870 clear_glyph_matrix (w->desired_matrix);
5871 clear_glyph_matrix (w->current_matrix);
5872 SET_TEXT_POS (pos, BEGV, BEGV_BYTE);
5873 try_window (FRAME_ROOT_WINDOW (f), pos, 0);
5875 /* Compute width and height of the tooltip. */
5876 width = height = 0;
5877 for (i = 0; i < w->desired_matrix->nrows; ++i)
5879 struct glyph_row *row = &w->desired_matrix->rows[i];
5880 struct glyph *last;
5881 int row_width;
5883 /* Stop at the first empty row at the end. */
5884 if (!row->enabled_p || !row->displays_text_p)
5885 break;
5887 /* Let the row go over the full width of the frame. */
5888 row->full_width_p = 1;
5890 #ifdef TODO /* Investigate why some fonts need more width than is
5891 calculated for some tooltips. */
5892 /* There's a glyph at the end of rows that is use to place
5893 the cursor there. Don't include the width of this glyph. */
5894 if (row->used[TEXT_AREA])
5896 last = &row->glyphs[TEXT_AREA][row->used[TEXT_AREA] - 1];
5897 row_width = row->pixel_width - last->pixel_width;
5899 else
5900 #endif
5901 row_width = row->pixel_width;
5903 /* TODO: find why tips do not draw along baseline as instructed. */
5904 height += row->height;
5905 width = max (width, row_width);
5908 /* Add the frame's internal border to the width and height the X
5909 window should have. */
5910 height += 2 * FRAME_INTERNAL_BORDER_WIDTH (f);
5911 width += 2 * FRAME_INTERNAL_BORDER_WIDTH (f);
5913 /* Move the tooltip window where the mouse pointer is. Resize and
5914 show it. */
5915 compute_tip_xy (f, parms, dx, dy, width, height, &root_x, &root_y);
5918 /* Adjust Window size to take border into account. */
5919 RECT rect;
5920 rect.left = rect.top = 0;
5921 rect.right = width;
5922 rect.bottom = height;
5923 AdjustWindowRect (&rect, f->output_data.w32->dwStyle,
5924 FRAME_EXTERNAL_MENU_BAR (f));
5926 /* Position and size tooltip, and put it in the topmost group.
5927 The add-on of 3 to the 5th argument is a kludge: without it,
5928 some fonts cause the last character of the tip to be truncated,
5929 for some obscure reason. */
5930 SetWindowPos (FRAME_W32_WINDOW (f), HWND_TOPMOST,
5931 root_x, root_y, rect.right - rect.left + 3,
5932 rect.bottom - rect.top, SWP_NOACTIVATE);
5934 /* Ensure tooltip is on top of other topmost windows (eg menus). */
5935 SetWindowPos (FRAME_W32_WINDOW (f), HWND_TOP,
5936 0, 0, 0, 0,
5937 SWP_NOMOVE | SWP_NOSIZE | SWP_NOACTIVATE);
5939 /* Let redisplay know that we have made the frame visible already. */
5940 f->async_visible = 1;
5942 ShowWindow (FRAME_W32_WINDOW (f), SW_SHOWNOACTIVATE);
5945 /* Draw into the window. */
5946 w->must_be_updated_p = 1;
5947 update_single_window (w, 1);
5949 UNBLOCK_INPUT;
5951 /* Restore original current buffer. */
5952 set_buffer_internal_1 (old_buffer);
5953 windows_or_buffers_changed = old_windows_or_buffers_changed;
5955 start_timer:
5956 /* Let the tip disappear after timeout seconds. */
5957 tip_timer = call3 (intern ("run-at-time"), timeout, Qnil,
5958 intern ("x-hide-tip"));
5960 UNGCPRO;
5961 return unbind_to (count, Qnil);
5965 DEFUN ("x-hide-tip", Fx_hide_tip, Sx_hide_tip, 0, 0, 0,
5966 doc: /* Hide the current tooltip window, if there is any.
5967 Value is t if tooltip was open, nil otherwise. */)
5970 int count;
5971 Lisp_Object deleted, frame, timer;
5972 struct gcpro gcpro1, gcpro2;
5974 /* Return quickly if nothing to do. */
5975 if (NILP (tip_timer) && NILP (tip_frame))
5976 return Qnil;
5978 frame = tip_frame;
5979 timer = tip_timer;
5980 GCPRO2 (frame, timer);
5981 tip_frame = tip_timer = deleted = Qnil;
5983 count = SPECPDL_INDEX ();
5984 specbind (Qinhibit_redisplay, Qt);
5985 specbind (Qinhibit_quit, Qt);
5987 if (!NILP (timer))
5988 call1 (Qcancel_timer, timer);
5990 if (FRAMEP (frame))
5992 Fdelete_frame (frame, Qnil);
5993 deleted = Qt;
5996 UNGCPRO;
5997 return unbind_to (count, deleted);
6002 /***********************************************************************
6003 File selection dialog
6004 ***********************************************************************/
6005 extern Lisp_Object Qfile_name_history;
6007 /* Callback for altering the behavior of the Open File dialog.
6008 Makes the Filename text field contain "Current Directory" and be
6009 read-only when "Directories" is selected in the filter. This
6010 allows us to work around the fact that the standard Open File
6011 dialog does not support directories. */
6012 UINT CALLBACK
6013 file_dialog_callback (hwnd, msg, wParam, lParam)
6014 HWND hwnd;
6015 UINT msg;
6016 WPARAM wParam;
6017 LPARAM lParam;
6019 if (msg == WM_NOTIFY)
6021 OFNOTIFY * notify = (OFNOTIFY *)lParam;
6022 /* Detect when the Filter dropdown is changed. */
6023 if (notify->hdr.code == CDN_TYPECHANGE
6024 || notify->hdr.code == CDN_INITDONE)
6026 HWND dialog = GetParent (hwnd);
6027 HWND edit_control = GetDlgItem (dialog, FILE_NAME_TEXT_FIELD);
6029 /* Directories is in index 2. */
6030 if (notify->lpOFN->nFilterIndex == 2)
6032 CommDlg_OpenSave_SetControlText (dialog, FILE_NAME_TEXT_FIELD,
6033 "Current Directory");
6034 EnableWindow (edit_control, FALSE);
6036 else
6038 /* Don't override default filename on init done. */
6039 if (notify->hdr.code == CDN_TYPECHANGE)
6040 CommDlg_OpenSave_SetControlText (dialog,
6041 FILE_NAME_TEXT_FIELD, "");
6042 EnableWindow (edit_control, TRUE);
6046 return 0;
6049 /* Since we compile with _WIN32_WINNT set to 0x0400 (for NT4 compatibility)
6050 we end up with the old file dialogs. Define a big enough struct for the
6051 new dialog to trick GetOpenFileName into giving us the new dialogs on
6052 Windows 2000 and XP. */
6053 typedef struct
6055 OPENFILENAME real_details;
6056 void * pReserved;
6057 DWORD dwReserved;
6058 DWORD FlagsEx;
6059 } NEWOPENFILENAME;
6062 DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 5, 0,
6063 doc: /* Read file name, prompting with PROMPT in directory DIR.
6064 Use a file selection dialog.
6065 Select DEFAULT-FILENAME in the dialog's file selection box, if
6066 specified. Ensure that file exists if MUSTMATCH is non-nil.
6067 If ONLY-DIR-P is non-nil, the user can only select directories. */)
6068 (prompt, dir, default_filename, mustmatch, only_dir_p)
6069 Lisp_Object prompt, dir, default_filename, mustmatch, only_dir_p;
6071 struct frame *f = SELECTED_FRAME ();
6072 Lisp_Object file = Qnil;
6073 int count = SPECPDL_INDEX ();
6074 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
6075 char filename[MAX_PATH + 1];
6076 char init_dir[MAX_PATH + 1];
6077 int default_filter_index = 1; /* 1: All Files, 2: Directories only */
6079 GCPRO6 (prompt, dir, default_filename, mustmatch, only_dir_p, file);
6080 CHECK_STRING (prompt);
6081 CHECK_STRING (dir);
6083 /* Create the dialog with PROMPT as title, using DIR as initial
6084 directory and using "*" as pattern. */
6085 dir = Fexpand_file_name (dir, Qnil);
6086 strncpy (init_dir, SDATA (ENCODE_FILE (dir)), MAX_PATH);
6087 init_dir[MAX_PATH] = '\0';
6088 unixtodos_filename (init_dir);
6090 if (STRINGP (default_filename))
6092 char *file_name_only;
6093 char *full_path_name = SDATA (ENCODE_FILE (default_filename));
6095 unixtodos_filename (full_path_name);
6097 file_name_only = strrchr (full_path_name, '\\');
6098 if (!file_name_only)
6099 file_name_only = full_path_name;
6100 else
6101 file_name_only++;
6103 strncpy (filename, file_name_only, MAX_PATH);
6104 filename[MAX_PATH] = '\0';
6106 else
6107 filename[0] = '\0';
6110 NEWOPENFILENAME new_file_details;
6111 BOOL file_opened = FALSE;
6112 OPENFILENAME * file_details = &new_file_details.real_details;
6114 /* Prevent redisplay. */
6115 specbind (Qinhibit_redisplay, Qt);
6116 BLOCK_INPUT;
6118 bzero (&new_file_details, sizeof (new_file_details));
6119 /* Apparently NT4 crashes if you give it an unexpected size.
6120 I'm not sure about Windows 9x, so play it safe. */
6121 if (w32_major_version > 4 && w32_major_version < 95)
6122 file_details->lStructSize = sizeof (NEWOPENFILENAME);
6123 else
6124 file_details->lStructSize = sizeof (OPENFILENAME);
6126 file_details->hwndOwner = FRAME_W32_WINDOW (f);
6127 /* Undocumented Bug in Common File Dialog:
6128 If a filter is not specified, shell links are not resolved. */
6129 file_details->lpstrFilter = "All Files (*.*)\0*.*\0Directories\0*|*\0\0";
6130 file_details->lpstrFile = filename;
6131 file_details->nMaxFile = sizeof (filename);
6132 file_details->lpstrInitialDir = init_dir;
6133 file_details->lpstrTitle = SDATA (prompt);
6135 if (! NILP (only_dir_p))
6136 default_filter_index = 2;
6138 file_details->nFilterIndex = default_filter_index;
6140 file_details->Flags = (OFN_HIDEREADONLY | OFN_NOCHANGEDIR
6141 | OFN_EXPLORER | OFN_ENABLEHOOK);
6142 if (!NILP (mustmatch))
6144 /* Require that the path to the parent directory exists. */
6145 file_details->Flags |= OFN_PATHMUSTEXIST;
6146 /* If we are looking for a file, require that it exists. */
6147 if (NILP (only_dir_p))
6148 file_details->Flags |= OFN_FILEMUSTEXIST;
6151 file_details->lpfnHook = (LPOFNHOOKPROC) file_dialog_callback;
6153 file_opened = GetOpenFileName (file_details);
6155 UNBLOCK_INPUT;
6157 if (file_opened)
6159 dostounix_filename (filename);
6161 if (file_details->nFilterIndex == 2)
6163 /* "Directories" selected - strip dummy file name. */
6164 char * last = strrchr (filename, '/');
6165 *last = '\0';
6168 file = DECODE_FILE (build_string (filename));
6170 /* User cancelled the dialog without making a selection. */
6171 else if (!CommDlgExtendedError ())
6172 file = Qnil;
6173 /* An error occurred, fallback on reading from the mini-buffer. */
6174 else
6175 file = Fcompleting_read (prompt, intern ("read-file-name-internal"),
6176 dir, mustmatch, dir, Qfile_name_history,
6177 default_filename, Qnil);
6179 file = unbind_to (count, file);
6182 UNGCPRO;
6184 /* Make "Cancel" equivalent to C-g. */
6185 if (NILP (file))
6186 Fsignal (Qquit, Qnil);
6188 return unbind_to (count, file);
6192 /* Moving files to the system recycle bin.
6193 Used by `move-file-to-trash' instead of the default moving to ~/.Trash */
6194 DEFUN ("system-move-file-to-trash", Fsystem_move_file_to_trash,
6195 Ssystem_move_file_to_trash, 1, 1, 0,
6196 doc: /* Move file or directory named FILENAME to the recycle bin. */)
6197 (filename)
6198 Lisp_Object filename;
6200 Lisp_Object handler;
6201 Lisp_Object encoded_file;
6202 Lisp_Object operation;
6204 operation = Qdelete_file;
6205 if (!NILP (Ffile_directory_p (filename))
6206 && NILP (Ffile_symlink_p (filename)))
6208 operation = Qdelete_directory;
6209 filename = Fdirectory_file_name (filename);
6211 filename = Fexpand_file_name (filename, Qnil);
6213 handler = Ffind_file_name_handler (filename, operation);
6214 if (!NILP (handler))
6215 return call2 (handler, operation, filename);
6217 encoded_file = ENCODE_FILE (filename);
6220 const char * path;
6221 SHFILEOPSTRUCT file_op;
6222 char tmp_path[MAX_PATH + 1];
6224 path = map_w32_filename (SDATA (encoded_file), NULL);
6226 /* On Windows, write permission is required to delete/move files. */
6227 _chmod (path, 0666);
6229 bzero (tmp_path, sizeof (tmp_path));
6230 strcpy (tmp_path, path);
6232 bzero (&file_op, sizeof (file_op));
6233 file_op.hwnd = HWND_DESKTOP;
6234 file_op.wFunc = FO_DELETE;
6235 file_op.pFrom = tmp_path;
6236 file_op.fFlags = FOF_SILENT | FOF_NOCONFIRMATION | FOF_ALLOWUNDO
6237 | FOF_NOERRORUI | FOF_NO_CONNECTED_ELEMENTS;
6238 file_op.fAnyOperationsAborted = FALSE;
6240 if (SHFileOperation (&file_op) != 0)
6241 report_file_error ("Removing old name", list1 (filename));
6243 return Qnil;
6247 /***********************************************************************
6248 w32 specialized functions
6249 ***********************************************************************/
6251 DEFUN ("w32-send-sys-command", Fw32_send_sys_command,
6252 Sw32_send_sys_command, 1, 2, 0,
6253 doc: /* Send frame a Windows WM_SYSCOMMAND message of type COMMAND.
6254 Some useful values for COMMAND are #xf030 to maximize frame (#xf020
6255 to minimize), #xf120 to restore frame to original size, and #xf100
6256 to activate the menubar for keyboard access. #xf140 activates the
6257 screen saver if defined.
6259 If optional parameter FRAME is not specified, use selected frame. */)
6260 (command, frame)
6261 Lisp_Object command, frame;
6263 FRAME_PTR f = check_x_frame (frame);
6265 CHECK_NUMBER (command);
6267 PostMessage (FRAME_W32_WINDOW (f), WM_SYSCOMMAND, XINT (command), 0);
6269 return Qnil;
6272 DEFUN ("w32-shell-execute", Fw32_shell_execute, Sw32_shell_execute, 2, 4, 0,
6273 doc: /* Get Windows to perform OPERATION on DOCUMENT.
6274 This is a wrapper around the ShellExecute system function, which
6275 invokes the application registered to handle OPERATION for DOCUMENT.
6277 OPERATION is either nil or a string that names a supported operation.
6278 What operations can be used depends on the particular DOCUMENT and its
6279 handler application, but typically it is one of the following common
6280 operations:
6282 \"open\" - open DOCUMENT, which could be a file, a directory, or an
6283 executable program. If it is an application, that
6284 application is launched in the current buffer's default
6285 directory. Otherwise, the application associated with
6286 DOCUMENT is launched in the buffer's default directory.
6287 \"print\" - print DOCUMENT, which must be a file
6288 \"explore\" - start the Windows Explorer on DOCUMENT
6289 \"edit\" - launch an editor and open DOCUMENT for editing; which
6290 editor is launched depends on the association for the
6291 specified DOCUMENT
6292 \"find\" - initiate search starting from DOCUMENT which must specify
6293 a directory
6294 nil - invoke the default OPERATION, or \"open\" if default is
6295 not defined or unavailable
6297 DOCUMENT is typically the name of a document file or a URL, but can
6298 also be a program executable to run, or a directory to open in the
6299 Windows Explorer.
6301 If DOCUMENT is a program executable, the optional third arg PARAMETERS
6302 can be a string containing command line parameters that will be passed
6303 to the program; otherwise, PARAMETERS should be nil or unspecified.
6305 Optional fourth argument SHOW-FLAG can be used to control how the
6306 application will be displayed when it is invoked. If SHOW-FLAG is nil
6307 or unspecified, the application is displayed normally, otherwise it is
6308 an integer representing a ShowWindow flag:
6310 0 - start hidden
6311 1 - start normally
6312 3 - start maximized
6313 6 - start minimized */)
6314 (operation, document, parameters, show_flag)
6315 Lisp_Object operation, document, parameters, show_flag;
6317 Lisp_Object current_dir;
6319 CHECK_STRING (document);
6321 /* Encode filename, current directory and parameters. */
6322 current_dir = ENCODE_FILE (current_buffer->directory);
6323 document = ENCODE_FILE (document);
6324 if (STRINGP (parameters))
6325 parameters = ENCODE_SYSTEM (parameters);
6327 if ((int) ShellExecute (NULL,
6328 (STRINGP (operation) ?
6329 SDATA (operation) : NULL),
6330 SDATA (document),
6331 (STRINGP (parameters) ?
6332 SDATA (parameters) : NULL),
6333 SDATA (current_dir),
6334 (INTEGERP (show_flag) ?
6335 XINT (show_flag) : SW_SHOWDEFAULT))
6336 > 32)
6337 return Qt;
6338 error ("ShellExecute failed: %s", w32_strerror (0));
6341 /* Lookup virtual keycode from string representing the name of a
6342 non-ascii keystroke into the corresponding virtual key, using
6343 lispy_function_keys. */
6344 static int
6345 lookup_vk_code (char *key)
6347 int i;
6349 for (i = 0; i < 256; i++)
6350 if (lispy_function_keys[i]
6351 && strcmp (lispy_function_keys[i], key) == 0)
6352 return i;
6354 return -1;
6357 /* Convert a one-element vector style key sequence to a hot key
6358 definition. */
6359 static Lisp_Object
6360 w32_parse_hot_key (key)
6361 Lisp_Object key;
6363 /* Copied from Fdefine_key and store_in_keymap. */
6364 register Lisp_Object c;
6365 int vk_code;
6366 int lisp_modifiers;
6367 int w32_modifiers;
6368 struct gcpro gcpro1;
6370 CHECK_VECTOR (key);
6372 if (XFASTINT (Flength (key)) != 1)
6373 return Qnil;
6375 GCPRO1 (key);
6377 c = Faref (key, make_number (0));
6379 if (CONSP (c) && lucid_event_type_list_p (c))
6380 c = Fevent_convert_list (c);
6382 UNGCPRO;
6384 if (! INTEGERP (c) && ! SYMBOLP (c))
6385 error ("Key definition is invalid");
6387 /* Work out the base key and the modifiers. */
6388 if (SYMBOLP (c))
6390 c = parse_modifiers (c);
6391 lisp_modifiers = XINT (Fcar (Fcdr (c)));
6392 c = Fcar (c);
6393 if (!SYMBOLP (c))
6394 abort ();
6395 vk_code = lookup_vk_code (SDATA (SYMBOL_NAME (c)));
6397 else if (INTEGERP (c))
6399 lisp_modifiers = XINT (c) & ~CHARACTERBITS;
6400 /* Many ascii characters are their own virtual key code. */
6401 vk_code = XINT (c) & CHARACTERBITS;
6404 if (vk_code < 0 || vk_code > 255)
6405 return Qnil;
6407 if ((lisp_modifiers & meta_modifier) != 0
6408 && !NILP (Vw32_alt_is_meta))
6409 lisp_modifiers |= alt_modifier;
6411 /* Supply defs missing from mingw32. */
6412 #ifndef MOD_ALT
6413 #define MOD_ALT 0x0001
6414 #define MOD_CONTROL 0x0002
6415 #define MOD_SHIFT 0x0004
6416 #define MOD_WIN 0x0008
6417 #endif
6419 /* Convert lisp modifiers to Windows hot-key form. */
6420 w32_modifiers = (lisp_modifiers & hyper_modifier) ? MOD_WIN : 0;
6421 w32_modifiers |= (lisp_modifiers & alt_modifier) ? MOD_ALT : 0;
6422 w32_modifiers |= (lisp_modifiers & ctrl_modifier) ? MOD_CONTROL : 0;
6423 w32_modifiers |= (lisp_modifiers & shift_modifier) ? MOD_SHIFT : 0;
6425 return HOTKEY (vk_code, w32_modifiers);
6428 DEFUN ("w32-register-hot-key", Fw32_register_hot_key,
6429 Sw32_register_hot_key, 1, 1, 0,
6430 doc: /* Register KEY as a hot-key combination.
6431 Certain key combinations like Alt-Tab are reserved for system use on
6432 Windows, and therefore are normally intercepted by the system. However,
6433 most of these key combinations can be received by registering them as
6434 hot-keys, overriding their special meaning.
6436 KEY must be a one element key definition in vector form that would be
6437 acceptable to `define-key' (e.g. [A-tab] for Alt-Tab). The meta
6438 modifier is interpreted as Alt if `w32-alt-is-meta' is t, and hyper
6439 is always interpreted as the Windows modifier keys.
6441 The return value is the hotkey-id if registered, otherwise nil. */)
6442 (key)
6443 Lisp_Object key;
6445 key = w32_parse_hot_key (key);
6447 if (!NILP (key) && NILP (Fmemq (key, w32_grabbed_keys)))
6449 /* Reuse an empty slot if possible. */
6450 Lisp_Object item = Fmemq (Qnil, w32_grabbed_keys);
6452 /* Safe to add new key to list, even if we have focus. */
6453 if (NILP (item))
6454 w32_grabbed_keys = Fcons (key, w32_grabbed_keys);
6455 else
6456 XSETCAR (item, key);
6458 /* Notify input thread about new hot-key definition, so that it
6459 takes effect without needing to switch focus. */
6460 #ifdef USE_LISP_UNION_TYPE
6461 PostThreadMessage (dwWindowsThreadId, WM_EMACS_REGISTER_HOT_KEY,
6462 (WPARAM) key.i, 0);
6463 #else
6464 PostThreadMessage (dwWindowsThreadId, WM_EMACS_REGISTER_HOT_KEY,
6465 (WPARAM) key, 0);
6466 #endif
6469 return key;
6472 DEFUN ("w32-unregister-hot-key", Fw32_unregister_hot_key,
6473 Sw32_unregister_hot_key, 1, 1, 0,
6474 doc: /* Unregister KEY as a hot-key combination. */)
6475 (key)
6476 Lisp_Object key;
6478 Lisp_Object item;
6480 if (!INTEGERP (key))
6481 key = w32_parse_hot_key (key);
6483 item = Fmemq (key, w32_grabbed_keys);
6485 if (!NILP (item))
6487 /* Notify input thread about hot-key definition being removed, so
6488 that it takes effect without needing focus switch. */
6489 #ifdef USE_LISP_UNION_TYPE
6490 if (PostThreadMessage (dwWindowsThreadId, WM_EMACS_UNREGISTER_HOT_KEY,
6491 (WPARAM) XINT (XCAR (item)), (LPARAM) item.i))
6492 #else
6493 if (PostThreadMessage (dwWindowsThreadId, WM_EMACS_UNREGISTER_HOT_KEY,
6494 (WPARAM) XINT (XCAR (item)), (LPARAM) item))
6495 #endif
6497 MSG msg;
6498 GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE);
6500 return Qt;
6502 return Qnil;
6505 DEFUN ("w32-registered-hot-keys", Fw32_registered_hot_keys,
6506 Sw32_registered_hot_keys, 0, 0, 0,
6507 doc: /* Return list of registered hot-key IDs. */)
6510 return Fdelq (Qnil, Fcopy_sequence (w32_grabbed_keys));
6513 DEFUN ("w32-reconstruct-hot-key", Fw32_reconstruct_hot_key,
6514 Sw32_reconstruct_hot_key, 1, 1, 0,
6515 doc: /* Convert hot-key ID to a lisp key combination.
6516 usage: (w32-reconstruct-hot-key ID) */)
6517 (hotkeyid)
6518 Lisp_Object hotkeyid;
6520 int vk_code, w32_modifiers;
6521 Lisp_Object key;
6523 CHECK_NUMBER (hotkeyid);
6525 vk_code = HOTKEY_VK_CODE (hotkeyid);
6526 w32_modifiers = HOTKEY_MODIFIERS (hotkeyid);
6528 if (vk_code < 256 && lispy_function_keys[vk_code])
6529 key = intern (lispy_function_keys[vk_code]);
6530 else
6531 key = make_number (vk_code);
6533 key = Fcons (key, Qnil);
6534 if (w32_modifiers & MOD_SHIFT)
6535 key = Fcons (Qshift, key);
6536 if (w32_modifiers & MOD_CONTROL)
6537 key = Fcons (Qctrl, key);
6538 if (w32_modifiers & MOD_ALT)
6539 key = Fcons (NILP (Vw32_alt_is_meta) ? Qalt : Qmeta, key);
6540 if (w32_modifiers & MOD_WIN)
6541 key = Fcons (Qhyper, key);
6543 return key;
6546 DEFUN ("w32-toggle-lock-key", Fw32_toggle_lock_key,
6547 Sw32_toggle_lock_key, 1, 2, 0,
6548 doc: /* Toggle the state of the lock key KEY.
6549 KEY can be `capslock', `kp-numlock', or `scroll'.
6550 If the optional parameter NEW-STATE is a number, then the state of KEY
6551 is set to off if the low bit of NEW-STATE is zero, otherwise on. */)
6552 (key, new_state)
6553 Lisp_Object key, new_state;
6555 int vk_code;
6557 if (EQ (key, intern ("capslock")))
6558 vk_code = VK_CAPITAL;
6559 else if (EQ (key, intern ("kp-numlock")))
6560 vk_code = VK_NUMLOCK;
6561 else if (EQ (key, intern ("scroll")))
6562 vk_code = VK_SCROLL;
6563 else
6564 return Qnil;
6566 if (!dwWindowsThreadId)
6567 return make_number (w32_console_toggle_lock_key (vk_code, new_state));
6569 #ifdef USE_LISP_UNION_TYPE
6570 if (PostThreadMessage (dwWindowsThreadId, WM_EMACS_TOGGLE_LOCK_KEY,
6571 (WPARAM) vk_code, (LPARAM) new_state.i))
6572 #else
6573 if (PostThreadMessage (dwWindowsThreadId, WM_EMACS_TOGGLE_LOCK_KEY,
6574 (WPARAM) vk_code, (LPARAM) new_state))
6575 #endif
6577 MSG msg;
6578 GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE);
6579 return make_number (msg.wParam);
6581 return Qnil;
6584 DEFUN ("w32-window-exists-p", Fw32_window_exists_p, Sw32_window_exists_p,
6585 2, 2, 0,
6586 doc: /* Return non-nil if a window exists with the specified CLASS and NAME.
6588 This is a direct interface to the Windows API FindWindow function. */)
6589 (class, name)
6590 Lisp_Object class, name;
6592 HWND hnd;
6594 if (!NILP (class))
6595 CHECK_STRING (class);
6596 if (!NILP (name))
6597 CHECK_STRING (name);
6599 hnd = FindWindow (STRINGP (class) ? ((LPCTSTR) SDATA (class)) : NULL,
6600 STRINGP (name) ? ((LPCTSTR) SDATA (name)) : NULL);
6601 if (!hnd)
6602 return Qnil;
6603 return Qt;
6606 DEFUN ("w32-battery-status", Fw32_battery_status, Sw32_battery_status, 0, 0, 0,
6607 doc: /* Get power status information from Windows system.
6609 The following %-sequences are provided:
6610 %L AC line status (verbose)
6611 %B Battery status (verbose)
6612 %b Battery status, empty means high, `-' means low,
6613 `!' means critical, and `+' means charging
6614 %p Battery load percentage
6615 %s Remaining time (to charge or discharge) in seconds
6616 %m Remaining time (to charge or discharge) in minutes
6617 %h Remaining time (to charge or discharge) in hours
6618 %t Remaining time (to charge or discharge) in the form `h:min' */)
6621 Lisp_Object status = Qnil;
6623 SYSTEM_POWER_STATUS system_status;
6624 if (GetSystemPowerStatus (&system_status))
6626 Lisp_Object line_status, battery_status, battery_status_symbol;
6627 Lisp_Object load_percentage, seconds, minutes, hours, remain;
6628 Lisp_Object sequences[8];
6630 long seconds_left = (long) system_status.BatteryLifeTime;
6632 if (system_status.ACLineStatus == 0)
6633 line_status = build_string ("off-line");
6634 else if (system_status.ACLineStatus == 1)
6635 line_status = build_string ("on-line");
6636 else
6637 line_status = build_string ("N/A");
6639 if (system_status.BatteryFlag & 128)
6641 battery_status = build_string ("N/A");
6642 battery_status_symbol = build_string ("");
6644 else if (system_status.BatteryFlag & 8)
6646 battery_status = build_string ("charging");
6647 battery_status_symbol = build_string ("+");
6648 if (system_status.BatteryFullLifeTime != -1L)
6649 seconds_left = system_status.BatteryFullLifeTime - seconds_left;
6651 else if (system_status.BatteryFlag & 4)
6653 battery_status = build_string ("critical");
6654 battery_status_symbol = build_string ("!");
6656 else if (system_status.BatteryFlag & 2)
6658 battery_status = build_string ("low");
6659 battery_status_symbol = build_string ("-");
6661 else if (system_status.BatteryFlag & 1)
6663 battery_status = build_string ("high");
6664 battery_status_symbol = build_string ("");
6666 else
6668 battery_status = build_string ("medium");
6669 battery_status_symbol = build_string ("");
6672 if (system_status.BatteryLifePercent > 100)
6673 load_percentage = build_string ("N/A");
6674 else
6676 char buffer[16];
6677 _snprintf (buffer, 16, "%d", system_status.BatteryLifePercent);
6678 load_percentage = build_string (buffer);
6681 if (seconds_left < 0)
6682 seconds = minutes = hours = remain = build_string ("N/A");
6683 else
6685 long m;
6686 float h;
6687 char buffer[16];
6688 _snprintf (buffer, 16, "%ld", seconds_left);
6689 seconds = build_string (buffer);
6691 m = seconds_left / 60;
6692 _snprintf (buffer, 16, "%ld", m);
6693 minutes = build_string (buffer);
6695 h = seconds_left / 3600.0;
6696 _snprintf (buffer, 16, "%3.1f", h);
6697 hours = build_string (buffer);
6699 _snprintf (buffer, 16, "%ld:%02ld", m / 60, m % 60);
6700 remain = build_string (buffer);
6702 sequences[0] = Fcons (make_number ('L'), line_status);
6703 sequences[1] = Fcons (make_number ('B'), battery_status);
6704 sequences[2] = Fcons (make_number ('b'), battery_status_symbol);
6705 sequences[3] = Fcons (make_number ('p'), load_percentage);
6706 sequences[4] = Fcons (make_number ('s'), seconds);
6707 sequences[5] = Fcons (make_number ('m'), minutes);
6708 sequences[6] = Fcons (make_number ('h'), hours);
6709 sequences[7] = Fcons (make_number ('t'), remain);
6711 status = Flist (8, sequences);
6713 return status;
6717 DEFUN ("file-system-info", Ffile_system_info, Sfile_system_info, 1, 1, 0,
6718 doc: /* Return storage information about the file system FILENAME is on.
6719 Value is a list of floats (TOTAL FREE AVAIL), where TOTAL is the total
6720 storage of the file system, FREE is the free storage, and AVAIL is the
6721 storage available to a non-superuser. All 3 numbers are in bytes.
6722 If the underlying system call fails, value is nil. */)
6723 (filename)
6724 Lisp_Object filename;
6726 Lisp_Object encoded, value;
6728 CHECK_STRING (filename);
6729 filename = Fexpand_file_name (filename, Qnil);
6730 encoded = ENCODE_FILE (filename);
6732 value = Qnil;
6734 /* Determining the required information on Windows turns out, sadly,
6735 to be more involved than one would hope. The original Win32 api
6736 call for this will return bogus information on some systems, but we
6737 must dynamically probe for the replacement api, since that was
6738 added rather late on. */
6740 HMODULE hKernel = GetModuleHandle ("kernel32");
6741 BOOL (*pfn_GetDiskFreeSpaceEx)
6742 (char *, PULARGE_INTEGER, PULARGE_INTEGER, PULARGE_INTEGER)
6743 = (void *) GetProcAddress (hKernel, "GetDiskFreeSpaceEx");
6745 /* On Windows, we may need to specify the root directory of the
6746 volume holding FILENAME. */
6747 char rootname[MAX_PATH];
6748 char *name = SDATA (encoded);
6750 /* find the root name of the volume if given */
6751 if (isalpha (name[0]) && name[1] == ':')
6753 rootname[0] = name[0];
6754 rootname[1] = name[1];
6755 rootname[2] = '\\';
6756 rootname[3] = 0;
6758 else if (IS_DIRECTORY_SEP (name[0]) && IS_DIRECTORY_SEP (name[1]))
6760 char *str = rootname;
6761 int slashes = 4;
6764 if (IS_DIRECTORY_SEP (*name) && --slashes == 0)
6765 break;
6766 *str++ = *name++;
6768 while ( *name );
6770 *str++ = '\\';
6771 *str = 0;
6774 if (pfn_GetDiskFreeSpaceEx)
6776 /* Unsigned large integers cannot be cast to double, so
6777 use signed ones instead. */
6778 LARGE_INTEGER availbytes;
6779 LARGE_INTEGER freebytes;
6780 LARGE_INTEGER totalbytes;
6782 if (pfn_GetDiskFreeSpaceEx (rootname,
6783 (ULARGE_INTEGER *)&availbytes,
6784 (ULARGE_INTEGER *)&totalbytes,
6785 (ULARGE_INTEGER *)&freebytes))
6786 value = list3 (make_float ((double) totalbytes.QuadPart),
6787 make_float ((double) freebytes.QuadPart),
6788 make_float ((double) availbytes.QuadPart));
6790 else
6792 DWORD sectors_per_cluster;
6793 DWORD bytes_per_sector;
6794 DWORD free_clusters;
6795 DWORD total_clusters;
6797 if (GetDiskFreeSpace (rootname,
6798 &sectors_per_cluster,
6799 &bytes_per_sector,
6800 &free_clusters,
6801 &total_clusters))
6802 value = list3 (make_float ((double) total_clusters
6803 * sectors_per_cluster * bytes_per_sector),
6804 make_float ((double) free_clusters
6805 * sectors_per_cluster * bytes_per_sector),
6806 make_float ((double) free_clusters
6807 * sectors_per_cluster * bytes_per_sector));
6811 return value;
6814 DEFUN ("default-printer-name", Fdefault_printer_name, Sdefault_printer_name,
6815 0, 0, 0, doc: /* Return the name of Windows default printer device. */)
6818 static char pname_buf[256];
6819 int err;
6820 HANDLE hPrn;
6821 PRINTER_INFO_2 *ppi2 = NULL;
6822 DWORD dwNeeded = 0, dwReturned = 0;
6824 /* Retrieve the default string from Win.ini (the registry).
6825 * String will be in form "printername,drivername,portname".
6826 * This is the most portable way to get the default printer. */
6827 if (GetProfileString ("windows", "device", ",,", pname_buf, sizeof (pname_buf)) <= 0)
6828 return Qnil;
6829 /* printername precedes first "," character */
6830 strtok (pname_buf, ",");
6831 /* We want to know more than the printer name */
6832 if (!OpenPrinter (pname_buf, &hPrn, NULL))
6833 return Qnil;
6834 GetPrinter (hPrn, 2, NULL, 0, &dwNeeded);
6835 if (dwNeeded == 0)
6837 ClosePrinter (hPrn);
6838 return Qnil;
6840 /* Allocate memory for the PRINTER_INFO_2 struct */
6841 ppi2 = (PRINTER_INFO_2 *) xmalloc (dwNeeded);
6842 if (!ppi2)
6844 ClosePrinter (hPrn);
6845 return Qnil;
6847 /* Call GetPrinter again with big enouth memory block */
6848 err = GetPrinter (hPrn, 2, (LPBYTE)ppi2, dwNeeded, &dwReturned);
6849 ClosePrinter (hPrn);
6850 if (!err)
6852 xfree (ppi2);
6853 return Qnil;
6856 if (ppi2)
6858 if (ppi2->Attributes & PRINTER_ATTRIBUTE_SHARED && ppi2->pServerName)
6860 /* a remote printer */
6861 if (*ppi2->pServerName == '\\')
6862 _snprintf (pname_buf, sizeof (pname_buf), "%s\\%s", ppi2->pServerName,
6863 ppi2->pShareName);
6864 else
6865 _snprintf (pname_buf, sizeof (pname_buf), "\\\\%s\\%s", ppi2->pServerName,
6866 ppi2->pShareName);
6867 pname_buf[sizeof (pname_buf) - 1] = '\0';
6869 else
6871 /* a local printer */
6872 strncpy (pname_buf, ppi2->pPortName, sizeof (pname_buf));
6873 pname_buf[sizeof (pname_buf) - 1] = '\0';
6874 /* `pPortName' can include several ports, delimited by ','.
6875 * we only use the first one. */
6876 strtok (pname_buf, ",");
6878 xfree (ppi2);
6881 return build_string (pname_buf);
6884 /***********************************************************************
6885 Initialization
6886 ***********************************************************************/
6888 /* Keep this list in the same order as frame_parms in frame.c.
6889 Use 0 for unsupported frame parameters. */
6891 frame_parm_handler w32_frame_parm_handlers[] =
6893 x_set_autoraise,
6894 x_set_autolower,
6895 x_set_background_color,
6896 x_set_border_color,
6897 x_set_border_width,
6898 x_set_cursor_color,
6899 x_set_cursor_type,
6900 x_set_font,
6901 x_set_foreground_color,
6902 x_set_icon_name,
6903 x_set_icon_type,
6904 x_set_internal_border_width,
6905 x_set_menu_bar_lines,
6906 x_set_mouse_color,
6907 x_explicitly_set_name,
6908 x_set_scroll_bar_width,
6909 x_set_title,
6910 x_set_unsplittable,
6911 x_set_vertical_scroll_bars,
6912 x_set_visibility,
6913 x_set_tool_bar_lines,
6914 0, /* x_set_scroll_bar_foreground, */
6915 0, /* x_set_scroll_bar_background, */
6916 x_set_screen_gamma,
6917 x_set_line_spacing,
6918 x_set_fringe_width,
6919 x_set_fringe_width,
6920 0, /* x_set_wait_for_wm, */
6921 x_set_fullscreen,
6922 x_set_font_backend,
6923 x_set_alpha
6926 void
6927 syms_of_w32fns ()
6929 globals_of_w32fns ();
6930 /* This is zero if not using MS-Windows. */
6931 w32_in_use = 0;
6932 track_mouse_window = NULL;
6934 w32_visible_system_caret_hwnd = NULL;
6936 DEFSYM (Qnone, "none");
6937 DEFSYM (Qsuppress_icon, "suppress-icon");
6938 DEFSYM (Qundefined_color, "undefined-color");
6939 DEFSYM (Qcancel_timer, "cancel-timer");
6940 DEFSYM (Qhyper, "hyper");
6941 DEFSYM (Qsuper, "super");
6942 DEFSYM (Qmeta, "meta");
6943 DEFSYM (Qalt, "alt");
6944 DEFSYM (Qctrl, "ctrl");
6945 DEFSYM (Qcontrol, "control");
6946 DEFSYM (Qshift, "shift");
6947 DEFSYM (Qfont_param, "font-parameter");
6948 /* This is the end of symbol initialization. */
6950 /* Text property `display' should be nonsticky by default. */
6951 Vtext_property_default_nonsticky
6952 = Fcons (Fcons (Qdisplay, Qt), Vtext_property_default_nonsticky);
6955 Fput (Qundefined_color, Qerror_conditions,
6956 Fcons (Qundefined_color, Fcons (Qerror, Qnil)));
6957 Fput (Qundefined_color, Qerror_message,
6958 build_string ("Undefined color"));
6960 staticpro (&w32_grabbed_keys);
6961 w32_grabbed_keys = Qnil;
6963 DEFVAR_LISP ("w32-color-map", &Vw32_color_map,
6964 doc: /* An array of color name mappings for Windows. */);
6965 Vw32_color_map = Qnil;
6967 DEFVAR_LISP ("w32-pass-alt-to-system", &Vw32_pass_alt_to_system,
6968 doc: /* Non-nil if Alt key presses are passed on to Windows.
6969 When non-nil, for example, Alt pressed and released and then space will
6970 open the System menu. When nil, Emacs processes the Alt key events, and
6971 then silently swallows them. */);
6972 Vw32_pass_alt_to_system = Qnil;
6974 DEFVAR_LISP ("w32-alt-is-meta", &Vw32_alt_is_meta,
6975 doc: /* Non-nil if the Alt key is to be considered the same as the META key.
6976 When nil, Emacs will translate the Alt key to the ALT modifier, not to META. */);
6977 Vw32_alt_is_meta = Qt;
6979 DEFVAR_INT ("w32-quit-key", &w32_quit_key,
6980 doc: /* If non-zero, the virtual key code for an alternative quit key. */);
6981 w32_quit_key = 0;
6983 DEFVAR_LISP ("w32-pass-lwindow-to-system",
6984 &Vw32_pass_lwindow_to_system,
6985 doc: /* If non-nil, the left \"Windows\" key is passed on to Windows.
6987 When non-nil, the Start menu is opened by tapping the key.
6988 If you set this to nil, the left \"Windows\" key is processed by Emacs
6989 according to the value of `w32-lwindow-modifier', which see.
6991 Note that some combinations of the left \"Windows\" key with other keys are
6992 caught by Windows at low level, and so binding them in Emacs will have no
6993 effect. For example, <lwindow>-r always pops up the Windows Run dialog,
6994 <lwindow>-<Pause> pops up the "System Properties" dialog, etc. However, see
6995 the doc string of `w32-phantom-key-code'. */);
6996 Vw32_pass_lwindow_to_system = Qt;
6998 DEFVAR_LISP ("w32-pass-rwindow-to-system",
6999 &Vw32_pass_rwindow_to_system,
7000 doc: /* If non-nil, the right \"Windows\" key is passed on to Windows.
7002 When non-nil, the Start menu is opened by tapping the key.
7003 If you set this to nil, the right \"Windows\" key is processed by Emacs
7004 according to the value of `w32-rwindow-modifier', which see.
7006 Note that some combinations of the right \"Windows\" key with other keys are
7007 caught by Windows at low level, and so binding them in Emacs will have no
7008 effect. For example, <rwindow>-r always pops up the Windows Run dialog,
7009 <rwindow>-<Pause> pops up the "System Properties" dialog, etc. However, see
7010 the doc string of `w32-phantom-key-code'. */);
7011 Vw32_pass_rwindow_to_system = Qt;
7013 DEFVAR_LISP ("w32-phantom-key-code",
7014 &Vw32_phantom_key_code,
7015 doc: /* Virtual key code used to generate \"phantom\" key presses.
7016 Value is a number between 0 and 255.
7018 Phantom key presses are generated in order to stop the system from
7019 acting on \"Windows\" key events when `w32-pass-lwindow-to-system' or
7020 `w32-pass-rwindow-to-system' is nil. */);
7021 /* Although 255 is technically not a valid key code, it works and
7022 means that this hack won't interfere with any real key code. */
7023 XSETINT (Vw32_phantom_key_code, 255);
7025 DEFVAR_LISP ("w32-enable-num-lock",
7026 &Vw32_enable_num_lock,
7027 doc: /* If non-nil, the Num Lock key acts normally.
7028 Set to nil to handle Num Lock as the `kp-numlock' key. */);
7029 Vw32_enable_num_lock = Qt;
7031 DEFVAR_LISP ("w32-enable-caps-lock",
7032 &Vw32_enable_caps_lock,
7033 doc: /* If non-nil, the Caps Lock key acts normally.
7034 Set to nil to handle Caps Lock as the `capslock' key. */);
7035 Vw32_enable_caps_lock = Qt;
7037 DEFVAR_LISP ("w32-scroll-lock-modifier",
7038 &Vw32_scroll_lock_modifier,
7039 doc: /* Modifier to use for the Scroll Lock ON state.
7040 The value can be hyper, super, meta, alt, control or shift for the
7041 respective modifier, or nil to handle Scroll Lock as the `scroll' key.
7042 Any other value will cause the Scroll Lock key to be ignored. */);
7043 Vw32_scroll_lock_modifier = Qt;
7045 DEFVAR_LISP ("w32-lwindow-modifier",
7046 &Vw32_lwindow_modifier,
7047 doc: /* Modifier to use for the left \"Windows\" key.
7048 The value can be hyper, super, meta, alt, control or shift for the
7049 respective modifier, or nil to appear as the `lwindow' key.
7050 Any other value will cause the key to be ignored. */);
7051 Vw32_lwindow_modifier = Qnil;
7053 DEFVAR_LISP ("w32-rwindow-modifier",
7054 &Vw32_rwindow_modifier,
7055 doc: /* Modifier to use for the right \"Windows\" key.
7056 The value can be hyper, super, meta, alt, control or shift for the
7057 respective modifier, or nil to appear as the `rwindow' key.
7058 Any other value will cause the key to be ignored. */);
7059 Vw32_rwindow_modifier = Qnil;
7061 DEFVAR_LISP ("w32-apps-modifier",
7062 &Vw32_apps_modifier,
7063 doc: /* Modifier to use for the \"Apps\" key.
7064 The value can be hyper, super, meta, alt, control or shift for the
7065 respective modifier, or nil to appear as the `apps' key.
7066 Any other value will cause the key to be ignored. */);
7067 Vw32_apps_modifier = Qnil;
7069 DEFVAR_BOOL ("w32-enable-synthesized-fonts", &w32_enable_synthesized_fonts,
7070 doc: /* Non-nil enables selection of artificially italicized and bold fonts. */);
7071 w32_enable_synthesized_fonts = 0;
7073 DEFVAR_LISP ("w32-enable-palette", &Vw32_enable_palette,
7074 doc: /* Non-nil enables Windows palette management to map colors exactly. */);
7075 Vw32_enable_palette = Qt;
7077 DEFVAR_INT ("w32-mouse-button-tolerance",
7078 &w32_mouse_button_tolerance,
7079 doc: /* Analogue of double click interval for faking middle mouse events.
7080 The value is the minimum time in milliseconds that must elapse between
7081 left and right button down events before they are considered distinct events.
7082 If both mouse buttons are depressed within this interval, a middle mouse
7083 button down event is generated instead. */);
7084 w32_mouse_button_tolerance = GetDoubleClickTime () / 2;
7086 DEFVAR_INT ("w32-mouse-move-interval",
7087 &w32_mouse_move_interval,
7088 doc: /* Minimum interval between mouse move events.
7089 The value is the minimum time in milliseconds that must elapse between
7090 successive mouse move (or scroll bar drag) events before they are
7091 reported as lisp events. */);
7092 w32_mouse_move_interval = 0;
7094 DEFVAR_BOOL ("w32-pass-extra-mouse-buttons-to-system",
7095 &w32_pass_extra_mouse_buttons_to_system,
7096 doc: /* If non-nil, the fourth and fifth mouse buttons are passed to Windows.
7097 Recent versions of Windows support mice with up to five buttons.
7098 Since most applications don't support these extra buttons, most mouse
7099 drivers will allow you to map them to functions at the system level.
7100 If this variable is non-nil, Emacs will pass them on, allowing the
7101 system to handle them. */);
7102 w32_pass_extra_mouse_buttons_to_system = 0;
7104 DEFVAR_BOOL ("w32-pass-multimedia-buttons-to-system",
7105 &w32_pass_multimedia_buttons_to_system,
7106 doc: /* If non-nil, media buttons are passed to Windows.
7107 Some modern keyboards contain buttons for controlling media players, web
7108 browsers and other applications. Generally these buttons are handled on a
7109 system wide basis, but by setting this to nil they are made available
7110 to Emacs for binding. Depending on your keyboard, additional keys that
7111 may be available are:
7113 browser-back, browser-forward, browser-refresh, browser-stop,
7114 browser-search, browser-favorites, browser-home,
7115 mail, mail-reply, mail-forward, mail-send,
7116 app-1, app-2,
7117 help, find, new, open, close, save, print, undo, redo, copy, cut, paste,
7118 spell-check, correction-list, toggle-dictate-command,
7119 media-next, media-previous, media-stop, media-play-pause, media-select,
7120 media-play, media-pause, media-record, media-fast-forward, media-rewind,
7121 media-channel-up, media-channel-down,
7122 volume-mute, volume-up, volume-down,
7123 mic-volume-mute, mic-volume-down, mic-volume-up, mic-toggle,
7124 bass-down, bass-boost, bass-up, treble-down, treble-up */);
7125 w32_pass_multimedia_buttons_to_system = 1;
7127 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape,
7128 doc: /* The shape of the pointer when over text.
7129 Changing the value does not affect existing frames
7130 unless you set the mouse color. */);
7131 Vx_pointer_shape = Qnil;
7133 Vx_nontext_pointer_shape = Qnil;
7135 Vx_mode_pointer_shape = Qnil;
7137 DEFVAR_LISP ("x-hourglass-pointer-shape", &Vx_hourglass_pointer_shape,
7138 doc: /* The shape of the pointer when Emacs is busy.
7139 This variable takes effect when you create a new frame
7140 or when you set the mouse color. */);
7141 Vx_hourglass_pointer_shape = Qnil;
7143 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
7144 &Vx_sensitive_text_pointer_shape,
7145 doc: /* The shape of the pointer when over mouse-sensitive text.
7146 This variable takes effect when you create a new frame
7147 or when you set the mouse color. */);
7148 Vx_sensitive_text_pointer_shape = Qnil;
7150 DEFVAR_LISP ("x-window-horizontal-drag-cursor",
7151 &Vx_window_horizontal_drag_shape,
7152 doc: /* Pointer shape to use for indicating a window can be dragged horizontally.
7153 This variable takes effect when you create a new frame
7154 or when you set the mouse color. */);
7155 Vx_window_horizontal_drag_shape = Qnil;
7157 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel,
7158 doc: /* A string indicating the foreground color of the cursor box. */);
7159 Vx_cursor_fore_pixel = Qnil;
7161 DEFVAR_LISP ("x-max-tooltip-size", &Vx_max_tooltip_size,
7162 doc: /* Maximum size for tooltips.
7163 Value is a pair (COLUMNS . ROWS). Text larger than this is clipped. */);
7164 Vx_max_tooltip_size = Fcons (make_number (80), make_number (40));
7166 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager,
7167 doc: /* Non-nil if no window manager is in use.
7168 Emacs doesn't try to figure this out; this is always nil
7169 unless you set it to something else. */);
7170 /* We don't have any way to find this out, so set it to nil
7171 and maybe the user would like to set it to t. */
7172 Vx_no_window_manager = Qnil;
7174 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
7175 &Vx_pixel_size_width_font_regexp,
7176 doc: /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'.
7178 Since Emacs gets width of a font matching with this regexp from
7179 PIXEL_SIZE field of the name, font finding mechanism gets faster for
7180 such a font. This is especially effective for such large fonts as
7181 Chinese, Japanese, and Korean. */);
7182 Vx_pixel_size_width_font_regexp = Qnil;
7184 DEFVAR_LISP ("w32-bdf-filename-alist",
7185 &Vw32_bdf_filename_alist,
7186 doc: /* List of bdf fonts and their corresponding filenames. */);
7187 Vw32_bdf_filename_alist = Qnil;
7189 DEFVAR_BOOL ("w32-strict-fontnames",
7190 &w32_strict_fontnames,
7191 doc: /* Non-nil means only use fonts that are exact matches for those requested.
7192 Default is nil, which allows old fontnames that are not XLFD compliant,
7193 and allows third-party CJK display to work by specifying false charset
7194 fields to trick Emacs into translating to Big5, SJIS etc.
7195 Setting this to t will prevent wrong fonts being selected when
7196 fontsets are automatically created. */);
7197 w32_strict_fontnames = 0;
7199 DEFVAR_BOOL ("w32-strict-painting",
7200 &w32_strict_painting,
7201 doc: /* Non-nil means use strict rules for repainting frames.
7202 Set this to nil to get the old behavior for repainting; this should
7203 only be necessary if the default setting causes problems. */);
7204 w32_strict_painting = 1;
7206 #if 0 /* TODO: Port to W32 */
7207 defsubr (&Sx_change_window_property);
7208 defsubr (&Sx_delete_window_property);
7209 defsubr (&Sx_window_property);
7210 #endif
7211 defsubr (&Sxw_display_color_p);
7212 defsubr (&Sx_display_grayscale_p);
7213 defsubr (&Sxw_color_defined_p);
7214 defsubr (&Sxw_color_values);
7215 defsubr (&Sx_server_max_request_size);
7216 defsubr (&Sx_server_vendor);
7217 defsubr (&Sx_server_version);
7218 defsubr (&Sx_display_pixel_width);
7219 defsubr (&Sx_display_pixel_height);
7220 defsubr (&Sx_display_mm_width);
7221 defsubr (&Sx_display_mm_height);
7222 defsubr (&Sx_display_screens);
7223 defsubr (&Sx_display_planes);
7224 defsubr (&Sx_display_color_cells);
7225 defsubr (&Sx_display_visual_class);
7226 defsubr (&Sx_display_backing_store);
7227 defsubr (&Sx_display_save_under);
7228 defsubr (&Sx_create_frame);
7229 defsubr (&Sx_open_connection);
7230 defsubr (&Sx_close_connection);
7231 defsubr (&Sx_display_list);
7232 defsubr (&Sx_synchronize);
7233 defsubr (&Sx_focus_frame);
7235 /* W32 specific functions */
7237 defsubr (&Sw32_define_rgb_color);
7238 defsubr (&Sw32_default_color_map);
7239 defsubr (&Sw32_load_color_file);
7240 defsubr (&Sw32_send_sys_command);
7241 defsubr (&Sw32_shell_execute);
7242 defsubr (&Sw32_register_hot_key);
7243 defsubr (&Sw32_unregister_hot_key);
7244 defsubr (&Sw32_registered_hot_keys);
7245 defsubr (&Sw32_reconstruct_hot_key);
7246 defsubr (&Sw32_toggle_lock_key);
7247 defsubr (&Sw32_window_exists_p);
7248 defsubr (&Sw32_battery_status);
7250 defsubr (&Sfile_system_info);
7251 defsubr (&Sdefault_printer_name);
7253 check_window_system_func = check_w32;
7256 hourglass_timer = 0;
7257 hourglass_hwnd = NULL;
7259 defsubr (&Sx_show_tip);
7260 defsubr (&Sx_hide_tip);
7261 tip_timer = Qnil;
7262 staticpro (&tip_timer);
7263 tip_frame = Qnil;
7264 staticpro (&tip_frame);
7266 last_show_tip_args = Qnil;
7267 staticpro (&last_show_tip_args);
7269 defsubr (&Sx_file_dialog);
7270 defsubr (&Ssystem_move_file_to_trash);
7275 globals_of_w32fns is used to initialize those global variables that
7276 must always be initialized on startup even when the global variable
7277 initialized is non zero (see the function main in emacs.c).
7278 globals_of_w32fns is called from syms_of_w32fns when the global
7279 variable initialized is 0 and directly from main when initialized
7280 is non zero.
7282 void
7283 globals_of_w32fns ()
7285 HMODULE user32_lib = GetModuleHandle ("user32.dll");
7287 TrackMouseEvent not available in all versions of Windows, so must load
7288 it dynamically. Do it once, here, instead of every time it is used.
7290 track_mouse_event_fn = (TrackMouseEvent_Proc)
7291 GetProcAddress (user32_lib, "TrackMouseEvent");
7292 /* ditto for GetClipboardSequenceNumber. */
7293 clipboard_sequence_fn = (ClipboardSequence_Proc)
7294 GetProcAddress (user32_lib, "GetClipboardSequenceNumber");
7296 monitor_from_point_fn = (MonitorFromPoint_Proc)
7297 GetProcAddress (user32_lib, "MonitorFromPoint");
7298 get_monitor_info_fn = (GetMonitorInfo_Proc)
7299 GetProcAddress (user32_lib, "GetMonitorInfoA");
7302 HMODULE imm32_lib = GetModuleHandle ("imm32.dll");
7303 get_composition_string_fn = (ImmGetCompositionString_Proc)
7304 GetProcAddress (imm32_lib, "ImmGetCompositionStringW");
7305 get_ime_context_fn = (ImmGetContext_Proc)
7306 GetProcAddress (imm32_lib, "ImmGetContext");
7308 DEFVAR_INT ("w32-ansi-code-page",
7309 &w32_ansi_code_page,
7310 doc: /* The ANSI code page used by the system. */);
7311 w32_ansi_code_page = GetACP ();
7313 /* MessageBox does not work without this when linked to comctl32.dll 6.0. */
7314 InitCommonControls ();
7316 syms_of_w32uniscribe ();
7319 #undef abort
7321 void
7322 w32_abort ()
7324 int button;
7325 button = MessageBox (NULL,
7326 "A fatal error has occurred!\n\n"
7327 "Would you like to attach a debugger?\n\n"
7328 "Select YES to debug, NO to abort Emacs"
7329 #if __GNUC__
7330 "\n\n(type \"gdb -p <emacs-PID>\" and\n"
7331 "\"continue\" inside GDB before clicking YES.)"
7332 #endif
7333 , "Emacs Abort Dialog",
7334 MB_ICONEXCLAMATION | MB_TASKMODAL
7335 | MB_SETFOREGROUND | MB_YESNO);
7336 switch (button)
7338 case IDYES:
7339 DebugBreak ();
7340 exit (2); /* tell the compiler we will never return */
7341 case IDNO:
7342 default:
7343 abort ();
7344 break;
7348 /* For convenience when debugging. */
7350 w32_last_error ()
7352 return GetLastError ();
7355 /* arch-tag: 707589ab-b9be-4638-8cdd-74629cc9b446
7356 (do not change this comment) */