(kermit-esc-char, kermit-clean-off): Doc fixes.
[emacs.git] / src / w32fns.c
blob011d647e722a7b9e8cc27c6fdb42f0a0c2540736
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));
79 extern int quit_char;
81 extern char *lispy_function_keys[];
83 /* The colormap for converting color names to RGB values */
84 Lisp_Object Vw32_color_map;
86 /* Non nil if alt key presses are passed on to Windows. */
87 Lisp_Object Vw32_pass_alt_to_system;
89 /* Non nil if alt key is translated to meta_modifier, nil if it is translated
90 to alt_modifier. */
91 Lisp_Object Vw32_alt_is_meta;
93 /* If non-zero, the windows virtual key code for an alternative quit key. */
94 int w32_quit_key;
96 /* Non nil if left window key events are passed on to Windows (this only
97 affects whether "tapping" the key opens the Start menu). */
98 Lisp_Object Vw32_pass_lwindow_to_system;
100 /* Non nil if right window key events are passed on to Windows (this
101 only affects whether "tapping" the key opens the Start menu). */
102 Lisp_Object Vw32_pass_rwindow_to_system;
104 /* Virtual key code used to generate "phantom" key presses in order
105 to stop system from acting on Windows key events. */
106 Lisp_Object Vw32_phantom_key_code;
108 /* Modifier associated with the left "Windows" key, or nil to act as a
109 normal key. */
110 Lisp_Object Vw32_lwindow_modifier;
112 /* Modifier associated with the right "Windows" key, or nil to act as a
113 normal key. */
114 Lisp_Object Vw32_rwindow_modifier;
116 /* Modifier associated with the "Apps" key, or nil to act as a normal
117 key. */
118 Lisp_Object Vw32_apps_modifier;
120 /* Value is nil if Num Lock acts as a function key. */
121 Lisp_Object Vw32_enable_num_lock;
123 /* Value is nil if Caps Lock acts as a function key. */
124 Lisp_Object Vw32_enable_caps_lock;
126 /* Modifier associated with Scroll Lock, or nil to act as a normal key. */
127 Lisp_Object Vw32_scroll_lock_modifier;
129 /* Switch to control whether we inhibit requests for synthesized bold
130 and italic versions of fonts. */
131 int w32_enable_synthesized_fonts;
133 /* Enable palette management. */
134 Lisp_Object Vw32_enable_palette;
136 /* Control how close left/right button down events must be to
137 be converted to a middle button down event. */
138 int w32_mouse_button_tolerance;
140 /* Minimum interval between mouse movement (and scroll bar drag)
141 events that are passed on to the event loop. */
142 int w32_mouse_move_interval;
144 /* Flag to indicate if XBUTTON events should be passed on to Windows. */
145 static int w32_pass_extra_mouse_buttons_to_system;
147 /* Flag to indicate if media keys should be passed on to Windows. */
148 static int w32_pass_multimedia_buttons_to_system;
150 /* Non nil if no window manager is in use. */
151 Lisp_Object Vx_no_window_manager;
153 /* Non-zero means we're allowed to display a hourglass pointer. */
155 int display_hourglass_p;
157 /* If non-zero, a w32 timer that, when it expires, displays an
158 hourglass cursor on all frames. */
159 static unsigned hourglass_timer = 0;
160 static HWND hourglass_hwnd = NULL;
162 /* The background and shape of the mouse pointer, and shape when not
163 over text or in the modeline. */
165 Lisp_Object Vx_pointer_shape, Vx_nontext_pointer_shape, Vx_mode_pointer_shape;
166 Lisp_Object Vx_hourglass_pointer_shape, Vx_window_horizontal_drag_shape;
168 /* The shape when over mouse-sensitive text. */
170 Lisp_Object Vx_sensitive_text_pointer_shape;
172 #ifndef IDC_HAND
173 #define IDC_HAND MAKEINTRESOURCE(32649)
174 #endif
176 /* Color of chars displayed in cursor box. */
178 Lisp_Object Vx_cursor_fore_pixel;
180 /* Nonzero if using Windows. */
182 static int w32_in_use;
184 /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'. */
186 Lisp_Object Vx_pixel_size_width_font_regexp;
188 /* Alist of bdf fonts and the files that define them. */
189 Lisp_Object Vw32_bdf_filename_alist;
191 /* A flag to control whether fonts are matched strictly or not. */
192 static int w32_strict_fontnames;
194 /* A flag to control whether we should only repaint if GetUpdateRect
195 indicates there is an update region. */
196 static int w32_strict_painting;
198 Lisp_Object Qnone;
199 Lisp_Object Qsuppress_icon;
200 Lisp_Object Qundefined_color;
201 Lisp_Object Qcancel_timer;
202 Lisp_Object Qfont_param;
203 Lisp_Object Qhyper;
204 Lisp_Object Qsuper;
205 Lisp_Object Qmeta;
206 Lisp_Object Qalt;
207 Lisp_Object Qctrl;
208 Lisp_Object Qcontrol;
209 Lisp_Object Qshift;
212 /* The ANSI codepage. */
213 int w32_ansi_code_page;
215 /* Prefix for system colors. */
216 #define SYSTEM_COLOR_PREFIX "System"
217 #define SYSTEM_COLOR_PREFIX_LEN (sizeof (SYSTEM_COLOR_PREFIX) - 1)
219 /* State variables for emulating a three button mouse. */
220 #define LMOUSE 1
221 #define MMOUSE 2
222 #define RMOUSE 4
224 static int button_state = 0;
225 static W32Msg saved_mouse_button_msg;
226 static unsigned mouse_button_timer = 0; /* non-zero when timer is active */
227 static W32Msg saved_mouse_move_msg;
228 static unsigned mouse_move_timer = 0;
230 /* Window that is tracking the mouse. */
231 static HWND track_mouse_window;
233 /* Multi-monitor API definitions that are not pulled from the headers
234 since we are compiling for NT 4. */
235 #ifndef MONITOR_DEFAULT_TO_NEAREST
236 #define MONITOR_DEFAULT_TO_NEAREST 2
237 #endif
238 /* MinGW headers define MONITORINFO unconditionally, but MSVC ones don't.
239 To avoid a compile error on one or the other, redefine with a new name. */
240 struct MONITOR_INFO
242 DWORD cbSize;
243 RECT rcMonitor;
244 RECT rcWork;
245 DWORD dwFlags;
248 typedef BOOL (WINAPI * TrackMouseEvent_Proc)
249 (IN OUT LPTRACKMOUSEEVENT lpEventTrack);
250 typedef LONG (WINAPI * ImmGetCompositionString_Proc)
251 (IN HIMC context, IN DWORD index, OUT LPVOID buffer, IN DWORD bufLen);
252 typedef HIMC (WINAPI * ImmGetContext_Proc) (IN HWND window);
253 typedef HMONITOR (WINAPI * MonitorFromPoint_Proc) (IN POINT pt, IN DWORD flags);
254 typedef BOOL (WINAPI * GetMonitorInfo_Proc)
255 (IN HMONITOR monitor, OUT struct MONITOR_INFO* info);
257 TrackMouseEvent_Proc track_mouse_event_fn = NULL;
258 ClipboardSequence_Proc clipboard_sequence_fn = NULL;
259 ImmGetCompositionString_Proc get_composition_string_fn = NULL;
260 ImmGetContext_Proc get_ime_context_fn = NULL;
261 MonitorFromPoint_Proc monitor_from_point_fn = NULL;
262 GetMonitorInfo_Proc get_monitor_info_fn = NULL;
264 extern AppendMenuW_Proc unicode_append_menu;
266 /* Flag to selectively ignore WM_IME_CHAR messages. */
267 static int ignore_ime_char = 0;
269 /* W95 mousewheel handler */
270 unsigned int msh_mousewheel = 0;
272 /* Timers */
273 #define MOUSE_BUTTON_ID 1
274 #define MOUSE_MOVE_ID 2
275 #define MENU_FREE_ID 3
276 #define HOURGLASS_ID 4
277 /* The delay (milliseconds) before a menu is freed after WM_EXITMENULOOP
278 is received. */
279 #define MENU_FREE_DELAY 1000
280 static unsigned menu_free_timer = 0;
282 /* The below are defined in frame.c. */
284 extern Lisp_Object Vwindow_system_version;
286 #ifdef GLYPH_DEBUG
287 int image_cache_refcount, dpyinfo_refcount;
288 #endif
291 /* From w32term.c. */
292 extern int w32_num_mouse_buttons;
293 extern Lisp_Object Vw32_recognize_altgr;
295 extern HWND w32_system_caret_hwnd;
297 extern int w32_system_caret_height;
298 extern int w32_system_caret_x;
299 extern int w32_system_caret_y;
300 extern int w32_use_visible_system_caret;
302 static HWND w32_visible_system_caret_hwnd;
304 /* From w32menu.c */
305 extern HMENU current_popup_menu;
306 static int menubar_in_use = 0;
308 /* From w32uniscribe.c */
309 extern void syms_of_w32uniscribe ();
310 extern int uniscribe_available;
312 /* Function prototypes for hourglass support. */
313 static void show_hourglass P_ ((struct frame *));
314 static void hide_hourglass P_ ((void));
318 /* Error if we are not connected to MS-Windows. */
319 void
320 check_w32 ()
322 if (! w32_in_use)
323 error ("MS-Windows not in use or not initialized");
326 /* Nonzero if we can use mouse menus.
327 You should not call this unless HAVE_MENUS is defined. */
330 have_menus_p ()
332 return w32_in_use;
335 /* Extract a frame as a FRAME_PTR, defaulting to the selected frame
336 and checking validity for W32. */
338 FRAME_PTR
339 check_x_frame (frame)
340 Lisp_Object frame;
342 FRAME_PTR f;
344 if (NILP (frame))
345 frame = selected_frame;
346 CHECK_LIVE_FRAME (frame);
347 f = XFRAME (frame);
348 if (! FRAME_W32_P (f))
349 error ("Non-W32 frame used");
350 return f;
353 /* Let the user specify a display with a frame.
354 nil stands for the selected frame--or, if that is not a w32 frame,
355 the first display on the list. */
357 struct w32_display_info *
358 check_x_display_info (frame)
359 Lisp_Object frame;
361 if (NILP (frame))
363 struct frame *sf = XFRAME (selected_frame);
365 if (FRAME_W32_P (sf) && FRAME_LIVE_P (sf))
366 return FRAME_W32_DISPLAY_INFO (sf);
367 else
368 return &one_w32_display_info;
370 else if (STRINGP (frame))
371 return x_display_info_for_name (frame);
372 else
374 FRAME_PTR f;
376 CHECK_LIVE_FRAME (frame);
377 f = XFRAME (frame);
378 if (! FRAME_W32_P (f))
379 error ("Non-W32 frame used");
380 return FRAME_W32_DISPLAY_INFO (f);
384 /* Return the Emacs frame-object corresponding to an w32 window.
385 It could be the frame's main window or an icon window. */
387 /* This function can be called during GC, so use GC_xxx type test macros. */
389 struct frame *
390 x_window_to_frame (dpyinfo, wdesc)
391 struct w32_display_info *dpyinfo;
392 HWND wdesc;
394 Lisp_Object tail, frame;
395 struct frame *f;
397 for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
399 frame = XCAR (tail);
400 if (!FRAMEP (frame))
401 continue;
402 f = XFRAME (frame);
403 if (!FRAME_W32_P (f) || FRAME_W32_DISPLAY_INFO (f) != dpyinfo)
404 continue;
406 if (FRAME_W32_WINDOW (f) == wdesc)
407 return f;
409 return 0;
413 static Lisp_Object unwind_create_frame P_ ((Lisp_Object));
414 static Lisp_Object unwind_create_tip_frame P_ ((Lisp_Object));
415 static void my_create_window P_ ((struct frame *));
416 static void my_create_tip_window P_ ((struct frame *));
418 /* TODO: Native Input Method support; see x_create_im. */
419 void x_set_foreground_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
420 void x_set_background_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
421 void x_set_mouse_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
422 void x_set_cursor_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
423 void x_set_border_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
424 void x_set_cursor_type P_ ((struct frame *, Lisp_Object, Lisp_Object));
425 void x_set_icon_type P_ ((struct frame *, Lisp_Object, Lisp_Object));
426 void x_set_icon_name P_ ((struct frame *, Lisp_Object, Lisp_Object));
427 void x_explicitly_set_name P_ ((struct frame *, Lisp_Object, Lisp_Object));
428 void x_set_menu_bar_lines P_ ((struct frame *, Lisp_Object, Lisp_Object));
429 void x_set_title P_ ((struct frame *, Lisp_Object, Lisp_Object));
430 void x_set_tool_bar_lines P_ ((struct frame *, Lisp_Object, Lisp_Object));
431 static void x_edge_detection P_ ((struct frame *, struct image *, Lisp_Object,
432 Lisp_Object));
437 /* Store the screen positions of frame F into XPTR and YPTR.
438 These are the positions of the containing window manager window,
439 not Emacs's own window. */
441 void
442 x_real_positions (f, xptr, yptr)
443 FRAME_PTR f;
444 int *xptr, *yptr;
446 POINT pt;
447 RECT rect;
449 /* Get the bounds of the WM window. */
450 GetWindowRect (FRAME_W32_WINDOW (f), &rect);
452 pt.x = 0;
453 pt.y = 0;
455 /* Convert (0, 0) in the client area to screen co-ordinates. */
456 ClientToScreen (FRAME_W32_WINDOW (f), &pt);
458 /* Remember x_pixels_diff and y_pixels_diff. */
459 f->x_pixels_diff = pt.x - rect.left;
460 f->y_pixels_diff = pt.y - rect.top;
462 *xptr = rect.left;
463 *yptr = rect.top;
468 DEFUN ("w32-define-rgb-color", Fw32_define_rgb_color,
469 Sw32_define_rgb_color, 4, 4, 0,
470 doc: /* Convert RGB numbers to a Windows color reference and associate with NAME.
471 This adds or updates a named color to `w32-color-map', making it
472 available for use. The original entry's RGB ref is returned, or nil
473 if the entry is new. */)
474 (red, green, blue, name)
475 Lisp_Object red, green, blue, name;
477 Lisp_Object rgb;
478 Lisp_Object oldrgb = Qnil;
479 Lisp_Object entry;
481 CHECK_NUMBER (red);
482 CHECK_NUMBER (green);
483 CHECK_NUMBER (blue);
484 CHECK_STRING (name);
486 XSETINT (rgb, RGB (XUINT (red), XUINT (green), XUINT (blue)));
488 BLOCK_INPUT;
490 /* replace existing entry in w32-color-map or add new entry. */
491 entry = Fassoc (name, Vw32_color_map);
492 if (NILP (entry))
494 entry = Fcons (name, rgb);
495 Vw32_color_map = Fcons (entry, Vw32_color_map);
497 else
499 oldrgb = Fcdr (entry);
500 Fsetcdr (entry, rgb);
503 UNBLOCK_INPUT;
505 return (oldrgb);
508 DEFUN ("w32-load-color-file", Fw32_load_color_file,
509 Sw32_load_color_file, 1, 1, 0,
510 doc: /* Create an alist of color entries from an external file.
511 Assign this value to `w32-color-map' to replace the existing color map.
513 The file should define one named RGB color per line like so:
514 R G B name
515 where R,G,B are numbers between 0 and 255 and name is an arbitrary string. */)
516 (filename)
517 Lisp_Object filename;
519 FILE *fp;
520 Lisp_Object cmap = Qnil;
521 Lisp_Object abspath;
523 CHECK_STRING (filename);
524 abspath = Fexpand_file_name (filename, Qnil);
526 fp = fopen (SDATA (filename), "rt");
527 if (fp)
529 char buf[512];
530 int red, green, blue;
531 int num;
533 BLOCK_INPUT;
535 while (fgets (buf, sizeof (buf), fp) != NULL) {
536 if (sscanf (buf, "%u %u %u %n", &red, &green, &blue, &num) == 3)
538 char *name = buf + num;
539 num = strlen (name) - 1;
540 if (name[num] == '\n')
541 name[num] = 0;
542 cmap = Fcons (Fcons (build_string (name),
543 make_number (RGB (red, green, blue))),
544 cmap);
547 fclose (fp);
549 UNBLOCK_INPUT;
552 return cmap;
555 /* The default colors for the w32 color map */
556 typedef struct colormap_t
558 char *name;
559 COLORREF colorref;
560 } colormap_t;
562 colormap_t w32_color_map[] =
564 {"snow" , PALETTERGB (255,250,250)},
565 {"ghost white" , PALETTERGB (248,248,255)},
566 {"GhostWhite" , PALETTERGB (248,248,255)},
567 {"white smoke" , PALETTERGB (245,245,245)},
568 {"WhiteSmoke" , PALETTERGB (245,245,245)},
569 {"gainsboro" , PALETTERGB (220,220,220)},
570 {"floral white" , PALETTERGB (255,250,240)},
571 {"FloralWhite" , PALETTERGB (255,250,240)},
572 {"old lace" , PALETTERGB (253,245,230)},
573 {"OldLace" , PALETTERGB (253,245,230)},
574 {"linen" , PALETTERGB (250,240,230)},
575 {"antique white" , PALETTERGB (250,235,215)},
576 {"AntiqueWhite" , PALETTERGB (250,235,215)},
577 {"papaya whip" , PALETTERGB (255,239,213)},
578 {"PapayaWhip" , PALETTERGB (255,239,213)},
579 {"blanched almond" , PALETTERGB (255,235,205)},
580 {"BlanchedAlmond" , PALETTERGB (255,235,205)},
581 {"bisque" , PALETTERGB (255,228,196)},
582 {"peach puff" , PALETTERGB (255,218,185)},
583 {"PeachPuff" , PALETTERGB (255,218,185)},
584 {"navajo white" , PALETTERGB (255,222,173)},
585 {"NavajoWhite" , PALETTERGB (255,222,173)},
586 {"moccasin" , PALETTERGB (255,228,181)},
587 {"cornsilk" , PALETTERGB (255,248,220)},
588 {"ivory" , PALETTERGB (255,255,240)},
589 {"lemon chiffon" , PALETTERGB (255,250,205)},
590 {"LemonChiffon" , PALETTERGB (255,250,205)},
591 {"seashell" , PALETTERGB (255,245,238)},
592 {"honeydew" , PALETTERGB (240,255,240)},
593 {"mint cream" , PALETTERGB (245,255,250)},
594 {"MintCream" , PALETTERGB (245,255,250)},
595 {"azure" , PALETTERGB (240,255,255)},
596 {"alice blue" , PALETTERGB (240,248,255)},
597 {"AliceBlue" , PALETTERGB (240,248,255)},
598 {"lavender" , PALETTERGB (230,230,250)},
599 {"lavender blush" , PALETTERGB (255,240,245)},
600 {"LavenderBlush" , PALETTERGB (255,240,245)},
601 {"misty rose" , PALETTERGB (255,228,225)},
602 {"MistyRose" , PALETTERGB (255,228,225)},
603 {"white" , PALETTERGB (255,255,255)},
604 {"black" , PALETTERGB ( 0, 0, 0)},
605 {"dark slate gray" , PALETTERGB ( 47, 79, 79)},
606 {"DarkSlateGray" , PALETTERGB ( 47, 79, 79)},
607 {"dark slate grey" , PALETTERGB ( 47, 79, 79)},
608 {"DarkSlateGrey" , PALETTERGB ( 47, 79, 79)},
609 {"dim gray" , PALETTERGB (105,105,105)},
610 {"DimGray" , PALETTERGB (105,105,105)},
611 {"dim grey" , PALETTERGB (105,105,105)},
612 {"DimGrey" , PALETTERGB (105,105,105)},
613 {"slate gray" , PALETTERGB (112,128,144)},
614 {"SlateGray" , PALETTERGB (112,128,144)},
615 {"slate grey" , PALETTERGB (112,128,144)},
616 {"SlateGrey" , PALETTERGB (112,128,144)},
617 {"light slate gray" , PALETTERGB (119,136,153)},
618 {"LightSlateGray" , PALETTERGB (119,136,153)},
619 {"light slate grey" , PALETTERGB (119,136,153)},
620 {"LightSlateGrey" , PALETTERGB (119,136,153)},
621 {"gray" , PALETTERGB (190,190,190)},
622 {"grey" , PALETTERGB (190,190,190)},
623 {"light grey" , PALETTERGB (211,211,211)},
624 {"LightGrey" , PALETTERGB (211,211,211)},
625 {"light gray" , PALETTERGB (211,211,211)},
626 {"LightGray" , PALETTERGB (211,211,211)},
627 {"midnight blue" , PALETTERGB ( 25, 25,112)},
628 {"MidnightBlue" , PALETTERGB ( 25, 25,112)},
629 {"navy" , PALETTERGB ( 0, 0,128)},
630 {"navy blue" , PALETTERGB ( 0, 0,128)},
631 {"NavyBlue" , PALETTERGB ( 0, 0,128)},
632 {"cornflower blue" , PALETTERGB (100,149,237)},
633 {"CornflowerBlue" , PALETTERGB (100,149,237)},
634 {"dark slate blue" , PALETTERGB ( 72, 61,139)},
635 {"DarkSlateBlue" , PALETTERGB ( 72, 61,139)},
636 {"slate blue" , PALETTERGB (106, 90,205)},
637 {"SlateBlue" , PALETTERGB (106, 90,205)},
638 {"medium slate blue" , PALETTERGB (123,104,238)},
639 {"MediumSlateBlue" , PALETTERGB (123,104,238)},
640 {"light slate blue" , PALETTERGB (132,112,255)},
641 {"LightSlateBlue" , PALETTERGB (132,112,255)},
642 {"medium blue" , PALETTERGB ( 0, 0,205)},
643 {"MediumBlue" , PALETTERGB ( 0, 0,205)},
644 {"royal blue" , PALETTERGB ( 65,105,225)},
645 {"RoyalBlue" , PALETTERGB ( 65,105,225)},
646 {"blue" , PALETTERGB ( 0, 0,255)},
647 {"dodger blue" , PALETTERGB ( 30,144,255)},
648 {"DodgerBlue" , PALETTERGB ( 30,144,255)},
649 {"deep sky blue" , PALETTERGB ( 0,191,255)},
650 {"DeepSkyBlue" , PALETTERGB ( 0,191,255)},
651 {"sky blue" , PALETTERGB (135,206,235)},
652 {"SkyBlue" , PALETTERGB (135,206,235)},
653 {"light sky blue" , PALETTERGB (135,206,250)},
654 {"LightSkyBlue" , PALETTERGB (135,206,250)},
655 {"steel blue" , PALETTERGB ( 70,130,180)},
656 {"SteelBlue" , PALETTERGB ( 70,130,180)},
657 {"light steel blue" , PALETTERGB (176,196,222)},
658 {"LightSteelBlue" , PALETTERGB (176,196,222)},
659 {"light blue" , PALETTERGB (173,216,230)},
660 {"LightBlue" , PALETTERGB (173,216,230)},
661 {"powder blue" , PALETTERGB (176,224,230)},
662 {"PowderBlue" , PALETTERGB (176,224,230)},
663 {"pale turquoise" , PALETTERGB (175,238,238)},
664 {"PaleTurquoise" , PALETTERGB (175,238,238)},
665 {"dark turquoise" , PALETTERGB ( 0,206,209)},
666 {"DarkTurquoise" , PALETTERGB ( 0,206,209)},
667 {"medium turquoise" , PALETTERGB ( 72,209,204)},
668 {"MediumTurquoise" , PALETTERGB ( 72,209,204)},
669 {"turquoise" , PALETTERGB ( 64,224,208)},
670 {"cyan" , PALETTERGB ( 0,255,255)},
671 {"light cyan" , PALETTERGB (224,255,255)},
672 {"LightCyan" , PALETTERGB (224,255,255)},
673 {"cadet blue" , PALETTERGB ( 95,158,160)},
674 {"CadetBlue" , PALETTERGB ( 95,158,160)},
675 {"medium aquamarine" , PALETTERGB (102,205,170)},
676 {"MediumAquamarine" , PALETTERGB (102,205,170)},
677 {"aquamarine" , PALETTERGB (127,255,212)},
678 {"dark green" , PALETTERGB ( 0,100, 0)},
679 {"DarkGreen" , PALETTERGB ( 0,100, 0)},
680 {"dark olive green" , PALETTERGB ( 85,107, 47)},
681 {"DarkOliveGreen" , PALETTERGB ( 85,107, 47)},
682 {"dark sea green" , PALETTERGB (143,188,143)},
683 {"DarkSeaGreen" , PALETTERGB (143,188,143)},
684 {"sea green" , PALETTERGB ( 46,139, 87)},
685 {"SeaGreen" , PALETTERGB ( 46,139, 87)},
686 {"medium sea green" , PALETTERGB ( 60,179,113)},
687 {"MediumSeaGreen" , PALETTERGB ( 60,179,113)},
688 {"light sea green" , PALETTERGB ( 32,178,170)},
689 {"LightSeaGreen" , PALETTERGB ( 32,178,170)},
690 {"pale green" , PALETTERGB (152,251,152)},
691 {"PaleGreen" , PALETTERGB (152,251,152)},
692 {"spring green" , PALETTERGB ( 0,255,127)},
693 {"SpringGreen" , PALETTERGB ( 0,255,127)},
694 {"lawn green" , PALETTERGB (124,252, 0)},
695 {"LawnGreen" , PALETTERGB (124,252, 0)},
696 {"green" , PALETTERGB ( 0,255, 0)},
697 {"chartreuse" , PALETTERGB (127,255, 0)},
698 {"medium spring green" , PALETTERGB ( 0,250,154)},
699 {"MediumSpringGreen" , PALETTERGB ( 0,250,154)},
700 {"green yellow" , PALETTERGB (173,255, 47)},
701 {"GreenYellow" , PALETTERGB (173,255, 47)},
702 {"lime green" , PALETTERGB ( 50,205, 50)},
703 {"LimeGreen" , PALETTERGB ( 50,205, 50)},
704 {"yellow green" , PALETTERGB (154,205, 50)},
705 {"YellowGreen" , PALETTERGB (154,205, 50)},
706 {"forest green" , PALETTERGB ( 34,139, 34)},
707 {"ForestGreen" , PALETTERGB ( 34,139, 34)},
708 {"olive drab" , PALETTERGB (107,142, 35)},
709 {"OliveDrab" , PALETTERGB (107,142, 35)},
710 {"dark khaki" , PALETTERGB (189,183,107)},
711 {"DarkKhaki" , PALETTERGB (189,183,107)},
712 {"khaki" , PALETTERGB (240,230,140)},
713 {"pale goldenrod" , PALETTERGB (238,232,170)},
714 {"PaleGoldenrod" , PALETTERGB (238,232,170)},
715 {"light goldenrod yellow" , PALETTERGB (250,250,210)},
716 {"LightGoldenrodYellow" , PALETTERGB (250,250,210)},
717 {"light yellow" , PALETTERGB (255,255,224)},
718 {"LightYellow" , PALETTERGB (255,255,224)},
719 {"yellow" , PALETTERGB (255,255, 0)},
720 {"gold" , PALETTERGB (255,215, 0)},
721 {"light goldenrod" , PALETTERGB (238,221,130)},
722 {"LightGoldenrod" , PALETTERGB (238,221,130)},
723 {"goldenrod" , PALETTERGB (218,165, 32)},
724 {"dark goldenrod" , PALETTERGB (184,134, 11)},
725 {"DarkGoldenrod" , PALETTERGB (184,134, 11)},
726 {"rosy brown" , PALETTERGB (188,143,143)},
727 {"RosyBrown" , PALETTERGB (188,143,143)},
728 {"indian red" , PALETTERGB (205, 92, 92)},
729 {"IndianRed" , PALETTERGB (205, 92, 92)},
730 {"saddle brown" , PALETTERGB (139, 69, 19)},
731 {"SaddleBrown" , PALETTERGB (139, 69, 19)},
732 {"sienna" , PALETTERGB (160, 82, 45)},
733 {"peru" , PALETTERGB (205,133, 63)},
734 {"burlywood" , PALETTERGB (222,184,135)},
735 {"beige" , PALETTERGB (245,245,220)},
736 {"wheat" , PALETTERGB (245,222,179)},
737 {"sandy brown" , PALETTERGB (244,164, 96)},
738 {"SandyBrown" , PALETTERGB (244,164, 96)},
739 {"tan" , PALETTERGB (210,180,140)},
740 {"chocolate" , PALETTERGB (210,105, 30)},
741 {"firebrick" , PALETTERGB (178,34, 34)},
742 {"brown" , PALETTERGB (165,42, 42)},
743 {"dark salmon" , PALETTERGB (233,150,122)},
744 {"DarkSalmon" , PALETTERGB (233,150,122)},
745 {"salmon" , PALETTERGB (250,128,114)},
746 {"light salmon" , PALETTERGB (255,160,122)},
747 {"LightSalmon" , PALETTERGB (255,160,122)},
748 {"orange" , PALETTERGB (255,165, 0)},
749 {"dark orange" , PALETTERGB (255,140, 0)},
750 {"DarkOrange" , PALETTERGB (255,140, 0)},
751 {"coral" , PALETTERGB (255,127, 80)},
752 {"light coral" , PALETTERGB (240,128,128)},
753 {"LightCoral" , PALETTERGB (240,128,128)},
754 {"tomato" , PALETTERGB (255, 99, 71)},
755 {"orange red" , PALETTERGB (255, 69, 0)},
756 {"OrangeRed" , PALETTERGB (255, 69, 0)},
757 {"red" , PALETTERGB (255, 0, 0)},
758 {"hot pink" , PALETTERGB (255,105,180)},
759 {"HotPink" , PALETTERGB (255,105,180)},
760 {"deep pink" , PALETTERGB (255, 20,147)},
761 {"DeepPink" , PALETTERGB (255, 20,147)},
762 {"pink" , PALETTERGB (255,192,203)},
763 {"light pink" , PALETTERGB (255,182,193)},
764 {"LightPink" , PALETTERGB (255,182,193)},
765 {"pale violet red" , PALETTERGB (219,112,147)},
766 {"PaleVioletRed" , PALETTERGB (219,112,147)},
767 {"maroon" , PALETTERGB (176, 48, 96)},
768 {"medium violet red" , PALETTERGB (199, 21,133)},
769 {"MediumVioletRed" , PALETTERGB (199, 21,133)},
770 {"violet red" , PALETTERGB (208, 32,144)},
771 {"VioletRed" , PALETTERGB (208, 32,144)},
772 {"magenta" , PALETTERGB (255, 0,255)},
773 {"violet" , PALETTERGB (238,130,238)},
774 {"plum" , PALETTERGB (221,160,221)},
775 {"orchid" , PALETTERGB (218,112,214)},
776 {"medium orchid" , PALETTERGB (186, 85,211)},
777 {"MediumOrchid" , PALETTERGB (186, 85,211)},
778 {"dark orchid" , PALETTERGB (153, 50,204)},
779 {"DarkOrchid" , PALETTERGB (153, 50,204)},
780 {"dark violet" , PALETTERGB (148, 0,211)},
781 {"DarkViolet" , PALETTERGB (148, 0,211)},
782 {"blue violet" , PALETTERGB (138, 43,226)},
783 {"BlueViolet" , PALETTERGB (138, 43,226)},
784 {"purple" , PALETTERGB (160, 32,240)},
785 {"medium purple" , PALETTERGB (147,112,219)},
786 {"MediumPurple" , PALETTERGB (147,112,219)},
787 {"thistle" , PALETTERGB (216,191,216)},
788 {"gray0" , PALETTERGB ( 0, 0, 0)},
789 {"grey0" , PALETTERGB ( 0, 0, 0)},
790 {"dark grey" , PALETTERGB (169,169,169)},
791 {"DarkGrey" , PALETTERGB (169,169,169)},
792 {"dark gray" , PALETTERGB (169,169,169)},
793 {"DarkGray" , PALETTERGB (169,169,169)},
794 {"dark blue" , PALETTERGB ( 0, 0,139)},
795 {"DarkBlue" , PALETTERGB ( 0, 0,139)},
796 {"dark cyan" , PALETTERGB ( 0,139,139)},
797 {"DarkCyan" , PALETTERGB ( 0,139,139)},
798 {"dark magenta" , PALETTERGB (139, 0,139)},
799 {"DarkMagenta" , PALETTERGB (139, 0,139)},
800 {"dark red" , PALETTERGB (139, 0, 0)},
801 {"DarkRed" , PALETTERGB (139, 0, 0)},
802 {"light green" , PALETTERGB (144,238,144)},
803 {"LightGreen" , PALETTERGB (144,238,144)},
806 DEFUN ("w32-default-color-map", Fw32_default_color_map, Sw32_default_color_map,
807 0, 0, 0, doc: /* Return the default color map. */)
810 int i;
811 colormap_t *pc = w32_color_map;
812 Lisp_Object cmap;
814 BLOCK_INPUT;
816 cmap = Qnil;
818 for (i = 0; i < sizeof (w32_color_map) / sizeof (w32_color_map[0]);
819 pc++, i++)
820 cmap = Fcons (Fcons (build_string (pc->name),
821 make_number (pc->colorref)),
822 cmap);
824 UNBLOCK_INPUT;
826 return (cmap);
829 static Lisp_Object
830 w32_to_x_color (rgb)
831 Lisp_Object rgb;
833 Lisp_Object color;
835 CHECK_NUMBER (rgb);
837 BLOCK_INPUT;
839 color = Frassq (rgb, Vw32_color_map);
841 UNBLOCK_INPUT;
843 if (!NILP (color))
844 return (Fcar (color));
845 else
846 return Qnil;
849 static Lisp_Object
850 w32_color_map_lookup (colorname)
851 char *colorname;
853 Lisp_Object tail, ret = Qnil;
855 BLOCK_INPUT;
857 for (tail = Vw32_color_map; CONSP (tail); tail = XCDR (tail))
859 register Lisp_Object elt, tem;
861 elt = XCAR (tail);
862 if (!CONSP (elt)) continue;
864 tem = Fcar (elt);
866 if (lstrcmpi (SDATA (tem), colorname) == 0)
868 ret = Fcdr (elt);
869 break;
872 QUIT;
876 UNBLOCK_INPUT;
878 return ret;
882 static void
883 add_system_logical_colors_to_map (system_colors)
884 Lisp_Object *system_colors;
886 HKEY colors_key;
888 /* Other registry operations are done with input blocked. */
889 BLOCK_INPUT;
891 /* Look for "Control Panel/Colors" under User and Machine registry
892 settings. */
893 if (RegOpenKeyEx (HKEY_CURRENT_USER, "Control Panel\\Colors", 0,
894 KEY_READ, &colors_key) == ERROR_SUCCESS
895 || RegOpenKeyEx (HKEY_LOCAL_MACHINE, "Control Panel\\Colors", 0,
896 KEY_READ, &colors_key) == ERROR_SUCCESS)
898 /* List all keys. */
899 char color_buffer[64];
900 char full_name_buffer[MAX_PATH + SYSTEM_COLOR_PREFIX_LEN];
901 int index = 0;
902 DWORD name_size, color_size;
903 char *name_buffer = full_name_buffer + SYSTEM_COLOR_PREFIX_LEN;
905 name_size = sizeof (full_name_buffer) - SYSTEM_COLOR_PREFIX_LEN;
906 color_size = sizeof (color_buffer);
908 strcpy (full_name_buffer, SYSTEM_COLOR_PREFIX);
910 while (RegEnumValueA (colors_key, index, name_buffer, &name_size,
911 NULL, NULL, color_buffer, &color_size)
912 == ERROR_SUCCESS)
914 int r, g, b;
915 if (sscanf (color_buffer, " %u %u %u", &r, &g, &b) == 3)
916 *system_colors = Fcons (Fcons (build_string (full_name_buffer),
917 make_number (RGB (r, g, b))),
918 *system_colors);
920 name_size = sizeof (full_name_buffer) - SYSTEM_COLOR_PREFIX_LEN;
921 color_size = sizeof (color_buffer);
922 index++;
924 RegCloseKey (colors_key);
927 UNBLOCK_INPUT;
931 static Lisp_Object
932 x_to_w32_color (colorname)
933 char * colorname;
935 register Lisp_Object ret = Qnil;
937 BLOCK_INPUT;
939 if (colorname[0] == '#')
941 /* Could be an old-style RGB Device specification. */
942 char *color;
943 int size;
944 color = colorname + 1;
946 size = strlen (color);
947 if (size == 3 || size == 6 || size == 9 || size == 12)
949 UINT colorval;
950 int i, pos;
951 pos = 0;
952 size /= 3;
953 colorval = 0;
955 for (i = 0; i < 3; i++)
957 char *end;
958 char t;
959 unsigned long value;
961 /* The check for 'x' in the following conditional takes into
962 account the fact that strtol allows a "0x" in front of
963 our numbers, and we don't. */
964 if (!isxdigit (color[0]) || color[1] == 'x')
965 break;
966 t = color[size];
967 color[size] = '\0';
968 value = strtoul (color, &end, 16);
969 color[size] = t;
970 if (errno == ERANGE || end - color != size)
971 break;
972 switch (size)
974 case 1:
975 value = value * 0x10;
976 break;
977 case 2:
978 break;
979 case 3:
980 value /= 0x10;
981 break;
982 case 4:
983 value /= 0x100;
984 break;
986 colorval |= (value << pos);
987 pos += 0x8;
988 if (i == 2)
990 UNBLOCK_INPUT;
991 XSETINT (ret, colorval);
992 return ret;
994 color = end;
998 else if (strnicmp (colorname, "rgb:", 4) == 0)
1000 char *color;
1001 UINT colorval;
1002 int i, pos;
1003 pos = 0;
1005 colorval = 0;
1006 color = colorname + 4;
1007 for (i = 0; i < 3; i++)
1009 char *end;
1010 unsigned long value;
1012 /* The check for 'x' in the following conditional takes into
1013 account the fact that strtol allows a "0x" in front of
1014 our numbers, and we don't. */
1015 if (!isxdigit (color[0]) || color[1] == 'x')
1016 break;
1017 value = strtoul (color, &end, 16);
1018 if (errno == ERANGE)
1019 break;
1020 switch (end - color)
1022 case 1:
1023 value = value * 0x10 + value;
1024 break;
1025 case 2:
1026 break;
1027 case 3:
1028 value /= 0x10;
1029 break;
1030 case 4:
1031 value /= 0x100;
1032 break;
1033 default:
1034 value = ULONG_MAX;
1036 if (value == ULONG_MAX)
1037 break;
1038 colorval |= (value << pos);
1039 pos += 0x8;
1040 if (i == 2)
1042 if (*end != '\0')
1043 break;
1044 UNBLOCK_INPUT;
1045 XSETINT (ret, colorval);
1046 return ret;
1048 if (*end != '/')
1049 break;
1050 color = end + 1;
1053 else if (strnicmp (colorname, "rgbi:", 5) == 0)
1055 /* This is an RGB Intensity specification. */
1056 char *color;
1057 UINT colorval;
1058 int i, pos;
1059 pos = 0;
1061 colorval = 0;
1062 color = colorname + 5;
1063 for (i = 0; i < 3; i++)
1065 char *end;
1066 double value;
1067 UINT val;
1069 value = strtod (color, &end);
1070 if (errno == ERANGE)
1071 break;
1072 if (value < 0.0 || value > 1.0)
1073 break;
1074 val = (UINT)(0x100 * value);
1075 /* We used 0x100 instead of 0xFF to give a continuous
1076 range between 0.0 and 1.0 inclusive. The next statement
1077 fixes the 1.0 case. */
1078 if (val == 0x100)
1079 val = 0xFF;
1080 colorval |= (val << pos);
1081 pos += 0x8;
1082 if (i == 2)
1084 if (*end != '\0')
1085 break;
1086 UNBLOCK_INPUT;
1087 XSETINT (ret, colorval);
1088 return ret;
1090 if (*end != '/')
1091 break;
1092 color = end + 1;
1095 /* I am not going to attempt to handle any of the CIE color schemes
1096 or TekHVC, since I don't know the algorithms for conversion to
1097 RGB. */
1099 /* If we fail to lookup the color name in w32_color_map, then check the
1100 colorname to see if it can be crudely approximated: If the X color
1101 ends in a number (e.g., "darkseagreen2"), strip the number and
1102 return the result of looking up the base color name. */
1103 ret = w32_color_map_lookup (colorname);
1104 if (NILP (ret))
1106 int len = strlen (colorname);
1108 if (isdigit (colorname[len - 1]))
1110 char *ptr, *approx = alloca (len + 1);
1112 strcpy (approx, colorname);
1113 ptr = &approx[len - 1];
1114 while (ptr > approx && isdigit (*ptr))
1115 *ptr-- = '\0';
1117 ret = w32_color_map_lookup (approx);
1121 UNBLOCK_INPUT;
1122 return ret;
1125 void
1126 w32_regenerate_palette (FRAME_PTR f)
1128 struct w32_palette_entry * list;
1129 LOGPALETTE * log_palette;
1130 HPALETTE new_palette;
1131 int i;
1133 /* don't bother trying to create palette if not supported */
1134 if (! FRAME_W32_DISPLAY_INFO (f)->has_palette)
1135 return;
1137 log_palette = (LOGPALETTE *)
1138 alloca (sizeof (LOGPALETTE) +
1139 FRAME_W32_DISPLAY_INFO (f)->num_colors * sizeof (PALETTEENTRY));
1140 log_palette->palVersion = 0x300;
1141 log_palette->palNumEntries = FRAME_W32_DISPLAY_INFO (f)->num_colors;
1143 list = FRAME_W32_DISPLAY_INFO (f)->color_list;
1144 for (i = 0;
1145 i < FRAME_W32_DISPLAY_INFO (f)->num_colors;
1146 i++, list = list->next)
1147 log_palette->palPalEntry[i] = list->entry;
1149 new_palette = CreatePalette (log_palette);
1151 enter_crit ();
1153 if (FRAME_W32_DISPLAY_INFO (f)->palette)
1154 DeleteObject (FRAME_W32_DISPLAY_INFO (f)->palette);
1155 FRAME_W32_DISPLAY_INFO (f)->palette = new_palette;
1157 /* Realize display palette and garbage all frames. */
1158 release_frame_dc (f, get_frame_dc (f));
1160 leave_crit ();
1163 #define W32_COLOR(pe) RGB (pe.peRed, pe.peGreen, pe.peBlue)
1164 #define SET_W32_COLOR(pe, color) \
1165 do \
1167 pe.peRed = GetRValue (color); \
1168 pe.peGreen = GetGValue (color); \
1169 pe.peBlue = GetBValue (color); \
1170 pe.peFlags = 0; \
1171 } while (0)
1173 #if 0
1174 /* Keep these around in case we ever want to track color usage. */
1175 void
1176 w32_map_color (FRAME_PTR f, COLORREF color)
1178 struct w32_palette_entry * list = FRAME_W32_DISPLAY_INFO (f)->color_list;
1180 if (NILP (Vw32_enable_palette))
1181 return;
1183 /* check if color is already mapped */
1184 while (list)
1186 if (W32_COLOR (list->entry) == color)
1188 ++list->refcount;
1189 return;
1191 list = list->next;
1194 /* not already mapped, so add to list and recreate Windows palette */
1195 list = (struct w32_palette_entry *)
1196 xmalloc (sizeof (struct w32_palette_entry));
1197 SET_W32_COLOR (list->entry, color);
1198 list->refcount = 1;
1199 list->next = FRAME_W32_DISPLAY_INFO (f)->color_list;
1200 FRAME_W32_DISPLAY_INFO (f)->color_list = list;
1201 FRAME_W32_DISPLAY_INFO (f)->num_colors++;
1203 /* set flag that palette must be regenerated */
1204 FRAME_W32_DISPLAY_INFO (f)->regen_palette = TRUE;
1207 void
1208 w32_unmap_color (FRAME_PTR f, COLORREF color)
1210 struct w32_palette_entry * list = FRAME_W32_DISPLAY_INFO (f)->color_list;
1211 struct w32_palette_entry **prev = &FRAME_W32_DISPLAY_INFO (f)->color_list;
1213 if (NILP (Vw32_enable_palette))
1214 return;
1216 /* check if color is already mapped */
1217 while (list)
1219 if (W32_COLOR (list->entry) == color)
1221 if (--list->refcount == 0)
1223 *prev = list->next;
1224 xfree (list);
1225 FRAME_W32_DISPLAY_INFO (f)->num_colors--;
1226 break;
1228 else
1229 return;
1231 prev = &list->next;
1232 list = list->next;
1235 /* set flag that palette must be regenerated */
1236 FRAME_W32_DISPLAY_INFO (f)->regen_palette = TRUE;
1238 #endif
1241 /* Gamma-correct COLOR on frame F. */
1243 void
1244 gamma_correct (f, color)
1245 struct frame *f;
1246 COLORREF *color;
1248 if (f->gamma)
1250 *color = PALETTERGB (
1251 pow (GetRValue (*color) / 255.0, f->gamma) * 255.0 + 0.5,
1252 pow (GetGValue (*color) / 255.0, f->gamma) * 255.0 + 0.5,
1253 pow (GetBValue (*color) / 255.0, f->gamma) * 255.0 + 0.5);
1258 /* Decide if color named COLOR is valid for the display associated with
1259 the selected frame; if so, return the rgb values in COLOR_DEF.
1260 If ALLOC is nonzero, allocate a new colormap cell. */
1263 w32_defined_color (f, color, color_def, alloc)
1264 FRAME_PTR f;
1265 char *color;
1266 XColor *color_def;
1267 int alloc;
1269 register Lisp_Object tem;
1270 COLORREF w32_color_ref;
1272 tem = x_to_w32_color (color);
1274 if (!NILP (tem))
1276 if (f)
1278 /* Apply gamma correction. */
1279 w32_color_ref = XUINT (tem);
1280 gamma_correct (f, &w32_color_ref);
1281 XSETINT (tem, w32_color_ref);
1284 /* Map this color to the palette if it is enabled. */
1285 if (!NILP (Vw32_enable_palette))
1287 struct w32_palette_entry * entry =
1288 one_w32_display_info.color_list;
1289 struct w32_palette_entry ** prev =
1290 &one_w32_display_info.color_list;
1292 /* check if color is already mapped */
1293 while (entry)
1295 if (W32_COLOR (entry->entry) == XUINT (tem))
1296 break;
1297 prev = &entry->next;
1298 entry = entry->next;
1301 if (entry == NULL && alloc)
1303 /* not already mapped, so add to list */
1304 entry = (struct w32_palette_entry *)
1305 xmalloc (sizeof (struct w32_palette_entry));
1306 SET_W32_COLOR (entry->entry, XUINT (tem));
1307 entry->next = NULL;
1308 *prev = entry;
1309 one_w32_display_info.num_colors++;
1311 /* set flag that palette must be regenerated */
1312 one_w32_display_info.regen_palette = TRUE;
1315 /* Ensure COLORREF value is snapped to nearest color in (default)
1316 palette by simulating the PALETTERGB macro. This works whether
1317 or not the display device has a palette. */
1318 w32_color_ref = XUINT (tem) | 0x2000000;
1320 color_def->pixel = w32_color_ref;
1321 color_def->red = GetRValue (w32_color_ref) * 256;
1322 color_def->green = GetGValue (w32_color_ref) * 256;
1323 color_def->blue = GetBValue (w32_color_ref) * 256;
1325 return 1;
1327 else
1329 return 0;
1333 /* Given a string ARG naming a color, compute a pixel value from it
1334 suitable for screen F.
1335 If F is not a color screen, return DEF (default) regardless of what
1336 ARG says. */
1339 x_decode_color (f, arg, def)
1340 FRAME_PTR f;
1341 Lisp_Object arg;
1342 int def;
1344 XColor cdef;
1346 CHECK_STRING (arg);
1348 if (strcmp (SDATA (arg), "black") == 0)
1349 return BLACK_PIX_DEFAULT (f);
1350 else if (strcmp (SDATA (arg), "white") == 0)
1351 return WHITE_PIX_DEFAULT (f);
1353 if ((FRAME_W32_DISPLAY_INFO (f)->n_planes * FRAME_W32_DISPLAY_INFO (f)->n_cbits) == 1)
1354 return def;
1356 /* w32_defined_color is responsible for coping with failures
1357 by looking for a near-miss. */
1358 if (w32_defined_color (f, SDATA (arg), &cdef, 1))
1359 return cdef.pixel;
1361 /* defined_color failed; return an ultimate default. */
1362 return def;
1367 /* Functions called only from `x_set_frame_param'
1368 to set individual parameters.
1370 If FRAME_W32_WINDOW (f) is 0,
1371 the frame is being created and its window does not exist yet.
1372 In that case, just record the parameter's new value
1373 in the standard place; do not attempt to change the window. */
1375 void
1376 x_set_foreground_color (f, arg, oldval)
1377 struct frame *f;
1378 Lisp_Object arg, oldval;
1380 struct w32_output *x = f->output_data.w32;
1381 PIX_TYPE fg, old_fg;
1383 fg = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1384 old_fg = FRAME_FOREGROUND_PIXEL (f);
1385 FRAME_FOREGROUND_PIXEL (f) = fg;
1387 if (FRAME_W32_WINDOW (f) != 0)
1389 if (x->cursor_pixel == old_fg)
1390 x->cursor_pixel = fg;
1392 update_face_from_frame_parameter (f, Qforeground_color, arg);
1393 if (FRAME_VISIBLE_P (f))
1394 redraw_frame (f);
1398 void
1399 x_set_background_color (f, arg, oldval)
1400 struct frame *f;
1401 Lisp_Object arg, oldval;
1403 FRAME_BACKGROUND_PIXEL (f)
1404 = x_decode_color (f, arg, WHITE_PIX_DEFAULT (f));
1406 if (FRAME_W32_WINDOW (f) != 0)
1408 SetWindowLong (FRAME_W32_WINDOW (f), WND_BACKGROUND_INDEX,
1409 FRAME_BACKGROUND_PIXEL (f));
1411 update_face_from_frame_parameter (f, Qbackground_color, arg);
1413 if (FRAME_VISIBLE_P (f))
1414 redraw_frame (f);
1418 void
1419 x_set_mouse_color (f, arg, oldval)
1420 struct frame *f;
1421 Lisp_Object arg, oldval;
1423 Cursor cursor, nontext_cursor, mode_cursor, hand_cursor;
1424 int count;
1425 int mask_color;
1427 if (!EQ (Qnil, arg))
1428 f->output_data.w32->mouse_pixel
1429 = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1430 mask_color = FRAME_BACKGROUND_PIXEL (f);
1432 /* Don't let pointers be invisible. */
1433 if (mask_color == f->output_data.w32->mouse_pixel
1434 && mask_color == FRAME_BACKGROUND_PIXEL (f))
1435 f->output_data.w32->mouse_pixel = FRAME_FOREGROUND_PIXEL (f);
1437 #if 0 /* TODO : cursor changes */
1438 BLOCK_INPUT;
1440 /* It's not okay to crash if the user selects a screwy cursor. */
1441 count = x_catch_errors (FRAME_W32_DISPLAY (f));
1443 if (!EQ (Qnil, Vx_pointer_shape))
1445 CHECK_NUMBER (Vx_pointer_shape);
1446 cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XINT (Vx_pointer_shape));
1448 else
1449 cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_xterm);
1450 x_check_errors (FRAME_W32_DISPLAY (f), "bad text pointer cursor: %s");
1452 if (!EQ (Qnil, Vx_nontext_pointer_shape))
1454 CHECK_NUMBER (Vx_nontext_pointer_shape);
1455 nontext_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f),
1456 XINT (Vx_nontext_pointer_shape));
1458 else
1459 nontext_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_left_ptr);
1460 x_check_errors (FRAME_W32_DISPLAY (f), "bad nontext pointer cursor: %s");
1462 if (!EQ (Qnil, Vx_hourglass_pointer_shape))
1464 CHECK_NUMBER (Vx_hourglass_pointer_shape);
1465 hourglass_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f),
1466 XINT (Vx_hourglass_pointer_shape));
1468 else
1469 hourglass_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_watch);
1470 x_check_errors (FRAME_W32_DISPLAY (f), "bad busy pointer cursor: %s");
1472 x_check_errors (FRAME_W32_DISPLAY (f), "bad nontext pointer cursor: %s");
1473 if (!EQ (Qnil, Vx_mode_pointer_shape))
1475 CHECK_NUMBER (Vx_mode_pointer_shape);
1476 mode_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f),
1477 XINT (Vx_mode_pointer_shape));
1479 else
1480 mode_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_xterm);
1481 x_check_errors (FRAME_W32_DISPLAY (f), "bad modeline pointer cursor: %s");
1483 if (!EQ (Qnil, Vx_sensitive_text_pointer_shape))
1485 CHECK_NUMBER (Vx_sensitive_text_pointer_shape);
1486 hand_cursor
1487 = XCreateFontCursor (FRAME_W32_DISPLAY (f),
1488 XINT (Vx_sensitive_text_pointer_shape));
1490 else
1491 hand_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_crosshair);
1493 if (!NILP (Vx_window_horizontal_drag_shape))
1495 CHECK_NUMBER (Vx_window_horizontal_drag_shape);
1496 horizontal_drag_cursor
1497 = XCreateFontCursor (FRAME_X_DISPLAY (f),
1498 XINT (Vx_window_horizontal_drag_shape));
1500 else
1501 horizontal_drag_cursor
1502 = XCreateFontCursor (FRAME_X_DISPLAY (f), XC_sb_h_double_arrow);
1504 /* Check and report errors with the above calls. */
1505 x_check_errors (FRAME_W32_DISPLAY (f), "can't set cursor shape: %s");
1506 x_uncatch_errors (FRAME_W32_DISPLAY (f), count);
1509 XColor fore_color, back_color;
1511 fore_color.pixel = f->output_data.w32->mouse_pixel;
1512 back_color.pixel = mask_color;
1513 XQueryColor (FRAME_W32_DISPLAY (f),
1514 DefaultColormap (FRAME_W32_DISPLAY (f),
1515 DefaultScreen (FRAME_W32_DISPLAY (f))),
1516 &fore_color);
1517 XQueryColor (FRAME_W32_DISPLAY (f),
1518 DefaultColormap (FRAME_W32_DISPLAY (f),
1519 DefaultScreen (FRAME_W32_DISPLAY (f))),
1520 &back_color);
1521 XRecolorCursor (FRAME_W32_DISPLAY (f), cursor,
1522 &fore_color, &back_color);
1523 XRecolorCursor (FRAME_W32_DISPLAY (f), nontext_cursor,
1524 &fore_color, &back_color);
1525 XRecolorCursor (FRAME_W32_DISPLAY (f), mode_cursor,
1526 &fore_color, &back_color);
1527 XRecolorCursor (FRAME_W32_DISPLAY (f), hand_cursor,
1528 &fore_color, &back_color);
1529 XRecolorCursor (FRAME_W32_DISPLAY (f), hourglass_cursor,
1530 &fore_color, &back_color);
1533 if (FRAME_W32_WINDOW (f) != 0)
1534 XDefineCursor (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f), cursor);
1536 if (cursor != f->output_data.w32->text_cursor && f->output_data.w32->text_cursor != 0)
1537 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->text_cursor);
1538 f->output_data.w32->text_cursor = cursor;
1540 if (nontext_cursor != f->output_data.w32->nontext_cursor
1541 && f->output_data.w32->nontext_cursor != 0)
1542 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->nontext_cursor);
1543 f->output_data.w32->nontext_cursor = nontext_cursor;
1545 if (hourglass_cursor != f->output_data.w32->hourglass_cursor
1546 && f->output_data.w32->hourglass_cursor != 0)
1547 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->hourglass_cursor);
1548 f->output_data.w32->hourglass_cursor = hourglass_cursor;
1550 if (mode_cursor != f->output_data.w32->modeline_cursor
1551 && f->output_data.w32->modeline_cursor != 0)
1552 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->modeline_cursor);
1553 f->output_data.w32->modeline_cursor = mode_cursor;
1555 if (hand_cursor != f->output_data.w32->hand_cursor
1556 && f->output_data.w32->hand_cursor != 0)
1557 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->hand_cursor);
1558 f->output_data.w32->hand_cursor = hand_cursor;
1560 XFlush (FRAME_W32_DISPLAY (f));
1561 UNBLOCK_INPUT;
1563 update_face_from_frame_parameter (f, Qmouse_color, arg);
1564 #endif /* TODO */
1567 void
1568 x_set_cursor_color (f, arg, oldval)
1569 struct frame *f;
1570 Lisp_Object arg, oldval;
1572 unsigned long fore_pixel, pixel;
1574 if (!NILP (Vx_cursor_fore_pixel))
1575 fore_pixel = x_decode_color (f, Vx_cursor_fore_pixel,
1576 WHITE_PIX_DEFAULT (f));
1577 else
1578 fore_pixel = FRAME_BACKGROUND_PIXEL (f);
1580 pixel = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1582 /* Make sure that the cursor color differs from the background color. */
1583 if (pixel == FRAME_BACKGROUND_PIXEL (f))
1585 pixel = f->output_data.w32->mouse_pixel;
1586 if (pixel == fore_pixel)
1587 fore_pixel = FRAME_BACKGROUND_PIXEL (f);
1590 f->output_data.w32->cursor_foreground_pixel = fore_pixel;
1591 f->output_data.w32->cursor_pixel = pixel;
1593 if (FRAME_W32_WINDOW (f) != 0)
1595 BLOCK_INPUT;
1596 /* Update frame's cursor_gc. */
1597 f->output_data.w32->cursor_gc->foreground = fore_pixel;
1598 f->output_data.w32->cursor_gc->background = pixel;
1600 UNBLOCK_INPUT;
1602 if (FRAME_VISIBLE_P (f))
1604 x_update_cursor (f, 0);
1605 x_update_cursor (f, 1);
1609 update_face_from_frame_parameter (f, Qcursor_color, arg);
1612 /* Set the border-color of frame F to pixel value PIX.
1613 Note that this does not fully take effect if done before
1614 F has a window. */
1616 void
1617 x_set_border_pixel (f, pix)
1618 struct frame *f;
1619 int pix;
1622 f->output_data.w32->border_pixel = pix;
1624 if (FRAME_W32_WINDOW (f) != 0 && f->border_width > 0)
1626 if (FRAME_VISIBLE_P (f))
1627 redraw_frame (f);
1631 /* Set the border-color of frame F to value described by ARG.
1632 ARG can be a string naming a color.
1633 The border-color is used for the border that is drawn by the server.
1634 Note that this does not fully take effect if done before
1635 F has a window; it must be redone when the window is created. */
1637 void
1638 x_set_border_color (f, arg, oldval)
1639 struct frame *f;
1640 Lisp_Object arg, oldval;
1642 int pix;
1644 CHECK_STRING (arg);
1645 pix = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1646 x_set_border_pixel (f, pix);
1647 update_face_from_frame_parameter (f, Qborder_color, arg);
1651 void
1652 x_set_cursor_type (f, arg, oldval)
1653 FRAME_PTR f;
1654 Lisp_Object arg, oldval;
1656 set_frame_cursor_types (f, arg);
1658 /* Make sure the cursor gets redrawn. */
1659 cursor_type_changed = 1;
1662 void
1663 x_set_icon_type (f, arg, oldval)
1664 struct frame *f;
1665 Lisp_Object arg, oldval;
1667 int result;
1669 if (NILP (arg) && NILP (oldval))
1670 return;
1672 if (STRINGP (arg) && STRINGP (oldval)
1673 && EQ (Fstring_equal (oldval, arg), Qt))
1674 return;
1676 if (SYMBOLP (arg) && SYMBOLP (oldval) && EQ (arg, oldval))
1677 return;
1679 BLOCK_INPUT;
1681 result = x_bitmap_icon (f, arg);
1682 if (result)
1684 UNBLOCK_INPUT;
1685 error ("No icon window available");
1688 UNBLOCK_INPUT;
1691 void
1692 x_set_icon_name (f, arg, oldval)
1693 struct frame *f;
1694 Lisp_Object arg, oldval;
1696 if (STRINGP (arg))
1698 if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
1699 return;
1701 else if (!NILP (arg) || NILP (oldval))
1702 return;
1704 f->icon_name = arg;
1706 #if 0
1707 if (f->output_data.w32->icon_bitmap != 0)
1708 return;
1710 BLOCK_INPUT;
1712 result = x_text_icon (f,
1713 (char *) SDATA ((!NILP (f->icon_name)
1714 ? f->icon_name
1715 : !NILP (f->title)
1716 ? f->title
1717 : f->name)));
1719 if (result)
1721 UNBLOCK_INPUT;
1722 error ("No icon window available");
1725 /* If the window was unmapped (and its icon was mapped),
1726 the new icon is not mapped, so map the window in its stead. */
1727 if (FRAME_VISIBLE_P (f))
1729 #ifdef USE_X_TOOLKIT
1730 XtPopup (f->output_data.w32->widget, XtGrabNone);
1731 #endif
1732 XMapWindow (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f));
1735 XFlush (FRAME_W32_DISPLAY (f));
1736 UNBLOCK_INPUT;
1737 #endif
1741 void
1742 x_set_menu_bar_lines (f, value, oldval)
1743 struct frame *f;
1744 Lisp_Object value, oldval;
1746 int nlines;
1747 int olines = FRAME_MENU_BAR_LINES (f);
1749 /* Right now, menu bars don't work properly in minibuf-only frames;
1750 most of the commands try to apply themselves to the minibuffer
1751 frame itself, and get an error because you can't switch buffers
1752 in or split the minibuffer window. */
1753 if (FRAME_MINIBUF_ONLY_P (f))
1754 return;
1756 if (INTEGERP (value))
1757 nlines = XINT (value);
1758 else
1759 nlines = 0;
1761 FRAME_MENU_BAR_LINES (f) = 0;
1762 if (nlines)
1763 FRAME_EXTERNAL_MENU_BAR (f) = 1;
1764 else
1766 if (FRAME_EXTERNAL_MENU_BAR (f) == 1)
1767 free_frame_menubar (f);
1768 FRAME_EXTERNAL_MENU_BAR (f) = 0;
1770 /* Adjust the frame size so that the client (text) dimensions
1771 remain the same. This depends on FRAME_EXTERNAL_MENU_BAR being
1772 set correctly. */
1773 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
1774 do_pending_window_change (0);
1776 adjust_glyphs (f);
1780 /* Set the number of lines used for the tool bar of frame F to VALUE.
1781 VALUE not an integer, or < 0 means set the lines to zero. OLDVAL
1782 is the old number of tool bar lines. This function changes the
1783 height of all windows on frame F to match the new tool bar height.
1784 The frame's height doesn't change. */
1786 void
1787 x_set_tool_bar_lines (f, value, oldval)
1788 struct frame *f;
1789 Lisp_Object value, oldval;
1791 int delta, nlines, root_height;
1792 Lisp_Object root_window;
1794 /* Treat tool bars like menu bars. */
1795 if (FRAME_MINIBUF_ONLY_P (f))
1796 return;
1798 /* Use VALUE only if an integer >= 0. */
1799 if (INTEGERP (value) && XINT (value) >= 0)
1800 nlines = XFASTINT (value);
1801 else
1802 nlines = 0;
1804 /* Make sure we redisplay all windows in this frame. */
1805 ++windows_or_buffers_changed;
1807 delta = nlines - FRAME_TOOL_BAR_LINES (f);
1809 /* Don't resize the tool-bar to more than we have room for. */
1810 root_window = FRAME_ROOT_WINDOW (f);
1811 root_height = WINDOW_TOTAL_LINES (XWINDOW (root_window));
1812 if (root_height - delta < 1)
1814 delta = root_height - 1;
1815 nlines = FRAME_TOOL_BAR_LINES (f) + delta;
1818 FRAME_TOOL_BAR_LINES (f) = nlines;
1819 change_window_heights (root_window, delta);
1820 adjust_glyphs (f);
1822 /* We also have to make sure that the internal border at the top of
1823 the frame, below the menu bar or tool bar, is redrawn when the
1824 tool bar disappears. This is so because the internal border is
1825 below the tool bar if one is displayed, but is below the menu bar
1826 if there isn't a tool bar. The tool bar draws into the area
1827 below the menu bar. */
1828 if (FRAME_W32_WINDOW (f) && FRAME_TOOL_BAR_LINES (f) == 0)
1830 clear_frame (f);
1831 clear_current_matrices (f);
1834 /* If the tool bar gets smaller, the internal border below it
1835 has to be cleared. It was formerly part of the display
1836 of the larger tool bar, and updating windows won't clear it. */
1837 if (delta < 0)
1839 int height = FRAME_INTERNAL_BORDER_WIDTH (f);
1840 int width = FRAME_PIXEL_WIDTH (f);
1841 int y = nlines * FRAME_LINE_HEIGHT (f);
1843 BLOCK_INPUT;
1845 HDC hdc = get_frame_dc (f);
1846 w32_clear_area (f, hdc, 0, y, width, height);
1847 release_frame_dc (f, hdc);
1849 UNBLOCK_INPUT;
1851 if (WINDOWP (f->tool_bar_window))
1852 clear_glyph_matrix (XWINDOW (f->tool_bar_window)->current_matrix);
1857 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
1858 w32_id_name.
1860 If EXPLICIT is non-zero, that indicates that lisp code is setting the
1861 name; if NAME is a string, set F's name to NAME and set
1862 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
1864 If EXPLICIT is zero, that indicates that Emacs redisplay code is
1865 suggesting a new name, which lisp code should override; if
1866 F->explicit_name is set, ignore the new name; otherwise, set it. */
1868 void
1869 x_set_name (f, name, explicit)
1870 struct frame *f;
1871 Lisp_Object name;
1872 int explicit;
1874 /* Make sure that requests from lisp code override requests from
1875 Emacs redisplay code. */
1876 if (explicit)
1878 /* If we're switching from explicit to implicit, we had better
1879 update the mode lines and thereby update the title. */
1880 if (f->explicit_name && NILP (name))
1881 update_mode_lines = 1;
1883 f->explicit_name = ! NILP (name);
1885 else if (f->explicit_name)
1886 return;
1888 /* If NAME is nil, set the name to the w32_id_name. */
1889 if (NILP (name))
1891 /* Check for no change needed in this very common case
1892 before we do any consing. */
1893 if (!strcmp (FRAME_W32_DISPLAY_INFO (f)->w32_id_name,
1894 SDATA (f->name)))
1895 return;
1896 name = build_string (FRAME_W32_DISPLAY_INFO (f)->w32_id_name);
1898 else
1899 CHECK_STRING (name);
1901 /* Don't change the name if it's already NAME. */
1902 if (! NILP (Fstring_equal (name, f->name)))
1903 return;
1905 f->name = name;
1907 /* For setting the frame title, the title parameter should override
1908 the name parameter. */
1909 if (! NILP (f->title))
1910 name = f->title;
1912 if (FRAME_W32_WINDOW (f))
1914 if (STRING_MULTIBYTE (name))
1915 name = ENCODE_SYSTEM (name);
1917 BLOCK_INPUT;
1918 SetWindowText (FRAME_W32_WINDOW (f), SDATA (name));
1919 UNBLOCK_INPUT;
1923 /* This function should be called when the user's lisp code has
1924 specified a name for the frame; the name will override any set by the
1925 redisplay code. */
1926 void
1927 x_explicitly_set_name (f, arg, oldval)
1928 FRAME_PTR f;
1929 Lisp_Object arg, oldval;
1931 x_set_name (f, arg, 1);
1934 /* This function should be called by Emacs redisplay code to set the
1935 name; names set this way will never override names set by the user's
1936 lisp code. */
1937 void
1938 x_implicitly_set_name (f, arg, oldval)
1939 FRAME_PTR f;
1940 Lisp_Object arg, oldval;
1942 x_set_name (f, arg, 0);
1945 /* Change the title of frame F to NAME.
1946 If NAME is nil, use the frame name as the title. */
1948 void
1949 x_set_title (f, name, old_name)
1950 struct frame *f;
1951 Lisp_Object name, old_name;
1953 /* Don't change the title if it's already NAME. */
1954 if (EQ (name, f->title))
1955 return;
1957 update_mode_lines = 1;
1959 f->title = name;
1961 if (NILP (name))
1962 name = f->name;
1964 if (FRAME_W32_WINDOW (f))
1966 if (STRING_MULTIBYTE (name))
1967 name = ENCODE_SYSTEM (name);
1969 BLOCK_INPUT;
1970 SetWindowText (FRAME_W32_WINDOW (f), SDATA (name));
1971 UNBLOCK_INPUT;
1976 void x_set_scroll_bar_default_width (f)
1977 struct frame *f;
1979 int wid = FRAME_COLUMN_WIDTH (f);
1981 FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = GetSystemMetrics (SM_CXVSCROLL);
1982 FRAME_CONFIG_SCROLL_BAR_COLS (f) = (FRAME_CONFIG_SCROLL_BAR_WIDTH (f) +
1983 wid - 1) / wid;
1987 /* Subroutines of creating a frame. */
1990 /* Return the value of parameter PARAM.
1992 First search ALIST, then Vdefault_frame_alist, then the X defaults
1993 database, using ATTRIBUTE as the attribute name and CLASS as its class.
1995 Convert the resource to the type specified by desired_type.
1997 If no default is specified, return Qunbound. If you call
1998 w32_get_arg, make sure you deal with Qunbound in a reasonable way,
1999 and don't let it get stored in any Lisp-visible variables! */
2001 static Lisp_Object
2002 w32_get_arg (alist, param, attribute, class, type)
2003 Lisp_Object alist, param;
2004 char *attribute;
2005 char *class;
2006 enum resource_types type;
2008 return x_get_arg (check_x_display_info (Qnil),
2009 alist, param, attribute, class, type);
2013 Cursor
2014 w32_load_cursor (LPCTSTR name)
2016 /* Try first to load cursor from application resource. */
2017 Cursor cursor = LoadImage ((HINSTANCE) GetModuleHandle (NULL),
2018 name, IMAGE_CURSOR, 0, 0,
2019 LR_DEFAULTCOLOR | LR_DEFAULTSIZE | LR_SHARED);
2020 if (!cursor)
2022 /* Then try to load a shared predefined cursor. */
2023 cursor = LoadImage (NULL, name, IMAGE_CURSOR, 0, 0,
2024 LR_DEFAULTCOLOR | LR_DEFAULTSIZE | LR_SHARED);
2026 return cursor;
2029 extern LRESULT CALLBACK w32_wnd_proc ();
2031 static BOOL
2032 w32_init_class (hinst)
2033 HINSTANCE hinst;
2035 WNDCLASS wc;
2037 wc.style = CS_HREDRAW | CS_VREDRAW;
2038 wc.lpfnWndProc = (WNDPROC) w32_wnd_proc;
2039 wc.cbClsExtra = 0;
2040 wc.cbWndExtra = WND_EXTRA_BYTES;
2041 wc.hInstance = hinst;
2042 wc.hIcon = LoadIcon (hinst, EMACS_CLASS);
2043 wc.hCursor = w32_load_cursor (IDC_ARROW);
2044 wc.hbrBackground = NULL; /* GetStockObject (WHITE_BRUSH); */
2045 wc.lpszMenuName = NULL;
2046 wc.lpszClassName = EMACS_CLASS;
2048 return (RegisterClass (&wc));
2051 static HWND
2052 w32_createscrollbar (f, bar)
2053 struct frame *f;
2054 struct scroll_bar * bar;
2056 return (CreateWindow ("SCROLLBAR", "", SBS_VERT | WS_CHILD | WS_VISIBLE,
2057 /* Position and size of scroll bar. */
2058 XINT (bar->left) + VERTICAL_SCROLL_BAR_WIDTH_TRIM,
2059 XINT (bar->top),
2060 XINT (bar->width) - VERTICAL_SCROLL_BAR_WIDTH_TRIM * 2,
2061 XINT (bar->height),
2062 FRAME_W32_WINDOW (f),
2063 NULL,
2064 hinst,
2065 NULL));
2068 static void
2069 w32_createwindow (f)
2070 struct frame *f;
2072 HWND hwnd;
2073 RECT rect;
2074 Lisp_Object top = Qunbound;
2075 Lisp_Object left = Qunbound;
2077 rect.left = rect.top = 0;
2078 rect.right = FRAME_PIXEL_WIDTH (f);
2079 rect.bottom = FRAME_PIXEL_HEIGHT (f);
2081 AdjustWindowRect (&rect, f->output_data.w32->dwStyle,
2082 FRAME_EXTERNAL_MENU_BAR (f));
2084 /* Do first time app init */
2086 if (!hprevinst)
2088 w32_init_class (hinst);
2091 if (f->size_hint_flags & USPosition || f->size_hint_flags & PPosition)
2093 XSETINT (left, f->left_pos);
2094 XSETINT (top, f->top_pos);
2096 else if (EQ (left, Qunbound) && EQ (top, Qunbound))
2098 /* When called with RES_TYPE_NUMBER, w32_get_arg will return zero
2099 for anything that is not a number and is not Qunbound. */
2100 left = w32_get_arg (Qnil, Qleft, "left", "Left", RES_TYPE_NUMBER);
2101 top = w32_get_arg (Qnil, Qtop, "top", "Top", RES_TYPE_NUMBER);
2104 FRAME_W32_WINDOW (f) = hwnd
2105 = CreateWindow (EMACS_CLASS,
2106 f->namebuf,
2107 f->output_data.w32->dwStyle | WS_CLIPCHILDREN,
2108 EQ (left, Qunbound) ? CW_USEDEFAULT : XINT (left),
2109 EQ (top, Qunbound) ? CW_USEDEFAULT : XINT (top),
2110 rect.right - rect.left,
2111 rect.bottom - rect.top,
2112 NULL,
2113 NULL,
2114 hinst,
2115 NULL);
2117 if (hwnd)
2119 SetWindowLong (hwnd, WND_FONTWIDTH_INDEX, FRAME_COLUMN_WIDTH (f));
2120 SetWindowLong (hwnd, WND_LINEHEIGHT_INDEX, FRAME_LINE_HEIGHT (f));
2121 SetWindowLong (hwnd, WND_BORDER_INDEX, FRAME_INTERNAL_BORDER_WIDTH (f));
2122 SetWindowLong (hwnd, WND_SCROLLBAR_INDEX, f->scroll_bar_actual_width);
2123 SetWindowLong (hwnd, WND_BACKGROUND_INDEX, FRAME_BACKGROUND_PIXEL (f));
2125 /* Enable drag-n-drop. */
2126 DragAcceptFiles (hwnd, TRUE);
2128 /* Do this to discard the default setting specified by our parent. */
2129 ShowWindow (hwnd, SW_HIDE);
2131 /* Update frame positions. */
2132 GetWindowRect (hwnd, &rect);
2133 f->left_pos = rect.left;
2134 f->top_pos = rect.top;
2138 static void
2139 my_post_msg (wmsg, hwnd, msg, wParam, lParam)
2140 W32Msg * wmsg;
2141 HWND hwnd;
2142 UINT msg;
2143 WPARAM wParam;
2144 LPARAM lParam;
2146 wmsg->msg.hwnd = hwnd;
2147 wmsg->msg.message = msg;
2148 wmsg->msg.wParam = wParam;
2149 wmsg->msg.lParam = lParam;
2150 wmsg->msg.time = GetMessageTime ();
2152 post_msg (wmsg);
2155 /* GetKeyState and MapVirtualKey on Windows 95 do not actually distinguish
2156 between left and right keys as advertised. We test for this
2157 support dynamically, and set a flag when the support is absent. If
2158 absent, we keep track of the left and right control and alt keys
2159 ourselves. This is particularly necessary on keyboards that rely
2160 upon the AltGr key, which is represented as having the left control
2161 and right alt keys pressed. For these keyboards, we need to know
2162 when the left alt key has been pressed in addition to the AltGr key
2163 so that we can properly support M-AltGr-key sequences (such as M-@
2164 on Swedish keyboards). */
2166 #define EMACS_LCONTROL 0
2167 #define EMACS_RCONTROL 1
2168 #define EMACS_LMENU 2
2169 #define EMACS_RMENU 3
2171 static int modifiers[4];
2172 static int modifiers_recorded;
2173 static int modifier_key_support_tested;
2175 static void
2176 test_modifier_support (unsigned int wparam)
2178 unsigned int l, r;
2180 if (wparam != VK_CONTROL && wparam != VK_MENU)
2181 return;
2182 if (wparam == VK_CONTROL)
2184 l = VK_LCONTROL;
2185 r = VK_RCONTROL;
2187 else
2189 l = VK_LMENU;
2190 r = VK_RMENU;
2192 if (!(GetKeyState (l) & 0x8000) && !(GetKeyState (r) & 0x8000))
2193 modifiers_recorded = 1;
2194 else
2195 modifiers_recorded = 0;
2196 modifier_key_support_tested = 1;
2199 static void
2200 record_keydown (unsigned int wparam, unsigned int lparam)
2202 int i;
2204 if (!modifier_key_support_tested)
2205 test_modifier_support (wparam);
2207 if ((wparam != VK_CONTROL && wparam != VK_MENU) || !modifiers_recorded)
2208 return;
2210 if (wparam == VK_CONTROL)
2211 i = (lparam & 0x1000000) ? EMACS_RCONTROL : EMACS_LCONTROL;
2212 else
2213 i = (lparam & 0x1000000) ? EMACS_RMENU : EMACS_LMENU;
2215 modifiers[i] = 1;
2218 static void
2219 record_keyup (unsigned int wparam, unsigned int lparam)
2221 int i;
2223 if ((wparam != VK_CONTROL && wparam != VK_MENU) || !modifiers_recorded)
2224 return;
2226 if (wparam == VK_CONTROL)
2227 i = (lparam & 0x1000000) ? EMACS_RCONTROL : EMACS_LCONTROL;
2228 else
2229 i = (lparam & 0x1000000) ? EMACS_RMENU : EMACS_LMENU;
2231 modifiers[i] = 0;
2234 /* Emacs can lose focus while a modifier key has been pressed. When
2235 it regains focus, be conservative and clear all modifiers since
2236 we cannot reconstruct the left and right modifier state. */
2237 static void
2238 reset_modifiers ()
2240 SHORT ctrl, alt;
2242 if (GetFocus () == NULL)
2243 /* Emacs doesn't have keyboard focus. Do nothing. */
2244 return;
2246 ctrl = GetAsyncKeyState (VK_CONTROL);
2247 alt = GetAsyncKeyState (VK_MENU);
2249 if (!(ctrl & 0x08000))
2250 /* Clear any recorded control modifier state. */
2251 modifiers[EMACS_RCONTROL] = modifiers[EMACS_LCONTROL] = 0;
2253 if (!(alt & 0x08000))
2254 /* Clear any recorded alt modifier state. */
2255 modifiers[EMACS_RMENU] = modifiers[EMACS_LMENU] = 0;
2257 /* Update the state of all modifier keys, because modifiers used in
2258 hot-key combinations can get stuck on if Emacs loses focus as a
2259 result of a hot-key being pressed. */
2261 BYTE keystate[256];
2263 #define CURRENT_STATE(key) ((GetAsyncKeyState (key) & 0x8000) >> 8)
2265 GetKeyboardState (keystate);
2266 keystate[VK_SHIFT] = CURRENT_STATE (VK_SHIFT);
2267 keystate[VK_CONTROL] = CURRENT_STATE (VK_CONTROL);
2268 keystate[VK_LCONTROL] = CURRENT_STATE (VK_LCONTROL);
2269 keystate[VK_RCONTROL] = CURRENT_STATE (VK_RCONTROL);
2270 keystate[VK_MENU] = CURRENT_STATE (VK_MENU);
2271 keystate[VK_LMENU] = CURRENT_STATE (VK_LMENU);
2272 keystate[VK_RMENU] = CURRENT_STATE (VK_RMENU);
2273 keystate[VK_LWIN] = CURRENT_STATE (VK_LWIN);
2274 keystate[VK_RWIN] = CURRENT_STATE (VK_RWIN);
2275 keystate[VK_APPS] = CURRENT_STATE (VK_APPS);
2276 SetKeyboardState (keystate);
2280 /* Synchronize modifier state with what is reported with the current
2281 keystroke. Even if we cannot distinguish between left and right
2282 modifier keys, we know that, if no modifiers are set, then neither
2283 the left or right modifier should be set. */
2284 static void
2285 sync_modifiers ()
2287 if (!modifiers_recorded)
2288 return;
2290 if (!(GetKeyState (VK_CONTROL) & 0x8000))
2291 modifiers[EMACS_RCONTROL] = modifiers[EMACS_LCONTROL] = 0;
2293 if (!(GetKeyState (VK_MENU) & 0x8000))
2294 modifiers[EMACS_RMENU] = modifiers[EMACS_LMENU] = 0;
2297 static int
2298 modifier_set (int vkey)
2300 if (vkey == VK_CAPITAL || vkey == VK_SCROLL)
2301 return (GetKeyState (vkey) & 0x1);
2302 if (!modifiers_recorded)
2303 return (GetKeyState (vkey) & 0x8000);
2305 switch (vkey)
2307 case VK_LCONTROL:
2308 return modifiers[EMACS_LCONTROL];
2309 case VK_RCONTROL:
2310 return modifiers[EMACS_RCONTROL];
2311 case VK_LMENU:
2312 return modifiers[EMACS_LMENU];
2313 case VK_RMENU:
2314 return modifiers[EMACS_RMENU];
2316 return (GetKeyState (vkey) & 0x8000);
2319 /* Convert between the modifier bits W32 uses and the modifier bits
2320 Emacs uses. */
2322 unsigned int
2323 w32_key_to_modifier (int key)
2325 Lisp_Object key_mapping;
2327 switch (key)
2329 case VK_LWIN:
2330 key_mapping = Vw32_lwindow_modifier;
2331 break;
2332 case VK_RWIN:
2333 key_mapping = Vw32_rwindow_modifier;
2334 break;
2335 case VK_APPS:
2336 key_mapping = Vw32_apps_modifier;
2337 break;
2338 case VK_SCROLL:
2339 key_mapping = Vw32_scroll_lock_modifier;
2340 break;
2341 default:
2342 key_mapping = Qnil;
2345 /* NB. This code runs in the input thread, asychronously to the lisp
2346 thread, so we must be careful to ensure access to lisp data is
2347 thread-safe. The following code is safe because the modifier
2348 variable values are updated atomically from lisp and symbols are
2349 not relocated by GC. Also, we don't have to worry about seeing GC
2350 markbits here. */
2351 if (EQ (key_mapping, Qhyper))
2352 return hyper_modifier;
2353 if (EQ (key_mapping, Qsuper))
2354 return super_modifier;
2355 if (EQ (key_mapping, Qmeta))
2356 return meta_modifier;
2357 if (EQ (key_mapping, Qalt))
2358 return alt_modifier;
2359 if (EQ (key_mapping, Qctrl))
2360 return ctrl_modifier;
2361 if (EQ (key_mapping, Qcontrol)) /* synonym for ctrl */
2362 return ctrl_modifier;
2363 if (EQ (key_mapping, Qshift))
2364 return shift_modifier;
2366 /* Don't generate any modifier if not explicitly requested. */
2367 return 0;
2370 static unsigned int
2371 w32_get_modifiers ()
2373 return ((modifier_set (VK_SHIFT) ? shift_modifier : 0) |
2374 (modifier_set (VK_CONTROL) ? ctrl_modifier : 0) |
2375 (modifier_set (VK_LWIN) ? w32_key_to_modifier (VK_LWIN) : 0) |
2376 (modifier_set (VK_RWIN) ? w32_key_to_modifier (VK_RWIN) : 0) |
2377 (modifier_set (VK_APPS) ? w32_key_to_modifier (VK_APPS) : 0) |
2378 (modifier_set (VK_SCROLL) ? w32_key_to_modifier (VK_SCROLL) : 0) |
2379 (modifier_set (VK_MENU) ?
2380 ((NILP (Vw32_alt_is_meta)) ? alt_modifier : meta_modifier) : 0));
2383 /* We map the VK_* modifiers into console modifier constants
2384 so that we can use the same routines to handle both console
2385 and window input. */
2387 static int
2388 construct_console_modifiers ()
2390 int mods;
2392 mods = 0;
2393 mods |= (modifier_set (VK_SHIFT)) ? SHIFT_PRESSED : 0;
2394 mods |= (modifier_set (VK_CAPITAL)) ? CAPSLOCK_ON : 0;
2395 mods |= (modifier_set (VK_SCROLL)) ? SCROLLLOCK_ON : 0;
2396 mods |= (modifier_set (VK_NUMLOCK)) ? NUMLOCK_ON : 0;
2397 mods |= (modifier_set (VK_LCONTROL)) ? LEFT_CTRL_PRESSED : 0;
2398 mods |= (modifier_set (VK_RCONTROL)) ? RIGHT_CTRL_PRESSED : 0;
2399 mods |= (modifier_set (VK_LMENU)) ? LEFT_ALT_PRESSED : 0;
2400 mods |= (modifier_set (VK_RMENU)) ? RIGHT_ALT_PRESSED : 0;
2401 mods |= (modifier_set (VK_LWIN)) ? LEFT_WIN_PRESSED : 0;
2402 mods |= (modifier_set (VK_RWIN)) ? RIGHT_WIN_PRESSED : 0;
2403 mods |= (modifier_set (VK_APPS)) ? APPS_PRESSED : 0;
2405 return mods;
2408 static int
2409 w32_get_key_modifiers (unsigned int wparam, unsigned int lparam)
2411 int mods;
2413 /* Convert to emacs modifiers. */
2414 mods = w32_kbd_mods_to_emacs (construct_console_modifiers (), wparam);
2416 return mods;
2419 unsigned int
2420 map_keypad_keys (unsigned int virt_key, unsigned int extended)
2422 if (virt_key < VK_CLEAR || virt_key > VK_DELETE)
2423 return virt_key;
2425 if (virt_key == VK_RETURN)
2426 return (extended ? VK_NUMPAD_ENTER : VK_RETURN);
2428 if (virt_key >= VK_PRIOR && virt_key <= VK_DOWN)
2429 return (!extended ? (VK_NUMPAD_PRIOR + (virt_key - VK_PRIOR)) : virt_key);
2431 if (virt_key == VK_INSERT || virt_key == VK_DELETE)
2432 return (!extended ? (VK_NUMPAD_INSERT + (virt_key - VK_INSERT)) : virt_key);
2434 if (virt_key == VK_CLEAR)
2435 return (!extended ? VK_NUMPAD_CLEAR : virt_key);
2437 return virt_key;
2440 /* List of special key combinations which w32 would normally capture,
2441 but Emacs should grab instead. Not directly visible to lisp, to
2442 simplify synchronization. Each item is an integer encoding a virtual
2443 key code and modifier combination to capture. */
2444 static Lisp_Object w32_grabbed_keys;
2446 #define HOTKEY(vk, mods) make_number (((vk) & 255) | ((mods) << 8))
2447 #define HOTKEY_ID(k) (XFASTINT (k) & 0xbfff)
2448 #define HOTKEY_VK_CODE(k) (XFASTINT (k) & 255)
2449 #define HOTKEY_MODIFIERS(k) (XFASTINT (k) >> 8)
2451 #define RAW_HOTKEY_ID(k) ((k) & 0xbfff)
2452 #define RAW_HOTKEY_VK_CODE(k) ((k) & 255)
2453 #define RAW_HOTKEY_MODIFIERS(k) ((k) >> 8)
2455 /* Register hot-keys for reserved key combinations when Emacs has
2456 keyboard focus, since this is the only way Emacs can receive key
2457 combinations like Alt-Tab which are used by the system. */
2459 static void
2460 register_hot_keys (hwnd)
2461 HWND hwnd;
2463 Lisp_Object keylist;
2465 /* Use CONSP, since we are called asynchronously. */
2466 for (keylist = w32_grabbed_keys; CONSP (keylist); keylist = XCDR (keylist))
2468 Lisp_Object key = XCAR (keylist);
2470 /* Deleted entries get set to nil. */
2471 if (!INTEGERP (key))
2472 continue;
2474 RegisterHotKey (hwnd, HOTKEY_ID (key),
2475 HOTKEY_MODIFIERS (key), HOTKEY_VK_CODE (key));
2479 static void
2480 unregister_hot_keys (hwnd)
2481 HWND hwnd;
2483 Lisp_Object keylist;
2485 for (keylist = w32_grabbed_keys; CONSP (keylist); keylist = XCDR (keylist))
2487 Lisp_Object key = XCAR (keylist);
2489 if (!INTEGERP (key))
2490 continue;
2492 UnregisterHotKey (hwnd, HOTKEY_ID (key));
2496 /* Main message dispatch loop. */
2498 static void
2499 w32_msg_pump (deferred_msg * msg_buf)
2501 MSG msg;
2502 int result;
2503 HWND focus_window;
2505 msh_mousewheel = RegisterWindowMessage (MSH_MOUSEWHEEL);
2507 while (GetMessage (&msg, NULL, 0, 0))
2509 if (msg.hwnd == NULL)
2511 switch (msg.message)
2513 case WM_NULL:
2514 /* Produced by complete_deferred_msg; just ignore. */
2515 break;
2516 case WM_EMACS_CREATEWINDOW:
2517 /* Initialize COM for this window. Even though we don't use it,
2518 some third party shell extensions can cause it to be used in
2519 system dialogs, which causes a crash if it is not initialized.
2520 This is a known bug in Windows, which was fixed long ago, but
2521 the patch for XP is not publically available until XP SP3,
2522 and older versions will never be patched. */
2523 CoInitialize (NULL);
2524 w32_createwindow ((struct frame *) msg.wParam);
2525 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE, 0, 0))
2526 abort ();
2527 break;
2528 case WM_EMACS_SETLOCALE:
2529 SetThreadLocale (msg.wParam);
2530 /* Reply is not expected. */
2531 break;
2532 case WM_EMACS_SETKEYBOARDLAYOUT:
2533 result = (int) ActivateKeyboardLayout ((HKL) msg.wParam, 0);
2534 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE,
2535 result, 0))
2536 abort ();
2537 break;
2538 case WM_EMACS_REGISTER_HOT_KEY:
2539 focus_window = GetFocus ();
2540 if (focus_window != NULL)
2541 RegisterHotKey (focus_window,
2542 RAW_HOTKEY_ID (msg.wParam),
2543 RAW_HOTKEY_MODIFIERS (msg.wParam),
2544 RAW_HOTKEY_VK_CODE (msg.wParam));
2545 /* Reply is not expected. */
2546 break;
2547 case WM_EMACS_UNREGISTER_HOT_KEY:
2548 focus_window = GetFocus ();
2549 if (focus_window != NULL)
2550 UnregisterHotKey (focus_window, RAW_HOTKEY_ID (msg.wParam));
2551 /* Mark item as erased. NB: this code must be
2552 thread-safe. The next line is okay because the cons
2553 cell is never made into garbage and is not relocated by
2554 GC. */
2555 XSETCAR ((Lisp_Object) ((EMACS_INT) msg.lParam), Qnil);
2556 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE, 0, 0))
2557 abort ();
2558 break;
2559 case WM_EMACS_TOGGLE_LOCK_KEY:
2561 int vk_code = (int) msg.wParam;
2562 int cur_state = (GetKeyState (vk_code) & 1);
2563 Lisp_Object new_state = (Lisp_Object) ((EMACS_INT) msg.lParam);
2565 /* NB: This code must be thread-safe. It is safe to
2566 call NILP because symbols are not relocated by GC,
2567 and pointer here is not touched by GC (so the markbit
2568 can't be set). Numbers are safe because they are
2569 immediate values. */
2570 if (NILP (new_state)
2571 || (NUMBERP (new_state)
2572 && ((XUINT (new_state)) & 1) != cur_state))
2574 one_w32_display_info.faked_key = vk_code;
2576 keybd_event ((BYTE) vk_code,
2577 (BYTE) MapVirtualKey (vk_code, 0),
2578 KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
2579 keybd_event ((BYTE) vk_code,
2580 (BYTE) MapVirtualKey (vk_code, 0),
2581 KEYEVENTF_EXTENDEDKEY | 0, 0);
2582 keybd_event ((BYTE) vk_code,
2583 (BYTE) MapVirtualKey (vk_code, 0),
2584 KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
2585 cur_state = !cur_state;
2587 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE,
2588 cur_state, 0))
2589 abort ();
2591 break;
2592 #ifdef MSG_DEBUG
2593 /* Broadcast messages make it here, so you need to be looking
2594 for something in particular for this to be useful. */
2595 default:
2596 DebPrint (("msg %x not expected by w32_msg_pump\n", msg.message));
2597 #endif
2600 else
2602 DispatchMessage (&msg);
2605 /* Exit nested loop when our deferred message has completed. */
2606 if (msg_buf->completed)
2607 break;
2611 deferred_msg * deferred_msg_head;
2613 static deferred_msg *
2614 find_deferred_msg (HWND hwnd, UINT msg)
2616 deferred_msg * item;
2618 /* Don't actually need synchronization for read access, since
2619 modification of single pointer is always atomic. */
2620 /* enter_crit (); */
2622 for (item = deferred_msg_head; item != NULL; item = item->next)
2623 if (item->w32msg.msg.hwnd == hwnd
2624 && item->w32msg.msg.message == msg)
2625 break;
2627 /* leave_crit (); */
2629 return item;
2632 static LRESULT
2633 send_deferred_msg (deferred_msg * msg_buf,
2634 HWND hwnd,
2635 UINT msg,
2636 WPARAM wParam,
2637 LPARAM lParam)
2639 /* Only input thread can send deferred messages. */
2640 if (GetCurrentThreadId () != dwWindowsThreadId)
2641 abort ();
2643 /* It is an error to send a message that is already deferred. */
2644 if (find_deferred_msg (hwnd, msg) != NULL)
2645 abort ();
2647 /* Enforced synchronization is not needed because this is the only
2648 function that alters deferred_msg_head, and the following critical
2649 section is guaranteed to only be serially reentered (since only the
2650 input thread can call us). */
2652 /* enter_crit (); */
2654 msg_buf->completed = 0;
2655 msg_buf->next = deferred_msg_head;
2656 deferred_msg_head = msg_buf;
2657 my_post_msg (&msg_buf->w32msg, hwnd, msg, wParam, lParam);
2659 /* leave_crit (); */
2661 /* Start a new nested message loop to process other messages until
2662 this one is completed. */
2663 w32_msg_pump (msg_buf);
2665 deferred_msg_head = msg_buf->next;
2667 return msg_buf->result;
2670 void
2671 complete_deferred_msg (HWND hwnd, UINT msg, LRESULT result)
2673 deferred_msg * msg_buf = find_deferred_msg (hwnd, msg);
2675 if (msg_buf == NULL)
2676 /* Message may have been cancelled, so don't abort. */
2677 return;
2679 msg_buf->result = result;
2680 msg_buf->completed = 1;
2682 /* Ensure input thread is woken so it notices the completion. */
2683 PostThreadMessage (dwWindowsThreadId, WM_NULL, 0, 0);
2686 static void
2687 cancel_all_deferred_msgs ()
2689 deferred_msg * item;
2691 /* Don't actually need synchronization for read access, since
2692 modification of single pointer is always atomic. */
2693 /* enter_crit (); */
2695 for (item = deferred_msg_head; item != NULL; item = item->next)
2697 item->result = 0;
2698 item->completed = 1;
2701 /* leave_crit (); */
2703 /* Ensure input thread is woken so it notices the completion. */
2704 PostThreadMessage (dwWindowsThreadId, WM_NULL, 0, 0);
2707 DWORD WINAPI
2708 w32_msg_worker (void *arg)
2710 MSG msg;
2711 deferred_msg dummy_buf;
2713 /* Ensure our message queue is created */
2715 PeekMessage (&msg, NULL, 0, 0, PM_NOREMOVE);
2717 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE, 0, 0))
2718 abort ();
2720 memset (&dummy_buf, 0, sizeof (dummy_buf));
2721 dummy_buf.w32msg.msg.hwnd = NULL;
2722 dummy_buf.w32msg.msg.message = WM_NULL;
2724 /* This is the initial message loop which should only exit when the
2725 application quits. */
2726 w32_msg_pump (&dummy_buf);
2728 return 0;
2731 static void
2732 signal_user_input ()
2734 /* Interrupt any lisp that wants to be interrupted by input. */
2735 if (!NILP (Vthrow_on_input))
2737 Vquit_flag = Vthrow_on_input;
2738 /* If we're inside a function that wants immediate quits,
2739 do it now. */
2740 if (immediate_quit && NILP (Vinhibit_quit))
2742 immediate_quit = 0;
2743 QUIT;
2749 static void
2750 post_character_message (hwnd, msg, wParam, lParam, modifiers)
2751 HWND hwnd;
2752 UINT msg;
2753 WPARAM wParam;
2754 LPARAM lParam;
2755 DWORD modifiers;
2758 W32Msg wmsg;
2760 wmsg.dwModifiers = modifiers;
2762 /* Detect quit_char and set quit-flag directly. Note that we
2763 still need to post a message to ensure the main thread will be
2764 woken up if blocked in sys_select, but we do NOT want to post
2765 the quit_char message itself (because it will usually be as if
2766 the user had typed quit_char twice). Instead, we post a dummy
2767 message that has no particular effect. */
2769 int c = wParam;
2770 if (isalpha (c) && wmsg.dwModifiers == ctrl_modifier)
2771 c = make_ctrl_char (c) & 0377;
2772 if (c == quit_char
2773 || (wmsg.dwModifiers == 0 &&
2774 w32_quit_key && wParam == w32_quit_key))
2776 Vquit_flag = Qt;
2778 /* The choice of message is somewhat arbitrary, as long as
2779 the main thread handler just ignores it. */
2780 msg = WM_NULL;
2782 /* Interrupt any blocking system calls. */
2783 signal_quit ();
2785 /* As a safety precaution, forcibly complete any deferred
2786 messages. This is a kludge, but I don't see any particularly
2787 clean way to handle the situation where a deferred message is
2788 "dropped" in the lisp thread, and will thus never be
2789 completed, eg. by the user trying to activate the menubar
2790 when the lisp thread is busy, and then typing C-g when the
2791 menubar doesn't open promptly (with the result that the
2792 menubar never responds at all because the deferred
2793 WM_INITMENU message is never completed). Another problem
2794 situation is when the lisp thread calls SendMessage (to send
2795 a window manager command) when a message has been deferred;
2796 the lisp thread gets blocked indefinitely waiting for the
2797 deferred message to be completed, which itself is waiting for
2798 the lisp thread to respond.
2800 Note that we don't want to block the input thread waiting for
2801 a reponse from the lisp thread (although that would at least
2802 solve the deadlock problem above), because we want to be able
2803 to receive C-g to interrupt the lisp thread. */
2804 cancel_all_deferred_msgs ();
2806 else
2807 signal_user_input ();
2810 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
2813 /* Main window procedure */
2815 LRESULT CALLBACK
2816 w32_wnd_proc (hwnd, msg, wParam, lParam)
2817 HWND hwnd;
2818 UINT msg;
2819 WPARAM wParam;
2820 LPARAM lParam;
2822 struct frame *f;
2823 struct w32_display_info *dpyinfo = &one_w32_display_info;
2824 W32Msg wmsg;
2825 int windows_translate;
2826 int key;
2828 /* Note that it is okay to call x_window_to_frame, even though we are
2829 not running in the main lisp thread, because frame deletion
2830 requires the lisp thread to synchronize with this thread. Thus, if
2831 a frame struct is returned, it can be used without concern that the
2832 lisp thread might make it disappear while we are using it.
2834 NB. Walking the frame list in this thread is safe (as long as
2835 writes of Lisp_Object slots are atomic, which they are on Windows).
2836 Although delete-frame can destructively modify the frame list while
2837 we are walking it, a garbage collection cannot occur until after
2838 delete-frame has synchronized with this thread.
2840 It is also safe to use functions that make GDI calls, such as
2841 w32_clear_rect, because these functions must obtain a DC handle
2842 from the frame struct using get_frame_dc which is thread-aware. */
2844 switch (msg)
2846 case WM_ERASEBKGND:
2847 f = x_window_to_frame (dpyinfo, hwnd);
2848 if (f)
2850 HDC hdc = get_frame_dc (f);
2851 GetUpdateRect (hwnd, &wmsg.rect, FALSE);
2852 w32_clear_rect (f, hdc, &wmsg.rect);
2853 release_frame_dc (f, hdc);
2855 #if defined (W32_DEBUG_DISPLAY)
2856 DebPrint (("WM_ERASEBKGND (frame %p): erasing %d,%d-%d,%d\n",
2858 wmsg.rect.left, wmsg.rect.top,
2859 wmsg.rect.right, wmsg.rect.bottom));
2860 #endif /* W32_DEBUG_DISPLAY */
2862 return 1;
2863 case WM_PALETTECHANGED:
2864 /* ignore our own changes */
2865 if ((HWND)wParam != hwnd)
2867 f = x_window_to_frame (dpyinfo, hwnd);
2868 if (f)
2869 /* get_frame_dc will realize our palette and force all
2870 frames to be redrawn if needed. */
2871 release_frame_dc (f, get_frame_dc (f));
2873 return 0;
2874 case WM_PAINT:
2876 PAINTSTRUCT paintStruct;
2877 RECT update_rect;
2878 bzero (&update_rect, sizeof (update_rect));
2880 f = x_window_to_frame (dpyinfo, hwnd);
2881 if (f == 0)
2883 DebPrint (("WM_PAINT received for unknown window %p\n", hwnd));
2884 return 0;
2887 /* MSDN Docs say not to call BeginPaint if GetUpdateRect
2888 fails. Apparently this can happen under some
2889 circumstances. */
2890 if (GetUpdateRect (hwnd, &update_rect, FALSE) || !w32_strict_painting)
2892 enter_crit ();
2893 BeginPaint (hwnd, &paintStruct);
2895 /* The rectangles returned by GetUpdateRect and BeginPaint
2896 do not always match. Play it safe by assuming both areas
2897 are invalid. */
2898 UnionRect (&(wmsg.rect), &update_rect, &(paintStruct.rcPaint));
2900 #if defined (W32_DEBUG_DISPLAY)
2901 DebPrint (("WM_PAINT (frame %p): painting %d,%d-%d,%d\n",
2903 wmsg.rect.left, wmsg.rect.top,
2904 wmsg.rect.right, wmsg.rect.bottom));
2905 DebPrint ((" [update region is %d,%d-%d,%d]\n",
2906 update_rect.left, update_rect.top,
2907 update_rect.right, update_rect.bottom));
2908 #endif
2909 EndPaint (hwnd, &paintStruct);
2910 leave_crit ();
2912 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
2914 return 0;
2917 /* If GetUpdateRect returns 0 (meaning there is no update
2918 region), assume the whole window needs to be repainted. */
2919 GetClientRect (hwnd, &wmsg.rect);
2920 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
2921 return 0;
2924 case WM_INPUTLANGCHANGE:
2925 /* Inform lisp thread of keyboard layout changes. */
2926 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
2928 /* Clear dead keys in the keyboard state; for simplicity only
2929 preserve modifier key states. */
2931 int i;
2932 BYTE keystate[256];
2934 GetKeyboardState (keystate);
2935 for (i = 0; i < 256; i++)
2936 if (1
2937 && i != VK_SHIFT
2938 && i != VK_LSHIFT
2939 && i != VK_RSHIFT
2940 && i != VK_CAPITAL
2941 && i != VK_NUMLOCK
2942 && i != VK_SCROLL
2943 && i != VK_CONTROL
2944 && i != VK_LCONTROL
2945 && i != VK_RCONTROL
2946 && i != VK_MENU
2947 && i != VK_LMENU
2948 && i != VK_RMENU
2949 && i != VK_LWIN
2950 && i != VK_RWIN)
2951 keystate[i] = 0;
2952 SetKeyboardState (keystate);
2954 goto dflt;
2956 case WM_HOTKEY:
2957 /* Synchronize hot keys with normal input. */
2958 PostMessage (hwnd, WM_KEYDOWN, HIWORD (lParam), 0);
2959 return (0);
2961 case WM_KEYUP:
2962 case WM_SYSKEYUP:
2963 record_keyup (wParam, lParam);
2964 goto dflt;
2966 case WM_KEYDOWN:
2967 case WM_SYSKEYDOWN:
2968 /* Ignore keystrokes we fake ourself; see below. */
2969 if (dpyinfo->faked_key == wParam)
2971 dpyinfo->faked_key = 0;
2972 /* Make sure TranslateMessage sees them though (as long as
2973 they don't produce WM_CHAR messages). This ensures that
2974 indicator lights are toggled promptly on Windows 9x, for
2975 example. */
2976 if (wParam < 256 && lispy_function_keys[wParam])
2978 windows_translate = 1;
2979 goto translate;
2981 return 0;
2984 /* Synchronize modifiers with current keystroke. */
2985 sync_modifiers ();
2986 record_keydown (wParam, lParam);
2987 wParam = map_keypad_keys (wParam, (lParam & 0x1000000L) != 0);
2989 windows_translate = 0;
2991 switch (wParam)
2993 case VK_LWIN:
2994 if (NILP (Vw32_pass_lwindow_to_system))
2996 /* Prevent system from acting on keyup (which opens the
2997 Start menu if no other key was pressed) by simulating a
2998 press of Space which we will ignore. */
2999 if (GetAsyncKeyState (wParam) & 1)
3001 if (NUMBERP (Vw32_phantom_key_code))
3002 key = XUINT (Vw32_phantom_key_code) & 255;
3003 else
3004 key = VK_SPACE;
3005 dpyinfo->faked_key = key;
3006 keybd_event (key, (BYTE) MapVirtualKey (key, 0), 0, 0);
3009 if (!NILP (Vw32_lwindow_modifier))
3010 return 0;
3011 break;
3012 case VK_RWIN:
3013 if (NILP (Vw32_pass_rwindow_to_system))
3015 if (GetAsyncKeyState (wParam) & 1)
3017 if (NUMBERP (Vw32_phantom_key_code))
3018 key = XUINT (Vw32_phantom_key_code) & 255;
3019 else
3020 key = VK_SPACE;
3021 dpyinfo->faked_key = key;
3022 keybd_event (key, (BYTE) MapVirtualKey (key, 0), 0, 0);
3025 if (!NILP (Vw32_rwindow_modifier))
3026 return 0;
3027 break;
3028 case VK_APPS:
3029 if (!NILP (Vw32_apps_modifier))
3030 return 0;
3031 break;
3032 case VK_MENU:
3033 if (NILP (Vw32_pass_alt_to_system))
3034 /* Prevent DefWindowProc from activating the menu bar if an
3035 Alt key is pressed and released by itself. */
3036 return 0;
3037 windows_translate = 1;
3038 break;
3039 case VK_CAPITAL:
3040 /* Decide whether to treat as modifier or function key. */
3041 if (NILP (Vw32_enable_caps_lock))
3042 goto disable_lock_key;
3043 windows_translate = 1;
3044 break;
3045 case VK_NUMLOCK:
3046 /* Decide whether to treat as modifier or function key. */
3047 if (NILP (Vw32_enable_num_lock))
3048 goto disable_lock_key;
3049 windows_translate = 1;
3050 break;
3051 case VK_SCROLL:
3052 /* Decide whether to treat as modifier or function key. */
3053 if (NILP (Vw32_scroll_lock_modifier))
3054 goto disable_lock_key;
3055 windows_translate = 1;
3056 break;
3057 disable_lock_key:
3058 /* Ensure the appropriate lock key state (and indicator light)
3059 remains in the same state. We do this by faking another
3060 press of the relevant key. Apparently, this really is the
3061 only way to toggle the state of the indicator lights. */
3062 dpyinfo->faked_key = wParam;
3063 keybd_event ((BYTE) wParam, (BYTE) MapVirtualKey (wParam, 0),
3064 KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
3065 keybd_event ((BYTE) wParam, (BYTE) MapVirtualKey (wParam, 0),
3066 KEYEVENTF_EXTENDEDKEY | 0, 0);
3067 keybd_event ((BYTE) wParam, (BYTE) MapVirtualKey (wParam, 0),
3068 KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
3069 /* Ensure indicator lights are updated promptly on Windows 9x
3070 (TranslateMessage apparently does this), after forwarding
3071 input event. */
3072 post_character_message (hwnd, msg, wParam, lParam,
3073 w32_get_key_modifiers (wParam, lParam));
3074 windows_translate = 1;
3075 break;
3076 case VK_CONTROL:
3077 case VK_SHIFT:
3078 case VK_PROCESSKEY: /* Generated by IME. */
3079 windows_translate = 1;
3080 break;
3081 case VK_CANCEL:
3082 /* Windows maps Ctrl-Pause (aka Ctrl-Break) into VK_CANCEL,
3083 which is confusing for purposes of key binding; convert
3084 VK_CANCEL events into VK_PAUSE events. */
3085 wParam = VK_PAUSE;
3086 break;
3087 case VK_PAUSE:
3088 /* Windows maps Ctrl-NumLock into VK_PAUSE, which is confusing
3089 for purposes of key binding; convert these back into
3090 VK_NUMLOCK events, at least when we want to see NumLock key
3091 presses. (Note that there is never any possibility that
3092 VK_PAUSE with Ctrl really is C-Pause as per above.) */
3093 if (NILP (Vw32_enable_num_lock) && modifier_set (VK_CONTROL))
3094 wParam = VK_NUMLOCK;
3095 break;
3096 default:
3097 /* If not defined as a function key, change it to a WM_CHAR message. */
3098 if (wParam > 255 || !lispy_function_keys[wParam])
3100 DWORD modifiers = construct_console_modifiers ();
3102 if (!NILP (Vw32_recognize_altgr)
3103 && modifier_set (VK_LCONTROL) && modifier_set (VK_RMENU))
3105 /* Always let TranslateMessage handle AltGr key chords;
3106 for some reason, ToAscii doesn't always process AltGr
3107 chords correctly. */
3108 windows_translate = 1;
3110 else if ((modifiers & (~SHIFT_PRESSED & ~CAPSLOCK_ON)) != 0)
3112 /* Handle key chords including any modifiers other
3113 than shift directly, in order to preserve as much
3114 modifier information as possible. */
3115 if ('A' <= wParam && wParam <= 'Z')
3117 /* Don't translate modified alphabetic keystrokes,
3118 so the user doesn't need to constantly switch
3119 layout to type control or meta keystrokes when
3120 the normal layout translates alphabetic
3121 characters to non-ascii characters. */
3122 if (!modifier_set (VK_SHIFT))
3123 wParam += ('a' - 'A');
3124 msg = WM_CHAR;
3126 else
3128 /* Try to handle other keystrokes by determining the
3129 base character (ie. translating the base key plus
3130 shift modifier). */
3131 int add;
3132 int isdead = 0;
3133 KEY_EVENT_RECORD key;
3135 key.bKeyDown = TRUE;
3136 key.wRepeatCount = 1;
3137 key.wVirtualKeyCode = wParam;
3138 key.wVirtualScanCode = (lParam & 0xFF0000) >> 16;
3139 key.uChar.AsciiChar = 0;
3140 key.dwControlKeyState = modifiers;
3142 add = w32_kbd_patch_key (&key);
3143 /* 0 means an unrecognised keycode, negative means
3144 dead key. Ignore both. */
3145 while (--add >= 0)
3147 /* Forward asciified character sequence. */
3148 post_character_message
3149 (hwnd, WM_CHAR,
3150 (unsigned char) key.uChar.AsciiChar, lParam,
3151 w32_get_key_modifiers (wParam, lParam));
3152 w32_kbd_patch_key (&key);
3154 return 0;
3157 else
3159 /* Let TranslateMessage handle everything else. */
3160 windows_translate = 1;
3165 translate:
3166 if (windows_translate)
3168 MSG windows_msg = { hwnd, msg, wParam, lParam, 0, {0,0} };
3169 windows_msg.time = GetMessageTime ();
3170 TranslateMessage (&windows_msg);
3171 goto dflt;
3174 /* Fall through */
3176 case WM_SYSCHAR:
3177 case WM_CHAR:
3178 post_character_message (hwnd, msg, wParam, lParam,
3179 w32_get_key_modifiers (wParam, lParam));
3180 break;
3182 case WM_UNICHAR:
3183 /* WM_UNICHAR looks promising from the docs, but the exact
3184 circumstances in which TranslateMessage sends it is one of those
3185 Microsoft secret API things that EU and US courts are supposed
3186 to have put a stop to already. Spy++ shows it being sent to Notepad
3187 and other MS apps, but never to Emacs.
3189 Some third party IMEs send it in accordance with the official
3190 documentation though, so handle it here.
3192 UNICODE_NOCHAR is used to test for support for this message.
3193 TRUE indicates that the message is supported. */
3194 if (wParam == UNICODE_NOCHAR)
3195 return TRUE;
3198 W32Msg wmsg;
3199 wmsg.dwModifiers = w32_get_key_modifiers (wParam, lParam);
3200 signal_user_input ();
3201 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3203 break;
3205 case WM_IME_CHAR:
3206 /* If we can't get the IME result as unicode, use default processing,
3207 which will at least allow characters decodable in the system locale
3208 get through. */
3209 if (!get_composition_string_fn)
3210 goto dflt;
3212 else if (!ignore_ime_char)
3214 wchar_t * buffer;
3215 int size, i;
3216 W32Msg wmsg;
3217 HIMC context = get_ime_context_fn (hwnd);
3218 wmsg.dwModifiers = w32_get_key_modifiers (wParam, lParam);
3219 /* Get buffer size. */
3220 size = get_composition_string_fn (context, GCS_RESULTSTR, buffer, 0);
3221 buffer = alloca(size);
3222 size = get_composition_string_fn (context, GCS_RESULTSTR,
3223 buffer, size);
3224 signal_user_input ();
3225 for (i = 0; i < size / sizeof (wchar_t); i++)
3227 my_post_msg (&wmsg, hwnd, WM_UNICHAR, (WPARAM) buffer[i],
3228 lParam);
3230 /* We output the whole string above, so ignore following ones
3231 until we are notified of the end of composition. */
3232 ignore_ime_char = 1;
3234 break;
3236 case WM_IME_ENDCOMPOSITION:
3237 ignore_ime_char = 0;
3238 goto dflt;
3240 /* Simulate middle mouse button events when left and right buttons
3241 are used together, but only if user has two button mouse. */
3242 case WM_LBUTTONDOWN:
3243 case WM_RBUTTONDOWN:
3244 if (w32_num_mouse_buttons > 2)
3245 goto handle_plain_button;
3248 int this = (msg == WM_LBUTTONDOWN) ? LMOUSE : RMOUSE;
3249 int other = (msg == WM_LBUTTONDOWN) ? RMOUSE : LMOUSE;
3251 if (button_state & this)
3252 return 0;
3254 if (button_state == 0)
3255 SetCapture (hwnd);
3257 button_state |= this;
3259 if (button_state & other)
3261 if (mouse_button_timer)
3263 KillTimer (hwnd, mouse_button_timer);
3264 mouse_button_timer = 0;
3266 /* Generate middle mouse event instead. */
3267 msg = WM_MBUTTONDOWN;
3268 button_state |= MMOUSE;
3270 else if (button_state & MMOUSE)
3272 /* Ignore button event if we've already generated a
3273 middle mouse down event. This happens if the
3274 user releases and press one of the two buttons
3275 after we've faked a middle mouse event. */
3276 return 0;
3278 else
3280 /* Flush out saved message. */
3281 post_msg (&saved_mouse_button_msg);
3283 wmsg.dwModifiers = w32_get_modifiers ();
3284 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3285 signal_user_input ();
3287 /* Clear message buffer. */
3288 saved_mouse_button_msg.msg.hwnd = 0;
3290 else
3292 /* Hold onto message for now. */
3293 mouse_button_timer =
3294 SetTimer (hwnd, MOUSE_BUTTON_ID,
3295 w32_mouse_button_tolerance, NULL);
3296 saved_mouse_button_msg.msg.hwnd = hwnd;
3297 saved_mouse_button_msg.msg.message = msg;
3298 saved_mouse_button_msg.msg.wParam = wParam;
3299 saved_mouse_button_msg.msg.lParam = lParam;
3300 saved_mouse_button_msg.msg.time = GetMessageTime ();
3301 saved_mouse_button_msg.dwModifiers = w32_get_modifiers ();
3304 return 0;
3306 case WM_LBUTTONUP:
3307 case WM_RBUTTONUP:
3308 if (w32_num_mouse_buttons > 2)
3309 goto handle_plain_button;
3312 int this = (msg == WM_LBUTTONUP) ? LMOUSE : RMOUSE;
3313 int other = (msg == WM_LBUTTONUP) ? RMOUSE : LMOUSE;
3315 if ((button_state & this) == 0)
3316 return 0;
3318 button_state &= ~this;
3320 if (button_state & MMOUSE)
3322 /* Only generate event when second button is released. */
3323 if ((button_state & other) == 0)
3325 msg = WM_MBUTTONUP;
3326 button_state &= ~MMOUSE;
3328 if (button_state) abort ();
3330 else
3331 return 0;
3333 else
3335 /* Flush out saved message if necessary. */
3336 if (saved_mouse_button_msg.msg.hwnd)
3338 post_msg (&saved_mouse_button_msg);
3341 wmsg.dwModifiers = w32_get_modifiers ();
3342 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3343 signal_user_input ();
3345 /* Always clear message buffer and cancel timer. */
3346 saved_mouse_button_msg.msg.hwnd = 0;
3347 KillTimer (hwnd, mouse_button_timer);
3348 mouse_button_timer = 0;
3350 if (button_state == 0)
3351 ReleaseCapture ();
3353 return 0;
3355 case WM_XBUTTONDOWN:
3356 case WM_XBUTTONUP:
3357 if (w32_pass_extra_mouse_buttons_to_system)
3358 goto dflt;
3359 /* else fall through and process them. */
3360 case WM_MBUTTONDOWN:
3361 case WM_MBUTTONUP:
3362 handle_plain_button:
3364 BOOL up;
3365 int button;
3367 /* Ignore middle and extra buttons as long as the menu is active. */
3368 f = x_window_to_frame (dpyinfo, hwnd);
3369 if (f && f->output_data.w32->menubar_active)
3370 return 0;
3372 if (parse_button (msg, HIWORD (wParam), &button, &up))
3374 if (up) ReleaseCapture ();
3375 else SetCapture (hwnd);
3376 button = (button == 0) ? LMOUSE :
3377 ((button == 1) ? MMOUSE : RMOUSE);
3378 if (up)
3379 button_state &= ~button;
3380 else
3381 button_state |= button;
3385 wmsg.dwModifiers = w32_get_modifiers ();
3386 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3387 signal_user_input ();
3389 /* Need to return true for XBUTTON messages, false for others,
3390 to indicate that we processed the message. */
3391 return (msg == WM_XBUTTONDOWN || msg == WM_XBUTTONUP);
3393 case WM_MOUSEMOVE:
3394 /* Ignore mouse movements as long as the menu is active. These
3395 movements are processed by the window manager anyway, and
3396 it's wrong to handle them as if they happened on the
3397 underlying frame. */
3398 f = x_window_to_frame (dpyinfo, hwnd);
3399 if (f && f->output_data.w32->menubar_active)
3400 return 0;
3402 /* If the mouse has just moved into the frame, start tracking
3403 it, so we will be notified when it leaves the frame. Mouse
3404 tracking only works under W98 and NT4 and later. On earlier
3405 versions, there is no way of telling when the mouse leaves the
3406 frame, so we just have to put up with help-echo and mouse
3407 highlighting remaining while the frame is not active. */
3408 if (track_mouse_event_fn && !track_mouse_window)
3410 TRACKMOUSEEVENT tme;
3411 tme.cbSize = sizeof (tme);
3412 tme.dwFlags = TME_LEAVE;
3413 tme.hwndTrack = hwnd;
3415 track_mouse_event_fn (&tme);
3416 track_mouse_window = hwnd;
3418 case WM_VSCROLL:
3419 if (w32_mouse_move_interval <= 0
3420 || (msg == WM_MOUSEMOVE && button_state == 0))
3422 wmsg.dwModifiers = w32_get_modifiers ();
3423 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3424 return 0;
3427 /* Hang onto mouse move and scroll messages for a bit, to avoid
3428 sending such events to Emacs faster than it can process them.
3429 If we get more events before the timer from the first message
3430 expires, we just replace the first message. */
3432 if (saved_mouse_move_msg.msg.hwnd == 0)
3433 mouse_move_timer =
3434 SetTimer (hwnd, MOUSE_MOVE_ID,
3435 w32_mouse_move_interval, NULL);
3437 /* Hold onto message for now. */
3438 saved_mouse_move_msg.msg.hwnd = hwnd;
3439 saved_mouse_move_msg.msg.message = msg;
3440 saved_mouse_move_msg.msg.wParam = wParam;
3441 saved_mouse_move_msg.msg.lParam = lParam;
3442 saved_mouse_move_msg.msg.time = GetMessageTime ();
3443 saved_mouse_move_msg.dwModifiers = w32_get_modifiers ();
3445 return 0;
3447 case WM_MOUSEWHEEL:
3448 case WM_DROPFILES:
3449 wmsg.dwModifiers = w32_get_modifiers ();
3450 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3451 signal_user_input ();
3452 return 0;
3454 case WM_APPCOMMAND:
3455 if (w32_pass_multimedia_buttons_to_system)
3456 goto dflt;
3457 /* Otherwise, pass to lisp, the same way we do with mousehwheel. */
3458 case WM_MOUSEHWHEEL:
3459 wmsg.dwModifiers = w32_get_modifiers ();
3460 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3461 signal_user_input ();
3462 /* Non-zero must be returned when WM_MOUSEHWHEEL messages are
3463 handled, to prevent the system trying to handle it by faking
3464 scroll bar events. */
3465 return 1;
3467 case WM_TIMER:
3468 /* Flush out saved messages if necessary. */
3469 if (wParam == mouse_button_timer)
3471 if (saved_mouse_button_msg.msg.hwnd)
3473 post_msg (&saved_mouse_button_msg);
3474 signal_user_input ();
3475 saved_mouse_button_msg.msg.hwnd = 0;
3477 KillTimer (hwnd, mouse_button_timer);
3478 mouse_button_timer = 0;
3480 else if (wParam == mouse_move_timer)
3482 if (saved_mouse_move_msg.msg.hwnd)
3484 post_msg (&saved_mouse_move_msg);
3485 saved_mouse_move_msg.msg.hwnd = 0;
3487 KillTimer (hwnd, mouse_move_timer);
3488 mouse_move_timer = 0;
3490 else if (wParam == menu_free_timer)
3492 KillTimer (hwnd, menu_free_timer);
3493 menu_free_timer = 0;
3494 f = x_window_to_frame (dpyinfo, hwnd);
3495 /* If a popup menu is active, don't wipe its strings. */
3496 if (menubar_in_use
3497 && current_popup_menu == NULL)
3499 /* Free memory used by owner-drawn and help-echo strings. */
3500 w32_free_menu_strings (hwnd);
3501 f->output_data.w32->menubar_active = 0;
3502 menubar_in_use = 0;
3505 else if (wParam == hourglass_timer)
3507 KillTimer (hwnd, hourglass_timer);
3508 hourglass_timer = 0;
3509 show_hourglass (x_window_to_frame (dpyinfo, hwnd));
3511 return 0;
3513 case WM_NCACTIVATE:
3514 /* Windows doesn't send us focus messages when putting up and
3515 taking down a system popup dialog as for Ctrl-Alt-Del on Windows 95.
3516 The only indication we get that something happened is receiving
3517 this message afterwards. So this is a good time to reset our
3518 keyboard modifiers' state. */
3519 reset_modifiers ();
3520 goto dflt;
3522 case WM_INITMENU:
3523 button_state = 0;
3524 ReleaseCapture ();
3525 /* We must ensure menu bar is fully constructed and up to date
3526 before allowing user interaction with it. To achieve this
3527 we send this message to the lisp thread and wait for a
3528 reply (whose value is not actually needed) to indicate that
3529 the menu bar is now ready for use, so we can now return.
3531 To remain responsive in the meantime, we enter a nested message
3532 loop that can process all other messages.
3534 However, we skip all this if the message results from calling
3535 TrackPopupMenu - in fact, we must NOT attempt to send the lisp
3536 thread a message because it is blocked on us at this point. We
3537 set menubar_active before calling TrackPopupMenu to indicate
3538 this (there is no possibility of confusion with real menubar
3539 being active). */
3541 f = x_window_to_frame (dpyinfo, hwnd);
3542 if (f
3543 && (f->output_data.w32->menubar_active
3544 /* We can receive this message even in the absence of a
3545 menubar (ie. when the system menu is activated) - in this
3546 case we do NOT want to forward the message, otherwise it
3547 will cause the menubar to suddenly appear when the user
3548 had requested it to be turned off! */
3549 || f->output_data.w32->menubar_widget == NULL))
3550 return 0;
3553 deferred_msg msg_buf;
3555 /* Detect if message has already been deferred; in this case
3556 we cannot return any sensible value to ignore this. */
3557 if (find_deferred_msg (hwnd, msg) != NULL)
3558 abort ();
3560 menubar_in_use = 1;
3562 return send_deferred_msg (&msg_buf, hwnd, msg, wParam, lParam);
3565 case WM_EXITMENULOOP:
3566 f = x_window_to_frame (dpyinfo, hwnd);
3568 /* If a menu is still active, check again after a short delay,
3569 since Windows often (always?) sends the WM_EXITMENULOOP
3570 before the corresponding WM_COMMAND message.
3571 Don't do this if a popup menu is active, since it is only
3572 menubar menus that require cleaning up in this way.
3574 if (f && menubar_in_use && current_popup_menu == NULL)
3575 menu_free_timer = SetTimer (hwnd, MENU_FREE_ID, MENU_FREE_DELAY, NULL);
3577 /* If hourglass cursor should be displayed, display it now. */
3578 if (f && f->output_data.w32->hourglass_p)
3579 SetCursor (f->output_data.w32->hourglass_cursor);
3581 goto dflt;
3583 case WM_MENUSELECT:
3584 /* Direct handling of help_echo in menus. Should be safe now
3585 that we generate the help_echo by placing a help event in the
3586 keyboard buffer. */
3588 HMENU menu = (HMENU) lParam;
3589 UINT menu_item = (UINT) LOWORD (wParam);
3590 UINT flags = (UINT) HIWORD (wParam);
3592 w32_menu_display_help (hwnd, menu, menu_item, flags);
3594 return 0;
3596 case WM_MEASUREITEM:
3597 f = x_window_to_frame (dpyinfo, hwnd);
3598 if (f)
3600 MEASUREITEMSTRUCT * pMis = (MEASUREITEMSTRUCT *) lParam;
3602 if (pMis->CtlType == ODT_MENU)
3604 /* Work out dimensions for popup menu titles. */
3605 char * title = (char *) pMis->itemData;
3606 HDC hdc = GetDC (hwnd);
3607 HFONT menu_font = GetCurrentObject (hdc, OBJ_FONT);
3608 LOGFONT menu_logfont;
3609 HFONT old_font;
3610 SIZE size;
3612 GetObject (menu_font, sizeof (menu_logfont), &menu_logfont);
3613 menu_logfont.lfWeight = FW_BOLD;
3614 menu_font = CreateFontIndirect (&menu_logfont);
3615 old_font = SelectObject (hdc, menu_font);
3617 pMis->itemHeight = GetSystemMetrics (SM_CYMENUSIZE);
3618 if (title)
3620 if (unicode_append_menu)
3621 GetTextExtentPoint32W (hdc, (WCHAR *) title,
3622 wcslen ((WCHAR *) title),
3623 &size);
3624 else
3625 GetTextExtentPoint32 (hdc, title, strlen (title), &size);
3627 pMis->itemWidth = size.cx;
3628 if (pMis->itemHeight < size.cy)
3629 pMis->itemHeight = size.cy;
3631 else
3632 pMis->itemWidth = 0;
3634 SelectObject (hdc, old_font);
3635 DeleteObject (menu_font);
3636 ReleaseDC (hwnd, hdc);
3637 return TRUE;
3640 return 0;
3642 case WM_DRAWITEM:
3643 f = x_window_to_frame (dpyinfo, hwnd);
3644 if (f)
3646 DRAWITEMSTRUCT * pDis = (DRAWITEMSTRUCT *) lParam;
3648 if (pDis->CtlType == ODT_MENU)
3650 /* Draw popup menu title. */
3651 char * title = (char *) pDis->itemData;
3652 if (title)
3654 HDC hdc = pDis->hDC;
3655 HFONT menu_font = GetCurrentObject (hdc, OBJ_FONT);
3656 LOGFONT menu_logfont;
3657 HFONT old_font;
3659 GetObject (menu_font, sizeof (menu_logfont), &menu_logfont);
3660 menu_logfont.lfWeight = FW_BOLD;
3661 menu_font = CreateFontIndirect (&menu_logfont);
3662 old_font = SelectObject (hdc, menu_font);
3664 /* Always draw title as if not selected. */
3665 if (unicode_append_menu)
3666 ExtTextOutW (hdc,
3667 pDis->rcItem.left
3668 + GetSystemMetrics (SM_CXMENUCHECK),
3669 pDis->rcItem.top,
3670 ETO_OPAQUE, &pDis->rcItem,
3671 (WCHAR *) title,
3672 wcslen ((WCHAR *) title), NULL);
3673 else
3674 ExtTextOut (hdc,
3675 pDis->rcItem.left
3676 + GetSystemMetrics (SM_CXMENUCHECK),
3677 pDis->rcItem.top,
3678 ETO_OPAQUE, &pDis->rcItem,
3679 title, strlen (title), NULL);
3681 SelectObject (hdc, old_font);
3682 DeleteObject (menu_font);
3684 return TRUE;
3687 return 0;
3689 #if 0
3690 /* Still not right - can't distinguish between clicks in the
3691 client area of the frame from clicks forwarded from the scroll
3692 bars - may have to hook WM_NCHITTEST to remember the mouse
3693 position and then check if it is in the client area ourselves. */
3694 case WM_MOUSEACTIVATE:
3695 /* Discard the mouse click that activates a frame, allowing the
3696 user to click anywhere without changing point (or worse!).
3697 Don't eat mouse clicks on scrollbars though!! */
3698 if (LOWORD (lParam) == HTCLIENT )
3699 return MA_ACTIVATEANDEAT;
3700 goto dflt;
3701 #endif
3703 case WM_MOUSELEAVE:
3704 /* No longer tracking mouse. */
3705 track_mouse_window = NULL;
3707 case WM_ACTIVATEAPP:
3708 case WM_ACTIVATE:
3709 case WM_WINDOWPOSCHANGED:
3710 case WM_SHOWWINDOW:
3711 /* Inform lisp thread that a frame might have just been obscured
3712 or exposed, so should recheck visibility of all frames. */
3713 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3714 goto dflt;
3716 case WM_SETFOCUS:
3717 dpyinfo->faked_key = 0;
3718 reset_modifiers ();
3719 register_hot_keys (hwnd);
3720 goto command;
3721 case WM_KILLFOCUS:
3722 unregister_hot_keys (hwnd);
3723 button_state = 0;
3724 ReleaseCapture ();
3725 /* Relinquish the system caret. */
3726 if (w32_system_caret_hwnd)
3728 w32_visible_system_caret_hwnd = NULL;
3729 w32_system_caret_hwnd = NULL;
3730 DestroyCaret ();
3732 goto command;
3733 case WM_COMMAND:
3734 menubar_in_use = 0;
3735 f = x_window_to_frame (dpyinfo, hwnd);
3736 if (f && HIWORD (wParam) == 0)
3738 if (menu_free_timer)
3740 KillTimer (hwnd, menu_free_timer);
3741 menu_free_timer = 0;
3744 case WM_MOVE:
3745 case WM_SIZE:
3746 command:
3747 wmsg.dwModifiers = w32_get_modifiers ();
3748 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3749 goto dflt;
3751 case WM_DESTROY:
3752 CoUninitialize ();
3753 return 0;
3755 case WM_CLOSE:
3756 wmsg.dwModifiers = w32_get_modifiers ();
3757 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3758 return 0;
3760 case WM_WINDOWPOSCHANGING:
3761 /* Don't restrict the sizing of tip frames. */
3762 if (hwnd == tip_window)
3763 return 0;
3765 WINDOWPLACEMENT wp;
3766 LPWINDOWPOS lppos = (WINDOWPOS *) lParam;
3768 wp.length = sizeof (WINDOWPLACEMENT);
3769 GetWindowPlacement (hwnd, &wp);
3771 if (wp.showCmd != SW_SHOWMINIMIZED && (lppos->flags & SWP_NOSIZE) == 0)
3773 RECT rect;
3774 int wdiff;
3775 int hdiff;
3776 DWORD font_width;
3777 DWORD line_height;
3778 DWORD internal_border;
3779 DWORD scrollbar_extra;
3780 RECT wr;
3782 wp.length = sizeof (wp);
3783 GetWindowRect (hwnd, &wr);
3785 enter_crit ();
3787 font_width = GetWindowLong (hwnd, WND_FONTWIDTH_INDEX);
3788 line_height = GetWindowLong (hwnd, WND_LINEHEIGHT_INDEX);
3789 internal_border = GetWindowLong (hwnd, WND_BORDER_INDEX);
3790 scrollbar_extra = GetWindowLong (hwnd, WND_SCROLLBAR_INDEX);
3792 leave_crit ();
3794 memset (&rect, 0, sizeof (rect));
3795 AdjustWindowRect (&rect, GetWindowLong (hwnd, GWL_STYLE),
3796 GetMenu (hwnd) != NULL);
3798 /* Force width and height of client area to be exact
3799 multiples of the character cell dimensions. */
3800 wdiff = (lppos->cx - (rect.right - rect.left)
3801 - 2 * internal_border - scrollbar_extra)
3802 % font_width;
3803 hdiff = (lppos->cy - (rect.bottom - rect.top)
3804 - 2 * internal_border)
3805 % line_height;
3807 if (wdiff || hdiff)
3809 /* For right/bottom sizing we can just fix the sizes.
3810 However for top/left sizing we will need to fix the X
3811 and Y positions as well. */
3813 int cx_mintrack = GetSystemMetrics (SM_CXMINTRACK);
3814 int cy_mintrack = GetSystemMetrics (SM_CYMINTRACK);
3816 lppos->cx = max (lppos->cx - wdiff, cx_mintrack);
3817 lppos->cy = max (lppos->cy - hdiff, cy_mintrack);
3819 if (wp.showCmd != SW_SHOWMAXIMIZED
3820 && (lppos->flags & SWP_NOMOVE) == 0)
3822 if (lppos->x != wr.left || lppos->y != wr.top)
3824 lppos->x += wdiff;
3825 lppos->y += hdiff;
3827 else
3829 lppos->flags |= SWP_NOMOVE;
3833 return 0;
3838 goto dflt;
3840 case WM_GETMINMAXINFO:
3841 /* Hack to allow resizing the Emacs frame above the screen size.
3842 Note that Windows 9x limits coordinates to 16-bits. */
3843 ((LPMINMAXINFO) lParam)->ptMaxTrackSize.x = 32767;
3844 ((LPMINMAXINFO) lParam)->ptMaxTrackSize.y = 32767;
3845 return 0;
3847 case WM_SETCURSOR:
3848 if (LOWORD (lParam) == HTCLIENT)
3850 f = x_window_to_frame (dpyinfo, hwnd);
3851 if (f->output_data.w32->hourglass_p && !menubar_in_use
3852 && !current_popup_menu)
3853 SetCursor (f->output_data.w32->hourglass_cursor);
3854 else
3855 SetCursor (f->output_data.w32->current_cursor);
3856 return 0;
3858 goto dflt;
3860 case WM_EMACS_SETCURSOR:
3862 Cursor cursor = (Cursor) wParam;
3863 f = x_window_to_frame (dpyinfo, hwnd);
3864 if (f && cursor)
3866 f->output_data.w32->current_cursor = cursor;
3867 if (!f->output_data.w32->hourglass_p)
3868 SetCursor (cursor);
3870 return 0;
3873 case WM_EMACS_CREATESCROLLBAR:
3874 return (LRESULT) w32_createscrollbar ((struct frame *) wParam,
3875 (struct scroll_bar *) lParam);
3877 case WM_EMACS_SHOWWINDOW:
3878 return ShowWindow ((HWND) wParam, (WPARAM) lParam);
3880 case WM_EMACS_SETFOREGROUND:
3882 HWND foreground_window;
3883 DWORD foreground_thread, retval;
3885 /* On NT 5.0, and apparently Windows 98, it is necessary to
3886 attach to the thread that currently has focus in order to
3887 pull the focus away from it. */
3888 foreground_window = GetForegroundWindow ();
3889 foreground_thread = GetWindowThreadProcessId (foreground_window, NULL);
3890 if (!foreground_window
3891 || foreground_thread == GetCurrentThreadId ()
3892 || !AttachThreadInput (GetCurrentThreadId (),
3893 foreground_thread, TRUE))
3894 foreground_thread = 0;
3896 retval = SetForegroundWindow ((HWND) wParam);
3898 /* Detach from the previous foreground thread. */
3899 if (foreground_thread)
3900 AttachThreadInput (GetCurrentThreadId (),
3901 foreground_thread, FALSE);
3903 return retval;
3906 case WM_EMACS_SETWINDOWPOS:
3908 WINDOWPOS * pos = (WINDOWPOS *) wParam;
3909 return SetWindowPos (hwnd, pos->hwndInsertAfter,
3910 pos->x, pos->y, pos->cx, pos->cy, pos->flags);
3913 case WM_EMACS_DESTROYWINDOW:
3914 DragAcceptFiles ((HWND) wParam, FALSE);
3915 return DestroyWindow ((HWND) wParam);
3917 case WM_EMACS_HIDE_CARET:
3918 return HideCaret (hwnd);
3920 case WM_EMACS_SHOW_CARET:
3921 return ShowCaret (hwnd);
3923 case WM_EMACS_DESTROY_CARET:
3924 w32_system_caret_hwnd = NULL;
3925 w32_visible_system_caret_hwnd = NULL;
3926 return DestroyCaret ();
3928 case WM_EMACS_TRACK_CARET:
3929 /* If there is currently no system caret, create one. */
3930 if (w32_system_caret_hwnd == NULL)
3932 /* Use the default caret width, and avoid changing it
3933 unneccesarily, as it confuses screen reader software. */
3934 w32_system_caret_hwnd = hwnd;
3935 CreateCaret (hwnd, NULL, 0,
3936 w32_system_caret_height);
3939 if (!SetCaretPos (w32_system_caret_x, w32_system_caret_y))
3940 return 0;
3941 /* Ensure visible caret gets turned on when requested. */
3942 else if (w32_use_visible_system_caret
3943 && w32_visible_system_caret_hwnd != hwnd)
3945 w32_visible_system_caret_hwnd = hwnd;
3946 return ShowCaret (hwnd);
3948 /* Ensure visible caret gets turned off when requested. */
3949 else if (!w32_use_visible_system_caret
3950 && w32_visible_system_caret_hwnd)
3952 w32_visible_system_caret_hwnd = NULL;
3953 return HideCaret (hwnd);
3955 else
3956 return 1;
3958 case WM_EMACS_TRACKPOPUPMENU:
3960 UINT flags;
3961 POINT *pos;
3962 int retval;
3963 pos = (POINT *)lParam;
3964 flags = TPM_CENTERALIGN;
3965 if (button_state & LMOUSE)
3966 flags |= TPM_LEFTBUTTON;
3967 else if (button_state & RMOUSE)
3968 flags |= TPM_RIGHTBUTTON;
3970 /* Remember we did a SetCapture on the initial mouse down event,
3971 so for safety, we make sure the capture is cancelled now. */
3972 ReleaseCapture ();
3973 button_state = 0;
3975 /* Use menubar_active to indicate that WM_INITMENU is from
3976 TrackPopupMenu below, and should be ignored. */
3977 f = x_window_to_frame (dpyinfo, hwnd);
3978 if (f)
3979 f->output_data.w32->menubar_active = 1;
3981 if (TrackPopupMenu ((HMENU)wParam, flags, pos->x, pos->y,
3982 0, hwnd, NULL))
3984 MSG amsg;
3985 /* Eat any mouse messages during popupmenu */
3986 while (PeekMessage (&amsg, hwnd, WM_MOUSEFIRST, WM_MOUSELAST,
3987 PM_REMOVE));
3988 /* Get the menu selection, if any */
3989 if (PeekMessage (&amsg, hwnd, WM_COMMAND, WM_COMMAND, PM_REMOVE))
3991 retval = LOWORD (amsg.wParam);
3993 else
3995 retval = 0;
3998 else
4000 retval = -1;
4003 return retval;
4006 default:
4007 /* Check for messages registered at runtime. */
4008 if (msg == msh_mousewheel)
4010 wmsg.dwModifiers = w32_get_modifiers ();
4011 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4012 signal_user_input ();
4013 return 0;
4016 dflt:
4017 return DefWindowProc (hwnd, msg, wParam, lParam);
4021 /* The most common default return code for handled messages is 0. */
4022 return 0;
4025 static void
4026 my_create_window (f)
4027 struct frame * f;
4029 MSG msg;
4031 if (!PostThreadMessage (dwWindowsThreadId, WM_EMACS_CREATEWINDOW, (WPARAM)f, 0))
4032 abort ();
4033 GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE);
4037 /* Create a tooltip window. Unlike my_create_window, we do not do this
4038 indirectly via the Window thread, as we do not need to process Window
4039 messages for the tooltip. Creating tooltips indirectly also creates
4040 deadlocks when tooltips are created for menu items. */
4041 static void
4042 my_create_tip_window (f)
4043 struct frame *f;
4045 RECT rect;
4047 rect.left = rect.top = 0;
4048 rect.right = FRAME_PIXEL_WIDTH (f);
4049 rect.bottom = FRAME_PIXEL_HEIGHT (f);
4051 AdjustWindowRect (&rect, f->output_data.w32->dwStyle,
4052 FRAME_EXTERNAL_MENU_BAR (f));
4054 tip_window = FRAME_W32_WINDOW (f)
4055 = CreateWindow (EMACS_CLASS,
4056 f->namebuf,
4057 f->output_data.w32->dwStyle,
4058 f->left_pos,
4059 f->top_pos,
4060 rect.right - rect.left,
4061 rect.bottom - rect.top,
4062 FRAME_W32_WINDOW (SELECTED_FRAME ()), /* owner */
4063 NULL,
4064 hinst,
4065 NULL);
4067 if (tip_window)
4069 SetWindowLong (tip_window, WND_FONTWIDTH_INDEX, FRAME_COLUMN_WIDTH (f));
4070 SetWindowLong (tip_window, WND_LINEHEIGHT_INDEX, FRAME_LINE_HEIGHT (f));
4071 SetWindowLong (tip_window, WND_BORDER_INDEX, FRAME_INTERNAL_BORDER_WIDTH (f));
4072 SetWindowLong (tip_window, WND_BACKGROUND_INDEX, FRAME_BACKGROUND_PIXEL (f));
4074 /* Tip frames have no scrollbars. */
4075 SetWindowLong (tip_window, WND_SCROLLBAR_INDEX, 0);
4077 /* Do this to discard the default setting specified by our parent. */
4078 ShowWindow (tip_window, SW_HIDE);
4083 /* Create and set up the w32 window for frame F. */
4085 static void
4086 w32_window (f, window_prompting, minibuffer_only)
4087 struct frame *f;
4088 long window_prompting;
4089 int minibuffer_only;
4091 BLOCK_INPUT;
4093 /* Use the resource name as the top-level window name
4094 for looking up resources. Make a non-Lisp copy
4095 for the window manager, so GC relocation won't bother it.
4097 Elsewhere we specify the window name for the window manager. */
4100 char *str = (char *) SDATA (Vx_resource_name);
4101 f->namebuf = (char *) xmalloc (strlen (str) + 1);
4102 strcpy (f->namebuf, str);
4105 my_create_window (f);
4107 validate_x_resource_name ();
4109 /* x_set_name normally ignores requests to set the name if the
4110 requested name is the same as the current name. This is the one
4111 place where that assumption isn't correct; f->name is set, but
4112 the server hasn't been told. */
4114 Lisp_Object name;
4115 int explicit = f->explicit_name;
4117 f->explicit_name = 0;
4118 name = f->name;
4119 f->name = Qnil;
4120 x_set_name (f, name, explicit);
4123 UNBLOCK_INPUT;
4125 if (!minibuffer_only && FRAME_EXTERNAL_MENU_BAR (f))
4126 initialize_frame_menubar (f);
4128 if (FRAME_W32_WINDOW (f) == 0)
4129 error ("Unable to create window");
4132 /* Handle the icon stuff for this window. Perhaps later we might
4133 want an x_set_icon_position which can be called interactively as
4134 well. */
4136 static void
4137 x_icon (f, parms)
4138 struct frame *f;
4139 Lisp_Object parms;
4141 Lisp_Object icon_x, icon_y;
4143 /* Set the position of the icon. Note that Windows 95 groups all
4144 icons in the tray. */
4145 icon_x = w32_get_arg (parms, Qicon_left, 0, 0, RES_TYPE_NUMBER);
4146 icon_y = w32_get_arg (parms, Qicon_top, 0, 0, RES_TYPE_NUMBER);
4147 if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
4149 CHECK_NUMBER (icon_x);
4150 CHECK_NUMBER (icon_y);
4152 else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
4153 error ("Both left and top icon corners of icon must be specified");
4155 BLOCK_INPUT;
4157 if (! EQ (icon_x, Qunbound))
4158 x_wm_set_icon_position (f, XINT (icon_x), XINT (icon_y));
4160 #if 0 /* TODO */
4161 /* Start up iconic or window? */
4162 x_wm_set_window_state
4163 (f, (EQ (w32_get_arg (parms, Qvisibility, 0, 0, RES_TYPE_SYMBOL), Qicon)
4164 ? IconicState
4165 : NormalState));
4167 x_text_icon (f, (char *) SDATA ((!NILP (f->icon_name)
4168 ? f->icon_name
4169 : f->name)));
4170 #endif
4172 UNBLOCK_INPUT;
4176 static void
4177 x_make_gc (f)
4178 struct frame *f;
4180 XGCValues gc_values;
4182 BLOCK_INPUT;
4184 /* Create the GC's of this frame.
4185 Note that many default values are used. */
4187 /* Normal video */
4188 gc_values.font = FRAME_FONT (f);
4190 /* Cursor has cursor-color background, background-color foreground. */
4191 gc_values.foreground = FRAME_BACKGROUND_PIXEL (f);
4192 gc_values.background = f->output_data.w32->cursor_pixel;
4193 f->output_data.w32->cursor_gc
4194 = XCreateGC (NULL, FRAME_W32_WINDOW (f),
4195 (GCFont | GCForeground | GCBackground),
4196 &gc_values);
4198 /* Reliefs. */
4199 f->output_data.w32->white_relief.gc = 0;
4200 f->output_data.w32->black_relief.gc = 0;
4202 UNBLOCK_INPUT;
4206 /* Handler for signals raised during x_create_frame and
4207 x_create_top_frame. FRAME is the frame which is partially
4208 constructed. */
4210 static Lisp_Object
4211 unwind_create_frame (frame)
4212 Lisp_Object frame;
4214 struct frame *f = XFRAME (frame);
4216 /* If frame is ``official'', nothing to do. */
4217 if (!CONSP (Vframe_list) || !EQ (XCAR (Vframe_list), frame))
4219 #ifdef GLYPH_DEBUG
4220 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
4221 #endif
4223 x_free_frame_resources (f);
4225 /* Check that reference counts are indeed correct. */
4226 xassert (dpyinfo->reference_count == dpyinfo_refcount);
4227 xassert (dpyinfo->image_cache->refcount == image_cache_refcount);
4229 return Qt;
4232 return Qnil;
4235 static void
4236 x_default_font_parameter (f, parms)
4237 struct frame *f;
4238 Lisp_Object parms;
4240 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
4241 Lisp_Object font_param = x_get_arg (dpyinfo, parms, Qfont, NULL, NULL,
4242 RES_TYPE_STRING);
4243 Lisp_Object font;
4244 if (EQ (font_param, Qunbound))
4245 font_param = Qnil;
4246 font = !NILP (font_param) ? font_param
4247 : x_get_arg (dpyinfo, parms, Qfont, "font", "Font", RES_TYPE_STRING);
4249 if (!STRINGP (font))
4251 int i;
4252 static char *names[]
4253 = { "Courier New-10",
4254 "-*-Courier-normal-r-*-*-13-*-*-*-c-*-iso8859-1",
4255 "-*-Fixedsys-normal-r-*-*-12-*-*-*-c-*-iso8859-1",
4256 "Fixedsys",
4257 NULL };
4259 for (i = 0; names[i]; i++)
4261 font = font_open_by_name (f, names[i]);
4262 if (! NILP (font))
4263 break;
4265 if (NILP (font))
4266 error ("No suitable font was found");
4268 else if (!NILP (font_param))
4270 /* Remember the explicit font parameter, so we can re-apply it after
4271 we've applied the `default' face settings. */
4272 x_set_frame_parameters (f, Fcons (Fcons (Qfont_param, font_param), Qnil));
4274 x_default_parameter (f, parms, Qfont, font, "font", "Font", RES_TYPE_STRING);
4277 DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
4278 1, 1, 0,
4279 doc: /* Make a new window, which is called a \"frame\" in Emacs terms.
4280 Return an Emacs frame object.
4281 PARAMETERS is an alist of frame parameters.
4282 If the parameters specify that the frame should not have a minibuffer,
4283 and do not specify a specific minibuffer window to use,
4284 then `default-minibuffer-frame' must be a frame whose minibuffer can
4285 be shared by the new frame.
4287 This function is an internal primitive--use `make-frame' instead. */)
4288 (parameters)
4289 Lisp_Object parameters;
4291 struct frame *f;
4292 Lisp_Object frame, tem;
4293 Lisp_Object name;
4294 int minibuffer_only = 0;
4295 long window_prompting = 0;
4296 int width, height;
4297 int count = SPECPDL_INDEX ();
4298 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
4299 Lisp_Object display;
4300 struct w32_display_info *dpyinfo = NULL;
4301 Lisp_Object parent;
4302 struct kboard *kb;
4304 check_w32 ();
4306 /* Make copy of frame parameters because the original is in pure
4307 storage now. */
4308 parameters = Fcopy_alist (parameters);
4310 /* Use this general default value to start with
4311 until we know if this frame has a specified name. */
4312 Vx_resource_name = Vinvocation_name;
4314 display = w32_get_arg (parameters, Qdisplay, 0, 0, RES_TYPE_STRING);
4315 if (EQ (display, Qunbound))
4316 display = Qnil;
4317 dpyinfo = check_x_display_info (display);
4318 #ifdef MULTI_KBOARD
4319 kb = dpyinfo->terminal->kboard;
4320 #else
4321 kb = &the_only_kboard;
4322 #endif
4324 name = w32_get_arg (parameters, Qname, "name", "Name", RES_TYPE_STRING);
4325 if (!STRINGP (name)
4326 && ! EQ (name, Qunbound)
4327 && ! NILP (name))
4328 error ("Invalid frame name--not a string or nil");
4330 if (STRINGP (name))
4331 Vx_resource_name = name;
4333 /* See if parent window is specified. */
4334 parent = w32_get_arg (parameters, Qparent_id, NULL, NULL, RES_TYPE_NUMBER);
4335 if (EQ (parent, Qunbound))
4336 parent = Qnil;
4337 if (! NILP (parent))
4338 CHECK_NUMBER (parent);
4340 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
4341 /* No need to protect DISPLAY because that's not used after passing
4342 it to make_frame_without_minibuffer. */
4343 frame = Qnil;
4344 GCPRO4 (parameters, parent, name, frame);
4345 tem = w32_get_arg (parameters, Qminibuffer, "minibuffer", "Minibuffer",
4346 RES_TYPE_SYMBOL);
4347 if (EQ (tem, Qnone) || NILP (tem))
4348 f = make_frame_without_minibuffer (Qnil, kb, display);
4349 else if (EQ (tem, Qonly))
4351 f = make_minibuffer_frame ();
4352 minibuffer_only = 1;
4354 else if (WINDOWP (tem))
4355 f = make_frame_without_minibuffer (tem, kb, display);
4356 else
4357 f = make_frame (1);
4359 XSETFRAME (frame, f);
4361 /* Note that Windows does support scroll bars. */
4362 FRAME_CAN_HAVE_SCROLL_BARS (f) = 1;
4364 /* By default, make scrollbars the system standard width. */
4365 FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = GetSystemMetrics (SM_CXVSCROLL);
4367 f->terminal = dpyinfo->terminal;
4368 f->terminal->reference_count++;
4370 f->output_method = output_w32;
4371 f->output_data.w32 =
4372 (struct w32_output *) xmalloc (sizeof (struct w32_output));
4373 bzero (f->output_data.w32, sizeof (struct w32_output));
4374 FRAME_FONTSET (f) = -1;
4375 record_unwind_protect (unwind_create_frame, frame);
4377 f->icon_name
4378 = w32_get_arg (parameters, Qicon_name, "iconName", "Title", RES_TYPE_STRING);
4379 if (! STRINGP (f->icon_name))
4380 f->icon_name = Qnil;
4382 /* FRAME_W32_DISPLAY_INFO (f) = dpyinfo; */
4383 #ifdef MULTI_KBOARD
4384 FRAME_KBOARD (f) = kb;
4385 #endif
4387 /* Specify the parent under which to make this window. */
4389 if (!NILP (parent))
4391 f->output_data.w32->parent_desc = (Window) XFASTINT (parent);
4392 f->output_data.w32->explicit_parent = 1;
4394 else
4396 f->output_data.w32->parent_desc = FRAME_W32_DISPLAY_INFO (f)->root_window;
4397 f->output_data.w32->explicit_parent = 0;
4400 /* Set the name; the functions to which we pass f expect the name to
4401 be set. */
4402 if (EQ (name, Qunbound) || NILP (name))
4404 f->name = build_string (dpyinfo->w32_id_name);
4405 f->explicit_name = 0;
4407 else
4409 f->name = name;
4410 f->explicit_name = 1;
4411 /* use the frame's title when getting resources for this frame. */
4412 specbind (Qx_resource_name, name);
4415 f->resx = dpyinfo->resx;
4416 f->resy = dpyinfo->resy;
4418 if (uniscribe_available)
4419 register_font_driver (&uniscribe_font_driver, f);
4420 register_font_driver (&w32font_driver, f);
4422 x_default_parameter (f, parameters, Qfont_backend, Qnil,
4423 "fontBackend", "FontBackend", RES_TYPE_STRING);
4424 /* Extract the window parameters from the supplied values
4425 that are needed to determine window geometry. */
4426 x_default_font_parameter (f, parameters);
4427 x_default_parameter (f, parameters, Qborder_width, make_number (2),
4428 "borderWidth", "BorderWidth", RES_TYPE_NUMBER);
4429 /* This defaults to 2 in order to match xterm. We recognize either
4430 internalBorderWidth or internalBorder (which is what xterm calls
4431 it). */
4432 if (NILP (Fassq (Qinternal_border_width, parameters)))
4434 Lisp_Object value;
4436 value = w32_get_arg (parameters, Qinternal_border_width,
4437 "internalBorder", "InternalBorder", RES_TYPE_NUMBER);
4438 if (! EQ (value, Qunbound))
4439 parameters = Fcons (Fcons (Qinternal_border_width, value),
4440 parameters);
4442 /* Default internalBorderWidth to 0 on Windows to match other programs. */
4443 x_default_parameter (f, parameters, Qinternal_border_width, make_number (0),
4444 "internalBorderWidth", "InternalBorder", RES_TYPE_NUMBER);
4445 x_default_parameter (f, parameters, Qvertical_scroll_bars, Qright,
4446 "verticalScrollBars", "ScrollBars", RES_TYPE_SYMBOL);
4448 /* Also do the stuff which must be set before the window exists. */
4449 x_default_parameter (f, parameters, Qforeground_color, build_string ("black"),
4450 "foreground", "Foreground", RES_TYPE_STRING);
4451 x_default_parameter (f, parameters, Qbackground_color, build_string ("white"),
4452 "background", "Background", RES_TYPE_STRING);
4453 x_default_parameter (f, parameters, Qmouse_color, build_string ("black"),
4454 "pointerColor", "Foreground", RES_TYPE_STRING);
4455 x_default_parameter (f, parameters, Qcursor_color, build_string ("black"),
4456 "cursorColor", "Foreground", RES_TYPE_STRING);
4457 x_default_parameter (f, parameters, Qborder_color, build_string ("black"),
4458 "borderColor", "BorderColor", RES_TYPE_STRING);
4459 x_default_parameter (f, parameters, Qscreen_gamma, Qnil,
4460 "screenGamma", "ScreenGamma", RES_TYPE_FLOAT);
4461 x_default_parameter (f, parameters, Qline_spacing, Qnil,
4462 "lineSpacing", "LineSpacing", RES_TYPE_NUMBER);
4463 x_default_parameter (f, parameters, Qleft_fringe, Qnil,
4464 "leftFringe", "LeftFringe", RES_TYPE_NUMBER);
4465 x_default_parameter (f, parameters, Qright_fringe, Qnil,
4466 "rightFringe", "RightFringe", RES_TYPE_NUMBER);
4469 /* Init faces before x_default_parameter is called for scroll-bar
4470 parameters because that function calls x_set_scroll_bar_width,
4471 which calls change_frame_size, which calls Fset_window_buffer,
4472 which runs hooks, which call Fvertical_motion. At the end, we
4473 end up in init_iterator with a null face cache, which should not
4474 happen. */
4475 init_frame_faces (f);
4477 x_default_parameter (f, parameters, Qmenu_bar_lines, make_number (1),
4478 "menuBar", "MenuBar", RES_TYPE_NUMBER);
4479 x_default_parameter (f, parameters, Qtool_bar_lines, make_number (1),
4480 "toolBar", "ToolBar", RES_TYPE_NUMBER);
4482 x_default_parameter (f, parameters, Qbuffer_predicate, Qnil,
4483 "bufferPredicate", "BufferPredicate", RES_TYPE_SYMBOL);
4484 x_default_parameter (f, parameters, Qtitle, Qnil,
4485 "title", "Title", RES_TYPE_STRING);
4486 x_default_parameter (f, parameters, Qfullscreen, Qnil,
4487 "fullscreen", "Fullscreen", RES_TYPE_SYMBOL);
4489 f->output_data.w32->dwStyle = WS_OVERLAPPEDWINDOW;
4490 f->output_data.w32->parent_desc = FRAME_W32_DISPLAY_INFO (f)->root_window;
4492 f->output_data.w32->text_cursor = w32_load_cursor (IDC_IBEAM);
4493 f->output_data.w32->nontext_cursor = w32_load_cursor (IDC_ARROW);
4494 f->output_data.w32->modeline_cursor = w32_load_cursor (IDC_ARROW);
4495 f->output_data.w32->hand_cursor = w32_load_cursor (IDC_HAND);
4496 f->output_data.w32->hourglass_cursor = w32_load_cursor (IDC_WAIT);
4497 f->output_data.w32->horizontal_drag_cursor = w32_load_cursor (IDC_SIZEWE);
4499 f->output_data.w32->current_cursor = f->output_data.w32->nontext_cursor;
4501 window_prompting = x_figure_window_size (f, parameters, 1);
4503 tem = w32_get_arg (parameters, Qunsplittable, 0, 0, RES_TYPE_BOOLEAN);
4504 f->no_split = minibuffer_only || EQ (tem, Qt);
4506 w32_window (f, window_prompting, minibuffer_only);
4507 x_icon (f, parameters);
4509 x_make_gc (f);
4511 /* Now consider the frame official. */
4512 FRAME_W32_DISPLAY_INFO (f)->reference_count++;
4513 Vframe_list = Fcons (frame, Vframe_list);
4515 /* We need to do this after creating the window, so that the
4516 icon-creation functions can say whose icon they're describing. */
4517 x_default_parameter (f, parameters, Qicon_type, Qnil,
4518 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL);
4520 x_default_parameter (f, parameters, Qauto_raise, Qnil,
4521 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN);
4522 x_default_parameter (f, parameters, Qauto_lower, Qnil,
4523 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN);
4524 x_default_parameter (f, parameters, Qcursor_type, Qbox,
4525 "cursorType", "CursorType", RES_TYPE_SYMBOL);
4526 x_default_parameter (f, parameters, Qscroll_bar_width, Qnil,
4527 "scrollBarWidth", "ScrollBarWidth", RES_TYPE_NUMBER);
4528 x_default_parameter (f, parameters, Qalpha, Qnil,
4529 "alpha", "Alpha", RES_TYPE_NUMBER);
4531 /* Dimensions, especially FRAME_LINES (f), must be done via change_frame_size.
4532 Change will not be effected unless different from the current
4533 FRAME_LINES (f). */
4534 width = FRAME_COLS (f);
4535 height = FRAME_LINES (f);
4537 FRAME_LINES (f) = 0;
4538 SET_FRAME_COLS (f, 0);
4539 change_frame_size (f, height, width, 1, 0, 0);
4541 /* Tell the server what size and position, etc, we want, and how
4542 badly we want them. This should be done after we have the menu
4543 bar so that its size can be taken into account. */
4544 BLOCK_INPUT;
4545 x_wm_set_size_hint (f, window_prompting, 0);
4546 UNBLOCK_INPUT;
4548 /* Make the window appear on the frame and enable display, unless
4549 the caller says not to. However, with explicit parent, Emacs
4550 cannot control visibility, so don't try. */
4551 if (! f->output_data.w32->explicit_parent)
4553 Lisp_Object visibility;
4555 visibility = w32_get_arg (parameters, Qvisibility, 0, 0, RES_TYPE_SYMBOL);
4556 if (EQ (visibility, Qunbound))
4557 visibility = Qt;
4559 if (EQ (visibility, Qicon))
4560 x_iconify_frame (f);
4561 else if (! NILP (visibility))
4562 x_make_frame_visible (f);
4563 else
4564 /* Must have been Qnil. */
4568 /* Initialize `default-minibuffer-frame' in case this is the first
4569 frame on this terminal. */
4570 if (FRAME_HAS_MINIBUF_P (f)
4571 && (!FRAMEP (kb->Vdefault_minibuffer_frame)
4572 || !FRAME_LIVE_P (XFRAME (kb->Vdefault_minibuffer_frame))))
4573 kb->Vdefault_minibuffer_frame = frame;
4575 /* All remaining specified parameters, which have not been "used"
4576 by x_get_arg and friends, now go in the misc. alist of the frame. */
4577 for (tem = parameters; CONSP (tem); tem = XCDR (tem))
4578 if (CONSP (XCAR (tem)) && !NILP (XCAR (XCAR (tem))))
4579 f->param_alist = Fcons (XCAR (tem), f->param_alist);
4581 UNGCPRO;
4583 /* Make sure windows on this frame appear in calls to next-window
4584 and similar functions. */
4585 Vwindow_list = Qnil;
4587 return unbind_to (count, frame);
4590 /* FRAME is used only to get a handle on the X display. We don't pass the
4591 display info directly because we're called from frame.c, which doesn't
4592 know about that structure. */
4593 Lisp_Object
4594 x_get_focus_frame (frame)
4595 struct frame *frame;
4597 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (frame);
4598 Lisp_Object xfocus;
4599 if (! dpyinfo->w32_focus_frame)
4600 return Qnil;
4602 XSETFRAME (xfocus, dpyinfo->w32_focus_frame);
4603 return xfocus;
4606 DEFUN ("x-focus-frame", Fx_focus_frame, Sx_focus_frame, 1, 1, 0,
4607 doc: /* Give FRAME input focus, raising to foreground if necessary. */)
4608 (frame)
4609 Lisp_Object frame;
4611 x_focus_on_frame (check_x_frame (frame));
4612 return Qnil;
4616 DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1, 2, 0,
4617 doc: /* Internal function called by `color-defined-p', which see. */)
4618 (color, frame)
4619 Lisp_Object color, frame;
4621 XColor foo;
4622 FRAME_PTR f = check_x_frame (frame);
4624 CHECK_STRING (color);
4626 if (w32_defined_color (f, SDATA (color), &foo, 0))
4627 return Qt;
4628 else
4629 return Qnil;
4632 DEFUN ("xw-color-values", Fxw_color_values, Sxw_color_values, 1, 2, 0,
4633 doc: /* Internal function called by `color-values', which see. */)
4634 (color, frame)
4635 Lisp_Object color, frame;
4637 XColor foo;
4638 FRAME_PTR f = check_x_frame (frame);
4640 CHECK_STRING (color);
4642 if (w32_defined_color (f, SDATA (color), &foo, 0))
4643 return list3 (make_number ((GetRValue (foo.pixel) << 8)
4644 | GetRValue (foo.pixel)),
4645 make_number ((GetGValue (foo.pixel) << 8)
4646 | GetGValue (foo.pixel)),
4647 make_number ((GetBValue (foo.pixel) << 8)
4648 | GetBValue (foo.pixel)));
4649 else
4650 return Qnil;
4653 DEFUN ("xw-display-color-p", Fxw_display_color_p, Sxw_display_color_p, 0, 1, 0,
4654 doc: /* Internal function called by `display-color-p', which see. */)
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) <= 2)
4661 return Qnil;
4663 return Qt;
4666 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p,
4667 Sx_display_grayscale_p, 0, 1, 0,
4668 doc: /* Return t if DISPLAY supports shades of gray.
4669 Note that color displays do support shades of gray.
4670 The optional argument DISPLAY specifies which display to ask about.
4671 DISPLAY should be either a frame or a display name (a string).
4672 If omitted or nil, that stands for the selected frame's display. */)
4673 (display)
4674 Lisp_Object display;
4676 struct w32_display_info *dpyinfo = check_x_display_info (display);
4678 if ((dpyinfo->n_planes * dpyinfo->n_cbits) <= 1)
4679 return Qnil;
4681 return Qt;
4684 DEFUN ("x-display-pixel-width", Fx_display_pixel_width,
4685 Sx_display_pixel_width, 0, 1, 0,
4686 doc: /* Return the width in pixels of DISPLAY.
4687 The optional argument DISPLAY specifies which display to ask about.
4688 DISPLAY should be either a frame or a display name (a string).
4689 If omitted or nil, that stands for the selected frame's display. */)
4690 (display)
4691 Lisp_Object display;
4693 struct w32_display_info *dpyinfo = check_x_display_info (display);
4695 return make_number (dpyinfo->width);
4698 DEFUN ("x-display-pixel-height", Fx_display_pixel_height,
4699 Sx_display_pixel_height, 0, 1, 0,
4700 doc: /* Return the height in pixels of DISPLAY.
4701 The optional argument DISPLAY specifies which display to ask about.
4702 DISPLAY should be either a frame or a display name (a string).
4703 If omitted or nil, that stands for the selected frame's display. */)
4704 (display)
4705 Lisp_Object display;
4707 struct w32_display_info *dpyinfo = check_x_display_info (display);
4709 return make_number (dpyinfo->height);
4712 DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes,
4713 0, 1, 0,
4714 doc: /* Return the number of bitplanes of DISPLAY.
4715 The optional argument DISPLAY specifies which display to ask about.
4716 DISPLAY should be either a frame or a display name (a string).
4717 If omitted or nil, that stands for the selected frame's display. */)
4718 (display)
4719 Lisp_Object display;
4721 struct w32_display_info *dpyinfo = check_x_display_info (display);
4723 return make_number (dpyinfo->n_planes * dpyinfo->n_cbits);
4726 DEFUN ("x-display-color-cells", Fx_display_color_cells, Sx_display_color_cells,
4727 0, 1, 0,
4728 doc: /* Return the number of color cells of DISPLAY.
4729 The optional argument DISPLAY specifies which display to ask about.
4730 DISPLAY should be either a frame or a display name (a string).
4731 If omitted or nil, that stands for the selected frame's display. */)
4732 (display)
4733 Lisp_Object display;
4735 struct w32_display_info *dpyinfo = check_x_display_info (display);
4736 HDC hdc;
4737 int cap;
4739 hdc = GetDC (dpyinfo->root_window);
4740 if (dpyinfo->has_palette)
4741 cap = GetDeviceCaps (hdc, SIZEPALETTE);
4742 else
4743 cap = GetDeviceCaps (hdc, NUMCOLORS);
4745 /* We force 24+ bit depths to 24-bit, both to prevent an overflow
4746 and because probably is more meaningful on Windows anyway */
4747 if (cap < 0)
4748 cap = 1 << min (dpyinfo->n_planes * dpyinfo->n_cbits, 24);
4750 ReleaseDC (dpyinfo->root_window, hdc);
4752 return make_number (cap);
4755 DEFUN ("x-server-max-request-size", Fx_server_max_request_size,
4756 Sx_server_max_request_size,
4757 0, 1, 0,
4758 doc: /* Return the maximum request size of the server of DISPLAY.
4759 The optional argument DISPLAY specifies which display to ask about.
4760 DISPLAY should be either a frame or a display name (a string).
4761 If omitted or nil, that stands for the selected frame's display. */)
4762 (display)
4763 Lisp_Object display;
4765 struct w32_display_info *dpyinfo = check_x_display_info (display);
4767 return make_number (1);
4770 DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0,
4771 doc: /* Return the "vendor ID" string of the W32 system (Microsoft).
4772 The optional argument DISPLAY specifies which display to ask about.
4773 DISPLAY should be either a frame or a display name (a string).
4774 If omitted or nil, that stands for the selected frame's display. */)
4775 (display)
4776 Lisp_Object display;
4778 return build_string ("Microsoft Corp.");
4781 DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0,
4782 doc: /* Return the version numbers of the server of DISPLAY.
4783 The value is a list of three integers: the major and minor
4784 version numbers of the X Protocol in use, and the distributor-specific
4785 release number. See also the function `x-server-vendor'.
4787 The optional argument DISPLAY specifies which display to ask about.
4788 DISPLAY should be either a frame or a display name (a string).
4789 If omitted or nil, that stands for the selected frame's display. */)
4790 (display)
4791 Lisp_Object display;
4793 return Fcons (make_number (w32_major_version),
4794 Fcons (make_number (w32_minor_version),
4795 Fcons (make_number (w32_build_number), Qnil)));
4798 DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0,
4799 doc: /* Return the number of screens on the server of DISPLAY.
4800 The optional argument DISPLAY specifies which display to ask about.
4801 DISPLAY should be either a frame or a display name (a string).
4802 If omitted or nil, that stands for the selected frame's display. */)
4803 (display)
4804 Lisp_Object display;
4806 return make_number (1);
4809 DEFUN ("x-display-mm-height", Fx_display_mm_height,
4810 Sx_display_mm_height, 0, 1, 0,
4811 doc: /* Return the height in millimeters of DISPLAY.
4812 The optional argument DISPLAY specifies which display to ask about.
4813 DISPLAY should be either a frame or a display name (a string).
4814 If omitted or nil, that stands for the selected frame's display. */)
4815 (display)
4816 Lisp_Object display;
4818 struct w32_display_info *dpyinfo = check_x_display_info (display);
4819 HDC hdc;
4820 int cap;
4822 hdc = GetDC (dpyinfo->root_window);
4824 cap = GetDeviceCaps (hdc, VERTSIZE);
4826 ReleaseDC (dpyinfo->root_window, hdc);
4828 return make_number (cap);
4831 DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0,
4832 doc: /* Return the width in millimeters of DISPLAY.
4833 The optional argument DISPLAY specifies which display to ask about.
4834 DISPLAY should be either a frame or a display name (a string).
4835 If omitted or nil, that stands for the selected frame's display. */)
4836 (display)
4837 Lisp_Object display;
4839 struct w32_display_info *dpyinfo = check_x_display_info (display);
4841 HDC hdc;
4842 int cap;
4844 hdc = GetDC (dpyinfo->root_window);
4846 cap = GetDeviceCaps (hdc, HORZSIZE);
4848 ReleaseDC (dpyinfo->root_window, hdc);
4850 return make_number (cap);
4853 DEFUN ("x-display-backing-store", Fx_display_backing_store,
4854 Sx_display_backing_store, 0, 1, 0,
4855 doc: /* Return an indication of whether DISPLAY does backing store.
4856 The value may be `always', `when-mapped', or `not-useful'.
4857 The optional argument DISPLAY specifies which display to ask about.
4858 DISPLAY should be either a frame or a display name (a string).
4859 If omitted or nil, that stands for the selected frame's display. */)
4860 (display)
4861 Lisp_Object display;
4863 return intern ("not-useful");
4866 DEFUN ("x-display-visual-class", Fx_display_visual_class,
4867 Sx_display_visual_class, 0, 1, 0,
4868 doc: /* Return the visual class of DISPLAY.
4869 The value is one of the symbols `static-gray', `gray-scale',
4870 `static-color', `pseudo-color', `true-color', or `direct-color'.
4872 The optional argument DISPLAY specifies which display to ask about.
4873 DISPLAY should be either a frame or a display name (a string).
4874 If omitted or nil, that stands for the selected frame's display. */)
4875 (display)
4876 Lisp_Object display;
4878 struct w32_display_info *dpyinfo = check_x_display_info (display);
4879 Lisp_Object result = Qnil;
4881 if (dpyinfo->has_palette)
4882 result = intern ("pseudo-color");
4883 else if (dpyinfo->n_planes * dpyinfo->n_cbits == 1)
4884 result = intern ("static-grey");
4885 else if (dpyinfo->n_planes * dpyinfo->n_cbits == 4)
4886 result = intern ("static-color");
4887 else if (dpyinfo->n_planes * dpyinfo->n_cbits > 8)
4888 result = intern ("true-color");
4890 return result;
4893 DEFUN ("x-display-save-under", Fx_display_save_under,
4894 Sx_display_save_under, 0, 1, 0,
4895 doc: /* Return t if DISPLAY supports the save-under feature.
4896 The optional argument DISPLAY specifies which display to ask about.
4897 DISPLAY should be either a frame or a display name (a string).
4898 If omitted or nil, that stands for the selected frame's display. */)
4899 (display)
4900 Lisp_Object display;
4902 return Qnil;
4906 x_pixel_width (f)
4907 register struct frame *f;
4909 return FRAME_PIXEL_WIDTH (f);
4913 x_pixel_height (f)
4914 register struct frame *f;
4916 return FRAME_PIXEL_HEIGHT (f);
4920 x_char_width (f)
4921 register struct frame *f;
4923 return FRAME_COLUMN_WIDTH (f);
4927 x_char_height (f)
4928 register struct frame *f;
4930 return FRAME_LINE_HEIGHT (f);
4934 x_screen_planes (f)
4935 register struct frame *f;
4937 return FRAME_W32_DISPLAY_INFO (f)->n_planes;
4940 /* Return the display structure for the display named NAME.
4941 Open a new connection if necessary. */
4943 struct w32_display_info *
4944 x_display_info_for_name (name)
4945 Lisp_Object name;
4947 Lisp_Object names;
4948 struct w32_display_info *dpyinfo;
4950 CHECK_STRING (name);
4952 for (dpyinfo = &one_w32_display_info, names = w32_display_name_list;
4953 dpyinfo;
4954 dpyinfo = dpyinfo->next, names = XCDR (names))
4956 Lisp_Object tem;
4957 tem = Fstring_equal (XCAR (XCAR (names)), name);
4958 if (!NILP (tem))
4959 return dpyinfo;
4962 /* Use this general default value to start with. */
4963 Vx_resource_name = Vinvocation_name;
4965 validate_x_resource_name ();
4967 dpyinfo = w32_term_init (name, (unsigned char *)0,
4968 (char *) SDATA (Vx_resource_name));
4970 if (dpyinfo == 0)
4971 error ("Cannot connect to server %s", SDATA (name));
4973 w32_in_use = 1;
4974 XSETFASTINT (Vwindow_system_version, 3);
4976 return dpyinfo;
4979 DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
4980 1, 3, 0, doc: /* Open a connection to a server.
4981 DISPLAY is the name of the display to connect to.
4982 Optional second arg XRM-STRING is a string of resources in xrdb format.
4983 If the optional third arg MUST-SUCCEED is non-nil,
4984 terminate Emacs if we can't open the connection. */)
4985 (display, xrm_string, must_succeed)
4986 Lisp_Object display, xrm_string, must_succeed;
4988 unsigned char *xrm_option;
4989 struct w32_display_info *dpyinfo;
4991 /* If initialization has already been done, return now to avoid
4992 overwriting critical parts of one_w32_display_info. */
4993 if (w32_in_use)
4994 return Qnil;
4996 CHECK_STRING (display);
4997 if (! NILP (xrm_string))
4998 CHECK_STRING (xrm_string);
5000 #if 0
5001 if (! EQ (Vwindow_system, intern ("w32")))
5002 error ("Not using Microsoft Windows");
5003 #endif
5005 /* Allow color mapping to be defined externally; first look in user's
5006 HOME directory, then in Emacs etc dir for a file called rgb.txt. */
5008 Lisp_Object color_file;
5009 struct gcpro gcpro1;
5011 color_file = build_string ("~/rgb.txt");
5013 GCPRO1 (color_file);
5015 if (NILP (Ffile_readable_p (color_file)))
5016 color_file =
5017 Fexpand_file_name (build_string ("rgb.txt"),
5018 Fsymbol_value (intern ("data-directory")));
5020 Vw32_color_map = Fw32_load_color_file (color_file);
5022 UNGCPRO;
5024 if (NILP (Vw32_color_map))
5025 Vw32_color_map = Fw32_default_color_map ();
5027 /* Merge in system logical colors. */
5028 add_system_logical_colors_to_map (&Vw32_color_map);
5030 if (! NILP (xrm_string))
5031 xrm_option = (unsigned char *) SDATA (xrm_string);
5032 else
5033 xrm_option = (unsigned char *) 0;
5035 /* Use this general default value to start with. */
5036 /* First remove .exe suffix from invocation-name - it looks ugly. */
5038 char basename[ MAX_PATH ], *str;
5040 strcpy (basename, SDATA (Vinvocation_name));
5041 str = strrchr (basename, '.');
5042 if (str) *str = 0;
5043 Vinvocation_name = build_string (basename);
5045 Vx_resource_name = Vinvocation_name;
5047 validate_x_resource_name ();
5049 /* This is what opens the connection and sets x_current_display.
5050 This also initializes many symbols, such as those used for input. */
5051 dpyinfo = w32_term_init (display, xrm_option,
5052 (char *) SDATA (Vx_resource_name));
5054 if (dpyinfo == 0)
5056 if (!NILP (must_succeed))
5057 fatal ("Cannot connect to server %s.\n",
5058 SDATA (display));
5059 else
5060 error ("Cannot connect to server %s", SDATA (display));
5063 w32_in_use = 1;
5065 XSETFASTINT (Vwindow_system_version, 3);
5066 return Qnil;
5069 DEFUN ("x-close-connection", Fx_close_connection,
5070 Sx_close_connection, 1, 1, 0,
5071 doc: /* Close the connection to DISPLAY's server.
5072 For DISPLAY, specify either a frame or a display name (a string).
5073 If DISPLAY is nil, that stands for the selected frame's display. */)
5074 (display)
5075 Lisp_Object display;
5077 struct w32_display_info *dpyinfo = check_x_display_info (display);
5078 int i;
5080 if (dpyinfo->reference_count > 0)
5081 error ("Display still has frames on it");
5083 BLOCK_INPUT;
5084 x_destroy_all_bitmaps (dpyinfo);
5086 x_delete_display (dpyinfo);
5087 UNBLOCK_INPUT;
5089 return Qnil;
5092 DEFUN ("x-display-list", Fx_display_list, Sx_display_list, 0, 0, 0,
5093 doc: /* Return the list of display names that Emacs has connections to. */)
5096 Lisp_Object tail, result;
5098 result = Qnil;
5099 for (tail = w32_display_name_list; CONSP (tail); tail = XCDR (tail))
5100 result = Fcons (XCAR (XCAR (tail)), result);
5102 return result;
5105 DEFUN ("x-synchronize", Fx_synchronize, Sx_synchronize, 1, 2, 0,
5106 doc: /* This is a noop on W32 systems. */)
5107 (on, display)
5108 Lisp_Object display, on;
5110 return Qnil;
5115 /***********************************************************************
5116 Window properties
5117 ***********************************************************************/
5119 DEFUN ("x-change-window-property", Fx_change_window_property,
5120 Sx_change_window_property, 2, 6, 0,
5121 doc: /* Change window property PROP to VALUE on the X window of FRAME.
5122 VALUE may be a string or a list of conses, numbers and/or strings.
5123 If an element in the list is a string, it is converted to
5124 an Atom and the value of the Atom is used. If an element is a cons,
5125 it is converted to a 32 bit number where the car is the 16 top bits and the
5126 cdr is the lower 16 bits.
5127 FRAME nil or omitted means use the selected frame.
5128 If TYPE is given and non-nil, it is the name of the type of VALUE.
5129 If TYPE is not given or nil, the type is STRING.
5130 FORMAT gives the size in bits of each element if VALUE is a list.
5131 It must be one of 8, 16 or 32.
5132 If VALUE is a string or FORMAT is nil or not given, FORMAT defaults to 8.
5133 If OUTER_P is non-nil, the property is changed for the outer X window of
5134 FRAME. Default is to change on the edit X window.
5136 Value is VALUE. */)
5137 (prop, value, frame, type, format, outer_p)
5138 Lisp_Object prop, value, frame, type, format, outer_p;
5140 #if 0 /* TODO : port window properties to W32 */
5141 struct frame *f = check_x_frame (frame);
5142 Atom prop_atom;
5144 CHECK_STRING (prop);
5145 CHECK_STRING (value);
5147 BLOCK_INPUT;
5148 prop_atom = XInternAtom (FRAME_W32_DISPLAY (f), SDATA (prop), False);
5149 XChangeProperty (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f),
5150 prop_atom, XA_STRING, 8, PropModeReplace,
5151 SDATA (value), SCHARS (value));
5153 /* Make sure the property is set when we return. */
5154 XFlush (FRAME_W32_DISPLAY (f));
5155 UNBLOCK_INPUT;
5157 #endif /* TODO */
5159 return value;
5163 DEFUN ("x-delete-window-property", Fx_delete_window_property,
5164 Sx_delete_window_property, 1, 2, 0,
5165 doc: /* Remove window property PROP from X window of FRAME.
5166 FRAME nil or omitted means use the selected frame. Value is PROP. */)
5167 (prop, frame)
5168 Lisp_Object prop, frame;
5170 #if 0 /* TODO : port window properties to W32 */
5172 struct frame *f = check_x_frame (frame);
5173 Atom prop_atom;
5175 CHECK_STRING (prop);
5176 BLOCK_INPUT;
5177 prop_atom = XInternAtom (FRAME_W32_DISPLAY (f), SDATA (prop), False);
5178 XDeleteProperty (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f), prop_atom);
5180 /* Make sure the property is removed when we return. */
5181 XFlush (FRAME_W32_DISPLAY (f));
5182 UNBLOCK_INPUT;
5183 #endif /* TODO */
5185 return prop;
5189 DEFUN ("x-window-property", Fx_window_property, Sx_window_property,
5190 1, 2, 0,
5191 doc: /* Value is the value of window property PROP on FRAME.
5192 If FRAME is nil or omitted, use the selected frame. Value is nil
5193 if FRAME hasn't a property with name PROP or if PROP has no string
5194 value. */)
5195 (prop, frame)
5196 Lisp_Object prop, frame;
5198 #if 0 /* TODO : port window properties to W32 */
5200 struct frame *f = check_x_frame (frame);
5201 Atom prop_atom;
5202 int rc;
5203 Lisp_Object prop_value = Qnil;
5204 char *tmp_data = NULL;
5205 Atom actual_type;
5206 int actual_format;
5207 unsigned long actual_size, bytes_remaining;
5209 CHECK_STRING (prop);
5210 BLOCK_INPUT;
5211 prop_atom = XInternAtom (FRAME_W32_DISPLAY (f), SDATA (prop), False);
5212 rc = XGetWindowProperty (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f),
5213 prop_atom, 0, 0, False, XA_STRING,
5214 &actual_type, &actual_format, &actual_size,
5215 &bytes_remaining, (unsigned char **) &tmp_data);
5216 if (rc == Success)
5218 int size = bytes_remaining;
5220 XFree (tmp_data);
5221 tmp_data = NULL;
5223 rc = XGetWindowProperty (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f),
5224 prop_atom, 0, bytes_remaining,
5225 False, XA_STRING,
5226 &actual_type, &actual_format,
5227 &actual_size, &bytes_remaining,
5228 (unsigned char **) &tmp_data);
5229 if (rc == Success)
5230 prop_value = make_string (tmp_data, size);
5232 XFree (tmp_data);
5235 UNBLOCK_INPUT;
5237 return prop_value;
5239 #endif /* TODO */
5240 return Qnil;
5245 /***********************************************************************
5246 Busy cursor
5247 ***********************************************************************/
5249 /* Non-zero means an hourglass cursor is currently shown. */
5251 static int hourglass_shown_p;
5253 /* Number of seconds to wait before displaying an hourglass cursor. */
5255 static Lisp_Object Vhourglass_delay;
5257 /* Default number of seconds to wait before displaying an hourglass
5258 cursor. */
5260 #define DEFAULT_HOURGLASS_DELAY 1
5262 /* Return non-zero if houglass timer has been started or hourglass is shown. */
5265 hourglass_started ()
5267 return hourglass_shown_p || hourglass_timer;
5270 /* Cancel a currently active hourglass timer, and start a new one. */
5272 void
5273 start_hourglass ()
5275 DWORD delay;
5276 int secs, msecs = 0;
5277 struct frame * f = SELECTED_FRAME ();
5279 /* No cursors on non GUI frames. */
5280 if (!FRAME_W32_P (f))
5281 return;
5283 cancel_hourglass ();
5285 if (INTEGERP (Vhourglass_delay)
5286 && XINT (Vhourglass_delay) > 0)
5287 secs = XFASTINT (Vhourglass_delay);
5288 else if (FLOATP (Vhourglass_delay)
5289 && XFLOAT_DATA (Vhourglass_delay) > 0)
5291 Lisp_Object tem;
5292 tem = Ftruncate (Vhourglass_delay, Qnil);
5293 secs = XFASTINT (tem);
5294 msecs = (XFLOAT_DATA (Vhourglass_delay) - secs) * 1000;
5296 else
5297 secs = DEFAULT_HOURGLASS_DELAY;
5299 delay = secs * 1000 + msecs;
5300 hourglass_hwnd = FRAME_W32_WINDOW (f);
5301 hourglass_timer = SetTimer (hourglass_hwnd, HOURGLASS_ID, delay, NULL);
5305 /* Cancel the hourglass cursor timer if active, hide an hourglass
5306 cursor if shown. */
5308 void
5309 cancel_hourglass ()
5311 if (hourglass_timer)
5313 KillTimer (hourglass_hwnd, hourglass_timer);
5314 hourglass_timer = 0;
5317 if (hourglass_shown_p)
5318 hide_hourglass ();
5322 /* Timer function of hourglass_timer.
5324 Display an hourglass cursor. Set the hourglass_p flag in display info
5325 to indicate that an hourglass cursor is shown. */
5327 static void
5328 show_hourglass (f)
5329 struct frame *f;
5331 if (!hourglass_shown_p)
5333 f->output_data.w32->hourglass_p = 1;
5334 if (!menubar_in_use && !current_popup_menu)
5335 SetCursor (f->output_data.w32->hourglass_cursor);
5336 hourglass_shown_p = 1;
5341 /* Hide the hourglass cursor on all frames, if it is currently shown. */
5343 static void
5344 hide_hourglass ()
5346 if (hourglass_shown_p)
5348 struct frame *f = x_window_to_frame (&one_w32_display_info,
5349 hourglass_hwnd);
5351 f->output_data.w32->hourglass_p = 0;
5352 SetCursor (f->output_data.w32->current_cursor);
5353 hourglass_shown_p = 0;
5359 /***********************************************************************
5360 Tool tips
5361 ***********************************************************************/
5363 static Lisp_Object x_create_tip_frame P_ ((struct w32_display_info *,
5364 Lisp_Object, Lisp_Object));
5365 static void compute_tip_xy P_ ((struct frame *, Lisp_Object, Lisp_Object,
5366 Lisp_Object, int, int, int *, int *));
5368 /* The frame of a currently visible tooltip. */
5370 Lisp_Object tip_frame;
5372 /* If non-nil, a timer started that hides the last tooltip when it
5373 fires. */
5375 Lisp_Object tip_timer;
5376 Window tip_window;
5378 /* If non-nil, a vector of 3 elements containing the last args
5379 with which x-show-tip was called. See there. */
5381 Lisp_Object last_show_tip_args;
5383 /* Maximum size for tooltips; a cons (COLUMNS . ROWS). */
5385 Lisp_Object Vx_max_tooltip_size;
5388 static Lisp_Object
5389 unwind_create_tip_frame (frame)
5390 Lisp_Object frame;
5392 Lisp_Object deleted;
5394 deleted = unwind_create_frame (frame);
5395 if (EQ (deleted, Qt))
5397 tip_window = NULL;
5398 tip_frame = Qnil;
5401 return deleted;
5405 /* Create a frame for a tooltip on the display described by DPYINFO.
5406 PARMS is a list of frame parameters. TEXT is the string to
5407 display in the tip frame. Value is the frame.
5409 Note that functions called here, esp. x_default_parameter can
5410 signal errors, for instance when a specified color name is
5411 undefined. We have to make sure that we're in a consistent state
5412 when this happens. */
5414 static Lisp_Object
5415 x_create_tip_frame (dpyinfo, parms, text)
5416 struct w32_display_info *dpyinfo;
5417 Lisp_Object parms, text;
5419 struct frame *f;
5420 Lisp_Object frame, tem;
5421 Lisp_Object name;
5422 long window_prompting = 0;
5423 int width, height;
5424 int count = SPECPDL_INDEX ();
5425 struct gcpro gcpro1, gcpro2, gcpro3;
5426 struct kboard *kb;
5427 int face_change_count_before = face_change_count;
5428 Lisp_Object buffer;
5429 struct buffer *old_buffer;
5431 check_w32 ();
5433 /* Use this general default value to start with until we know if
5434 this frame has a specified name. */
5435 Vx_resource_name = Vinvocation_name;
5437 #ifdef MULTI_KBOARD
5438 kb = dpyinfo->terminal->kboard;
5439 #else
5440 kb = &the_only_kboard;
5441 #endif
5443 /* Get the name of the frame to use for resource lookup. */
5444 name = w32_get_arg (parms, Qname, "name", "Name", RES_TYPE_STRING);
5445 if (!STRINGP (name)
5446 && !EQ (name, Qunbound)
5447 && !NILP (name))
5448 error ("Invalid frame name--not a string or nil");
5449 Vx_resource_name = name;
5451 frame = Qnil;
5452 GCPRO3 (parms, name, frame);
5453 /* Make a frame without minibuffer nor mode-line. */
5454 f = make_frame (0);
5455 f->wants_modeline = 0;
5456 XSETFRAME (frame, f);
5458 buffer = Fget_buffer_create (build_string (" *tip*"));
5459 Fset_window_buffer (FRAME_ROOT_WINDOW (f), buffer, Qnil);
5460 old_buffer = current_buffer;
5461 set_buffer_internal_1 (XBUFFER (buffer));
5462 current_buffer->truncate_lines = Qnil;
5463 specbind (Qinhibit_read_only, Qt);
5464 specbind (Qinhibit_modification_hooks, Qt);
5465 Ferase_buffer ();
5466 Finsert (1, &text);
5467 set_buffer_internal_1 (old_buffer);
5469 FRAME_CAN_HAVE_SCROLL_BARS (f) = 0;
5470 record_unwind_protect (unwind_create_tip_frame, frame);
5472 /* By setting the output method, we're essentially saying that
5473 the frame is live, as per FRAME_LIVE_P. If we get a signal
5474 from this point on, x_destroy_window might screw up reference
5475 counts etc. */
5476 f->terminal = dpyinfo->terminal;
5477 f->terminal->reference_count++;
5478 f->output_method = output_w32;
5479 f->output_data.w32 =
5480 (struct w32_output *) xmalloc (sizeof (struct w32_output));
5481 bzero (f->output_data.w32, sizeof (struct w32_output));
5483 FRAME_FONTSET (f) = -1;
5484 f->icon_name = Qnil;
5486 #if 0 /* GLYPH_DEBUG TODO: image support. */
5487 image_cache_refcount = FRAME_IMAGE_CACHE (f)->refcount;
5488 dpyinfo_refcount = dpyinfo->reference_count;
5489 #endif /* GLYPH_DEBUG */
5490 #ifdef MULTI_KBOARD
5491 FRAME_KBOARD (f) = kb;
5492 #endif
5493 f->output_data.w32->parent_desc = FRAME_W32_DISPLAY_INFO (f)->root_window;
5494 f->output_data.w32->explicit_parent = 0;
5496 /* Set the name; the functions to which we pass f expect the name to
5497 be set. */
5498 if (EQ (name, Qunbound) || NILP (name))
5500 f->name = build_string (dpyinfo->w32_id_name);
5501 f->explicit_name = 0;
5503 else
5505 f->name = name;
5506 f->explicit_name = 1;
5507 /* use the frame's title when getting resources for this frame. */
5508 specbind (Qx_resource_name, name);
5511 f->resx = dpyinfo->resx;
5512 f->resy = dpyinfo->resy;
5514 /* Perhaps, we must allow frame parameter, say `font-backend',
5515 to specify which font backends to use. */
5516 register_font_driver (&w32font_driver, f);
5518 x_default_parameter (f, parms, Qfont_backend, Qnil,
5519 "fontBackend", "FontBackend", RES_TYPE_STRING);
5521 /* Extract the window parameters from the supplied values
5522 that are needed to determine window geometry. */
5523 x_default_font_parameter (f, parms);
5525 x_default_parameter (f, parms, Qborder_width, make_number (2),
5526 "borderWidth", "BorderWidth", RES_TYPE_NUMBER);
5527 /* This defaults to 2 in order to match xterm. We recognize either
5528 internalBorderWidth or internalBorder (which is what xterm calls
5529 it). */
5530 if (NILP (Fassq (Qinternal_border_width, parms)))
5532 Lisp_Object value;
5534 value = w32_get_arg (parms, Qinternal_border_width,
5535 "internalBorder", "internalBorder", RES_TYPE_NUMBER);
5536 if (! EQ (value, Qunbound))
5537 parms = Fcons (Fcons (Qinternal_border_width, value),
5538 parms);
5540 x_default_parameter (f, parms, Qinternal_border_width, make_number (1),
5541 "internalBorderWidth", "internalBorderWidth",
5542 RES_TYPE_NUMBER);
5544 /* Also do the stuff which must be set before the window exists. */
5545 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
5546 "foreground", "Foreground", RES_TYPE_STRING);
5547 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
5548 "background", "Background", RES_TYPE_STRING);
5549 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
5550 "pointerColor", "Foreground", RES_TYPE_STRING);
5551 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
5552 "cursorColor", "Foreground", RES_TYPE_STRING);
5553 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
5554 "borderColor", "BorderColor", RES_TYPE_STRING);
5556 /* Init faces before x_default_parameter is called for scroll-bar
5557 parameters because that function calls x_set_scroll_bar_width,
5558 which calls change_frame_size, which calls Fset_window_buffer,
5559 which runs hooks, which call Fvertical_motion. At the end, we
5560 end up in init_iterator with a null face cache, which should not
5561 happen. */
5562 init_frame_faces (f);
5564 f->output_data.w32->dwStyle = WS_BORDER | WS_POPUP | WS_DISABLED;
5565 f->output_data.w32->parent_desc = FRAME_W32_DISPLAY_INFO (f)->root_window;
5567 window_prompting = x_figure_window_size (f, parms, 0);
5569 /* No fringes on tip frame. */
5570 f->fringe_cols = 0;
5571 f->left_fringe_width = 0;
5572 f->right_fringe_width = 0;
5574 BLOCK_INPUT;
5575 my_create_tip_window (f);
5576 UNBLOCK_INPUT;
5578 x_make_gc (f);
5580 x_default_parameter (f, parms, Qauto_raise, Qnil,
5581 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN);
5582 x_default_parameter (f, parms, Qauto_lower, Qnil,
5583 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN);
5584 x_default_parameter (f, parms, Qcursor_type, Qbox,
5585 "cursorType", "CursorType", RES_TYPE_SYMBOL);
5587 /* Dimensions, especially FRAME_LINES (f), must be done via change_frame_size.
5588 Change will not be effected unless different from the current
5589 FRAME_LINES (f). */
5590 width = FRAME_COLS (f);
5591 height = FRAME_LINES (f);
5592 FRAME_LINES (f) = 0;
5593 SET_FRAME_COLS (f, 0);
5594 change_frame_size (f, height, width, 1, 0, 0);
5596 /* Add `tooltip' frame parameter's default value. */
5597 if (NILP (Fframe_parameter (frame, intern ("tooltip"))))
5598 Fmodify_frame_parameters (frame, Fcons (Fcons (intern ("tooltip"), Qt),
5599 Qnil));
5601 /* Set up faces after all frame parameters are known. This call
5602 also merges in face attributes specified for new frames.
5604 Frame parameters may be changed if .Xdefaults contains
5605 specifications for the default font. For example, if there is an
5606 `Emacs.default.attributeBackground: pink', the `background-color'
5607 attribute of the frame get's set, which let's the internal border
5608 of the tooltip frame appear in pink. Prevent this. */
5610 Lisp_Object bg = Fframe_parameter (frame, Qbackground_color);
5612 /* Set tip_frame here, so that */
5613 tip_frame = frame;
5614 call1 (Qface_set_after_frame_default, frame);
5616 if (!EQ (bg, Fframe_parameter (frame, Qbackground_color)))
5617 Fmodify_frame_parameters (frame, Fcons (Fcons (Qbackground_color, bg),
5618 Qnil));
5621 f->no_split = 1;
5623 UNGCPRO;
5625 /* It is now ok to make the frame official even if we get an error
5626 below. And the frame needs to be on Vframe_list or making it
5627 visible won't work. */
5628 Vframe_list = Fcons (frame, Vframe_list);
5630 /* Now that the frame is official, it counts as a reference to
5631 its display. */
5632 FRAME_W32_DISPLAY_INFO (f)->reference_count++;
5634 /* Setting attributes of faces of the tooltip frame from resources
5635 and similar will increment face_change_count, which leads to the
5636 clearing of all current matrices. Since this isn't necessary
5637 here, avoid it by resetting face_change_count to the value it
5638 had before we created the tip frame. */
5639 face_change_count = face_change_count_before;
5641 /* Discard the unwind_protect. */
5642 return unbind_to (count, frame);
5646 /* Compute where to display tip frame F. PARMS is the list of frame
5647 parameters for F. DX and DY are specified offsets from the current
5648 location of the mouse. WIDTH and HEIGHT are the width and height
5649 of the tooltip. Return coordinates relative to the root window of
5650 the display in *ROOT_X, and *ROOT_Y. */
5652 static void
5653 compute_tip_xy (f, parms, dx, dy, width, height, root_x, root_y)
5654 struct frame *f;
5655 Lisp_Object parms, dx, dy;
5656 int width, height;
5657 int *root_x, *root_y;
5659 Lisp_Object left, top;
5660 int min_x, min_y, max_x, max_y;
5662 /* User-specified position? */
5663 left = Fcdr (Fassq (Qleft, parms));
5664 top = Fcdr (Fassq (Qtop, parms));
5666 /* Move the tooltip window where the mouse pointer is. Resize and
5667 show it. */
5668 if (!INTEGERP (left) || !INTEGERP (top))
5670 POINT pt;
5672 /* Default min and max values. */
5673 min_x = 0;
5674 min_y = 0;
5675 max_x = FRAME_W32_DISPLAY_INFO (f)->width;
5676 max_y = FRAME_W32_DISPLAY_INFO (f)->height;
5678 BLOCK_INPUT;
5679 GetCursorPos (&pt);
5680 *root_x = pt.x;
5681 *root_y = pt.y;
5682 UNBLOCK_INPUT;
5684 /* If multiple monitor support is available, constrain the tip onto
5685 the current monitor. This improves the above by allowing negative
5686 co-ordinates if monitor positions are such that they are valid, and
5687 snaps a tooltip onto a single monitor if we are close to the edge
5688 where it would otherwise flow onto the other monitor (or into
5689 nothingness if there is a gap in the overlap). */
5690 if (monitor_from_point_fn && get_monitor_info_fn)
5692 struct MONITOR_INFO info;
5693 HMONITOR monitor
5694 = monitor_from_point_fn (pt, MONITOR_DEFAULT_TO_NEAREST);
5695 info.cbSize = sizeof (info);
5697 if (get_monitor_info_fn (monitor, &info))
5699 min_x = info.rcWork.left;
5700 min_y = info.rcWork.top;
5701 max_x = info.rcWork.right;
5702 max_y = info.rcWork.bottom;
5707 if (INTEGERP (top))
5708 *root_y = XINT (top);
5709 else if (*root_y + XINT (dy) <= min_y)
5710 *root_y = min_y; /* Can happen for negative dy */
5711 else if (*root_y + XINT (dy) + height <= max_y)
5712 /* It fits below the pointer */
5713 *root_y += XINT (dy);
5714 else if (height + XINT (dy) + min_y <= *root_y)
5715 /* It fits above the pointer. */
5716 *root_y -= height + XINT (dy);
5717 else
5718 /* Put it on the top. */
5719 *root_y = min_y;
5721 if (INTEGERP (left))
5722 *root_x = XINT (left);
5723 else if (*root_x + XINT (dx) <= min_x)
5724 *root_x = 0; /* Can happen for negative dx */
5725 else if (*root_x + XINT (dx) + width <= max_x)
5726 /* It fits to the right of the pointer. */
5727 *root_x += XINT (dx);
5728 else if (width + XINT (dx) + min_x <= *root_x)
5729 /* It fits to the left of the pointer. */
5730 *root_x -= width + XINT (dx);
5731 else
5732 /* Put it left justified on the screen -- it ought to fit that way. */
5733 *root_x = min_x;
5737 DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0,
5738 doc: /* Show STRING in a \"tooltip\" window on frame FRAME.
5739 A tooltip window is a small window displaying a string.
5741 This is an internal function; Lisp code should call `tooltip-show'.
5743 FRAME nil or omitted means use the selected frame.
5745 PARMS is an optional list of frame parameters which can be
5746 used to change the tooltip's appearance.
5748 Automatically hide the tooltip after TIMEOUT seconds. TIMEOUT nil
5749 means use the default timeout of 5 seconds.
5751 If the list of frame parameters PARMS contains a `left' parameter,
5752 the tooltip is displayed at that x-position. Otherwise it is
5753 displayed at the mouse position, with offset DX added (default is 5 if
5754 DX isn't specified). Likewise for the y-position; if a `top' frame
5755 parameter is specified, it determines the y-position of the tooltip
5756 window, otherwise it is displayed at the mouse position, with offset
5757 DY added (default is -10).
5759 A tooltip's maximum size is specified by `x-max-tooltip-size'.
5760 Text larger than the specified size is clipped. */)
5761 (string, frame, parms, timeout, dx, dy)
5762 Lisp_Object string, frame, parms, timeout, dx, dy;
5764 struct frame *f;
5765 struct window *w;
5766 int root_x, root_y;
5767 struct buffer *old_buffer;
5768 struct text_pos pos;
5769 int i, width, height;
5770 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
5771 int old_windows_or_buffers_changed = windows_or_buffers_changed;
5772 int count = SPECPDL_INDEX ();
5774 specbind (Qinhibit_redisplay, Qt);
5776 GCPRO4 (string, parms, frame, timeout);
5778 CHECK_STRING (string);
5779 f = check_x_frame (frame);
5780 if (NILP (timeout))
5781 timeout = make_number (5);
5782 else
5783 CHECK_NATNUM (timeout);
5785 if (NILP (dx))
5786 dx = make_number (5);
5787 else
5788 CHECK_NUMBER (dx);
5790 if (NILP (dy))
5791 dy = make_number (-10);
5792 else
5793 CHECK_NUMBER (dy);
5795 if (NILP (last_show_tip_args))
5796 last_show_tip_args = Fmake_vector (make_number (3), Qnil);
5798 if (!NILP (tip_frame))
5800 Lisp_Object last_string = AREF (last_show_tip_args, 0);
5801 Lisp_Object last_frame = AREF (last_show_tip_args, 1);
5802 Lisp_Object last_parms = AREF (last_show_tip_args, 2);
5804 if (EQ (frame, last_frame)
5805 && !NILP (Fequal (last_string, string))
5806 && !NILP (Fequal (last_parms, parms)))
5808 struct frame *f = XFRAME (tip_frame);
5810 /* Only DX and DY have changed. */
5811 if (!NILP (tip_timer))
5813 Lisp_Object timer = tip_timer;
5814 tip_timer = Qnil;
5815 call1 (Qcancel_timer, timer);
5818 BLOCK_INPUT;
5819 compute_tip_xy (f, parms, dx, dy, FRAME_PIXEL_WIDTH (f),
5820 FRAME_PIXEL_HEIGHT (f), &root_x, &root_y);
5822 /* Put tooltip in topmost group and in position. */
5823 SetWindowPos (FRAME_W32_WINDOW (f), HWND_TOPMOST,
5824 root_x, root_y, 0, 0,
5825 SWP_NOSIZE | SWP_NOACTIVATE);
5827 /* Ensure tooltip is on top of other topmost windows (eg menus). */
5828 SetWindowPos (FRAME_W32_WINDOW (f), HWND_TOP,
5829 0, 0, 0, 0,
5830 SWP_NOMOVE | SWP_NOSIZE | SWP_NOACTIVATE);
5832 UNBLOCK_INPUT;
5833 goto start_timer;
5837 /* Hide a previous tip, if any. */
5838 Fx_hide_tip ();
5840 ASET (last_show_tip_args, 0, string);
5841 ASET (last_show_tip_args, 1, frame);
5842 ASET (last_show_tip_args, 2, parms);
5844 /* Add default values to frame parameters. */
5845 if (NILP (Fassq (Qname, parms)))
5846 parms = Fcons (Fcons (Qname, build_string ("tooltip")), parms);
5847 if (NILP (Fassq (Qinternal_border_width, parms)))
5848 parms = Fcons (Fcons (Qinternal_border_width, make_number (3)), parms);
5849 if (NILP (Fassq (Qborder_width, parms)))
5850 parms = Fcons (Fcons (Qborder_width, make_number (1)), parms);
5851 if (NILP (Fassq (Qborder_color, parms)))
5852 parms = Fcons (Fcons (Qborder_color, build_string ("lightyellow")), parms);
5853 if (NILP (Fassq (Qbackground_color, parms)))
5854 parms = Fcons (Fcons (Qbackground_color, build_string ("lightyellow")),
5855 parms);
5857 /* Block input until the tip has been fully drawn, to avoid crashes
5858 when drawing tips in menus. */
5859 BLOCK_INPUT;
5861 /* Create a frame for the tooltip, and record it in the global
5862 variable tip_frame. */
5863 frame = x_create_tip_frame (FRAME_W32_DISPLAY_INFO (f), parms, string);
5864 f = XFRAME (frame);
5866 /* Set up the frame's root window. */
5867 w = XWINDOW (FRAME_ROOT_WINDOW (f));
5868 w->left_col = w->top_line = make_number (0);
5870 if (CONSP (Vx_max_tooltip_size)
5871 && INTEGERP (XCAR (Vx_max_tooltip_size))
5872 && XINT (XCAR (Vx_max_tooltip_size)) > 0
5873 && INTEGERP (XCDR (Vx_max_tooltip_size))
5874 && XINT (XCDR (Vx_max_tooltip_size)) > 0)
5876 w->total_cols = XCAR (Vx_max_tooltip_size);
5877 w->total_lines = XCDR (Vx_max_tooltip_size);
5879 else
5881 w->total_cols = make_number (80);
5882 w->total_lines = make_number (40);
5885 FRAME_TOTAL_COLS (f) = XINT (w->total_cols);
5886 adjust_glyphs (f);
5887 w->pseudo_window_p = 1;
5889 /* Display the tooltip text in a temporary buffer. */
5890 old_buffer = current_buffer;
5891 set_buffer_internal_1 (XBUFFER (XWINDOW (FRAME_ROOT_WINDOW (f))->buffer));
5892 current_buffer->truncate_lines = Qnil;
5893 clear_glyph_matrix (w->desired_matrix);
5894 clear_glyph_matrix (w->current_matrix);
5895 SET_TEXT_POS (pos, BEGV, BEGV_BYTE);
5896 try_window (FRAME_ROOT_WINDOW (f), pos, 0);
5898 /* Compute width and height of the tooltip. */
5899 width = height = 0;
5900 for (i = 0; i < w->desired_matrix->nrows; ++i)
5902 struct glyph_row *row = &w->desired_matrix->rows[i];
5903 struct glyph *last;
5904 int row_width;
5906 /* Stop at the first empty row at the end. */
5907 if (!row->enabled_p || !row->displays_text_p)
5908 break;
5910 /* Let the row go over the full width of the frame. */
5911 row->full_width_p = 1;
5913 #ifdef TODO /* Investigate why some fonts need more width than is
5914 calculated for some tooltips. */
5915 /* There's a glyph at the end of rows that is use to place
5916 the cursor there. Don't include the width of this glyph. */
5917 if (row->used[TEXT_AREA])
5919 last = &row->glyphs[TEXT_AREA][row->used[TEXT_AREA] - 1];
5920 row_width = row->pixel_width - last->pixel_width;
5922 else
5923 #endif
5924 row_width = row->pixel_width;
5926 /* TODO: find why tips do not draw along baseline as instructed. */
5927 height += row->height;
5928 width = max (width, row_width);
5931 /* Add the frame's internal border to the width and height the X
5932 window should have. */
5933 height += 2 * FRAME_INTERNAL_BORDER_WIDTH (f);
5934 width += 2 * FRAME_INTERNAL_BORDER_WIDTH (f);
5936 /* Move the tooltip window where the mouse pointer is. Resize and
5937 show it. */
5938 compute_tip_xy (f, parms, dx, dy, width, height, &root_x, &root_y);
5941 /* Adjust Window size to take border into account. */
5942 RECT rect;
5943 rect.left = rect.top = 0;
5944 rect.right = width;
5945 rect.bottom = height;
5946 AdjustWindowRect (&rect, f->output_data.w32->dwStyle,
5947 FRAME_EXTERNAL_MENU_BAR (f));
5949 /* Position and size tooltip, and put it in the topmost group.
5950 The add-on of 3 to the 5th argument is a kludge: without it,
5951 some fonts cause the last character of the tip to be truncated,
5952 for some obscure reason. */
5953 SetWindowPos (FRAME_W32_WINDOW (f), HWND_TOPMOST,
5954 root_x, root_y, rect.right - rect.left + 3,
5955 rect.bottom - rect.top, SWP_NOACTIVATE);
5957 /* Ensure tooltip is on top of other topmost windows (eg menus). */
5958 SetWindowPos (FRAME_W32_WINDOW (f), HWND_TOP,
5959 0, 0, 0, 0,
5960 SWP_NOMOVE | SWP_NOSIZE | SWP_NOACTIVATE);
5962 /* Let redisplay know that we have made the frame visible already. */
5963 f->async_visible = 1;
5965 ShowWindow (FRAME_W32_WINDOW (f), SW_SHOWNOACTIVATE);
5968 /* Draw into the window. */
5969 w->must_be_updated_p = 1;
5970 update_single_window (w, 1);
5972 UNBLOCK_INPUT;
5974 /* Restore original current buffer. */
5975 set_buffer_internal_1 (old_buffer);
5976 windows_or_buffers_changed = old_windows_or_buffers_changed;
5978 start_timer:
5979 /* Let the tip disappear after timeout seconds. */
5980 tip_timer = call3 (intern ("run-at-time"), timeout, Qnil,
5981 intern ("x-hide-tip"));
5983 UNGCPRO;
5984 return unbind_to (count, Qnil);
5988 DEFUN ("x-hide-tip", Fx_hide_tip, Sx_hide_tip, 0, 0, 0,
5989 doc: /* Hide the current tooltip window, if there is any.
5990 Value is t if tooltip was open, nil otherwise. */)
5993 int count;
5994 Lisp_Object deleted, frame, timer;
5995 struct gcpro gcpro1, gcpro2;
5997 /* Return quickly if nothing to do. */
5998 if (NILP (tip_timer) && NILP (tip_frame))
5999 return Qnil;
6001 frame = tip_frame;
6002 timer = tip_timer;
6003 GCPRO2 (frame, timer);
6004 tip_frame = tip_timer = deleted = Qnil;
6006 count = SPECPDL_INDEX ();
6007 specbind (Qinhibit_redisplay, Qt);
6008 specbind (Qinhibit_quit, Qt);
6010 if (!NILP (timer))
6011 call1 (Qcancel_timer, timer);
6013 if (FRAMEP (frame))
6015 Fdelete_frame (frame, Qnil);
6016 deleted = Qt;
6019 UNGCPRO;
6020 return unbind_to (count, deleted);
6025 /***********************************************************************
6026 File selection dialog
6027 ***********************************************************************/
6028 extern Lisp_Object Qfile_name_history;
6030 /* Callback for altering the behavior of the Open File dialog.
6031 Makes the Filename text field contain "Current Directory" and be
6032 read-only when "Directories" is selected in the filter. This
6033 allows us to work around the fact that the standard Open File
6034 dialog does not support directories. */
6035 UINT CALLBACK
6036 file_dialog_callback (hwnd, msg, wParam, lParam)
6037 HWND hwnd;
6038 UINT msg;
6039 WPARAM wParam;
6040 LPARAM lParam;
6042 if (msg == WM_NOTIFY)
6044 OFNOTIFY * notify = (OFNOTIFY *)lParam;
6045 /* Detect when the Filter dropdown is changed. */
6046 if (notify->hdr.code == CDN_TYPECHANGE
6047 || notify->hdr.code == CDN_INITDONE)
6049 HWND dialog = GetParent (hwnd);
6050 HWND edit_control = GetDlgItem (dialog, FILE_NAME_TEXT_FIELD);
6052 /* Directories is in index 2. */
6053 if (notify->lpOFN->nFilterIndex == 2)
6055 CommDlg_OpenSave_SetControlText (dialog, FILE_NAME_TEXT_FIELD,
6056 "Current Directory");
6057 EnableWindow (edit_control, FALSE);
6059 else
6061 /* Don't override default filename on init done. */
6062 if (notify->hdr.code == CDN_TYPECHANGE)
6063 CommDlg_OpenSave_SetControlText (dialog,
6064 FILE_NAME_TEXT_FIELD, "");
6065 EnableWindow (edit_control, TRUE);
6069 return 0;
6072 /* Since we compile with _WIN32_WINNT set to 0x0400 (for NT4 compatibility)
6073 we end up with the old file dialogs. Define a big enough struct for the
6074 new dialog to trick GetOpenFileName into giving us the new dialogs on
6075 Windows 2000 and XP. */
6076 typedef struct
6078 OPENFILENAME real_details;
6079 void * pReserved;
6080 DWORD dwReserved;
6081 DWORD FlagsEx;
6082 } NEWOPENFILENAME;
6085 DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 5, 0,
6086 doc: /* Read file name, prompting with PROMPT in directory DIR.
6087 Use a file selection dialog.
6088 Select DEFAULT-FILENAME in the dialog's file selection box, if
6089 specified. Ensure that file exists if MUSTMATCH is non-nil.
6090 If ONLY-DIR-P is non-nil, the user can only select directories. */)
6091 (prompt, dir, default_filename, mustmatch, only_dir_p)
6092 Lisp_Object prompt, dir, default_filename, mustmatch, only_dir_p;
6094 struct frame *f = SELECTED_FRAME ();
6095 Lisp_Object file = Qnil;
6096 int count = SPECPDL_INDEX ();
6097 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
6098 char filename[MAX_PATH + 1];
6099 char init_dir[MAX_PATH + 1];
6100 int default_filter_index = 1; /* 1: All Files, 2: Directories only */
6102 GCPRO6 (prompt, dir, default_filename, mustmatch, only_dir_p, file);
6103 CHECK_STRING (prompt);
6104 CHECK_STRING (dir);
6106 /* Create the dialog with PROMPT as title, using DIR as initial
6107 directory and using "*" as pattern. */
6108 dir = Fexpand_file_name (dir, Qnil);
6109 strncpy (init_dir, SDATA (ENCODE_FILE (dir)), MAX_PATH);
6110 init_dir[MAX_PATH] = '\0';
6111 unixtodos_filename (init_dir);
6113 if (STRINGP (default_filename))
6115 char *file_name_only;
6116 char *full_path_name = SDATA (ENCODE_FILE (default_filename));
6118 unixtodos_filename (full_path_name);
6120 file_name_only = strrchr (full_path_name, '\\');
6121 if (!file_name_only)
6122 file_name_only = full_path_name;
6123 else
6124 file_name_only++;
6126 strncpy (filename, file_name_only, MAX_PATH);
6127 filename[MAX_PATH] = '\0';
6129 else
6130 filename[0] = '\0';
6133 NEWOPENFILENAME new_file_details;
6134 BOOL file_opened = FALSE;
6135 OPENFILENAME * file_details = &new_file_details.real_details;
6137 /* Prevent redisplay. */
6138 specbind (Qinhibit_redisplay, Qt);
6139 BLOCK_INPUT;
6141 bzero (&new_file_details, sizeof (new_file_details));
6142 /* Apparently NT4 crashes if you give it an unexpected size.
6143 I'm not sure about Windows 9x, so play it safe. */
6144 if (w32_major_version > 4 && w32_major_version < 95)
6145 file_details->lStructSize = sizeof (NEWOPENFILENAME);
6146 else
6147 file_details->lStructSize = sizeof (OPENFILENAME);
6149 file_details->hwndOwner = FRAME_W32_WINDOW (f);
6150 /* Undocumented Bug in Common File Dialog:
6151 If a filter is not specified, shell links are not resolved. */
6152 file_details->lpstrFilter = "All Files (*.*)\0*.*\0Directories\0*|*\0\0";
6153 file_details->lpstrFile = filename;
6154 file_details->nMaxFile = sizeof (filename);
6155 file_details->lpstrInitialDir = init_dir;
6156 file_details->lpstrTitle = SDATA (prompt);
6158 if (! NILP (only_dir_p))
6159 default_filter_index = 2;
6161 file_details->nFilterIndex = default_filter_index;
6163 file_details->Flags = (OFN_HIDEREADONLY | OFN_NOCHANGEDIR
6164 | OFN_EXPLORER | OFN_ENABLEHOOK);
6165 if (!NILP (mustmatch))
6167 /* Require that the path to the parent directory exists. */
6168 file_details->Flags |= OFN_PATHMUSTEXIST;
6169 /* If we are looking for a file, require that it exists. */
6170 if (NILP (only_dir_p))
6171 file_details->Flags |= OFN_FILEMUSTEXIST;
6174 file_details->lpfnHook = (LPOFNHOOKPROC) file_dialog_callback;
6176 file_opened = GetOpenFileName (file_details);
6178 UNBLOCK_INPUT;
6180 if (file_opened)
6182 dostounix_filename (filename);
6184 if (file_details->nFilterIndex == 2)
6186 /* "Directories" selected - strip dummy file name. */
6187 char * last = strrchr (filename, '/');
6188 *last = '\0';
6191 file = DECODE_FILE (build_string (filename));
6193 /* User cancelled the dialog without making a selection. */
6194 else if (!CommDlgExtendedError ())
6195 file = Qnil;
6196 /* An error occurred, fallback on reading from the mini-buffer. */
6197 else
6198 file = Fcompleting_read (prompt, intern ("read-file-name-internal"),
6199 dir, mustmatch, dir, Qfile_name_history,
6200 default_filename, Qnil);
6202 file = unbind_to (count, file);
6205 UNGCPRO;
6207 /* Make "Cancel" equivalent to C-g. */
6208 if (NILP (file))
6209 Fsignal (Qquit, Qnil);
6211 return unbind_to (count, file);
6215 /* Moving files to the system recycle bin.
6216 Used by `move-file-to-trash' instead of the default moving to ~/.Trash */
6217 DEFUN ("system-move-file-to-trash", Fsystem_move_file_to_trash,
6218 Ssystem_move_file_to_trash, 1, 1, 0,
6219 doc: /* Move file or directory named FILENAME to the recycle bin. */)
6220 (filename)
6221 Lisp_Object filename;
6223 Lisp_Object handler;
6224 Lisp_Object encoded_file;
6225 Lisp_Object operation;
6227 operation = Qdelete_file;
6228 if (!NILP (Ffile_directory_p (filename))
6229 && NILP (Ffile_symlink_p (filename)))
6231 operation = Qdelete_directory;
6232 filename = Fdirectory_file_name (filename);
6234 filename = Fexpand_file_name (filename, Qnil);
6236 handler = Ffind_file_name_handler (filename, operation);
6237 if (!NILP (handler))
6238 return call2 (handler, operation, filename);
6240 encoded_file = ENCODE_FILE (filename);
6243 const char * path;
6244 SHFILEOPSTRUCT file_op;
6245 char tmp_path[MAX_PATH + 1];
6247 path = map_w32_filename (SDATA (encoded_file), NULL);
6249 /* On Windows, write permission is required to delete/move files. */
6250 _chmod (path, 0666);
6252 bzero (tmp_path, sizeof (tmp_path));
6253 strcpy (tmp_path, path);
6255 bzero (&file_op, sizeof (file_op));
6256 file_op.hwnd = HWND_DESKTOP;
6257 file_op.wFunc = FO_DELETE;
6258 file_op.pFrom = tmp_path;
6259 file_op.fFlags = FOF_SILENT | FOF_NOCONFIRMATION | FOF_ALLOWUNDO
6260 | FOF_NOERRORUI | FOF_NO_CONNECTED_ELEMENTS;
6261 file_op.fAnyOperationsAborted = FALSE;
6263 if (SHFileOperation (&file_op) != 0)
6264 report_file_error ("Removing old name", list1 (filename));
6266 return Qnil;
6270 /***********************************************************************
6271 w32 specialized functions
6272 ***********************************************************************/
6274 DEFUN ("w32-send-sys-command", Fw32_send_sys_command,
6275 Sw32_send_sys_command, 1, 2, 0,
6276 doc: /* Send frame a Windows WM_SYSCOMMAND message of type COMMAND.
6277 Some useful values for COMMAND are #xf030 to maximize frame (#xf020
6278 to minimize), #xf120 to restore frame to original size, and #xf100
6279 to activate the menubar for keyboard access. #xf140 activates the
6280 screen saver if defined.
6282 If optional parameter FRAME is not specified, use selected frame. */)
6283 (command, frame)
6284 Lisp_Object command, frame;
6286 FRAME_PTR f = check_x_frame (frame);
6288 CHECK_NUMBER (command);
6290 PostMessage (FRAME_W32_WINDOW (f), WM_SYSCOMMAND, XINT (command), 0);
6292 return Qnil;
6295 DEFUN ("w32-shell-execute", Fw32_shell_execute, Sw32_shell_execute, 2, 4, 0,
6296 doc: /* Get Windows to perform OPERATION on DOCUMENT.
6297 This is a wrapper around the ShellExecute system function, which
6298 invokes the application registered to handle OPERATION for DOCUMENT.
6300 OPERATION is either nil or a string that names a supported operation.
6301 What operations can be used depends on the particular DOCUMENT and its
6302 handler application, but typically it is one of the following common
6303 operations:
6305 \"open\" - open DOCUMENT, which could be a file, a directory, or an
6306 executable program. If it is an application, that
6307 application is launched in the current buffer's default
6308 directory. Otherwise, the application associated with
6309 DOCUMENT is launched in the buffer's default directory.
6310 \"print\" - print DOCUMENT, which must be a file
6311 \"explore\" - start the Windows Explorer on DOCUMENT
6312 \"edit\" - launch an editor and open DOCUMENT for editing; which
6313 editor is launched depends on the association for the
6314 specified DOCUMENT
6315 \"find\" - initiate search starting from DOCUMENT which must specify
6316 a directory
6317 nil - invoke the default OPERATION, or \"open\" if default is
6318 not defined or unavailable
6320 DOCUMENT is typically the name of a document file or a URL, but can
6321 also be a program executable to run, or a directory to open in the
6322 Windows Explorer.
6324 If DOCUMENT is a program executable, the optional third arg PARAMETERS
6325 can be a string containing command line parameters that will be passed
6326 to the program; otherwise, PARAMETERS should be nil or unspecified.
6328 Optional fourth argument SHOW-FLAG can be used to control how the
6329 application will be displayed when it is invoked. If SHOW-FLAG is nil
6330 or unspecified, the application is displayed normally, otherwise it is
6331 an integer representing a ShowWindow flag:
6333 0 - start hidden
6334 1 - start normally
6335 3 - start maximized
6336 6 - start minimized */)
6337 (operation, document, parameters, show_flag)
6338 Lisp_Object operation, document, parameters, show_flag;
6340 Lisp_Object current_dir;
6342 CHECK_STRING (document);
6344 /* Encode filename, current directory and parameters. */
6345 current_dir = ENCODE_FILE (current_buffer->directory);
6346 document = ENCODE_FILE (document);
6347 if (STRINGP (parameters))
6348 parameters = ENCODE_SYSTEM (parameters);
6350 if ((int) ShellExecute (NULL,
6351 (STRINGP (operation) ?
6352 SDATA (operation) : NULL),
6353 SDATA (document),
6354 (STRINGP (parameters) ?
6355 SDATA (parameters) : NULL),
6356 SDATA (current_dir),
6357 (INTEGERP (show_flag) ?
6358 XINT (show_flag) : SW_SHOWDEFAULT))
6359 > 32)
6360 return Qt;
6361 error ("ShellExecute failed: %s", w32_strerror (0));
6364 /* Lookup virtual keycode from string representing the name of a
6365 non-ascii keystroke into the corresponding virtual key, using
6366 lispy_function_keys. */
6367 static int
6368 lookup_vk_code (char *key)
6370 int i;
6372 for (i = 0; i < 256; i++)
6373 if (lispy_function_keys[i]
6374 && strcmp (lispy_function_keys[i], key) == 0)
6375 return i;
6377 return -1;
6380 /* Convert a one-element vector style key sequence to a hot key
6381 definition. */
6382 static Lisp_Object
6383 w32_parse_hot_key (key)
6384 Lisp_Object key;
6386 /* Copied from Fdefine_key and store_in_keymap. */
6387 register Lisp_Object c;
6388 int vk_code;
6389 int lisp_modifiers;
6390 int w32_modifiers;
6391 struct gcpro gcpro1;
6393 CHECK_VECTOR (key);
6395 if (XFASTINT (Flength (key)) != 1)
6396 return Qnil;
6398 GCPRO1 (key);
6400 c = Faref (key, make_number (0));
6402 if (CONSP (c) && lucid_event_type_list_p (c))
6403 c = Fevent_convert_list (c);
6405 UNGCPRO;
6407 if (! INTEGERP (c) && ! SYMBOLP (c))
6408 error ("Key definition is invalid");
6410 /* Work out the base key and the modifiers. */
6411 if (SYMBOLP (c))
6413 c = parse_modifiers (c);
6414 lisp_modifiers = XINT (Fcar (Fcdr (c)));
6415 c = Fcar (c);
6416 if (!SYMBOLP (c))
6417 abort ();
6418 vk_code = lookup_vk_code (SDATA (SYMBOL_NAME (c)));
6420 else if (INTEGERP (c))
6422 lisp_modifiers = XINT (c) & ~CHARACTERBITS;
6423 /* Many ascii characters are their own virtual key code. */
6424 vk_code = XINT (c) & CHARACTERBITS;
6427 if (vk_code < 0 || vk_code > 255)
6428 return Qnil;
6430 if ((lisp_modifiers & meta_modifier) != 0
6431 && !NILP (Vw32_alt_is_meta))
6432 lisp_modifiers |= alt_modifier;
6434 /* Supply defs missing from mingw32. */
6435 #ifndef MOD_ALT
6436 #define MOD_ALT 0x0001
6437 #define MOD_CONTROL 0x0002
6438 #define MOD_SHIFT 0x0004
6439 #define MOD_WIN 0x0008
6440 #endif
6442 /* Convert lisp modifiers to Windows hot-key form. */
6443 w32_modifiers = (lisp_modifiers & hyper_modifier) ? MOD_WIN : 0;
6444 w32_modifiers |= (lisp_modifiers & alt_modifier) ? MOD_ALT : 0;
6445 w32_modifiers |= (lisp_modifiers & ctrl_modifier) ? MOD_CONTROL : 0;
6446 w32_modifiers |= (lisp_modifiers & shift_modifier) ? MOD_SHIFT : 0;
6448 return HOTKEY (vk_code, w32_modifiers);
6451 DEFUN ("w32-register-hot-key", Fw32_register_hot_key,
6452 Sw32_register_hot_key, 1, 1, 0,
6453 doc: /* Register KEY as a hot-key combination.
6454 Certain key combinations like Alt-Tab are reserved for system use on
6455 Windows, and therefore are normally intercepted by the system. However,
6456 most of these key combinations can be received by registering them as
6457 hot-keys, overriding their special meaning.
6459 KEY must be a one element key definition in vector form that would be
6460 acceptable to `define-key' (e.g. [A-tab] for Alt-Tab). The meta
6461 modifier is interpreted as Alt if `w32-alt-is-meta' is t, and hyper
6462 is always interpreted as the Windows modifier keys.
6464 The return value is the hotkey-id if registered, otherwise nil. */)
6465 (key)
6466 Lisp_Object key;
6468 key = w32_parse_hot_key (key);
6470 if (!NILP (key) && NILP (Fmemq (key, w32_grabbed_keys)))
6472 /* Reuse an empty slot if possible. */
6473 Lisp_Object item = Fmemq (Qnil, w32_grabbed_keys);
6475 /* Safe to add new key to list, even if we have focus. */
6476 if (NILP (item))
6477 w32_grabbed_keys = Fcons (key, w32_grabbed_keys);
6478 else
6479 XSETCAR (item, key);
6481 /* Notify input thread about new hot-key definition, so that it
6482 takes effect without needing to switch focus. */
6483 #ifdef USE_LISP_UNION_TYPE
6484 PostThreadMessage (dwWindowsThreadId, WM_EMACS_REGISTER_HOT_KEY,
6485 (WPARAM) key.i, 0);
6486 #else
6487 PostThreadMessage (dwWindowsThreadId, WM_EMACS_REGISTER_HOT_KEY,
6488 (WPARAM) key, 0);
6489 #endif
6492 return key;
6495 DEFUN ("w32-unregister-hot-key", Fw32_unregister_hot_key,
6496 Sw32_unregister_hot_key, 1, 1, 0,
6497 doc: /* Unregister KEY as a hot-key combination. */)
6498 (key)
6499 Lisp_Object key;
6501 Lisp_Object item;
6503 if (!INTEGERP (key))
6504 key = w32_parse_hot_key (key);
6506 item = Fmemq (key, w32_grabbed_keys);
6508 if (!NILP (item))
6510 /* Notify input thread about hot-key definition being removed, so
6511 that it takes effect without needing focus switch. */
6512 #ifdef USE_LISP_UNION_TYPE
6513 if (PostThreadMessage (dwWindowsThreadId, WM_EMACS_UNREGISTER_HOT_KEY,
6514 (WPARAM) XINT (XCAR (item)), (LPARAM) item.i))
6515 #else
6516 if (PostThreadMessage (dwWindowsThreadId, WM_EMACS_UNREGISTER_HOT_KEY,
6517 (WPARAM) XINT (XCAR (item)), (LPARAM) item))
6518 #endif
6520 MSG msg;
6521 GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE);
6523 return Qt;
6525 return Qnil;
6528 DEFUN ("w32-registered-hot-keys", Fw32_registered_hot_keys,
6529 Sw32_registered_hot_keys, 0, 0, 0,
6530 doc: /* Return list of registered hot-key IDs. */)
6533 return Fdelq (Qnil, Fcopy_sequence (w32_grabbed_keys));
6536 DEFUN ("w32-reconstruct-hot-key", Fw32_reconstruct_hot_key,
6537 Sw32_reconstruct_hot_key, 1, 1, 0,
6538 doc: /* Convert hot-key ID to a lisp key combination.
6539 usage: (w32-reconstruct-hot-key ID) */)
6540 (hotkeyid)
6541 Lisp_Object hotkeyid;
6543 int vk_code, w32_modifiers;
6544 Lisp_Object key;
6546 CHECK_NUMBER (hotkeyid);
6548 vk_code = HOTKEY_VK_CODE (hotkeyid);
6549 w32_modifiers = HOTKEY_MODIFIERS (hotkeyid);
6551 if (vk_code < 256 && lispy_function_keys[vk_code])
6552 key = intern (lispy_function_keys[vk_code]);
6553 else
6554 key = make_number (vk_code);
6556 key = Fcons (key, Qnil);
6557 if (w32_modifiers & MOD_SHIFT)
6558 key = Fcons (Qshift, key);
6559 if (w32_modifiers & MOD_CONTROL)
6560 key = Fcons (Qctrl, key);
6561 if (w32_modifiers & MOD_ALT)
6562 key = Fcons (NILP (Vw32_alt_is_meta) ? Qalt : Qmeta, key);
6563 if (w32_modifiers & MOD_WIN)
6564 key = Fcons (Qhyper, key);
6566 return key;
6569 DEFUN ("w32-toggle-lock-key", Fw32_toggle_lock_key,
6570 Sw32_toggle_lock_key, 1, 2, 0,
6571 doc: /* Toggle the state of the lock key KEY.
6572 KEY can be `capslock', `kp-numlock', or `scroll'.
6573 If the optional parameter NEW-STATE is a number, then the state of KEY
6574 is set to off if the low bit of NEW-STATE is zero, otherwise on. */)
6575 (key, new_state)
6576 Lisp_Object key, new_state;
6578 int vk_code;
6580 if (EQ (key, intern ("capslock")))
6581 vk_code = VK_CAPITAL;
6582 else if (EQ (key, intern ("kp-numlock")))
6583 vk_code = VK_NUMLOCK;
6584 else if (EQ (key, intern ("scroll")))
6585 vk_code = VK_SCROLL;
6586 else
6587 return Qnil;
6589 if (!dwWindowsThreadId)
6590 return make_number (w32_console_toggle_lock_key (vk_code, new_state));
6592 #ifdef USE_LISP_UNION_TYPE
6593 if (PostThreadMessage (dwWindowsThreadId, WM_EMACS_TOGGLE_LOCK_KEY,
6594 (WPARAM) vk_code, (LPARAM) new_state.i))
6595 #else
6596 if (PostThreadMessage (dwWindowsThreadId, WM_EMACS_TOGGLE_LOCK_KEY,
6597 (WPARAM) vk_code, (LPARAM) new_state))
6598 #endif
6600 MSG msg;
6601 GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE);
6602 return make_number (msg.wParam);
6604 return Qnil;
6607 DEFUN ("w32-window-exists-p", Fw32_window_exists_p, Sw32_window_exists_p,
6608 2, 2, 0,
6609 doc: /* Return non-nil if a window exists with the specified CLASS and NAME.
6611 This is a direct interface to the Windows API FindWindow function. */)
6612 (class, name)
6613 Lisp_Object class, name;
6615 HWND hnd;
6617 if (!NILP (class))
6618 CHECK_STRING (class);
6619 if (!NILP (name))
6620 CHECK_STRING (name);
6622 hnd = FindWindow (STRINGP (class) ? ((LPCTSTR) SDATA (class)) : NULL,
6623 STRINGP (name) ? ((LPCTSTR) SDATA (name)) : NULL);
6624 if (!hnd)
6625 return Qnil;
6626 return Qt;
6629 DEFUN ("w32-battery-status", Fw32_battery_status, Sw32_battery_status, 0, 0, 0,
6630 doc: /* Get power status information from Windows system.
6632 The following %-sequences are provided:
6633 %L AC line status (verbose)
6634 %B Battery status (verbose)
6635 %b Battery status, empty means high, `-' means low,
6636 `!' means critical, and `+' means charging
6637 %p Battery load percentage
6638 %s Remaining time (to charge or discharge) in seconds
6639 %m Remaining time (to charge or discharge) in minutes
6640 %h Remaining time (to charge or discharge) in hours
6641 %t Remaining time (to charge or discharge) in the form `h:min' */)
6644 Lisp_Object status = Qnil;
6646 SYSTEM_POWER_STATUS system_status;
6647 if (GetSystemPowerStatus (&system_status))
6649 Lisp_Object line_status, battery_status, battery_status_symbol;
6650 Lisp_Object load_percentage, seconds, minutes, hours, remain;
6651 Lisp_Object sequences[8];
6653 long seconds_left = (long) system_status.BatteryLifeTime;
6655 if (system_status.ACLineStatus == 0)
6656 line_status = build_string ("off-line");
6657 else if (system_status.ACLineStatus == 1)
6658 line_status = build_string ("on-line");
6659 else
6660 line_status = build_string ("N/A");
6662 if (system_status.BatteryFlag & 128)
6664 battery_status = build_string ("N/A");
6665 battery_status_symbol = build_string ("");
6667 else if (system_status.BatteryFlag & 8)
6669 battery_status = build_string ("charging");
6670 battery_status_symbol = build_string ("+");
6671 if (system_status.BatteryFullLifeTime != -1L)
6672 seconds_left = system_status.BatteryFullLifeTime - seconds_left;
6674 else if (system_status.BatteryFlag & 4)
6676 battery_status = build_string ("critical");
6677 battery_status_symbol = build_string ("!");
6679 else if (system_status.BatteryFlag & 2)
6681 battery_status = build_string ("low");
6682 battery_status_symbol = build_string ("-");
6684 else if (system_status.BatteryFlag & 1)
6686 battery_status = build_string ("high");
6687 battery_status_symbol = build_string ("");
6689 else
6691 battery_status = build_string ("medium");
6692 battery_status_symbol = build_string ("");
6695 if (system_status.BatteryLifePercent > 100)
6696 load_percentage = build_string ("N/A");
6697 else
6699 char buffer[16];
6700 _snprintf (buffer, 16, "%d", system_status.BatteryLifePercent);
6701 load_percentage = build_string (buffer);
6704 if (seconds_left < 0)
6705 seconds = minutes = hours = remain = build_string ("N/A");
6706 else
6708 long m;
6709 float h;
6710 char buffer[16];
6711 _snprintf (buffer, 16, "%ld", seconds_left);
6712 seconds = build_string (buffer);
6714 m = seconds_left / 60;
6715 _snprintf (buffer, 16, "%ld", m);
6716 minutes = build_string (buffer);
6718 h = seconds_left / 3600.0;
6719 _snprintf (buffer, 16, "%3.1f", h);
6720 hours = build_string (buffer);
6722 _snprintf (buffer, 16, "%ld:%02ld", m / 60, m % 60);
6723 remain = build_string (buffer);
6725 sequences[0] = Fcons (make_number ('L'), line_status);
6726 sequences[1] = Fcons (make_number ('B'), battery_status);
6727 sequences[2] = Fcons (make_number ('b'), battery_status_symbol);
6728 sequences[3] = Fcons (make_number ('p'), load_percentage);
6729 sequences[4] = Fcons (make_number ('s'), seconds);
6730 sequences[5] = Fcons (make_number ('m'), minutes);
6731 sequences[6] = Fcons (make_number ('h'), hours);
6732 sequences[7] = Fcons (make_number ('t'), remain);
6734 status = Flist (8, sequences);
6736 return status;
6740 DEFUN ("file-system-info", Ffile_system_info, Sfile_system_info, 1, 1, 0,
6741 doc: /* Return storage information about the file system FILENAME is on.
6742 Value is a list of floats (TOTAL FREE AVAIL), where TOTAL is the total
6743 storage of the file system, FREE is the free storage, and AVAIL is the
6744 storage available to a non-superuser. All 3 numbers are in bytes.
6745 If the underlying system call fails, value is nil. */)
6746 (filename)
6747 Lisp_Object filename;
6749 Lisp_Object encoded, value;
6751 CHECK_STRING (filename);
6752 filename = Fexpand_file_name (filename, Qnil);
6753 encoded = ENCODE_FILE (filename);
6755 value = Qnil;
6757 /* Determining the required information on Windows turns out, sadly,
6758 to be more involved than one would hope. The original Win32 api
6759 call for this will return bogus information on some systems, but we
6760 must dynamically probe for the replacement api, since that was
6761 added rather late on. */
6763 HMODULE hKernel = GetModuleHandle ("kernel32");
6764 BOOL (*pfn_GetDiskFreeSpaceEx)
6765 (char *, PULARGE_INTEGER, PULARGE_INTEGER, PULARGE_INTEGER)
6766 = (void *) GetProcAddress (hKernel, "GetDiskFreeSpaceEx");
6768 /* On Windows, we may need to specify the root directory of the
6769 volume holding FILENAME. */
6770 char rootname[MAX_PATH];
6771 char *name = SDATA (encoded);
6773 /* find the root name of the volume if given */
6774 if (isalpha (name[0]) && name[1] == ':')
6776 rootname[0] = name[0];
6777 rootname[1] = name[1];
6778 rootname[2] = '\\';
6779 rootname[3] = 0;
6781 else if (IS_DIRECTORY_SEP (name[0]) && IS_DIRECTORY_SEP (name[1]))
6783 char *str = rootname;
6784 int slashes = 4;
6787 if (IS_DIRECTORY_SEP (*name) && --slashes == 0)
6788 break;
6789 *str++ = *name++;
6791 while ( *name );
6793 *str++ = '\\';
6794 *str = 0;
6797 if (pfn_GetDiskFreeSpaceEx)
6799 /* Unsigned large integers cannot be cast to double, so
6800 use signed ones instead. */
6801 LARGE_INTEGER availbytes;
6802 LARGE_INTEGER freebytes;
6803 LARGE_INTEGER totalbytes;
6805 if (pfn_GetDiskFreeSpaceEx (rootname,
6806 (ULARGE_INTEGER *)&availbytes,
6807 (ULARGE_INTEGER *)&totalbytes,
6808 (ULARGE_INTEGER *)&freebytes))
6809 value = list3 (make_float ((double) totalbytes.QuadPart),
6810 make_float ((double) freebytes.QuadPart),
6811 make_float ((double) availbytes.QuadPart));
6813 else
6815 DWORD sectors_per_cluster;
6816 DWORD bytes_per_sector;
6817 DWORD free_clusters;
6818 DWORD total_clusters;
6820 if (GetDiskFreeSpace (rootname,
6821 &sectors_per_cluster,
6822 &bytes_per_sector,
6823 &free_clusters,
6824 &total_clusters))
6825 value = list3 (make_float ((double) total_clusters
6826 * sectors_per_cluster * bytes_per_sector),
6827 make_float ((double) free_clusters
6828 * sectors_per_cluster * bytes_per_sector),
6829 make_float ((double) free_clusters
6830 * sectors_per_cluster * bytes_per_sector));
6834 return value;
6837 DEFUN ("default-printer-name", Fdefault_printer_name, Sdefault_printer_name,
6838 0, 0, 0, doc: /* Return the name of Windows default printer device. */)
6841 static char pname_buf[256];
6842 int err;
6843 HANDLE hPrn;
6844 PRINTER_INFO_2 *ppi2 = NULL;
6845 DWORD dwNeeded = 0, dwReturned = 0;
6847 /* Retrieve the default string from Win.ini (the registry).
6848 * String will be in form "printername,drivername,portname".
6849 * This is the most portable way to get the default printer. */
6850 if (GetProfileString ("windows", "device", ",,", pname_buf, sizeof (pname_buf)) <= 0)
6851 return Qnil;
6852 /* printername precedes first "," character */
6853 strtok (pname_buf, ",");
6854 /* We want to know more than the printer name */
6855 if (!OpenPrinter (pname_buf, &hPrn, NULL))
6856 return Qnil;
6857 GetPrinter (hPrn, 2, NULL, 0, &dwNeeded);
6858 if (dwNeeded == 0)
6860 ClosePrinter (hPrn);
6861 return Qnil;
6863 /* Allocate memory for the PRINTER_INFO_2 struct */
6864 ppi2 = (PRINTER_INFO_2 *) xmalloc (dwNeeded);
6865 if (!ppi2)
6867 ClosePrinter (hPrn);
6868 return Qnil;
6870 /* Call GetPrinter again with big enouth memory block */
6871 err = GetPrinter (hPrn, 2, (LPBYTE)ppi2, dwNeeded, &dwReturned);
6872 ClosePrinter (hPrn);
6873 if (!err)
6875 xfree (ppi2);
6876 return Qnil;
6879 if (ppi2)
6881 if (ppi2->Attributes & PRINTER_ATTRIBUTE_SHARED && ppi2->pServerName)
6883 /* a remote printer */
6884 if (*ppi2->pServerName == '\\')
6885 _snprintf (pname_buf, sizeof (pname_buf), "%s\\%s", ppi2->pServerName,
6886 ppi2->pShareName);
6887 else
6888 _snprintf (pname_buf, sizeof (pname_buf), "\\\\%s\\%s", ppi2->pServerName,
6889 ppi2->pShareName);
6890 pname_buf[sizeof (pname_buf) - 1] = '\0';
6892 else
6894 /* a local printer */
6895 strncpy (pname_buf, ppi2->pPortName, sizeof (pname_buf));
6896 pname_buf[sizeof (pname_buf) - 1] = '\0';
6897 /* `pPortName' can include several ports, delimited by ','.
6898 * we only use the first one. */
6899 strtok (pname_buf, ",");
6901 xfree (ppi2);
6904 return build_string (pname_buf);
6907 /***********************************************************************
6908 Initialization
6909 ***********************************************************************/
6911 /* Keep this list in the same order as frame_parms in frame.c.
6912 Use 0 for unsupported frame parameters. */
6914 frame_parm_handler w32_frame_parm_handlers[] =
6916 x_set_autoraise,
6917 x_set_autolower,
6918 x_set_background_color,
6919 x_set_border_color,
6920 x_set_border_width,
6921 x_set_cursor_color,
6922 x_set_cursor_type,
6923 x_set_font,
6924 x_set_foreground_color,
6925 x_set_icon_name,
6926 x_set_icon_type,
6927 x_set_internal_border_width,
6928 x_set_menu_bar_lines,
6929 x_set_mouse_color,
6930 x_explicitly_set_name,
6931 x_set_scroll_bar_width,
6932 x_set_title,
6933 x_set_unsplittable,
6934 x_set_vertical_scroll_bars,
6935 x_set_visibility,
6936 x_set_tool_bar_lines,
6937 0, /* x_set_scroll_bar_foreground, */
6938 0, /* x_set_scroll_bar_background, */
6939 x_set_screen_gamma,
6940 x_set_line_spacing,
6941 x_set_fringe_width,
6942 x_set_fringe_width,
6943 0, /* x_set_wait_for_wm, */
6944 x_set_fullscreen,
6945 x_set_font_backend,
6946 x_set_alpha
6949 void
6950 syms_of_w32fns ()
6952 globals_of_w32fns ();
6953 /* This is zero if not using MS-Windows. */
6954 w32_in_use = 0;
6955 track_mouse_window = NULL;
6957 w32_visible_system_caret_hwnd = NULL;
6959 DEFSYM (Qnone, "none");
6960 DEFSYM (Qsuppress_icon, "suppress-icon");
6961 DEFSYM (Qundefined_color, "undefined-color");
6962 DEFSYM (Qcancel_timer, "cancel-timer");
6963 DEFSYM (Qhyper, "hyper");
6964 DEFSYM (Qsuper, "super");
6965 DEFSYM (Qmeta, "meta");
6966 DEFSYM (Qalt, "alt");
6967 DEFSYM (Qctrl, "ctrl");
6968 DEFSYM (Qcontrol, "control");
6969 DEFSYM (Qshift, "shift");
6970 DEFSYM (Qfont_param, "font-parameter");
6971 /* This is the end of symbol initialization. */
6973 /* Text property `display' should be nonsticky by default. */
6974 Vtext_property_default_nonsticky
6975 = Fcons (Fcons (Qdisplay, Qt), Vtext_property_default_nonsticky);
6978 Fput (Qundefined_color, Qerror_conditions,
6979 Fcons (Qundefined_color, Fcons (Qerror, Qnil)));
6980 Fput (Qundefined_color, Qerror_message,
6981 build_string ("Undefined color"));
6983 staticpro (&w32_grabbed_keys);
6984 w32_grabbed_keys = Qnil;
6986 DEFVAR_LISP ("w32-color-map", &Vw32_color_map,
6987 doc: /* An array of color name mappings for Windows. */);
6988 Vw32_color_map = Qnil;
6990 DEFVAR_LISP ("w32-pass-alt-to-system", &Vw32_pass_alt_to_system,
6991 doc: /* Non-nil if Alt key presses are passed on to Windows.
6992 When non-nil, for example, Alt pressed and released and then space will
6993 open the System menu. When nil, Emacs processes the Alt key events, and
6994 then silently swallows them. */);
6995 Vw32_pass_alt_to_system = Qnil;
6997 DEFVAR_LISP ("w32-alt-is-meta", &Vw32_alt_is_meta,
6998 doc: /* Non-nil if the Alt key is to be considered the same as the META key.
6999 When nil, Emacs will translate the Alt key to the ALT modifier, not to META. */);
7000 Vw32_alt_is_meta = Qt;
7002 DEFVAR_INT ("w32-quit-key", &w32_quit_key,
7003 doc: /* If non-zero, the virtual key code for an alternative quit key. */);
7004 w32_quit_key = 0;
7006 DEFVAR_LISP ("w32-pass-lwindow-to-system",
7007 &Vw32_pass_lwindow_to_system,
7008 doc: /* If non-nil, the left \"Windows\" key is passed on to Windows.
7010 When non-nil, the Start menu is opened by tapping the key.
7011 If you set this to nil, the left \"Windows\" key is processed by Emacs
7012 according to the value of `w32-lwindow-modifier', which see.
7014 Note that some combinations of the left \"Windows\" key with other keys are
7015 caught by Windows at low level, and so binding them in Emacs will have no
7016 effect. For example, <lwindow>-r always pops up the Windows Run dialog,
7017 <lwindow>-<Pause> pops up the "System Properties" dialog, etc. However, see
7018 the doc string of `w32-phantom-key-code'. */);
7019 Vw32_pass_lwindow_to_system = Qt;
7021 DEFVAR_LISP ("w32-pass-rwindow-to-system",
7022 &Vw32_pass_rwindow_to_system,
7023 doc: /* If non-nil, the right \"Windows\" key is passed on to Windows.
7025 When non-nil, the Start menu is opened by tapping the key.
7026 If you set this to nil, the right \"Windows\" key is processed by Emacs
7027 according to the value of `w32-rwindow-modifier', which see.
7029 Note that some combinations of the right \"Windows\" key with other keys are
7030 caught by Windows at low level, and so binding them in Emacs will have no
7031 effect. For example, <rwindow>-r always pops up the Windows Run dialog,
7032 <rwindow>-<Pause> pops up the "System Properties" dialog, etc. However, see
7033 the doc string of `w32-phantom-key-code'. */);
7034 Vw32_pass_rwindow_to_system = Qt;
7036 DEFVAR_LISP ("w32-phantom-key-code",
7037 &Vw32_phantom_key_code,
7038 doc: /* Virtual key code used to generate \"phantom\" key presses.
7039 Value is a number between 0 and 255.
7041 Phantom key presses are generated in order to stop the system from
7042 acting on \"Windows\" key events when `w32-pass-lwindow-to-system' or
7043 `w32-pass-rwindow-to-system' is nil. */);
7044 /* Although 255 is technically not a valid key code, it works and
7045 means that this hack won't interfere with any real key code. */
7046 XSETINT (Vw32_phantom_key_code, 255);
7048 DEFVAR_LISP ("w32-enable-num-lock",
7049 &Vw32_enable_num_lock,
7050 doc: /* If non-nil, the Num Lock key acts normally.
7051 Set to nil to handle Num Lock as the `kp-numlock' key. */);
7052 Vw32_enable_num_lock = Qt;
7054 DEFVAR_LISP ("w32-enable-caps-lock",
7055 &Vw32_enable_caps_lock,
7056 doc: /* If non-nil, the Caps Lock key acts normally.
7057 Set to nil to handle Caps Lock as the `capslock' key. */);
7058 Vw32_enable_caps_lock = Qt;
7060 DEFVAR_LISP ("w32-scroll-lock-modifier",
7061 &Vw32_scroll_lock_modifier,
7062 doc: /* Modifier to use for the Scroll Lock ON state.
7063 The value can be hyper, super, meta, alt, control or shift for the
7064 respective modifier, or nil to handle Scroll Lock as the `scroll' key.
7065 Any other value will cause the Scroll Lock key to be ignored. */);
7066 Vw32_scroll_lock_modifier = Qt;
7068 DEFVAR_LISP ("w32-lwindow-modifier",
7069 &Vw32_lwindow_modifier,
7070 doc: /* Modifier to use for the left \"Windows\" key.
7071 The value can be hyper, super, meta, alt, control or shift for the
7072 respective modifier, or nil to appear as the `lwindow' key.
7073 Any other value will cause the key to be ignored. */);
7074 Vw32_lwindow_modifier = Qnil;
7076 DEFVAR_LISP ("w32-rwindow-modifier",
7077 &Vw32_rwindow_modifier,
7078 doc: /* Modifier to use for the right \"Windows\" key.
7079 The value can be hyper, super, meta, alt, control or shift for the
7080 respective modifier, or nil to appear as the `rwindow' key.
7081 Any other value will cause the key to be ignored. */);
7082 Vw32_rwindow_modifier = Qnil;
7084 DEFVAR_LISP ("w32-apps-modifier",
7085 &Vw32_apps_modifier,
7086 doc: /* Modifier to use for the \"Apps\" key.
7087 The value can be hyper, super, meta, alt, control or shift for the
7088 respective modifier, or nil to appear as the `apps' key.
7089 Any other value will cause the key to be ignored. */);
7090 Vw32_apps_modifier = Qnil;
7092 DEFVAR_BOOL ("w32-enable-synthesized-fonts", &w32_enable_synthesized_fonts,
7093 doc: /* Non-nil enables selection of artificially italicized and bold fonts. */);
7094 w32_enable_synthesized_fonts = 0;
7096 DEFVAR_LISP ("w32-enable-palette", &Vw32_enable_palette,
7097 doc: /* Non-nil enables Windows palette management to map colors exactly. */);
7098 Vw32_enable_palette = Qt;
7100 DEFVAR_INT ("w32-mouse-button-tolerance",
7101 &w32_mouse_button_tolerance,
7102 doc: /* Analogue of double click interval for faking middle mouse events.
7103 The value is the minimum time in milliseconds that must elapse between
7104 left and right button down events before they are considered distinct events.
7105 If both mouse buttons are depressed within this interval, a middle mouse
7106 button down event is generated instead. */);
7107 w32_mouse_button_tolerance = GetDoubleClickTime () / 2;
7109 DEFVAR_INT ("w32-mouse-move-interval",
7110 &w32_mouse_move_interval,
7111 doc: /* Minimum interval between mouse move events.
7112 The value is the minimum time in milliseconds that must elapse between
7113 successive mouse move (or scroll bar drag) events before they are
7114 reported as lisp events. */);
7115 w32_mouse_move_interval = 0;
7117 DEFVAR_BOOL ("w32-pass-extra-mouse-buttons-to-system",
7118 &w32_pass_extra_mouse_buttons_to_system,
7119 doc: /* If non-nil, the fourth and fifth mouse buttons are passed to Windows.
7120 Recent versions of Windows support mice with up to five buttons.
7121 Since most applications don't support these extra buttons, most mouse
7122 drivers will allow you to map them to functions at the system level.
7123 If this variable is non-nil, Emacs will pass them on, allowing the
7124 system to handle them. */);
7125 w32_pass_extra_mouse_buttons_to_system = 0;
7127 DEFVAR_BOOL ("w32-pass-multimedia-buttons-to-system",
7128 &w32_pass_multimedia_buttons_to_system,
7129 doc: /* If non-nil, media buttons are passed to Windows.
7130 Some modern keyboards contain buttons for controlling media players, web
7131 browsers and other applications. Generally these buttons are handled on a
7132 system wide basis, but by setting this to nil they are made available
7133 to Emacs for binding. Depending on your keyboard, additional keys that
7134 may be available are:
7136 browser-back, browser-forward, browser-refresh, browser-stop,
7137 browser-search, browser-favorites, browser-home,
7138 mail, mail-reply, mail-forward, mail-send,
7139 app-1, app-2,
7140 help, find, new, open, close, save, print, undo, redo, copy, cut, paste,
7141 spell-check, correction-list, toggle-dictate-command,
7142 media-next, media-previous, media-stop, media-play-pause, media-select,
7143 media-play, media-pause, media-record, media-fast-forward, media-rewind,
7144 media-channel-up, media-channel-down,
7145 volume-mute, volume-up, volume-down,
7146 mic-volume-mute, mic-volume-down, mic-volume-up, mic-toggle,
7147 bass-down, bass-boost, bass-up, treble-down, treble-up */);
7148 w32_pass_multimedia_buttons_to_system = 1;
7150 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape,
7151 doc: /* The shape of the pointer when over text.
7152 Changing the value does not affect existing frames
7153 unless you set the mouse color. */);
7154 Vx_pointer_shape = Qnil;
7156 Vx_nontext_pointer_shape = Qnil;
7158 Vx_mode_pointer_shape = Qnil;
7160 DEFVAR_LISP ("x-hourglass-pointer-shape", &Vx_hourglass_pointer_shape,
7161 doc: /* The shape of the pointer when Emacs is busy.
7162 This variable takes effect when you create a new frame
7163 or when you set the mouse color. */);
7164 Vx_hourglass_pointer_shape = Qnil;
7166 DEFVAR_BOOL ("display-hourglass", &display_hourglass_p,
7167 doc: /* Non-zero means Emacs displays an hourglass pointer on window systems. */);
7168 display_hourglass_p = 1;
7170 DEFVAR_LISP ("hourglass-delay", &Vhourglass_delay,
7171 doc: /* *Seconds to wait before displaying an hourglass pointer.
7172 Value must be an integer or float. */);
7173 Vhourglass_delay = make_number (DEFAULT_HOURGLASS_DELAY);
7175 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
7176 &Vx_sensitive_text_pointer_shape,
7177 doc: /* The shape of the pointer when over mouse-sensitive text.
7178 This variable takes effect when you create a new frame
7179 or when you set the mouse color. */);
7180 Vx_sensitive_text_pointer_shape = Qnil;
7182 DEFVAR_LISP ("x-window-horizontal-drag-cursor",
7183 &Vx_window_horizontal_drag_shape,
7184 doc: /* Pointer shape to use for indicating a window can be dragged horizontally.
7185 This variable takes effect when you create a new frame
7186 or when you set the mouse color. */);
7187 Vx_window_horizontal_drag_shape = Qnil;
7189 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel,
7190 doc: /* A string indicating the foreground color of the cursor box. */);
7191 Vx_cursor_fore_pixel = Qnil;
7193 DEFVAR_LISP ("x-max-tooltip-size", &Vx_max_tooltip_size,
7194 doc: /* Maximum size for tooltips.
7195 Value is a pair (COLUMNS . ROWS). Text larger than this is clipped. */);
7196 Vx_max_tooltip_size = Fcons (make_number (80), make_number (40));
7198 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager,
7199 doc: /* Non-nil if no window manager is in use.
7200 Emacs doesn't try to figure this out; this is always nil
7201 unless you set it to something else. */);
7202 /* We don't have any way to find this out, so set it to nil
7203 and maybe the user would like to set it to t. */
7204 Vx_no_window_manager = Qnil;
7206 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
7207 &Vx_pixel_size_width_font_regexp,
7208 doc: /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'.
7210 Since Emacs gets width of a font matching with this regexp from
7211 PIXEL_SIZE field of the name, font finding mechanism gets faster for
7212 such a font. This is especially effective for such large fonts as
7213 Chinese, Japanese, and Korean. */);
7214 Vx_pixel_size_width_font_regexp = Qnil;
7216 DEFVAR_LISP ("w32-bdf-filename-alist",
7217 &Vw32_bdf_filename_alist,
7218 doc: /* List of bdf fonts and their corresponding filenames. */);
7219 Vw32_bdf_filename_alist = Qnil;
7221 DEFVAR_BOOL ("w32-strict-fontnames",
7222 &w32_strict_fontnames,
7223 doc: /* Non-nil means only use fonts that are exact matches for those requested.
7224 Default is nil, which allows old fontnames that are not XLFD compliant,
7225 and allows third-party CJK display to work by specifying false charset
7226 fields to trick Emacs into translating to Big5, SJIS etc.
7227 Setting this to t will prevent wrong fonts being selected when
7228 fontsets are automatically created. */);
7229 w32_strict_fontnames = 0;
7231 DEFVAR_BOOL ("w32-strict-painting",
7232 &w32_strict_painting,
7233 doc: /* Non-nil means use strict rules for repainting frames.
7234 Set this to nil to get the old behavior for repainting; this should
7235 only be necessary if the default setting causes problems. */);
7236 w32_strict_painting = 1;
7238 #if 0 /* TODO: Port to W32 */
7239 defsubr (&Sx_change_window_property);
7240 defsubr (&Sx_delete_window_property);
7241 defsubr (&Sx_window_property);
7242 #endif
7243 defsubr (&Sxw_display_color_p);
7244 defsubr (&Sx_display_grayscale_p);
7245 defsubr (&Sxw_color_defined_p);
7246 defsubr (&Sxw_color_values);
7247 defsubr (&Sx_server_max_request_size);
7248 defsubr (&Sx_server_vendor);
7249 defsubr (&Sx_server_version);
7250 defsubr (&Sx_display_pixel_width);
7251 defsubr (&Sx_display_pixel_height);
7252 defsubr (&Sx_display_mm_width);
7253 defsubr (&Sx_display_mm_height);
7254 defsubr (&Sx_display_screens);
7255 defsubr (&Sx_display_planes);
7256 defsubr (&Sx_display_color_cells);
7257 defsubr (&Sx_display_visual_class);
7258 defsubr (&Sx_display_backing_store);
7259 defsubr (&Sx_display_save_under);
7260 defsubr (&Sx_create_frame);
7261 defsubr (&Sx_open_connection);
7262 defsubr (&Sx_close_connection);
7263 defsubr (&Sx_display_list);
7264 defsubr (&Sx_synchronize);
7265 defsubr (&Sx_focus_frame);
7267 /* W32 specific functions */
7269 defsubr (&Sw32_define_rgb_color);
7270 defsubr (&Sw32_default_color_map);
7271 defsubr (&Sw32_load_color_file);
7272 defsubr (&Sw32_send_sys_command);
7273 defsubr (&Sw32_shell_execute);
7274 defsubr (&Sw32_register_hot_key);
7275 defsubr (&Sw32_unregister_hot_key);
7276 defsubr (&Sw32_registered_hot_keys);
7277 defsubr (&Sw32_reconstruct_hot_key);
7278 defsubr (&Sw32_toggle_lock_key);
7279 defsubr (&Sw32_window_exists_p);
7280 defsubr (&Sw32_battery_status);
7282 defsubr (&Sfile_system_info);
7283 defsubr (&Sdefault_printer_name);
7285 check_window_system_func = check_w32;
7288 hourglass_timer = 0;
7289 hourglass_hwnd = NULL;
7290 hourglass_shown_p = 0;
7291 defsubr (&Sx_show_tip);
7292 defsubr (&Sx_hide_tip);
7293 tip_timer = Qnil;
7294 staticpro (&tip_timer);
7295 tip_frame = Qnil;
7296 staticpro (&tip_frame);
7298 last_show_tip_args = Qnil;
7299 staticpro (&last_show_tip_args);
7301 defsubr (&Sx_file_dialog);
7302 defsubr (&Ssystem_move_file_to_trash);
7307 globals_of_w32fns is used to initialize those global variables that
7308 must always be initialized on startup even when the global variable
7309 initialized is non zero (see the function main in emacs.c).
7310 globals_of_w32fns is called from syms_of_w32fns when the global
7311 variable initialized is 0 and directly from main when initialized
7312 is non zero.
7314 void
7315 globals_of_w32fns ()
7317 HMODULE user32_lib = GetModuleHandle ("user32.dll");
7319 TrackMouseEvent not available in all versions of Windows, so must load
7320 it dynamically. Do it once, here, instead of every time it is used.
7322 track_mouse_event_fn = (TrackMouseEvent_Proc)
7323 GetProcAddress (user32_lib, "TrackMouseEvent");
7324 /* ditto for GetClipboardSequenceNumber. */
7325 clipboard_sequence_fn = (ClipboardSequence_Proc)
7326 GetProcAddress (user32_lib, "GetClipboardSequenceNumber");
7328 monitor_from_point_fn = (MonitorFromPoint_Proc)
7329 GetProcAddress (user32_lib, "MonitorFromPoint");
7330 get_monitor_info_fn = (GetMonitorInfo_Proc)
7331 GetProcAddress (user32_lib, "GetMonitorInfoA");
7334 HMODULE imm32_lib = GetModuleHandle ("imm32.dll");
7335 get_composition_string_fn = (ImmGetCompositionString_Proc)
7336 GetProcAddress (imm32_lib, "ImmGetCompositionStringW");
7337 get_ime_context_fn = (ImmGetContext_Proc)
7338 GetProcAddress (imm32_lib, "ImmGetContext");
7340 DEFVAR_INT ("w32-ansi-code-page",
7341 &w32_ansi_code_page,
7342 doc: /* The ANSI code page used by the system. */);
7343 w32_ansi_code_page = GetACP ();
7345 /* MessageBox does not work without this when linked to comctl32.dll 6.0. */
7346 InitCommonControls ();
7348 syms_of_w32uniscribe ();
7351 #undef abort
7353 void
7354 w32_abort ()
7356 int button;
7357 button = MessageBox (NULL,
7358 "A fatal error has occurred!\n\n"
7359 "Would you like to attach a debugger?\n\n"
7360 "Select YES to debug, NO to abort Emacs"
7361 #if __GNUC__
7362 "\n\n(type \"gdb -p <emacs-PID>\" and\n"
7363 "\"continue\" inside GDB before clicking YES.)"
7364 #endif
7365 , "Emacs Abort Dialog",
7366 MB_ICONEXCLAMATION | MB_TASKMODAL
7367 | MB_SETFOREGROUND | MB_YESNO);
7368 switch (button)
7370 case IDYES:
7371 DebugBreak ();
7372 exit (2); /* tell the compiler we will never return */
7373 case IDNO:
7374 default:
7375 abort ();
7376 break;
7380 /* For convenience when debugging. */
7382 w32_last_error ()
7384 return GetLastError ();
7387 /* arch-tag: 707589ab-b9be-4638-8cdd-74629cc9b446
7388 (do not change this comment) */