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