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