(mailcap-replace-in-string): New compatibility alias.
[bpt/emacs.git] / src / w32fns.c
CommitLineData
e9e23e23 1/* Graphical user interface functions for the Microsoft W32 API.
0b5538bd 2 Copyright (C) 1989, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000,
8cabe764
GM
3 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
4 Free Software Foundation, Inc.
ee78dc32
GV
5
6This file is part of GNU Emacs.
7
8GNU Emacs is free software; you can redistribute it and/or modify
9it under the terms of the GNU General Public License as published by
684d6f5b 10the Free Software Foundation; either version 3, or (at your option)
ee78dc32
GV
11any later version.
12
13GNU Emacs is distributed in the hope that it will be useful,
14but WITHOUT ANY WARRANTY; without even the implied warranty of
15MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16GNU General Public License for more details.
17
18You should have received a copy of the GNU General Public License
19along with GNU Emacs; see the file COPYING. If not, write to
4fc5845f
LK
20the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
21Boston, MA 02110-1301, USA. */
ee78dc32
GV
22
23/* Added by Kevin Gallo */
24
ee78dc32 25#include <config.h>
1edf84e7
GV
26
27#include <signal.h>
ee78dc32 28#include <stdio.h>
1edf84e7
GV
29#include <limits.h>
30#include <errno.h>
b00afeae 31#include <math.h>
ee78dc32
GV
32
33#include "lisp.h"
34#include "w32term.h"
35#include "frame.h"
36#include "window.h"
37#include "buffer.h"
6fc2811b 38#include "intervals.h"
10b4bc33
JR
39#include "dispextern.h"
40#include "keyboard.h"
ee78dc32 41#include "blockinput.h"
57bda87a 42#include "epaths.h"
10b4bc33
JR
43#include "character.h"
44#include "charset.h"
4587b026 45#include "coding.h"
3545439c 46#include "ccl.h"
10b4bc33 47#include "fontset.h"
6fc2811b 48#include "systime.h"
10b4bc33
JR
49#include "termhooks.h"
50#include "w32heap.h"
6fc2811b
JR
51
52#include "bitmaps/gray.xbm"
ee78dc32 53
60860eb3 54#include <commctrl.h>
ee78dc32 55#include <commdlg.h>
cb9e33d4 56#include <shellapi.h>
6fc2811b 57#include <ctype.h>
6b61353c 58#include <winspool.h>
d5781bb6 59#include <objbase.h>
ee78dc32 60
1030b26b 61#include <dlgs.h>
820eff5a 62#include <imm.h>
1030b26b
JR
63#define FILE_NAME_TEXT_FIELD edt1
64
a1fe5c00
JR
65#ifdef USE_FONT_BACKEND
66#include "font.h"
67#endif
68
9785d95b
BK
69void syms_of_w32fns ();
70void globals_of_w32fns ();
71
ee78dc32 72extern void free_frame_menubar ();
6fc2811b 73extern double atof ();
9eb16b62
JR
74extern int w32_console_toggle_lock_key P_ ((int, Lisp_Object));
75extern void w32_menu_display_help P_ ((HWND, HMENU, UINT, UINT));
76extern void w32_free_menu_strings P_ ((HWND));
ad5674f5 77extern XCharStruct *w32_per_char_metric P_ ((XFontStruct *, wchar_t *, int));
9eb16b62 78
5ac45f98 79extern int quit_char;
ee78dc32 80
ccc2d29c
GV
81extern char *lispy_function_keys[];
82
ee78dc32 83/* The colormap for converting color names to RGB values */
fbd6baed 84Lisp_Object Vw32_color_map;
ee78dc32 85
da36a4d6 86/* Non nil if alt key presses are passed on to Windows. */
fbd6baed 87Lisp_Object Vw32_pass_alt_to_system;
da36a4d6 88
8c205c63
RS
89/* Non nil if alt key is translated to meta_modifier, nil if it is translated
90 to alt_modifier. */
fbd6baed 91Lisp_Object Vw32_alt_is_meta;
8c205c63 92
7d081355 93/* If non-zero, the windows virtual key code for an alternative quit key. */
2ba49441 94int w32_quit_key;
7d081355 95
ccc2d29c
GV
96/* Non nil if left window key events are passed on to Windows (this only
97 affects whether "tapping" the key opens the Start menu). */
98Lisp_Object Vw32_pass_lwindow_to_system;
99
100/* Non nil if right window key events are passed on to Windows (this
101 only affects whether "tapping" the key opens the Start menu). */
102Lisp_Object Vw32_pass_rwindow_to_system;
103
adcc3809
GV
104/* Virtual key code used to generate "phantom" key presses in order
105 to stop system from acting on Windows key events. */
106Lisp_Object Vw32_phantom_key_code;
107
ccc2d29c
GV
108/* Modifier associated with the left "Windows" key, or nil to act as a
109 normal key. */
110Lisp_Object Vw32_lwindow_modifier;
111
112/* Modifier associated with the right "Windows" key, or nil to act as a
113 normal key. */
114Lisp_Object Vw32_rwindow_modifier;
115
116/* Modifier associated with the "Apps" key, or nil to act as a normal
117 key. */
118Lisp_Object Vw32_apps_modifier;
119
120/* Value is nil if Num Lock acts as a function key. */
121Lisp_Object Vw32_enable_num_lock;
122
123/* Value is nil if Caps Lock acts as a function key. */
124Lisp_Object Vw32_enable_caps_lock;
125
126/* Modifier associated with Scroll Lock, or nil to act as a normal key. */
127Lisp_Object Vw32_scroll_lock_modifier;
da36a4d6 128
7ce9aaca 129/* Switch to control whether we inhibit requests for synthesized bold
6fc2811b 130 and italic versions of fonts. */
d84b082d 131int w32_enable_synthesized_fonts;
5ac45f98
GV
132
133/* Enable palette management. */
fbd6baed 134Lisp_Object Vw32_enable_palette;
5ac45f98
GV
135
136/* Control how close left/right button down events must be to
137 be converted to a middle button down event. */
2ba49441 138int w32_mouse_button_tolerance;
5ac45f98 139
84fb1139
KH
140/* Minimum interval between mouse movement (and scroll bar drag)
141 events that are passed on to the event loop. */
2ba49441 142int w32_mouse_move_interval;
84fb1139 143
74214547 144/* Flag to indicate if XBUTTON events should be passed on to Windows. */
74084731 145static int w32_pass_extra_mouse_buttons_to_system;
74214547 146
0b151762 147/* Flag to indicate if media keys should be passed on to Windows. */
74084731 148static int w32_pass_multimedia_buttons_to_system;
0b151762 149
ee78dc32
GV
150/* Non nil if no window manager is in use. */
151Lisp_Object Vx_no_window_manager;
152
0af913d7 153/* Non-zero means we're allowed to display a hourglass pointer. */
dfff8a69 154
0af913d7 155int display_hourglass_p;
6fc2811b 156
d148e14d
JR
157/* If non-zero, a w32 timer that, when it expires, displays an
158 hourglass cursor on all frames. */
159static unsigned hourglass_timer = 0;
160static HWND hourglass_hwnd = NULL;
161
ee78dc32
GV
162/* The background and shape of the mouse pointer, and shape when not
163 over text or in the modeline. */
dfff8a69 164
ee78dc32 165Lisp_Object Vx_pointer_shape, Vx_nontext_pointer_shape, Vx_mode_pointer_shape;
829b13e2 166Lisp_Object Vx_hourglass_pointer_shape, Vx_window_horizontal_drag_shape;
6fc2811b 167
ee78dc32 168/* The shape when over mouse-sensitive text. */
dfff8a69 169
ee78dc32
GV
170Lisp_Object Vx_sensitive_text_pointer_shape;
171
c9b2104d
JR
172#ifndef IDC_HAND
173#define IDC_HAND MAKEINTRESOURCE(32649)
174#endif
175
ee78dc32 176/* Color of chars displayed in cursor box. */
dfff8a69 177
ee78dc32
GV
178Lisp_Object Vx_cursor_fore_pixel;
179
1edf84e7 180/* Nonzero if using Windows. */
dfff8a69 181
1edf84e7
GV
182static int w32_in_use;
183
4587b026 184/* Regexp matching a font name whose width is the same as `PIXEL_SIZE'. */
dfff8a69 185
4587b026
GV
186Lisp_Object Vx_pixel_size_width_font_regexp;
187
33d52f9c
GV
188/* Alist of bdf fonts and the files that define them. */
189Lisp_Object Vw32_bdf_filename_alist;
190
f46e6225 191/* A flag to control whether fonts are matched strictly or not. */
74084731 192static int w32_strict_fontnames;
1075afa9 193
c0611964
AI
194/* A flag to control whether we should only repaint if GetUpdateRect
195 indicates there is an update region. */
74084731 196static int w32_strict_painting;
c0611964 197
dfff8a69 198/* Associative list linking character set strings to Windows codepages. */
74084731 199static Lisp_Object Vw32_charset_info_alist;
dfff8a69
JR
200
201/* VIETNAMESE_CHARSET is not defined in some versions of MSVC. */
202#ifndef VIETNAMESE_CHARSET
203#define VIETNAMESE_CHARSET 163
204#endif
205
ee78dc32 206Lisp_Object Qnone;
ee78dc32 207Lisp_Object Qsuppress_icon;
ee78dc32 208Lisp_Object Qundefined_color;
dc220243 209Lisp_Object Qcancel_timer;
adcc3809
GV
210Lisp_Object Qhyper;
211Lisp_Object Qsuper;
212Lisp_Object Qmeta;
213Lisp_Object Qalt;
214Lisp_Object Qctrl;
215Lisp_Object Qcontrol;
216Lisp_Object Qshift;
217
dfff8a69
JR
218Lisp_Object Qw32_charset_ansi;
219Lisp_Object Qw32_charset_default;
220Lisp_Object Qw32_charset_symbol;
221Lisp_Object Qw32_charset_shiftjis;
767b1ff0 222Lisp_Object Qw32_charset_hangeul;
dfff8a69
JR
223Lisp_Object Qw32_charset_gb2312;
224Lisp_Object Qw32_charset_chinesebig5;
225Lisp_Object Qw32_charset_oem;
226
71eab8d1
AI
227#ifndef JOHAB_CHARSET
228#define JOHAB_CHARSET 130
229#endif
dfff8a69
JR
230#ifdef JOHAB_CHARSET
231Lisp_Object Qw32_charset_easteurope;
232Lisp_Object Qw32_charset_turkish;
233Lisp_Object Qw32_charset_baltic;
234Lisp_Object Qw32_charset_russian;
235Lisp_Object Qw32_charset_arabic;
236Lisp_Object Qw32_charset_greek;
237Lisp_Object Qw32_charset_hebrew;
767b1ff0 238Lisp_Object Qw32_charset_vietnamese;
dfff8a69
JR
239Lisp_Object Qw32_charset_thai;
240Lisp_Object Qw32_charset_johab;
241Lisp_Object Qw32_charset_mac;
242#endif
243
244#ifdef UNICODE_CHARSET
245Lisp_Object Qw32_charset_unicode;
246#endif
247
4bf91535 248/* The ANSI codepage. */
2ba49441 249int w32_ansi_code_page;
4bf91535 250
5a8a15ec
JR
251/* Prefix for system colors. */
252#define SYSTEM_COLOR_PREFIX "System"
253#define SYSTEM_COLOR_PREFIX_LEN (sizeof (SYSTEM_COLOR_PREFIX) - 1)
254
5ac45f98
GV
255/* State variables for emulating a three button mouse. */
256#define LMOUSE 1
257#define MMOUSE 2
258#define RMOUSE 4
259
260static int button_state = 0;
fbd6baed 261static W32Msg saved_mouse_button_msg;
48094ace 262static unsigned mouse_button_timer = 0; /* non-zero when timer is active */
fbd6baed 263static W32Msg saved_mouse_move_msg;
48094ace 264static unsigned mouse_move_timer = 0;
84fb1139 265
9eb16b62
JR
266/* Window that is tracking the mouse. */
267static HWND track_mouse_window;
f60ae425 268
64f0809d
JR
269/* Multi-monitor API definitions that are not pulled from the headers
270 since we are compiling for NT 4. */
271#ifndef MONITOR_DEFAULT_TO_NEAREST
272#define MONITOR_DEFAULT_TO_NEAREST 2
273#endif
274/* MinGW headers define MONITORINFO unconditionally, but MSVC ones don't.
275 To avoid a compile error on one or the other, redefine with a new name. */
276struct MONITOR_INFO
277{
278 DWORD cbSize;
279 RECT rcMonitor;
280 RECT rcWork;
281 DWORD dwFlags;
282};
283
ccc0fdaa
JR
284typedef BOOL (WINAPI * TrackMouseEvent_Proc)
285 (IN OUT LPTRACKMOUSEEVENT lpEventTrack);
820eff5a
JR
286typedef LONG (WINAPI * ImmGetCompositionString_Proc)
287 (IN HIMC context, IN DWORD index, OUT LPVOID buffer, IN DWORD bufLen);
288typedef HIMC (WINAPI * ImmGetContext_Proc) (IN HWND window);
64f0809d
JR
289typedef HMONITOR (WINAPI * MonitorFromPoint_Proc) (IN POINT pt, IN DWORD flags);
290typedef BOOL (WINAPI * GetMonitorInfo_Proc)
291 (IN HMONITOR monitor, OUT struct MONITOR_INFO* info);
f60ae425 292
ccc0fdaa
JR
293TrackMouseEvent_Proc track_mouse_event_fn = NULL;
294ClipboardSequence_Proc clipboard_sequence_fn = NULL;
820eff5a
JR
295ImmGetCompositionString_Proc get_composition_string_fn = NULL;
296ImmGetContext_Proc get_ime_context_fn = NULL;
64f0809d
JR
297MonitorFromPoint_Proc monitor_from_point_fn = NULL;
298GetMonitorInfo_Proc get_monitor_info_fn = NULL;
820eff5a 299
b4005349 300extern AppendMenuW_Proc unicode_append_menu;
9eb16b62 301
820eff5a
JR
302/* Flag to selectively ignore WM_IME_CHAR messages. */
303static int ignore_ime_char = 0;
304
93fbe8b7 305/* W95 mousewheel handler */
7d0393cf 306unsigned int msh_mousewheel = 0;
93fbe8b7 307
48094ace 308/* Timers */
84fb1139
KH
309#define MOUSE_BUTTON_ID 1
310#define MOUSE_MOVE_ID 2
48094ace 311#define MENU_FREE_ID 3
d148e14d 312#define HOURGLASS_ID 4
48094ace
JR
313/* The delay (milliseconds) before a menu is freed after WM_EXITMENULOOP
314 is received. */
315#define MENU_FREE_DELAY 1000
316static unsigned menu_free_timer = 0;
5ac45f98 317
ee78dc32 318/* The below are defined in frame.c. */
dfff8a69 319
ee78dc32
GV
320extern Lisp_Object Vwindow_system_version;
321
937e601e
AI
322#ifdef GLYPH_DEBUG
323int image_cache_refcount, dpyinfo_refcount;
324#endif
325
326
fbd6baed 327/* From w32term.c. */
2ba49441 328extern int w32_num_mouse_buttons;
ccc2d29c 329extern Lisp_Object Vw32_recognize_altgr;
5ac45f98 330
65906840 331extern HWND w32_system_caret_hwnd;
93f2ca61 332
65906840
JR
333extern int w32_system_caret_height;
334extern int w32_system_caret_x;
335extern int w32_system_caret_y;
93f2ca61
JR
336extern int w32_use_visible_system_caret;
337
d285988b 338static HWND w32_visible_system_caret_hwnd;
65906840 339
5d22ded9
JR
340/* From w32menu.c */
341extern HMENU current_popup_menu;
58e55497 342static int menubar_in_use = 0;
5d22ded9 343
cbfedb1c
JR
344/* From w32uniscribe.c */
345#ifdef USE_FONT_BACKEND
346extern void syms_of_w32uniscribe ();
347extern int uniscribe_available;
348#endif
349
d148e14d
JR
350/* Function prototypes for hourglass support. */
351static void show_hourglass P_ ((struct frame *));
352static void hide_hourglass P_ ((void));
353
354
ee78dc32 355\f
1edf84e7
GV
356/* Error if we are not connected to MS-Windows. */
357void
358check_w32 ()
359{
360 if (! w32_in_use)
361 error ("MS-Windows not in use or not initialized");
362}
363
364/* Nonzero if we can use mouse menus.
365 You should not call this unless HAVE_MENUS is defined. */
7d0393cf 366
1edf84e7
GV
367int
368have_menus_p ()
369{
370 return w32_in_use;
371}
372
ee78dc32 373/* Extract a frame as a FRAME_PTR, defaulting to the selected frame
fbd6baed 374 and checking validity for W32. */
ee78dc32
GV
375
376FRAME_PTR
377check_x_frame (frame)
378 Lisp_Object frame;
379{
380 FRAME_PTR f;
381
382 if (NILP (frame))
6fc2811b 383 frame = selected_frame;
b7826503 384 CHECK_LIVE_FRAME (frame);
6fc2811b 385 f = XFRAME (frame);
fbd6baed 386 if (! FRAME_W32_P (f))
21517c3d 387 error ("Non-W32 frame used");
ee78dc32
GV
388 return f;
389}
390
7d0393cf 391/* Let the user specify a display with a frame.
fbd6baed 392 nil stands for the selected frame--or, if that is not a w32 frame,
ee78dc32
GV
393 the first display on the list. */
394
6d906347 395struct w32_display_info *
ee78dc32
GV
396check_x_display_info (frame)
397 Lisp_Object frame;
398{
399 if (NILP (frame))
400 {
6fc2811b 401 struct frame *sf = XFRAME (selected_frame);
7d0393cf 402
6fc2811b
JR
403 if (FRAME_W32_P (sf) && FRAME_LIVE_P (sf))
404 return FRAME_W32_DISPLAY_INFO (sf);
ee78dc32 405 else
fbd6baed 406 return &one_w32_display_info;
ee78dc32
GV
407 }
408 else if (STRINGP (frame))
409 return x_display_info_for_name (frame);
410 else
411 {
412 FRAME_PTR f;
413
b7826503 414 CHECK_LIVE_FRAME (frame);
ee78dc32 415 f = XFRAME (frame);
fbd6baed 416 if (! FRAME_W32_P (f))
21517c3d 417 error ("Non-W32 frame used");
fbd6baed 418 return FRAME_W32_DISPLAY_INFO (f);
ee78dc32
GV
419 }
420}
421\f
fbd6baed 422/* Return the Emacs frame-object corresponding to an w32 window.
ee78dc32
GV
423 It could be the frame's main window or an icon window. */
424
425/* This function can be called during GC, so use GC_xxx type test macros. */
426
427struct frame *
428x_window_to_frame (dpyinfo, wdesc)
fbd6baed 429 struct w32_display_info *dpyinfo;
ee78dc32
GV
430 HWND wdesc;
431{
432 Lisp_Object tail, frame;
433 struct frame *f;
434
8e50cc2d 435 for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
ee78dc32 436 {
8e713be6 437 frame = XCAR (tail);
8e50cc2d 438 if (!FRAMEP (frame))
ee78dc32
GV
439 continue;
440 f = XFRAME (frame);
2d764c78 441 if (!FRAME_W32_P (f) || FRAME_W32_DISPLAY_INFO (f) != dpyinfo)
ee78dc32 442 continue;
f79e6790 443
fbd6baed 444 if (FRAME_W32_WINDOW (f) == wdesc)
ee78dc32
GV
445 return f;
446 }
447 return 0;
448}
449
450\f
937e601e
AI
451static Lisp_Object unwind_create_frame P_ ((Lisp_Object));
452static Lisp_Object unwind_create_tip_frame P_ ((Lisp_Object));
0962822d
JB
453static void my_create_window P_ ((struct frame *));
454static void my_create_tip_window P_ ((struct frame *));
6d906347 455
767b1ff0 456/* TODO: Native Input Method support; see x_create_im. */
6fc2811b
JR
457void x_set_foreground_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
458void x_set_background_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
459void x_set_mouse_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
460void x_set_cursor_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
461void x_set_border_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
462void x_set_cursor_type P_ ((struct frame *, Lisp_Object, Lisp_Object));
463void x_set_icon_type P_ ((struct frame *, Lisp_Object, Lisp_Object));
464void x_set_icon_name P_ ((struct frame *, Lisp_Object, Lisp_Object));
6fc2811b 465void x_explicitly_set_name P_ ((struct frame *, Lisp_Object, Lisp_Object));
6fc2811b 466void x_set_menu_bar_lines P_ ((struct frame *, Lisp_Object, Lisp_Object));
6fc2811b 467void x_set_title P_ ((struct frame *, Lisp_Object, Lisp_Object));
6fc2811b 468void x_set_tool_bar_lines P_ ((struct frame *, Lisp_Object, Lisp_Object));
3cf3436e
JR
469static void x_edge_detection P_ ((struct frame *, struct image *, Lisp_Object,
470 Lisp_Object));
ee78dc32 471
ee78dc32 472
ee78dc32 473\f
ee78dc32
GV
474
475/* Store the screen positions of frame F into XPTR and YPTR.
476 These are the positions of the containing window manager window,
477 not Emacs's own window. */
478
479void
480x_real_positions (f, xptr, yptr)
481 FRAME_PTR f;
482 int *xptr, *yptr;
483{
484 POINT pt;
f7b9d4d1 485 RECT rect;
3c190163 486
ee04257d
JR
487 /* Get the bounds of the WM window. */
488 GetWindowRect (FRAME_W32_WINDOW (f), &rect);
f7b9d4d1 489
ee04257d
JR
490 pt.x = 0;
491 pt.y = 0;
ee78dc32 492
ee04257d
JR
493 /* Convert (0, 0) in the client area to screen co-ordinates. */
494 ClientToScreen (FRAME_W32_WINDOW (f), &pt);
ee78dc32 495
f7b9d4d1 496 /* Remember x_pixels_diff and y_pixels_diff. */
be786000
KS
497 f->x_pixels_diff = pt.x - rect.left;
498 f->y_pixels_diff = pt.y - rect.top;
f7b9d4d1 499
ee04257d
JR
500 *xptr = rect.left;
501 *yptr = rect.top;
ee78dc32
GV
502}
503
ee78dc32
GV
504\f
505
74e1aeec
JR
506DEFUN ("w32-define-rgb-color", Fw32_define_rgb_color,
507 Sw32_define_rgb_color, 4, 4, 0,
23f250f4 508 doc: /* Convert RGB numbers to a Windows color reference and associate with NAME.
02b39a28 509This adds or updates a named color to `w32-color-map', making it
74e1aeec
JR
510available for use. The original entry's RGB ref is returned, or nil
511if the entry is new. */)
5ac45f98
GV
512 (red, green, blue, name)
513 Lisp_Object red, green, blue, name;
ee78dc32 514{
5ac45f98
GV
515 Lisp_Object rgb;
516 Lisp_Object oldrgb = Qnil;
517 Lisp_Object entry;
518
b7826503
PJ
519 CHECK_NUMBER (red);
520 CHECK_NUMBER (green);
521 CHECK_NUMBER (blue);
522 CHECK_STRING (name);
ee78dc32 523
74084731 524 XSETINT (rgb, RGB (XUINT (red), XUINT (green), XUINT (blue)));
ee78dc32 525
5ac45f98 526 BLOCK_INPUT;
ee78dc32 527
fbd6baed
GV
528 /* replace existing entry in w32-color-map or add new entry. */
529 entry = Fassoc (name, Vw32_color_map);
5ac45f98
GV
530 if (NILP (entry))
531 {
532 entry = Fcons (name, rgb);
fbd6baed 533 Vw32_color_map = Fcons (entry, Vw32_color_map);
5ac45f98
GV
534 }
535 else
536 {
537 oldrgb = Fcdr (entry);
538 Fsetcdr (entry, rgb);
539 }
540
541 UNBLOCK_INPUT;
542
543 return (oldrgb);
ee78dc32
GV
544}
545
74e1aeec
JR
546DEFUN ("w32-load-color-file", Fw32_load_color_file,
547 Sw32_load_color_file, 1, 1, 0,
548 doc: /* Create an alist of color entries from an external file.
02b39a28 549Assign this value to `w32-color-map' to replace the existing color map.
74e1aeec
JR
550
551The file should define one named RGB color per line like so:
552 R G B name
553where R,G,B are numbers between 0 and 255 and name is an arbitrary string. */)
5ac45f98
GV
554 (filename)
555 Lisp_Object filename;
556{
557 FILE *fp;
558 Lisp_Object cmap = Qnil;
559 Lisp_Object abspath;
560
b7826503 561 CHECK_STRING (filename);
5ac45f98
GV
562 abspath = Fexpand_file_name (filename, Qnil);
563
d5db4077 564 fp = fopen (SDATA (filename), "rt");
5ac45f98
GV
565 if (fp)
566 {
567 char buf[512];
568 int red, green, blue;
569 int num;
570
571 BLOCK_INPUT;
572
573 while (fgets (buf, sizeof (buf), fp) != NULL) {
574 if (sscanf (buf, "%u %u %u %n", &red, &green, &blue, &num) == 3)
575 {
576 char *name = buf + num;
577 num = strlen (name) - 1;
578 if (name[num] == '\n')
579 name[num] = 0;
580 cmap = Fcons (Fcons (build_string (name),
581 make_number (RGB (red, green, blue))),
582 cmap);
583 }
584 }
585 fclose (fp);
586
587 UNBLOCK_INPUT;
588 }
589
590 return cmap;
591}
ee78dc32 592
fbd6baed 593/* The default colors for the w32 color map */
7d0393cf 594typedef struct colormap_t
ee78dc32
GV
595{
596 char *name;
597 COLORREF colorref;
598} colormap_t;
599
7d0393cf 600colormap_t w32_color_map[] =
ee78dc32 601{
1da8a614
GV
602 {"snow" , PALETTERGB (255,250,250)},
603 {"ghost white" , PALETTERGB (248,248,255)},
604 {"GhostWhite" , PALETTERGB (248,248,255)},
605 {"white smoke" , PALETTERGB (245,245,245)},
606 {"WhiteSmoke" , PALETTERGB (245,245,245)},
607 {"gainsboro" , PALETTERGB (220,220,220)},
608 {"floral white" , PALETTERGB (255,250,240)},
609 {"FloralWhite" , PALETTERGB (255,250,240)},
610 {"old lace" , PALETTERGB (253,245,230)},
611 {"OldLace" , PALETTERGB (253,245,230)},
612 {"linen" , PALETTERGB (250,240,230)},
613 {"antique white" , PALETTERGB (250,235,215)},
614 {"AntiqueWhite" , PALETTERGB (250,235,215)},
615 {"papaya whip" , PALETTERGB (255,239,213)},
616 {"PapayaWhip" , PALETTERGB (255,239,213)},
617 {"blanched almond" , PALETTERGB (255,235,205)},
618 {"BlanchedAlmond" , PALETTERGB (255,235,205)},
619 {"bisque" , PALETTERGB (255,228,196)},
620 {"peach puff" , PALETTERGB (255,218,185)},
621 {"PeachPuff" , PALETTERGB (255,218,185)},
622 {"navajo white" , PALETTERGB (255,222,173)},
623 {"NavajoWhite" , PALETTERGB (255,222,173)},
624 {"moccasin" , PALETTERGB (255,228,181)},
625 {"cornsilk" , PALETTERGB (255,248,220)},
626 {"ivory" , PALETTERGB (255,255,240)},
627 {"lemon chiffon" , PALETTERGB (255,250,205)},
628 {"LemonChiffon" , PALETTERGB (255,250,205)},
629 {"seashell" , PALETTERGB (255,245,238)},
630 {"honeydew" , PALETTERGB (240,255,240)},
631 {"mint cream" , PALETTERGB (245,255,250)},
632 {"MintCream" , PALETTERGB (245,255,250)},
633 {"azure" , PALETTERGB (240,255,255)},
634 {"alice blue" , PALETTERGB (240,248,255)},
635 {"AliceBlue" , PALETTERGB (240,248,255)},
636 {"lavender" , PALETTERGB (230,230,250)},
637 {"lavender blush" , PALETTERGB (255,240,245)},
638 {"LavenderBlush" , PALETTERGB (255,240,245)},
639 {"misty rose" , PALETTERGB (255,228,225)},
640 {"MistyRose" , PALETTERGB (255,228,225)},
641 {"white" , PALETTERGB (255,255,255)},
642 {"black" , PALETTERGB ( 0, 0, 0)},
643 {"dark slate gray" , PALETTERGB ( 47, 79, 79)},
644 {"DarkSlateGray" , PALETTERGB ( 47, 79, 79)},
645 {"dark slate grey" , PALETTERGB ( 47, 79, 79)},
646 {"DarkSlateGrey" , PALETTERGB ( 47, 79, 79)},
647 {"dim gray" , PALETTERGB (105,105,105)},
648 {"DimGray" , PALETTERGB (105,105,105)},
649 {"dim grey" , PALETTERGB (105,105,105)},
650 {"DimGrey" , PALETTERGB (105,105,105)},
651 {"slate gray" , PALETTERGB (112,128,144)},
652 {"SlateGray" , PALETTERGB (112,128,144)},
653 {"slate grey" , PALETTERGB (112,128,144)},
654 {"SlateGrey" , PALETTERGB (112,128,144)},
655 {"light slate gray" , PALETTERGB (119,136,153)},
656 {"LightSlateGray" , PALETTERGB (119,136,153)},
657 {"light slate grey" , PALETTERGB (119,136,153)},
658 {"LightSlateGrey" , PALETTERGB (119,136,153)},
659 {"gray" , PALETTERGB (190,190,190)},
660 {"grey" , PALETTERGB (190,190,190)},
661 {"light grey" , PALETTERGB (211,211,211)},
662 {"LightGrey" , PALETTERGB (211,211,211)},
663 {"light gray" , PALETTERGB (211,211,211)},
664 {"LightGray" , PALETTERGB (211,211,211)},
665 {"midnight blue" , PALETTERGB ( 25, 25,112)},
666 {"MidnightBlue" , PALETTERGB ( 25, 25,112)},
667 {"navy" , PALETTERGB ( 0, 0,128)},
668 {"navy blue" , PALETTERGB ( 0, 0,128)},
669 {"NavyBlue" , PALETTERGB ( 0, 0,128)},
670 {"cornflower blue" , PALETTERGB (100,149,237)},
671 {"CornflowerBlue" , PALETTERGB (100,149,237)},
672 {"dark slate blue" , PALETTERGB ( 72, 61,139)},
673 {"DarkSlateBlue" , PALETTERGB ( 72, 61,139)},
674 {"slate blue" , PALETTERGB (106, 90,205)},
675 {"SlateBlue" , PALETTERGB (106, 90,205)},
676 {"medium slate blue" , PALETTERGB (123,104,238)},
677 {"MediumSlateBlue" , PALETTERGB (123,104,238)},
678 {"light slate blue" , PALETTERGB (132,112,255)},
679 {"LightSlateBlue" , PALETTERGB (132,112,255)},
680 {"medium blue" , PALETTERGB ( 0, 0,205)},
681 {"MediumBlue" , PALETTERGB ( 0, 0,205)},
682 {"royal blue" , PALETTERGB ( 65,105,225)},
683 {"RoyalBlue" , PALETTERGB ( 65,105,225)},
684 {"blue" , PALETTERGB ( 0, 0,255)},
685 {"dodger blue" , PALETTERGB ( 30,144,255)},
686 {"DodgerBlue" , PALETTERGB ( 30,144,255)},
687 {"deep sky blue" , PALETTERGB ( 0,191,255)},
688 {"DeepSkyBlue" , PALETTERGB ( 0,191,255)},
689 {"sky blue" , PALETTERGB (135,206,235)},
690 {"SkyBlue" , PALETTERGB (135,206,235)},
691 {"light sky blue" , PALETTERGB (135,206,250)},
692 {"LightSkyBlue" , PALETTERGB (135,206,250)},
693 {"steel blue" , PALETTERGB ( 70,130,180)},
694 {"SteelBlue" , PALETTERGB ( 70,130,180)},
695 {"light steel blue" , PALETTERGB (176,196,222)},
696 {"LightSteelBlue" , PALETTERGB (176,196,222)},
697 {"light blue" , PALETTERGB (173,216,230)},
698 {"LightBlue" , PALETTERGB (173,216,230)},
699 {"powder blue" , PALETTERGB (176,224,230)},
700 {"PowderBlue" , PALETTERGB (176,224,230)},
701 {"pale turquoise" , PALETTERGB (175,238,238)},
702 {"PaleTurquoise" , PALETTERGB (175,238,238)},
703 {"dark turquoise" , PALETTERGB ( 0,206,209)},
704 {"DarkTurquoise" , PALETTERGB ( 0,206,209)},
705 {"medium turquoise" , PALETTERGB ( 72,209,204)},
706 {"MediumTurquoise" , PALETTERGB ( 72,209,204)},
707 {"turquoise" , PALETTERGB ( 64,224,208)},
708 {"cyan" , PALETTERGB ( 0,255,255)},
709 {"light cyan" , PALETTERGB (224,255,255)},
710 {"LightCyan" , PALETTERGB (224,255,255)},
711 {"cadet blue" , PALETTERGB ( 95,158,160)},
712 {"CadetBlue" , PALETTERGB ( 95,158,160)},
713 {"medium aquamarine" , PALETTERGB (102,205,170)},
714 {"MediumAquamarine" , PALETTERGB (102,205,170)},
715 {"aquamarine" , PALETTERGB (127,255,212)},
716 {"dark green" , PALETTERGB ( 0,100, 0)},
717 {"DarkGreen" , PALETTERGB ( 0,100, 0)},
718 {"dark olive green" , PALETTERGB ( 85,107, 47)},
719 {"DarkOliveGreen" , PALETTERGB ( 85,107, 47)},
720 {"dark sea green" , PALETTERGB (143,188,143)},
721 {"DarkSeaGreen" , PALETTERGB (143,188,143)},
722 {"sea green" , PALETTERGB ( 46,139, 87)},
723 {"SeaGreen" , PALETTERGB ( 46,139, 87)},
724 {"medium sea green" , PALETTERGB ( 60,179,113)},
725 {"MediumSeaGreen" , PALETTERGB ( 60,179,113)},
726 {"light sea green" , PALETTERGB ( 32,178,170)},
727 {"LightSeaGreen" , PALETTERGB ( 32,178,170)},
728 {"pale green" , PALETTERGB (152,251,152)},
729 {"PaleGreen" , PALETTERGB (152,251,152)},
730 {"spring green" , PALETTERGB ( 0,255,127)},
731 {"SpringGreen" , PALETTERGB ( 0,255,127)},
732 {"lawn green" , PALETTERGB (124,252, 0)},
733 {"LawnGreen" , PALETTERGB (124,252, 0)},
734 {"green" , PALETTERGB ( 0,255, 0)},
735 {"chartreuse" , PALETTERGB (127,255, 0)},
736 {"medium spring green" , PALETTERGB ( 0,250,154)},
737 {"MediumSpringGreen" , PALETTERGB ( 0,250,154)},
738 {"green yellow" , PALETTERGB (173,255, 47)},
739 {"GreenYellow" , PALETTERGB (173,255, 47)},
740 {"lime green" , PALETTERGB ( 50,205, 50)},
741 {"LimeGreen" , PALETTERGB ( 50,205, 50)},
742 {"yellow green" , PALETTERGB (154,205, 50)},
743 {"YellowGreen" , PALETTERGB (154,205, 50)},
744 {"forest green" , PALETTERGB ( 34,139, 34)},
745 {"ForestGreen" , PALETTERGB ( 34,139, 34)},
746 {"olive drab" , PALETTERGB (107,142, 35)},
747 {"OliveDrab" , PALETTERGB (107,142, 35)},
748 {"dark khaki" , PALETTERGB (189,183,107)},
749 {"DarkKhaki" , PALETTERGB (189,183,107)},
750 {"khaki" , PALETTERGB (240,230,140)},
751 {"pale goldenrod" , PALETTERGB (238,232,170)},
752 {"PaleGoldenrod" , PALETTERGB (238,232,170)},
753 {"light goldenrod yellow" , PALETTERGB (250,250,210)},
754 {"LightGoldenrodYellow" , PALETTERGB (250,250,210)},
755 {"light yellow" , PALETTERGB (255,255,224)},
756 {"LightYellow" , PALETTERGB (255,255,224)},
757 {"yellow" , PALETTERGB (255,255, 0)},
758 {"gold" , PALETTERGB (255,215, 0)},
759 {"light goldenrod" , PALETTERGB (238,221,130)},
760 {"LightGoldenrod" , PALETTERGB (238,221,130)},
761 {"goldenrod" , PALETTERGB (218,165, 32)},
762 {"dark goldenrod" , PALETTERGB (184,134, 11)},
763 {"DarkGoldenrod" , PALETTERGB (184,134, 11)},
764 {"rosy brown" , PALETTERGB (188,143,143)},
765 {"RosyBrown" , PALETTERGB (188,143,143)},
766 {"indian red" , PALETTERGB (205, 92, 92)},
767 {"IndianRed" , PALETTERGB (205, 92, 92)},
768 {"saddle brown" , PALETTERGB (139, 69, 19)},
769 {"SaddleBrown" , PALETTERGB (139, 69, 19)},
770 {"sienna" , PALETTERGB (160, 82, 45)},
771 {"peru" , PALETTERGB (205,133, 63)},
772 {"burlywood" , PALETTERGB (222,184,135)},
773 {"beige" , PALETTERGB (245,245,220)},
774 {"wheat" , PALETTERGB (245,222,179)},
775 {"sandy brown" , PALETTERGB (244,164, 96)},
776 {"SandyBrown" , PALETTERGB (244,164, 96)},
777 {"tan" , PALETTERGB (210,180,140)},
778 {"chocolate" , PALETTERGB (210,105, 30)},
779 {"firebrick" , PALETTERGB (178,34, 34)},
780 {"brown" , PALETTERGB (165,42, 42)},
781 {"dark salmon" , PALETTERGB (233,150,122)},
782 {"DarkSalmon" , PALETTERGB (233,150,122)},
783 {"salmon" , PALETTERGB (250,128,114)},
784 {"light salmon" , PALETTERGB (255,160,122)},
785 {"LightSalmon" , PALETTERGB (255,160,122)},
786 {"orange" , PALETTERGB (255,165, 0)},
787 {"dark orange" , PALETTERGB (255,140, 0)},
788 {"DarkOrange" , PALETTERGB (255,140, 0)},
789 {"coral" , PALETTERGB (255,127, 80)},
790 {"light coral" , PALETTERGB (240,128,128)},
791 {"LightCoral" , PALETTERGB (240,128,128)},
792 {"tomato" , PALETTERGB (255, 99, 71)},
793 {"orange red" , PALETTERGB (255, 69, 0)},
794 {"OrangeRed" , PALETTERGB (255, 69, 0)},
795 {"red" , PALETTERGB (255, 0, 0)},
796 {"hot pink" , PALETTERGB (255,105,180)},
797 {"HotPink" , PALETTERGB (255,105,180)},
798 {"deep pink" , PALETTERGB (255, 20,147)},
799 {"DeepPink" , PALETTERGB (255, 20,147)},
800 {"pink" , PALETTERGB (255,192,203)},
801 {"light pink" , PALETTERGB (255,182,193)},
802 {"LightPink" , PALETTERGB (255,182,193)},
803 {"pale violet red" , PALETTERGB (219,112,147)},
804 {"PaleVioletRed" , PALETTERGB (219,112,147)},
805 {"maroon" , PALETTERGB (176, 48, 96)},
806 {"medium violet red" , PALETTERGB (199, 21,133)},
807 {"MediumVioletRed" , PALETTERGB (199, 21,133)},
808 {"violet red" , PALETTERGB (208, 32,144)},
809 {"VioletRed" , PALETTERGB (208, 32,144)},
810 {"magenta" , PALETTERGB (255, 0,255)},
811 {"violet" , PALETTERGB (238,130,238)},
812 {"plum" , PALETTERGB (221,160,221)},
813 {"orchid" , PALETTERGB (218,112,214)},
814 {"medium orchid" , PALETTERGB (186, 85,211)},
815 {"MediumOrchid" , PALETTERGB (186, 85,211)},
816 {"dark orchid" , PALETTERGB (153, 50,204)},
817 {"DarkOrchid" , PALETTERGB (153, 50,204)},
818 {"dark violet" , PALETTERGB (148, 0,211)},
819 {"DarkViolet" , PALETTERGB (148, 0,211)},
820 {"blue violet" , PALETTERGB (138, 43,226)},
821 {"BlueViolet" , PALETTERGB (138, 43,226)},
822 {"purple" , PALETTERGB (160, 32,240)},
823 {"medium purple" , PALETTERGB (147,112,219)},
824 {"MediumPurple" , PALETTERGB (147,112,219)},
825 {"thistle" , PALETTERGB (216,191,216)},
826 {"gray0" , PALETTERGB ( 0, 0, 0)},
827 {"grey0" , PALETTERGB ( 0, 0, 0)},
828 {"dark grey" , PALETTERGB (169,169,169)},
829 {"DarkGrey" , PALETTERGB (169,169,169)},
830 {"dark gray" , PALETTERGB (169,169,169)},
831 {"DarkGray" , PALETTERGB (169,169,169)},
832 {"dark blue" , PALETTERGB ( 0, 0,139)},
833 {"DarkBlue" , PALETTERGB ( 0, 0,139)},
834 {"dark cyan" , PALETTERGB ( 0,139,139)},
835 {"DarkCyan" , PALETTERGB ( 0,139,139)},
836 {"dark magenta" , PALETTERGB (139, 0,139)},
837 {"DarkMagenta" , PALETTERGB (139, 0,139)},
838 {"dark red" , PALETTERGB (139, 0, 0)},
839 {"DarkRed" , PALETTERGB (139, 0, 0)},
840 {"light green" , PALETTERGB (144,238,144)},
841 {"LightGreen" , PALETTERGB (144,238,144)},
ee78dc32
GV
842};
843
fbd6baed 844DEFUN ("w32-default-color-map", Fw32_default_color_map, Sw32_default_color_map,
74e1aeec 845 0, 0, 0, doc: /* Return the default color map. */)
ee78dc32
GV
846 ()
847{
848 int i;
fbd6baed 849 colormap_t *pc = w32_color_map;
ee78dc32 850 Lisp_Object cmap;
7d0393cf 851
ee78dc32 852 BLOCK_INPUT;
7d0393cf 853
ee78dc32 854 cmap = Qnil;
7d0393cf
JB
855
856 for (i = 0; i < sizeof (w32_color_map) / sizeof (w32_color_map[0]);
ee78dc32
GV
857 pc++, i++)
858 cmap = Fcons (Fcons (build_string (pc->name),
859 make_number (pc->colorref)),
860 cmap);
7d0393cf 861
ee78dc32 862 UNBLOCK_INPUT;
7d0393cf 863
ee78dc32
GV
864 return (cmap);
865}
ee78dc32 866
74084731 867static Lisp_Object
fbd6baed 868w32_to_x_color (rgb)
ee78dc32
GV
869 Lisp_Object rgb;
870{
871 Lisp_Object color;
7d0393cf 872
b7826503 873 CHECK_NUMBER (rgb);
7d0393cf 874
ee78dc32 875 BLOCK_INPUT;
7d0393cf 876
fbd6baed 877 color = Frassq (rgb, Vw32_color_map);
7d0393cf 878
ee78dc32 879 UNBLOCK_INPUT;
7d0393cf 880
ee78dc32
GV
881 if (!NILP (color))
882 return (Fcar (color));
883 else
884 return Qnil;
885}
886
2ba49441 887static Lisp_Object
5d7fed93
GV
888w32_color_map_lookup (colorname)
889 char *colorname;
890{
891 Lisp_Object tail, ret = Qnil;
892
893 BLOCK_INPUT;
894
99784d63 895 for (tail = Vw32_color_map; CONSP (tail); tail = XCDR (tail))
5d7fed93
GV
896 {
897 register Lisp_Object elt, tem;
898
99784d63 899 elt = XCAR (tail);
5d7fed93
GV
900 if (!CONSP (elt)) continue;
901
902 tem = Fcar (elt);
903
d5db4077 904 if (lstrcmpi (SDATA (tem), colorname) == 0)
5d7fed93 905 {
2ba49441 906 ret = Fcdr (elt);
5d7fed93
GV
907 break;
908 }
909
910 QUIT;
911 }
912
913
914 UNBLOCK_INPUT;
915
916 return ret;
917}
918
5a8a15ec
JR
919
920static void
921add_system_logical_colors_to_map (system_colors)
922 Lisp_Object *system_colors;
923{
924 HKEY colors_key;
925
926 /* Other registry operations are done with input blocked. */
927 BLOCK_INPUT;
928
929 /* Look for "Control Panel/Colors" under User and Machine registry
930 settings. */
931 if (RegOpenKeyEx (HKEY_CURRENT_USER, "Control Panel\\Colors", 0,
932 KEY_READ, &colors_key) == ERROR_SUCCESS
933 || RegOpenKeyEx (HKEY_LOCAL_MACHINE, "Control Panel\\Colors", 0,
934 KEY_READ, &colors_key) == ERROR_SUCCESS)
935 {
936 /* List all keys. */
937 char color_buffer[64];
938 char full_name_buffer[MAX_PATH + SYSTEM_COLOR_PREFIX_LEN];
939 int index = 0;
940 DWORD name_size, color_size;
941 char *name_buffer = full_name_buffer + SYSTEM_COLOR_PREFIX_LEN;
942
943 name_size = sizeof (full_name_buffer) - SYSTEM_COLOR_PREFIX_LEN;
944 color_size = sizeof (color_buffer);
945
946 strcpy (full_name_buffer, SYSTEM_COLOR_PREFIX);
947
948 while (RegEnumValueA (colors_key, index, name_buffer, &name_size,
949 NULL, NULL, color_buffer, &color_size)
950 == ERROR_SUCCESS)
951 {
952 int r, g, b;
953 if (sscanf (color_buffer, " %u %u %u", &r, &g, &b) == 3)
954 *system_colors = Fcons (Fcons (build_string (full_name_buffer),
955 make_number (RGB (r, g, b))),
956 *system_colors);
957
958 name_size = sizeof (full_name_buffer) - SYSTEM_COLOR_PREFIX_LEN;
959 color_size = sizeof (color_buffer);
960 index++;
961 }
962 RegCloseKey (colors_key);
963 }
964
965 UNBLOCK_INPUT;
966}
967
968
2ba49441 969static Lisp_Object
fbd6baed 970x_to_w32_color (colorname)
ee78dc32
GV
971 char * colorname;
972{
8edb0a6f
JR
973 register Lisp_Object ret = Qnil;
974
ee78dc32 975 BLOCK_INPUT;
1edf84e7
GV
976
977 if (colorname[0] == '#')
978 {
979 /* Could be an old-style RGB Device specification. */
980 char *color;
981 int size;
982 color = colorname + 1;
7d0393cf 983
74084731 984 size = strlen (color);
1edf84e7
GV
985 if (size == 3 || size == 6 || size == 9 || size == 12)
986 {
987 UINT colorval;
988 int i, pos;
989 pos = 0;
990 size /= 3;
991 colorval = 0;
7d0393cf 992
1edf84e7
GV
993 for (i = 0; i < 3; i++)
994 {
995 char *end;
996 char t;
997 unsigned long value;
998
999 /* The check for 'x' in the following conditional takes into
1000 account the fact that strtol allows a "0x" in front of
1001 our numbers, and we don't. */
74084731 1002 if (!isxdigit (color[0]) || color[1] == 'x')
1edf84e7
GV
1003 break;
1004 t = color[size];
1005 color[size] = '\0';
74084731 1006 value = strtoul (color, &end, 16);
1edf84e7
GV
1007 color[size] = t;
1008 if (errno == ERANGE || end - color != size)
1009 break;
1010 switch (size)
1011 {
1012 case 1:
1013 value = value * 0x10;
1014 break;
1015 case 2:
1016 break;
1017 case 3:
1018 value /= 0x10;
1019 break;
1020 case 4:
1021 value /= 0x100;
1022 break;
1023 }
1024 colorval |= (value << pos);
1025 pos += 0x8;
1026 if (i == 2)
1027 {
1028 UNBLOCK_INPUT;
2ba49441
JR
1029 XSETINT (ret, colorval);
1030 return ret;
1edf84e7
GV
1031 }
1032 color = end;
1033 }
1034 }
1035 }
74084731 1036 else if (strnicmp (colorname, "rgb:", 4) == 0)
1edf84e7
GV
1037 {
1038 char *color;
1039 UINT colorval;
1040 int i, pos;
1041 pos = 0;
1042
1043 colorval = 0;
1044 color = colorname + 4;
1045 for (i = 0; i < 3; i++)
1046 {
1047 char *end;
1048 unsigned long value;
7d0393cf 1049
1edf84e7
GV
1050 /* The check for 'x' in the following conditional takes into
1051 account the fact that strtol allows a "0x" in front of
1052 our numbers, and we don't. */
74084731 1053 if (!isxdigit (color[0]) || color[1] == 'x')
1edf84e7 1054 break;
74084731 1055 value = strtoul (color, &end, 16);
1edf84e7
GV
1056 if (errno == ERANGE)
1057 break;
1058 switch (end - color)
1059 {
1060 case 1:
1061 value = value * 0x10 + value;
1062 break;
1063 case 2:
1064 break;
1065 case 3:
1066 value /= 0x10;
1067 break;
1068 case 4:
1069 value /= 0x100;
1070 break;
1071 default:
1072 value = ULONG_MAX;
1073 }
1074 if (value == ULONG_MAX)
1075 break;
1076 colorval |= (value << pos);
1077 pos += 0x8;
1078 if (i == 2)
1079 {
1080 if (*end != '\0')
1081 break;
1082 UNBLOCK_INPUT;
2ba49441
JR
1083 XSETINT (ret, colorval);
1084 return ret;
1edf84e7
GV
1085 }
1086 if (*end != '/')
1087 break;
1088 color = end + 1;
1089 }
1090 }
74084731 1091 else if (strnicmp (colorname, "rgbi:", 5) == 0)
1edf84e7
GV
1092 {
1093 /* This is an RGB Intensity specification. */
1094 char *color;
1095 UINT colorval;
1096 int i, pos;
1097 pos = 0;
1098
1099 colorval = 0;
1100 color = colorname + 5;
1101 for (i = 0; i < 3; i++)
1102 {
1103 char *end;
1104 double value;
1105 UINT val;
1106
74084731 1107 value = strtod (color, &end);
1edf84e7
GV
1108 if (errno == ERANGE)
1109 break;
1110 if (value < 0.0 || value > 1.0)
1111 break;
1112 val = (UINT)(0x100 * value);
7d0393cf 1113 /* We used 0x100 instead of 0xFF to give a continuous
1edf84e7
GV
1114 range between 0.0 and 1.0 inclusive. The next statement
1115 fixes the 1.0 case. */
1116 if (val == 0x100)
1117 val = 0xFF;
1118 colorval |= (val << pos);
1119 pos += 0x8;
1120 if (i == 2)
1121 {
1122 if (*end != '\0')
1123 break;
1124 UNBLOCK_INPUT;
2ba49441
JR
1125 XSETINT (ret, colorval);
1126 return ret;
1edf84e7
GV
1127 }
1128 if (*end != '/')
1129 break;
1130 color = end + 1;
1131 }
1132 }
1133 /* I am not going to attempt to handle any of the CIE color schemes
1134 or TekHVC, since I don't know the algorithms for conversion to
1135 RGB. */
f695b4b1
GV
1136
1137 /* If we fail to lookup the color name in w32_color_map, then check the
7d0393cf 1138 colorname to see if it can be crudely approximated: If the X color
f695b4b1
GV
1139 ends in a number (e.g., "darkseagreen2"), strip the number and
1140 return the result of looking up the base color name. */
1141 ret = w32_color_map_lookup (colorname);
7d0393cf 1142 if (NILP (ret))
ee78dc32 1143 {
f695b4b1 1144 int len = strlen (colorname);
ee78dc32 1145
7d0393cf 1146 if (isdigit (colorname[len - 1]))
f695b4b1 1147 {
8b77111c 1148 char *ptr, *approx = alloca (len + 1);
ee78dc32 1149
f695b4b1
GV
1150 strcpy (approx, colorname);
1151 ptr = &approx[len - 1];
7d0393cf 1152 while (ptr > approx && isdigit (*ptr))
f695b4b1 1153 *ptr-- = '\0';
ee78dc32 1154
f695b4b1 1155 ret = w32_color_map_lookup (approx);
ee78dc32 1156 }
ee78dc32 1157 }
7d0393cf 1158
ee78dc32 1159 UNBLOCK_INPUT;
ee78dc32
GV
1160 return ret;
1161}
1162
5ac45f98 1163void
fbd6baed 1164w32_regenerate_palette (FRAME_PTR f)
5ac45f98 1165{
fbd6baed 1166 struct w32_palette_entry * list;
5ac45f98
GV
1167 LOGPALETTE * log_palette;
1168 HPALETTE new_palette;
1169 int i;
1170
1171 /* don't bother trying to create palette if not supported */
fbd6baed 1172 if (! FRAME_W32_DISPLAY_INFO (f)->has_palette)
5ac45f98
GV
1173 return;
1174
1175 log_palette = (LOGPALETTE *)
1176 alloca (sizeof (LOGPALETTE) +
fbd6baed 1177 FRAME_W32_DISPLAY_INFO (f)->num_colors * sizeof (PALETTEENTRY));
5ac45f98 1178 log_palette->palVersion = 0x300;
fbd6baed 1179 log_palette->palNumEntries = FRAME_W32_DISPLAY_INFO (f)->num_colors;
5ac45f98 1180
fbd6baed 1181 list = FRAME_W32_DISPLAY_INFO (f)->color_list;
5ac45f98 1182 for (i = 0;
fbd6baed 1183 i < FRAME_W32_DISPLAY_INFO (f)->num_colors;
5ac45f98
GV
1184 i++, list = list->next)
1185 log_palette->palPalEntry[i] = list->entry;
1186
1187 new_palette = CreatePalette (log_palette);
1188
1189 enter_crit ();
1190
fbd6baed
GV
1191 if (FRAME_W32_DISPLAY_INFO (f)->palette)
1192 DeleteObject (FRAME_W32_DISPLAY_INFO (f)->palette);
1193 FRAME_W32_DISPLAY_INFO (f)->palette = new_palette;
5ac45f98
GV
1194
1195 /* Realize display palette and garbage all frames. */
1196 release_frame_dc (f, get_frame_dc (f));
1197
1198 leave_crit ();
1199}
1200
fbd6baed
GV
1201#define W32_COLOR(pe) RGB (pe.peRed, pe.peGreen, pe.peBlue)
1202#define SET_W32_COLOR(pe, color) \
5ac45f98
GV
1203 do \
1204 { \
1205 pe.peRed = GetRValue (color); \
1206 pe.peGreen = GetGValue (color); \
1207 pe.peBlue = GetBValue (color); \
1208 pe.peFlags = 0; \
1209 } while (0)
1210
1211#if 0
1212/* Keep these around in case we ever want to track color usage. */
1213void
fbd6baed 1214w32_map_color (FRAME_PTR f, COLORREF color)
5ac45f98 1215{
fbd6baed 1216 struct w32_palette_entry * list = FRAME_W32_DISPLAY_INFO (f)->color_list;
5ac45f98 1217
fbd6baed 1218 if (NILP (Vw32_enable_palette))
5ac45f98
GV
1219 return;
1220
1221 /* check if color is already mapped */
1222 while (list)
1223 {
fbd6baed 1224 if (W32_COLOR (list->entry) == color)
5ac45f98
GV
1225 {
1226 ++list->refcount;
1227 return;
1228 }
1229 list = list->next;
1230 }
1231
1232 /* not already mapped, so add to list and recreate Windows palette */
fbd6baed
GV
1233 list = (struct w32_palette_entry *)
1234 xmalloc (sizeof (struct w32_palette_entry));
1235 SET_W32_COLOR (list->entry, color);
5ac45f98 1236 list->refcount = 1;
fbd6baed
GV
1237 list->next = FRAME_W32_DISPLAY_INFO (f)->color_list;
1238 FRAME_W32_DISPLAY_INFO (f)->color_list = list;
1239 FRAME_W32_DISPLAY_INFO (f)->num_colors++;
5ac45f98
GV
1240
1241 /* set flag that palette must be regenerated */
fbd6baed 1242 FRAME_W32_DISPLAY_INFO (f)->regen_palette = TRUE;
5ac45f98
GV
1243}
1244
1245void
fbd6baed 1246w32_unmap_color (FRAME_PTR f, COLORREF color)
5ac45f98 1247{
fbd6baed
GV
1248 struct w32_palette_entry * list = FRAME_W32_DISPLAY_INFO (f)->color_list;
1249 struct w32_palette_entry **prev = &FRAME_W32_DISPLAY_INFO (f)->color_list;
5ac45f98 1250
fbd6baed 1251 if (NILP (Vw32_enable_palette))
5ac45f98
GV
1252 return;
1253
1254 /* check if color is already mapped */
1255 while (list)
1256 {
fbd6baed 1257 if (W32_COLOR (list->entry) == color)
5ac45f98
GV
1258 {
1259 if (--list->refcount == 0)
1260 {
1261 *prev = list->next;
1262 xfree (list);
fbd6baed 1263 FRAME_W32_DISPLAY_INFO (f)->num_colors--;
5ac45f98
GV
1264 break;
1265 }
1266 else
1267 return;
1268 }
1269 prev = &list->next;
1270 list = list->next;
1271 }
1272
1273 /* set flag that palette must be regenerated */
fbd6baed 1274 FRAME_W32_DISPLAY_INFO (f)->regen_palette = TRUE;
5ac45f98
GV
1275}
1276#endif
1277
6fc2811b
JR
1278
1279/* Gamma-correct COLOR on frame F. */
1280
1281void
1282gamma_correct (f, color)
1283 struct frame *f;
1284 COLORREF *color;
1285{
1286 if (f->gamma)
1287 {
1288 *color = PALETTERGB (
1289 pow (GetRValue (*color) / 255.0, f->gamma) * 255.0 + 0.5,
1290 pow (GetGValue (*color) / 255.0, f->gamma) * 255.0 + 0.5,
1291 pow (GetBValue (*color) / 255.0, f->gamma) * 255.0 + 0.5);
1292 }
1293}
1294
1295
ee78dc32
GV
1296/* Decide if color named COLOR is valid for the display associated with
1297 the selected frame; if so, return the rgb values in COLOR_DEF.
1298 If ALLOC is nonzero, allocate a new colormap cell. */
1299
1300int
6fc2811b 1301w32_defined_color (f, color, color_def, alloc)
ee78dc32
GV
1302 FRAME_PTR f;
1303 char *color;
6fc2811b 1304 XColor *color_def;
ee78dc32
GV
1305 int alloc;
1306{
1307 register Lisp_Object tem;
6fc2811b 1308 COLORREF w32_color_ref;
3c190163 1309
fbd6baed 1310 tem = x_to_w32_color (color);
3c190163 1311
7d0393cf 1312 if (!NILP (tem))
ee78dc32 1313 {
d88c567c
JR
1314 if (f)
1315 {
1316 /* Apply gamma correction. */
1317 w32_color_ref = XUINT (tem);
1318 gamma_correct (f, &w32_color_ref);
1319 XSETINT (tem, w32_color_ref);
1320 }
9badad41
JR
1321
1322 /* Map this color to the palette if it is enabled. */
fbd6baed 1323 if (!NILP (Vw32_enable_palette))
5ac45f98 1324 {
fbd6baed 1325 struct w32_palette_entry * entry =
d88c567c 1326 one_w32_display_info.color_list;
fbd6baed 1327 struct w32_palette_entry ** prev =
d88c567c 1328 &one_w32_display_info.color_list;
7d0393cf 1329
5ac45f98
GV
1330 /* check if color is already mapped */
1331 while (entry)
1332 {
fbd6baed 1333 if (W32_COLOR (entry->entry) == XUINT (tem))
5ac45f98
GV
1334 break;
1335 prev = &entry->next;
1336 entry = entry->next;
1337 }
1338
1339 if (entry == NULL && alloc)
1340 {
1341 /* not already mapped, so add to list */
fbd6baed
GV
1342 entry = (struct w32_palette_entry *)
1343 xmalloc (sizeof (struct w32_palette_entry));
1344 SET_W32_COLOR (entry->entry, XUINT (tem));
5ac45f98
GV
1345 entry->next = NULL;
1346 *prev = entry;
d88c567c 1347 one_w32_display_info.num_colors++;
5ac45f98
GV
1348
1349 /* set flag that palette must be regenerated */
d88c567c 1350 one_w32_display_info.regen_palette = TRUE;
5ac45f98
GV
1351 }
1352 }
1353 /* Ensure COLORREF value is snapped to nearest color in (default)
1354 palette by simulating the PALETTERGB macro. This works whether
1355 or not the display device has a palette. */
6fc2811b
JR
1356 w32_color_ref = XUINT (tem) | 0x2000000;
1357
6fc2811b 1358 color_def->pixel = w32_color_ref;
197edd35
JR
1359 color_def->red = GetRValue (w32_color_ref) * 256;
1360 color_def->green = GetGValue (w32_color_ref) * 256;
1361 color_def->blue = GetBValue (w32_color_ref) * 256;
6fc2811b 1362
ee78dc32 1363 return 1;
5ac45f98 1364 }
7d0393cf 1365 else
3c190163
GV
1366 {
1367 return 0;
1368 }
ee78dc32
GV
1369}
1370
1371/* Given a string ARG naming a color, compute a pixel value from it
1372 suitable for screen F.
1373 If F is not a color screen, return DEF (default) regardless of what
1374 ARG says. */
1375
1376int
1377x_decode_color (f, arg, def)
1378 FRAME_PTR f;
1379 Lisp_Object arg;
1380 int def;
1381{
6fc2811b 1382 XColor cdef;
ee78dc32 1383
b7826503 1384 CHECK_STRING (arg);
ee78dc32 1385
d5db4077 1386 if (strcmp (SDATA (arg), "black") == 0)
ee78dc32 1387 return BLACK_PIX_DEFAULT (f);
d5db4077 1388 else if (strcmp (SDATA (arg), "white") == 0)
ee78dc32
GV
1389 return WHITE_PIX_DEFAULT (f);
1390
fbd6baed 1391 if ((FRAME_W32_DISPLAY_INFO (f)->n_planes * FRAME_W32_DISPLAY_INFO (f)->n_cbits) == 1)
ee78dc32
GV
1392 return def;
1393
6fc2811b 1394 /* w32_defined_color is responsible for coping with failures
ee78dc32 1395 by looking for a near-miss. */
d5db4077 1396 if (w32_defined_color (f, SDATA (arg), &cdef, 1))
6fc2811b 1397 return cdef.pixel;
ee78dc32
GV
1398
1399 /* defined_color failed; return an ultimate default. */
1400 return def;
1401}
1402\f
6fc2811b
JR
1403
1404
ee78dc32
GV
1405/* Functions called only from `x_set_frame_param'
1406 to set individual parameters.
1407
fbd6baed 1408 If FRAME_W32_WINDOW (f) is 0,
ee78dc32
GV
1409 the frame is being created and its window does not exist yet.
1410 In that case, just record the parameter's new value
1411 in the standard place; do not attempt to change the window. */
1412
1413void
1414x_set_foreground_color (f, arg, oldval)
1415 struct frame *f;
1416 Lisp_Object arg, oldval;
1417{
3cf3436e
JR
1418 struct w32_output *x = f->output_data.w32;
1419 PIX_TYPE fg, old_fg;
1420
1421 fg = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1422 old_fg = FRAME_FOREGROUND_PIXEL (f);
1423 FRAME_FOREGROUND_PIXEL (f) = fg;
5ac45f98 1424
fbd6baed 1425 if (FRAME_W32_WINDOW (f) != 0)
ee78dc32 1426 {
3cf3436e
JR
1427 if (x->cursor_pixel == old_fg)
1428 x->cursor_pixel = fg;
1429
6fc2811b 1430 update_face_from_frame_parameter (f, Qforeground_color, arg);
ee78dc32
GV
1431 if (FRAME_VISIBLE_P (f))
1432 redraw_frame (f);
1433 }
1434}
1435
1436void
1437x_set_background_color (f, arg, oldval)
1438 struct frame *f;
1439 Lisp_Object arg, oldval;
1440{
6fc2811b 1441 FRAME_BACKGROUND_PIXEL (f)
ee78dc32
GV
1442 = x_decode_color (f, arg, WHITE_PIX_DEFAULT (f));
1443
fbd6baed 1444 if (FRAME_W32_WINDOW (f) != 0)
ee78dc32 1445 {
6fc2811b
JR
1446 SetWindowLong (FRAME_W32_WINDOW (f), WND_BACKGROUND_INDEX,
1447 FRAME_BACKGROUND_PIXEL (f));
ee78dc32 1448
6fc2811b 1449 update_face_from_frame_parameter (f, Qbackground_color, arg);
ee78dc32
GV
1450
1451 if (FRAME_VISIBLE_P (f))
1452 redraw_frame (f);
1453 }
1454}
1455
1456void
1457x_set_mouse_color (f, arg, oldval)
1458 struct frame *f;
1459 Lisp_Object arg, oldval;
1460{
7d63e5e3 1461 Cursor cursor, nontext_cursor, mode_cursor, hand_cursor;
dfc465d3 1462 int count;
ee78dc32
GV
1463 int mask_color;
1464
1465 if (!EQ (Qnil, arg))
fbd6baed 1466 f->output_data.w32->mouse_pixel
ee78dc32 1467 = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
6fc2811b
JR
1468 mask_color = FRAME_BACKGROUND_PIXEL (f);
1469
1470 /* Don't let pointers be invisible. */
fbd6baed 1471 if (mask_color == f->output_data.w32->mouse_pixel
6fc2811b
JR
1472 && mask_color == FRAME_BACKGROUND_PIXEL (f))
1473 f->output_data.w32->mouse_pixel = FRAME_FOREGROUND_PIXEL (f);
ee78dc32 1474
767b1ff0 1475#if 0 /* TODO : cursor changes */
ee78dc32
GV
1476 BLOCK_INPUT;
1477
1478 /* It's not okay to crash if the user selects a screwy cursor. */
fadca6c6 1479 count = x_catch_errors (FRAME_W32_DISPLAY (f));
ee78dc32
GV
1480
1481 if (!EQ (Qnil, Vx_pointer_shape))
1482 {
b7826503 1483 CHECK_NUMBER (Vx_pointer_shape);
fbd6baed 1484 cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XINT (Vx_pointer_shape));
ee78dc32
GV
1485 }
1486 else
fbd6baed
GV
1487 cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_xterm);
1488 x_check_errors (FRAME_W32_DISPLAY (f), "bad text pointer cursor: %s");
ee78dc32
GV
1489
1490 if (!EQ (Qnil, Vx_nontext_pointer_shape))
1491 {
b7826503 1492 CHECK_NUMBER (Vx_nontext_pointer_shape);
fbd6baed 1493 nontext_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f),
ee78dc32
GV
1494 XINT (Vx_nontext_pointer_shape));
1495 }
1496 else
fbd6baed
GV
1497 nontext_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_left_ptr);
1498 x_check_errors (FRAME_W32_DISPLAY (f), "bad nontext pointer cursor: %s");
ee78dc32 1499
0af913d7 1500 if (!EQ (Qnil, Vx_hourglass_pointer_shape))
6fc2811b 1501 {
b7826503 1502 CHECK_NUMBER (Vx_hourglass_pointer_shape);
0af913d7
GM
1503 hourglass_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f),
1504 XINT (Vx_hourglass_pointer_shape));
6fc2811b
JR
1505 }
1506 else
0af913d7 1507 hourglass_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_watch);
6fc2811b 1508 x_check_errors (FRAME_W32_DISPLAY (f), "bad busy pointer cursor: %s");
7d0393cf 1509
6fc2811b 1510 x_check_errors (FRAME_W32_DISPLAY (f), "bad nontext pointer cursor: %s");
ee78dc32
GV
1511 if (!EQ (Qnil, Vx_mode_pointer_shape))
1512 {
b7826503 1513 CHECK_NUMBER (Vx_mode_pointer_shape);
fbd6baed 1514 mode_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f),
ee78dc32
GV
1515 XINT (Vx_mode_pointer_shape));
1516 }
1517 else
fbd6baed
GV
1518 mode_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_xterm);
1519 x_check_errors (FRAME_W32_DISPLAY (f), "bad modeline pointer cursor: %s");
ee78dc32
GV
1520
1521 if (!EQ (Qnil, Vx_sensitive_text_pointer_shape))
1522 {
b7826503 1523 CHECK_NUMBER (Vx_sensitive_text_pointer_shape);
7d63e5e3 1524 hand_cursor
fbd6baed 1525 = XCreateFontCursor (FRAME_W32_DISPLAY (f),
ee78dc32
GV
1526 XINT (Vx_sensitive_text_pointer_shape));
1527 }
1528 else
7d63e5e3 1529 hand_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_crosshair);
ee78dc32 1530
4694d762
JR
1531 if (!NILP (Vx_window_horizontal_drag_shape))
1532 {
b7826503 1533 CHECK_NUMBER (Vx_window_horizontal_drag_shape);
4694d762
JR
1534 horizontal_drag_cursor
1535 = XCreateFontCursor (FRAME_X_DISPLAY (f),
1536 XINT (Vx_window_horizontal_drag_shape));
1537 }
1538 else
1539 horizontal_drag_cursor
1540 = XCreateFontCursor (FRAME_X_DISPLAY (f), XC_sb_h_double_arrow);
1541
ee78dc32 1542 /* Check and report errors with the above calls. */
fbd6baed 1543 x_check_errors (FRAME_W32_DISPLAY (f), "can't set cursor shape: %s");
fadca6c6 1544 x_uncatch_errors (FRAME_W32_DISPLAY (f), count);
ee78dc32
GV
1545
1546 {
1547 XColor fore_color, back_color;
1548
fbd6baed 1549 fore_color.pixel = f->output_data.w32->mouse_pixel;
ee78dc32 1550 back_color.pixel = mask_color;
fbd6baed
GV
1551 XQueryColor (FRAME_W32_DISPLAY (f),
1552 DefaultColormap (FRAME_W32_DISPLAY (f),
1553 DefaultScreen (FRAME_W32_DISPLAY (f))),
ee78dc32 1554 &fore_color);
fbd6baed
GV
1555 XQueryColor (FRAME_W32_DISPLAY (f),
1556 DefaultColormap (FRAME_W32_DISPLAY (f),
1557 DefaultScreen (FRAME_W32_DISPLAY (f))),
ee78dc32 1558 &back_color);
fbd6baed 1559 XRecolorCursor (FRAME_W32_DISPLAY (f), cursor,
ee78dc32 1560 &fore_color, &back_color);
fbd6baed 1561 XRecolorCursor (FRAME_W32_DISPLAY (f), nontext_cursor,
ee78dc32 1562 &fore_color, &back_color);
fbd6baed 1563 XRecolorCursor (FRAME_W32_DISPLAY (f), mode_cursor,
ee78dc32 1564 &fore_color, &back_color);
7d63e5e3 1565 XRecolorCursor (FRAME_W32_DISPLAY (f), hand_cursor,
ee78dc32 1566 &fore_color, &back_color);
0af913d7 1567 XRecolorCursor (FRAME_W32_DISPLAY (f), hourglass_cursor,
6fc2811b 1568 &fore_color, &back_color);
ee78dc32
GV
1569 }
1570
fbd6baed 1571 if (FRAME_W32_WINDOW (f) != 0)
6fc2811b 1572 XDefineCursor (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f), cursor);
ee78dc32 1573
fbd6baed
GV
1574 if (cursor != f->output_data.w32->text_cursor && f->output_data.w32->text_cursor != 0)
1575 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->text_cursor);
1576 f->output_data.w32->text_cursor = cursor;
1577
1578 if (nontext_cursor != f->output_data.w32->nontext_cursor
1579 && f->output_data.w32->nontext_cursor != 0)
1580 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->nontext_cursor);
1581 f->output_data.w32->nontext_cursor = nontext_cursor;
1582
0af913d7
GM
1583 if (hourglass_cursor != f->output_data.w32->hourglass_cursor
1584 && f->output_data.w32->hourglass_cursor != 0)
1585 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->hourglass_cursor);
1586 f->output_data.w32->hourglass_cursor = hourglass_cursor;
6fc2811b 1587
fbd6baed
GV
1588 if (mode_cursor != f->output_data.w32->modeline_cursor
1589 && f->output_data.w32->modeline_cursor != 0)
1590 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->modeline_cursor);
1591 f->output_data.w32->modeline_cursor = mode_cursor;
7d0393cf 1592
7d63e5e3
KS
1593 if (hand_cursor != f->output_data.w32->hand_cursor
1594 && f->output_data.w32->hand_cursor != 0)
1595 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->hand_cursor);
1596 f->output_data.w32->hand_cursor = hand_cursor;
fbd6baed
GV
1597
1598 XFlush (FRAME_W32_DISPLAY (f));
ee78dc32 1599 UNBLOCK_INPUT;
6fc2811b
JR
1600
1601 update_face_from_frame_parameter (f, Qmouse_color, arg);
767b1ff0 1602#endif /* TODO */
ee78dc32
GV
1603}
1604
1605void
1606x_set_cursor_color (f, arg, oldval)
1607 struct frame *f;
1608 Lisp_Object arg, oldval;
1609{
70a0239a 1610 unsigned long fore_pixel, pixel;
ee78dc32 1611
dfff8a69 1612 if (!NILP (Vx_cursor_fore_pixel))
ee78dc32 1613 fore_pixel = x_decode_color (f, Vx_cursor_fore_pixel,
70a0239a 1614 WHITE_PIX_DEFAULT (f));
ee78dc32 1615 else
6fc2811b 1616 fore_pixel = FRAME_BACKGROUND_PIXEL (f);
70a0239a 1617
6759f872 1618 pixel = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
7d0393cf 1619
ee78dc32 1620 /* Make sure that the cursor color differs from the background color. */
70a0239a 1621 if (pixel == FRAME_BACKGROUND_PIXEL (f))
ee78dc32 1622 {
70a0239a
JR
1623 pixel = f->output_data.w32->mouse_pixel;
1624 if (pixel == fore_pixel)
6fc2811b 1625 fore_pixel = FRAME_BACKGROUND_PIXEL (f);
ee78dc32 1626 }
70a0239a 1627
ac849ba4 1628 f->output_data.w32->cursor_foreground_pixel = fore_pixel;
70a0239a 1629 f->output_data.w32->cursor_pixel = pixel;
ee78dc32 1630
fbd6baed 1631 if (FRAME_W32_WINDOW (f) != 0)
ee78dc32 1632 {
0327b4cc
JR
1633 BLOCK_INPUT;
1634 /* Update frame's cursor_gc. */
1635 f->output_data.w32->cursor_gc->foreground = fore_pixel;
1636 f->output_data.w32->cursor_gc->background = pixel;
1637
1638 UNBLOCK_INPUT;
1639
ee78dc32
GV
1640 if (FRAME_VISIBLE_P (f))
1641 {
70a0239a
JR
1642 x_update_cursor (f, 0);
1643 x_update_cursor (f, 1);
ee78dc32
GV
1644 }
1645 }
6fc2811b
JR
1646
1647 update_face_from_frame_parameter (f, Qcursor_color, arg);
ee78dc32
GV
1648}
1649
33d52f9c
GV
1650/* Set the border-color of frame F to pixel value PIX.
1651 Note that this does not fully take effect if done before
7d0393cf 1652 F has a window. */
6d906347 1653
33d52f9c
GV
1654void
1655x_set_border_pixel (f, pix)
1656 struct frame *f;
1657 int pix;
1658{
6d906347 1659
33d52f9c
GV
1660 f->output_data.w32->border_pixel = pix;
1661
be786000 1662 if (FRAME_W32_WINDOW (f) != 0 && f->border_width > 0)
33d52f9c
GV
1663 {
1664 if (FRAME_VISIBLE_P (f))
1665 redraw_frame (f);
1666 }
1667}
1668
ee78dc32
GV
1669/* Set the border-color of frame F to value described by ARG.
1670 ARG can be a string naming a color.
1671 The border-color is used for the border that is drawn by the server.
1672 Note that this does not fully take effect if done before
1673 F has a window; it must be redone when the window is created. */
1674
1675void
1676x_set_border_color (f, arg, oldval)
1677 struct frame *f;
1678 Lisp_Object arg, oldval;
1679{
ee78dc32
GV
1680 int pix;
1681
b7826503 1682 CHECK_STRING (arg);
ee78dc32 1683 pix = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
ee78dc32 1684 x_set_border_pixel (f, pix);
6fc2811b 1685 update_face_from_frame_parameter (f, Qborder_color, arg);
ee78dc32
GV
1686}
1687
dfff8a69
JR
1688
1689void
1690x_set_cursor_type (f, arg, oldval)
1691 FRAME_PTR f;
1692 Lisp_Object arg, oldval;
1693{
50e363e6 1694 set_frame_cursor_types (f, arg);
ee78dc32 1695
623cdbf2 1696 /* Make sure the cursor gets redrawn. */
c922a224 1697 cursor_type_changed = 1;
ee78dc32 1698}
dfff8a69 1699\f
ee78dc32
GV
1700void
1701x_set_icon_type (f, arg, oldval)
1702 struct frame *f;
1703 Lisp_Object arg, oldval;
1704{
ee78dc32
GV
1705 int result;
1706
eb7576ce
GV
1707 if (NILP (arg) && NILP (oldval))
1708 return;
1709
7d0393cf 1710 if (STRINGP (arg) && STRINGP (oldval)
eb7576ce
GV
1711 && EQ (Fstring_equal (oldval, arg), Qt))
1712 return;
1713
1714 if (SYMBOLP (arg) && SYMBOLP (oldval) && EQ (arg, oldval))
ee78dc32
GV
1715 return;
1716
1717 BLOCK_INPUT;
ee78dc32 1718
eb7576ce 1719 result = x_bitmap_icon (f, arg);
ee78dc32
GV
1720 if (result)
1721 {
1722 UNBLOCK_INPUT;
1723 error ("No icon window available");
1724 }
1725
ee78dc32 1726 UNBLOCK_INPUT;
ee78dc32
GV
1727}
1728
ee78dc32
GV
1729void
1730x_set_icon_name (f, arg, oldval)
1731 struct frame *f;
1732 Lisp_Object arg, oldval;
1733{
ee78dc32
GV
1734 if (STRINGP (arg))
1735 {
1736 if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
1737 return;
1738 }
3f65d6f5 1739 else if (!NILP (arg) || NILP (oldval))
ee78dc32
GV
1740 return;
1741
1742 f->icon_name = arg;
1743
1744#if 0
fbd6baed 1745 if (f->output_data.w32->icon_bitmap != 0)
ee78dc32
GV
1746 return;
1747
1748 BLOCK_INPUT;
1749
1750 result = x_text_icon (f,
d5db4077
KR
1751 (char *) SDATA ((!NILP (f->icon_name)
1752 ? f->icon_name
1753 : !NILP (f->title)
1754 ? f->title
1755 : f->name)));
ee78dc32
GV
1756
1757 if (result)
1758 {
1759 UNBLOCK_INPUT;
1760 error ("No icon window available");
1761 }
1762
1763 /* If the window was unmapped (and its icon was mapped),
1764 the new icon is not mapped, so map the window in its stead. */
1765 if (FRAME_VISIBLE_P (f))
1766 {
1767#ifdef USE_X_TOOLKIT
fbd6baed 1768 XtPopup (f->output_data.w32->widget, XtGrabNone);
ee78dc32 1769#endif
fbd6baed 1770 XMapWindow (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f));
ee78dc32
GV
1771 }
1772
fbd6baed 1773 XFlush (FRAME_W32_DISPLAY (f));
ee78dc32
GV
1774 UNBLOCK_INPUT;
1775#endif
1776}
1777
a1258667 1778\f
ee78dc32
GV
1779void
1780x_set_menu_bar_lines (f, value, oldval)
1781 struct frame *f;
1782 Lisp_Object value, oldval;
1783{
1784 int nlines;
1785 int olines = FRAME_MENU_BAR_LINES (f);
1786
1787 /* Right now, menu bars don't work properly in minibuf-only frames;
1788 most of the commands try to apply themselves to the minibuffer
6fc2811b 1789 frame itself, and get an error because you can't switch buffers
ee78dc32
GV
1790 in or split the minibuffer window. */
1791 if (FRAME_MINIBUF_ONLY_P (f))
1792 return;
1793
1794 if (INTEGERP (value))
1795 nlines = XINT (value);
1796 else
1797 nlines = 0;
1798
1799 FRAME_MENU_BAR_LINES (f) = 0;
1800 if (nlines)
1801 FRAME_EXTERNAL_MENU_BAR (f) = 1;
1802 else
1803 {
1804 if (FRAME_EXTERNAL_MENU_BAR (f) == 1)
1805 free_frame_menubar (f);
1806 FRAME_EXTERNAL_MENU_BAR (f) = 0;
1edf84e7
GV
1807
1808 /* Adjust the frame size so that the client (text) dimensions
1809 remain the same. This depends on FRAME_EXTERNAL_MENU_BAR being
1810 set correctly. */
be786000 1811 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
6fc2811b 1812 do_pending_window_change (0);
ee78dc32 1813 }
6fc2811b
JR
1814 adjust_glyphs (f);
1815}
1816
1817
1818/* Set the number of lines used for the tool bar of frame F to VALUE.
1819 VALUE not an integer, or < 0 means set the lines to zero. OLDVAL
1820 is the old number of tool bar lines. This function changes the
1821 height of all windows on frame F to match the new tool bar height.
1822 The frame's height doesn't change. */
1823
1824void
1825x_set_tool_bar_lines (f, value, oldval)
1826 struct frame *f;
1827 Lisp_Object value, oldval;
1828{
36f8209a
JR
1829 int delta, nlines, root_height;
1830 Lisp_Object root_window;
6fc2811b 1831
dc220243
JR
1832 /* Treat tool bars like menu bars. */
1833 if (FRAME_MINIBUF_ONLY_P (f))
1834 return;
1835
6fc2811b
JR
1836 /* Use VALUE only if an integer >= 0. */
1837 if (INTEGERP (value) && XINT (value) >= 0)
1838 nlines = XFASTINT (value);
1839 else
1840 nlines = 0;
1841
1842 /* Make sure we redisplay all windows in this frame. */
1843 ++windows_or_buffers_changed;
1844
1845 delta = nlines - FRAME_TOOL_BAR_LINES (f);
36f8209a
JR
1846
1847 /* Don't resize the tool-bar to more than we have room for. */
1848 root_window = FRAME_ROOT_WINDOW (f);
be786000 1849 root_height = WINDOW_TOTAL_LINES (XWINDOW (root_window));
36f8209a
JR
1850 if (root_height - delta < 1)
1851 {
1852 delta = root_height - 1;
1853 nlines = FRAME_TOOL_BAR_LINES (f) + delta;
1854 }
1855
6fc2811b 1856 FRAME_TOOL_BAR_LINES (f) = nlines;
6d906347 1857 change_window_heights (root_window, delta);
6fc2811b 1858 adjust_glyphs (f);
36f8209a
JR
1859
1860 /* We also have to make sure that the internal border at the top of
1861 the frame, below the menu bar or tool bar, is redrawn when the
1862 tool bar disappears. This is so because the internal border is
1863 below the tool bar if one is displayed, but is below the menu bar
1864 if there isn't a tool bar. The tool bar draws into the area
1865 below the menu bar. */
1866 if (FRAME_W32_WINDOW (f) && FRAME_TOOL_BAR_LINES (f) == 0)
1867 {
2dc8b986 1868 clear_frame (f);
36f8209a 1869 clear_current_matrices (f);
36f8209a
JR
1870 }
1871
1872 /* If the tool bar gets smaller, the internal border below it
1873 has to be cleared. It was formerly part of the display
1874 of the larger tool bar, and updating windows won't clear it. */
1875 if (delta < 0)
1876 {
1877 int height = FRAME_INTERNAL_BORDER_WIDTH (f);
be786000
KS
1878 int width = FRAME_PIXEL_WIDTH (f);
1879 int y = nlines * FRAME_LINE_HEIGHT (f);
36f8209a
JR
1880
1881 BLOCK_INPUT;
1882 {
1883 HDC hdc = get_frame_dc (f);
1884 w32_clear_area (f, hdc, 0, y, width, height);
1885 release_frame_dc (f, hdc);
1886 }
1887 UNBLOCK_INPUT;
3cf3436e
JR
1888
1889 if (WINDOWP (f->tool_bar_window))
1890 clear_glyph_matrix (XWINDOW (f->tool_bar_window)->current_matrix);
36f8209a 1891 }
ee78dc32
GV
1892}
1893
6fc2811b 1894
ee78dc32 1895/* Change the name of frame F to NAME. If NAME is nil, set F's name to
fbd6baed 1896 w32_id_name.
ee78dc32
GV
1897
1898 If EXPLICIT is non-zero, that indicates that lisp code is setting the
1899 name; if NAME is a string, set F's name to NAME and set
1900 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
1901
1902 If EXPLICIT is zero, that indicates that Emacs redisplay code is
1903 suggesting a new name, which lisp code should override; if
1904 F->explicit_name is set, ignore the new name; otherwise, set it. */
1905
1906void
1907x_set_name (f, name, explicit)
1908 struct frame *f;
1909 Lisp_Object name;
1910 int explicit;
1911{
7d0393cf 1912 /* Make sure that requests from lisp code override requests from
ee78dc32
GV
1913 Emacs redisplay code. */
1914 if (explicit)
1915 {
1916 /* If we're switching from explicit to implicit, we had better
1917 update the mode lines and thereby update the title. */
1918 if (f->explicit_name && NILP (name))
1919 update_mode_lines = 1;
1920
1921 f->explicit_name = ! NILP (name);
1922 }
1923 else if (f->explicit_name)
1924 return;
1925
fbd6baed 1926 /* If NAME is nil, set the name to the w32_id_name. */
ee78dc32
GV
1927 if (NILP (name))
1928 {
1929 /* Check for no change needed in this very common case
1930 before we do any consing. */
fbd6baed 1931 if (!strcmp (FRAME_W32_DISPLAY_INFO (f)->w32_id_name,
d5db4077 1932 SDATA (f->name)))
ee78dc32 1933 return;
fbd6baed 1934 name = build_string (FRAME_W32_DISPLAY_INFO (f)->w32_id_name);
ee78dc32
GV
1935 }
1936 else
b7826503 1937 CHECK_STRING (name);
ee78dc32
GV
1938
1939 /* Don't change the name if it's already NAME. */
1940 if (! NILP (Fstring_equal (name, f->name)))
1941 return;
1942
1edf84e7
GV
1943 f->name = name;
1944
1945 /* For setting the frame title, the title parameter should override
1946 the name parameter. */
1947 if (! NILP (f->title))
1948 name = f->title;
1949
fbd6baed 1950 if (FRAME_W32_WINDOW (f))
ee78dc32 1951 {
6fc2811b 1952 if (STRING_MULTIBYTE (name))
dfff8a69 1953 name = ENCODE_SYSTEM (name);
6fc2811b 1954
ee78dc32 1955 BLOCK_INPUT;
74084731 1956 SetWindowText (FRAME_W32_WINDOW (f), SDATA (name));
ee78dc32
GV
1957 UNBLOCK_INPUT;
1958 }
ee78dc32
GV
1959}
1960
1961/* This function should be called when the user's lisp code has
1962 specified a name for the frame; the name will override any set by the
1963 redisplay code. */
1964void
1965x_explicitly_set_name (f, arg, oldval)
1966 FRAME_PTR f;
1967 Lisp_Object arg, oldval;
1968{
1969 x_set_name (f, arg, 1);
1970}
1971
1972/* This function should be called by Emacs redisplay code to set the
1973 name; names set this way will never override names set by the user's
1974 lisp code. */
1975void
1976x_implicitly_set_name (f, arg, oldval)
1977 FRAME_PTR f;
1978 Lisp_Object arg, oldval;
1979{
1980 x_set_name (f, arg, 0);
1981}
1edf84e7
GV
1982\f
1983/* Change the title of frame F to NAME.
40aa4c27 1984 If NAME is nil, use the frame name as the title. */
ee78dc32 1985
1edf84e7 1986void
6fc2811b 1987x_set_title (f, name, old_name)
1edf84e7 1988 struct frame *f;
6fc2811b 1989 Lisp_Object name, old_name;
1edf84e7
GV
1990{
1991 /* Don't change the title if it's already NAME. */
1992 if (EQ (name, f->title))
1993 return;
1994
1995 update_mode_lines = 1;
1996
1997 f->title = name;
1998
1999 if (NILP (name))
2000 name = f->name;
2001
2002 if (FRAME_W32_WINDOW (f))
2003 {
6fc2811b 2004 if (STRING_MULTIBYTE (name))
dfff8a69 2005 name = ENCODE_SYSTEM (name);
6fc2811b 2006
1edf84e7 2007 BLOCK_INPUT;
74084731 2008 SetWindowText (FRAME_W32_WINDOW (f), SDATA (name));
1edf84e7
GV
2009 UNBLOCK_INPUT;
2010 }
2011}
ee78dc32 2012
ee78dc32 2013
19f093e5 2014void x_set_scroll_bar_default_width (f)
ee78dc32 2015 struct frame *f;
ee78dc32 2016{
be786000 2017 int wid = FRAME_COLUMN_WIDTH (f);
6fc2811b 2018
be786000
KS
2019 FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = GetSystemMetrics (SM_CXVSCROLL);
2020 FRAME_CONFIG_SCROLL_BAR_COLS (f) = (FRAME_CONFIG_SCROLL_BAR_WIDTH (f) +
2021 wid - 1) / wid;
ee78dc32 2022}
6d906347 2023
ee78dc32 2024\f
7d0393cf 2025/* Subroutines of creating a frame. */
ee78dc32 2026
ee78dc32
GV
2027
2028/* Return the value of parameter PARAM.
2029
2030 First search ALIST, then Vdefault_frame_alist, then the X defaults
2031 database, using ATTRIBUTE as the attribute name and CLASS as its class.
2032
2033 Convert the resource to the type specified by desired_type.
2034
2035 If no default is specified, return Qunbound. If you call
6fc2811b 2036 w32_get_arg, make sure you deal with Qunbound in a reasonable way,
ee78dc32
GV
2037 and don't let it get stored in any Lisp-visible variables! */
2038
2039static Lisp_Object
6fc2811b 2040w32_get_arg (alist, param, attribute, class, type)
ee78dc32
GV
2041 Lisp_Object alist, param;
2042 char *attribute;
2043 char *class;
2044 enum resource_types type;
2045{
6d906347
KS
2046 return x_get_arg (check_x_display_info (Qnil),
2047 alist, param, attribute, class, type);
ee78dc32
GV
2048}
2049
2050\f
c9b2104d
JR
2051Cursor
2052w32_load_cursor (LPCTSTR name)
2053{
2054 /* Try first to load cursor from application resource. */
74084731 2055 Cursor cursor = LoadImage ((HINSTANCE) GetModuleHandle (NULL),
c9b2104d
JR
2056 name, IMAGE_CURSOR, 0, 0,
2057 LR_DEFAULTCOLOR | LR_DEFAULTSIZE | LR_SHARED);
2058 if (!cursor)
2059 {
2060 /* Then try to load a shared predefined cursor. */
2061 cursor = LoadImage (NULL, name, IMAGE_CURSOR, 0, 0,
2062 LR_DEFAULTCOLOR | LR_DEFAULTSIZE | LR_SHARED);
2063 }
2064 return cursor;
2065}
ee78dc32 2066
fbd6baed 2067extern LRESULT CALLBACK w32_wnd_proc ();
ee78dc32 2068
74084731 2069static BOOL
fbd6baed 2070w32_init_class (hinst)
ee78dc32
GV
2071 HINSTANCE hinst;
2072{
2073 WNDCLASS wc;
2074
5ac45f98 2075 wc.style = CS_HREDRAW | CS_VREDRAW;
fbd6baed 2076 wc.lpfnWndProc = (WNDPROC) w32_wnd_proc;
ee78dc32
GV
2077 wc.cbClsExtra = 0;
2078 wc.cbWndExtra = WND_EXTRA_BYTES;
2079 wc.hInstance = hinst;
2080 wc.hIcon = LoadIcon (hinst, EMACS_CLASS);
c9b2104d 2081 wc.hCursor = w32_load_cursor (IDC_ARROW);
4587b026 2082 wc.hbrBackground = NULL; /* GetStockObject (WHITE_BRUSH); */
ee78dc32
GV
2083 wc.lpszMenuName = NULL;
2084 wc.lpszClassName = EMACS_CLASS;
2085
2086 return (RegisterClass (&wc));
2087}
2088
74084731 2089static HWND
fbd6baed 2090w32_createscrollbar (f, bar)
ee78dc32
GV
2091 struct frame *f;
2092 struct scroll_bar * bar;
2093{
2094 return (CreateWindow ("SCROLLBAR", "", SBS_VERT | WS_CHILD | WS_VISIBLE,
2095 /* Position and size of scroll bar. */
74084731
JB
2096 XINT (bar->left) + VERTICAL_SCROLL_BAR_WIDTH_TRIM,
2097 XINT (bar->top),
2098 XINT (bar->width) - VERTICAL_SCROLL_BAR_WIDTH_TRIM * 2,
2099 XINT (bar->height),
fbd6baed 2100 FRAME_W32_WINDOW (f),
ee78dc32
GV
2101 NULL,
2102 hinst,
2103 NULL));
2104}
2105
74084731 2106static void
fbd6baed 2107w32_createwindow (f)
ee78dc32
GV
2108 struct frame *f;
2109{
2110 HWND hwnd;
1edf84e7 2111 RECT rect;
df70725f
EZ
2112 Lisp_Object top = Qunbound;
2113 Lisp_Object left = Qunbound;
1edf84e7
GV
2114
2115 rect.left = rect.top = 0;
be786000
KS
2116 rect.right = FRAME_PIXEL_WIDTH (f);
2117 rect.bottom = FRAME_PIXEL_HEIGHT (f);
7d0393cf 2118
1edf84e7
GV
2119 AdjustWindowRect (&rect, f->output_data.w32->dwStyle,
2120 FRAME_EXTERNAL_MENU_BAR (f));
7d0393cf 2121
ee78dc32 2122 /* Do first time app init */
7d0393cf 2123
ee78dc32
GV
2124 if (!hprevinst)
2125 {
fbd6baed 2126 w32_init_class (hinst);
ee78dc32 2127 }
7d0393cf 2128
2770d589
JR
2129 if (f->size_hint_flags & USPosition || f->size_hint_flags & PPosition)
2130 {
2131 XSETINT (left, f->left_pos);
2132 XSETINT (top, f->top_pos);
2133 }
2134 else if (EQ (left, Qunbound) && EQ (top, Qunbound))
df70725f
EZ
2135 {
2136 /* When called with RES_TYPE_NUMBER, w32_get_arg will return zero
2137 for anything that is not a number and is not Qunbound. */
2138 left = w32_get_arg (Qnil, Qleft, "left", "Left", RES_TYPE_NUMBER);
2139 top = w32_get_arg (Qnil, Qtop, "top", "Top", RES_TYPE_NUMBER);
2140 }
48b62d10 2141
1edf84e7
GV
2142 FRAME_W32_WINDOW (f) = hwnd
2143 = CreateWindow (EMACS_CLASS,
2144 f->namebuf,
9ead1b60 2145 f->output_data.w32->dwStyle | WS_CLIPCHILDREN,
48b62d10
EZ
2146 EQ (left, Qunbound) ? CW_USEDEFAULT : XINT (left),
2147 EQ (top, Qunbound) ? CW_USEDEFAULT : XINT (top),
1edf84e7
GV
2148 rect.right - rect.left,
2149 rect.bottom - rect.top,
2150 NULL,
2151 NULL,
2152 hinst,
2153 NULL);
2154
ee78dc32
GV
2155 if (hwnd)
2156 {
be786000
KS
2157 SetWindowLong (hwnd, WND_FONTWIDTH_INDEX, FRAME_COLUMN_WIDTH (f));
2158 SetWindowLong (hwnd, WND_LINEHEIGHT_INDEX, FRAME_LINE_HEIGHT (f));
2159 SetWindowLong (hwnd, WND_BORDER_INDEX, FRAME_INTERNAL_BORDER_WIDTH (f));
2160 SetWindowLong (hwnd, WND_SCROLLBAR_INDEX, f->scroll_bar_actual_width);
6fc2811b 2161 SetWindowLong (hwnd, WND_BACKGROUND_INDEX, FRAME_BACKGROUND_PIXEL (f));
ee78dc32 2162
cb9e33d4
RS
2163 /* Enable drag-n-drop. */
2164 DragAcceptFiles (hwnd, TRUE);
7d0393cf 2165
5ac45f98
GV
2166 /* Do this to discard the default setting specified by our parent. */
2167 ShowWindow (hwnd, SW_HIDE);
1771bb6e
EZ
2168
2169 /* Update frame positions. */
2170 GetWindowRect (hwnd, &rect);
2171 f->left_pos = rect.left;
2172 f->top_pos = rect.top;
3c190163 2173 }
3c190163
GV
2174}
2175
74084731 2176static void
ee78dc32 2177my_post_msg (wmsg, hwnd, msg, wParam, lParam)
fbd6baed 2178 W32Msg * wmsg;
ee78dc32
GV
2179 HWND hwnd;
2180 UINT msg;
2181 WPARAM wParam;
2182 LPARAM lParam;
2183{
2184 wmsg->msg.hwnd = hwnd;
2185 wmsg->msg.message = msg;
2186 wmsg->msg.wParam = wParam;
2187 wmsg->msg.lParam = lParam;
2188 wmsg->msg.time = GetMessageTime ();
2189
2190 post_msg (wmsg);
2191}
2192
e9e23e23 2193/* GetKeyState and MapVirtualKey on Windows 95 do not actually distinguish
a1a80b40
GV
2194 between left and right keys as advertised. We test for this
2195 support dynamically, and set a flag when the support is absent. If
2196 absent, we keep track of the left and right control and alt keys
2197 ourselves. This is particularly necessary on keyboards that rely
2198 upon the AltGr key, which is represented as having the left control
2199 and right alt keys pressed. For these keyboards, we need to know
2200 when the left alt key has been pressed in addition to the AltGr key
2201 so that we can properly support M-AltGr-key sequences (such as M-@
2202 on Swedish keyboards). */
2203
2204#define EMACS_LCONTROL 0
2205#define EMACS_RCONTROL 1
2206#define EMACS_LMENU 2
2207#define EMACS_RMENU 3
2208
2209static int modifiers[4];
2210static int modifiers_recorded;
2211static int modifier_key_support_tested;
2212
2213static void
2214test_modifier_support (unsigned int wparam)
2215{
2216 unsigned int l, r;
2217
2218 if (wparam != VK_CONTROL && wparam != VK_MENU)
2219 return;
2220 if (wparam == VK_CONTROL)
2221 {
2222 l = VK_LCONTROL;
2223 r = VK_RCONTROL;
2224 }
2225 else
2226 {
2227 l = VK_LMENU;
2228 r = VK_RMENU;
2229 }
2230 if (!(GetKeyState (l) & 0x8000) && !(GetKeyState (r) & 0x8000))
2231 modifiers_recorded = 1;
2232 else
2233 modifiers_recorded = 0;
2234 modifier_key_support_tested = 1;
2235}
2236
2237static void
2238record_keydown (unsigned int wparam, unsigned int lparam)
2239{
2240 int i;
2241
2242 if (!modifier_key_support_tested)
2243 test_modifier_support (wparam);
2244
2245 if ((wparam != VK_CONTROL && wparam != VK_MENU) || !modifiers_recorded)
2246 return;
2247
2248 if (wparam == VK_CONTROL)
2249 i = (lparam & 0x1000000) ? EMACS_RCONTROL : EMACS_LCONTROL;
2250 else
2251 i = (lparam & 0x1000000) ? EMACS_RMENU : EMACS_LMENU;
2252
2253 modifiers[i] = 1;
2254}
2255
2256static void
2257record_keyup (unsigned int wparam, unsigned int lparam)
2258{
2259 int i;
2260
2261 if ((wparam != VK_CONTROL && wparam != VK_MENU) || !modifiers_recorded)
2262 return;
2263
2264 if (wparam == VK_CONTROL)
2265 i = (lparam & 0x1000000) ? EMACS_RCONTROL : EMACS_LCONTROL;
2266 else
2267 i = (lparam & 0x1000000) ? EMACS_RMENU : EMACS_LMENU;
2268
2269 modifiers[i] = 0;
2270}
2271
da36a4d6 2272/* Emacs can lose focus while a modifier key has been pressed. When
7d0393cf 2273 it regains focus, be conservative and clear all modifiers since
da36a4d6
GV
2274 we cannot reconstruct the left and right modifier state. */
2275static void
2276reset_modifiers ()
2277{
8681157a
RS
2278 SHORT ctrl, alt;
2279
adcc3809
GV
2280 if (GetFocus () == NULL)
2281 /* Emacs doesn't have keyboard focus. Do nothing. */
da36a4d6 2282 return;
8681157a
RS
2283
2284 ctrl = GetAsyncKeyState (VK_CONTROL);
2285 alt = GetAsyncKeyState (VK_MENU);
2286
8681157a
RS
2287 if (!(ctrl & 0x08000))
2288 /* Clear any recorded control modifier state. */
2289 modifiers[EMACS_RCONTROL] = modifiers[EMACS_LCONTROL] = 0;
2290
2291 if (!(alt & 0x08000))
2292 /* Clear any recorded alt modifier state. */
2293 modifiers[EMACS_RMENU] = modifiers[EMACS_LMENU] = 0;
2294
adcc3809
GV
2295 /* Update the state of all modifier keys, because modifiers used in
2296 hot-key combinations can get stuck on if Emacs loses focus as a
2297 result of a hot-key being pressed. */
2298 {
2299 BYTE keystate[256];
2300
2301#define CURRENT_STATE(key) ((GetAsyncKeyState (key) & 0x8000) >> 8)
2302
2303 GetKeyboardState (keystate);
2304 keystate[VK_SHIFT] = CURRENT_STATE (VK_SHIFT);
2305 keystate[VK_CONTROL] = CURRENT_STATE (VK_CONTROL);
2306 keystate[VK_LCONTROL] = CURRENT_STATE (VK_LCONTROL);
2307 keystate[VK_RCONTROL] = CURRENT_STATE (VK_RCONTROL);
2308 keystate[VK_MENU] = CURRENT_STATE (VK_MENU);
2309 keystate[VK_LMENU] = CURRENT_STATE (VK_LMENU);
2310 keystate[VK_RMENU] = CURRENT_STATE (VK_RMENU);
2311 keystate[VK_LWIN] = CURRENT_STATE (VK_LWIN);
2312 keystate[VK_RWIN] = CURRENT_STATE (VK_RWIN);
2313 keystate[VK_APPS] = CURRENT_STATE (VK_APPS);
2314 SetKeyboardState (keystate);
2315 }
da36a4d6
GV
2316}
2317
7830e24b
RS
2318/* Synchronize modifier state with what is reported with the current
2319 keystroke. Even if we cannot distinguish between left and right
2320 modifier keys, we know that, if no modifiers are set, then neither
2321 the left or right modifier should be set. */
2322static void
2323sync_modifiers ()
2324{
2325 if (!modifiers_recorded)
2326 return;
2327
7d0393cf 2328 if (!(GetKeyState (VK_CONTROL) & 0x8000))
7830e24b
RS
2329 modifiers[EMACS_RCONTROL] = modifiers[EMACS_LCONTROL] = 0;
2330
7d0393cf 2331 if (!(GetKeyState (VK_MENU) & 0x8000))
7830e24b
RS
2332 modifiers[EMACS_RMENU] = modifiers[EMACS_LMENU] = 0;
2333}
2334
a1a80b40
GV
2335static int
2336modifier_set (int vkey)
2337{
ccc2d29c 2338 if (vkey == VK_CAPITAL || vkey == VK_SCROLL)
891560d6 2339 return (GetKeyState (vkey) & 0x1);
a1a80b40
GV
2340 if (!modifiers_recorded)
2341 return (GetKeyState (vkey) & 0x8000);
2342
2343 switch (vkey)
2344 {
2345 case VK_LCONTROL:
2346 return modifiers[EMACS_LCONTROL];
2347 case VK_RCONTROL:
2348 return modifiers[EMACS_RCONTROL];
2349 case VK_LMENU:
2350 return modifiers[EMACS_LMENU];
2351 case VK_RMENU:
2352 return modifiers[EMACS_RMENU];
a1a80b40
GV
2353 }
2354 return (GetKeyState (vkey) & 0x8000);
2355}
2356
ccc2d29c
GV
2357/* Convert between the modifier bits W32 uses and the modifier bits
2358 Emacs uses. */
2359
2360unsigned int
2361w32_key_to_modifier (int key)
2362{
2363 Lisp_Object key_mapping;
2364
2365 switch (key)
2366 {
2367 case VK_LWIN:
2368 key_mapping = Vw32_lwindow_modifier;
2369 break;
2370 case VK_RWIN:
2371 key_mapping = Vw32_rwindow_modifier;
2372 break;
2373 case VK_APPS:
2374 key_mapping = Vw32_apps_modifier;
2375 break;
2376 case VK_SCROLL:
2377 key_mapping = Vw32_scroll_lock_modifier;
2378 break;
2379 default:
2380 key_mapping = Qnil;
2381 }
2382
adcc3809
GV
2383 /* NB. This code runs in the input thread, asychronously to the lisp
2384 thread, so we must be careful to ensure access to lisp data is
2385 thread-safe. The following code is safe because the modifier
2386 variable values are updated atomically from lisp and symbols are
2387 not relocated by GC. Also, we don't have to worry about seeing GC
2388 markbits here. */
2389 if (EQ (key_mapping, Qhyper))
ccc2d29c 2390 return hyper_modifier;
adcc3809 2391 if (EQ (key_mapping, Qsuper))
ccc2d29c 2392 return super_modifier;
adcc3809 2393 if (EQ (key_mapping, Qmeta))
ccc2d29c 2394 return meta_modifier;
adcc3809 2395 if (EQ (key_mapping, Qalt))
ccc2d29c 2396 return alt_modifier;
adcc3809 2397 if (EQ (key_mapping, Qctrl))
ccc2d29c 2398 return ctrl_modifier;
adcc3809 2399 if (EQ (key_mapping, Qcontrol)) /* synonym for ctrl */
ccc2d29c 2400 return ctrl_modifier;
adcc3809 2401 if (EQ (key_mapping, Qshift))
ccc2d29c
GV
2402 return shift_modifier;
2403
2404 /* Don't generate any modifier if not explicitly requested. */
2405 return 0;
2406}
2407
74084731 2408static unsigned int
ccc2d29c
GV
2409w32_get_modifiers ()
2410{
2411 return ((modifier_set (VK_SHIFT) ? shift_modifier : 0) |
2412 (modifier_set (VK_CONTROL) ? ctrl_modifier : 0) |
2413 (modifier_set (VK_LWIN) ? w32_key_to_modifier (VK_LWIN) : 0) |
2414 (modifier_set (VK_RWIN) ? w32_key_to_modifier (VK_RWIN) : 0) |
2415 (modifier_set (VK_APPS) ? w32_key_to_modifier (VK_APPS) : 0) |
2416 (modifier_set (VK_SCROLL) ? w32_key_to_modifier (VK_SCROLL) : 0) |
2417 (modifier_set (VK_MENU) ?
2418 ((NILP (Vw32_alt_is_meta)) ? alt_modifier : meta_modifier) : 0));
2419}
2420
a1a80b40
GV
2421/* We map the VK_* modifiers into console modifier constants
2422 so that we can use the same routines to handle both console
2423 and window input. */
2424
2425static int
ccc2d29c 2426construct_console_modifiers ()
a1a80b40
GV
2427{
2428 int mods;
2429
a1a80b40
GV
2430 mods = 0;
2431 mods |= (modifier_set (VK_SHIFT)) ? SHIFT_PRESSED : 0;
2432 mods |= (modifier_set (VK_CAPITAL)) ? CAPSLOCK_ON : 0;
ccc2d29c
GV
2433 mods |= (modifier_set (VK_SCROLL)) ? SCROLLLOCK_ON : 0;
2434 mods |= (modifier_set (VK_NUMLOCK)) ? NUMLOCK_ON : 0;
a1a80b40
GV
2435 mods |= (modifier_set (VK_LCONTROL)) ? LEFT_CTRL_PRESSED : 0;
2436 mods |= (modifier_set (VK_RCONTROL)) ? RIGHT_CTRL_PRESSED : 0;
2437 mods |= (modifier_set (VK_LMENU)) ? LEFT_ALT_PRESSED : 0;
2438 mods |= (modifier_set (VK_RMENU)) ? RIGHT_ALT_PRESSED : 0;
ccc2d29c
GV
2439 mods |= (modifier_set (VK_LWIN)) ? LEFT_WIN_PRESSED : 0;
2440 mods |= (modifier_set (VK_RWIN)) ? RIGHT_WIN_PRESSED : 0;
2441 mods |= (modifier_set (VK_APPS)) ? APPS_PRESSED : 0;
a1a80b40
GV
2442
2443 return mods;
2444}
2445
ccc2d29c
GV
2446static int
2447w32_get_key_modifiers (unsigned int wparam, unsigned int lparam)
da36a4d6 2448{
ccc2d29c
GV
2449 int mods;
2450
2451 /* Convert to emacs modifiers. */
2452 mods = w32_kbd_mods_to_emacs (construct_console_modifiers (), wparam);
2453
2454 return mods;
2455}
da36a4d6 2456
ccc2d29c
GV
2457unsigned int
2458map_keypad_keys (unsigned int virt_key, unsigned int extended)
2459{
2460 if (virt_key < VK_CLEAR || virt_key > VK_DELETE)
2461 return virt_key;
da36a4d6 2462
ccc2d29c 2463 if (virt_key == VK_RETURN)
da36a4d6
GV
2464 return (extended ? VK_NUMPAD_ENTER : VK_RETURN);
2465
ccc2d29c
GV
2466 if (virt_key >= VK_PRIOR && virt_key <= VK_DOWN)
2467 return (!extended ? (VK_NUMPAD_PRIOR + (virt_key - VK_PRIOR)) : virt_key);
2468
2469 if (virt_key == VK_INSERT || virt_key == VK_DELETE)
2470 return (!extended ? (VK_NUMPAD_INSERT + (virt_key - VK_INSERT)) : virt_key);
2471
2472 if (virt_key == VK_CLEAR)
2473 return (!extended ? VK_NUMPAD_CLEAR : virt_key);
2474
2475 return virt_key;
2476}
2477
2478/* List of special key combinations which w32 would normally capture,
74084731 2479 but Emacs should grab instead. Not directly visible to lisp, to
ccc2d29c
GV
2480 simplify synchronization. Each item is an integer encoding a virtual
2481 key code and modifier combination to capture. */
74084731 2482static Lisp_Object w32_grabbed_keys;
ccc2d29c 2483
74084731 2484#define HOTKEY(vk, mods) make_number (((vk) & 255) | ((mods) << 8))
ccc2d29c
GV
2485#define HOTKEY_ID(k) (XFASTINT (k) & 0xbfff)
2486#define HOTKEY_VK_CODE(k) (XFASTINT (k) & 255)
2487#define HOTKEY_MODIFIERS(k) (XFASTINT (k) >> 8)
2488
2ba49441
JR
2489#define RAW_HOTKEY_ID(k) ((k) & 0xbfff)
2490#define RAW_HOTKEY_VK_CODE(k) ((k) & 255)
2491#define RAW_HOTKEY_MODIFIERS(k) ((k) >> 8)
2492
ccc2d29c
GV
2493/* Register hot-keys for reserved key combinations when Emacs has
2494 keyboard focus, since this is the only way Emacs can receive key
2495 combinations like Alt-Tab which are used by the system. */
2496
2497static void
2498register_hot_keys (hwnd)
2499 HWND hwnd;
2500{
2501 Lisp_Object keylist;
2502
8e50cc2d
SM
2503 /* Use CONSP, since we are called asynchronously. */
2504 for (keylist = w32_grabbed_keys; CONSP (keylist); keylist = XCDR (keylist))
ccc2d29c
GV
2505 {
2506 Lisp_Object key = XCAR (keylist);
2507
2508 /* Deleted entries get set to nil. */
2509 if (!INTEGERP (key))
2510 continue;
2511
2512 RegisterHotKey (hwnd, HOTKEY_ID (key),
2513 HOTKEY_MODIFIERS (key), HOTKEY_VK_CODE (key));
2514 }
2515}
2516
2517static void
2518unregister_hot_keys (hwnd)
2519 HWND hwnd;
2520{
2521 Lisp_Object keylist;
2522
8e50cc2d 2523 for (keylist = w32_grabbed_keys; CONSP (keylist); keylist = XCDR (keylist))
ccc2d29c
GV
2524 {
2525 Lisp_Object key = XCAR (keylist);
2526
2527 if (!INTEGERP (key))
2528 continue;
2529
2530 UnregisterHotKey (hwnd, HOTKEY_ID (key));
2531 }
2532}
2533
5ac45f98
GV
2534/* Main message dispatch loop. */
2535
1edf84e7
GV
2536static void
2537w32_msg_pump (deferred_msg * msg_buf)
5ac45f98
GV
2538{
2539 MSG msg;
ccc2d29c
GV
2540 int result;
2541 HWND focus_window;
93fbe8b7
GV
2542
2543 msh_mousewheel = RegisterWindowMessage (MSH_MOUSEWHEEL);
7d0393cf 2544
5ac45f98
GV
2545 while (GetMessage (&msg, NULL, 0, 0))
2546 {
2547 if (msg.hwnd == NULL)
2548 {
2549 switch (msg.message)
2550 {
3ef68e6b
AI
2551 case WM_NULL:
2552 /* Produced by complete_deferred_msg; just ignore. */
2553 break;
5ac45f98 2554 case WM_EMACS_CREATEWINDOW:
d5781bb6
JR
2555 /* Initialize COM for this window. Even though we don't use it,
2556 some third party shell extensions can cause it to be used in
2557 system dialogs, which causes a crash if it is not initialized.
2558 This is a known bug in Windows, which was fixed long ago, but
2559 the patch for XP is not publically available until XP SP3,
2560 and older versions will never be patched. */
2561 CoInitialize (NULL);
fbd6baed 2562 w32_createwindow ((struct frame *) msg.wParam);
1edf84e7
GV
2563 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE, 0, 0))
2564 abort ();
5ac45f98 2565 break;
dfdb4047
GV
2566 case WM_EMACS_SETLOCALE:
2567 SetThreadLocale (msg.wParam);
2568 /* Reply is not expected. */
2569 break;
ccc2d29c
GV
2570 case WM_EMACS_SETKEYBOARDLAYOUT:
2571 result = (int) ActivateKeyboardLayout ((HKL) msg.wParam, 0);
2572 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE,
2573 result, 0))
2574 abort ();
2575 break;
2576 case WM_EMACS_REGISTER_HOT_KEY:
2577 focus_window = GetFocus ();
2578 if (focus_window != NULL)
2579 RegisterHotKey (focus_window,
2ba49441
JR
2580 RAW_HOTKEY_ID (msg.wParam),
2581 RAW_HOTKEY_MODIFIERS (msg.wParam),
2582 RAW_HOTKEY_VK_CODE (msg.wParam));
ccc2d29c
GV
2583 /* Reply is not expected. */
2584 break;
2585 case WM_EMACS_UNREGISTER_HOT_KEY:
2586 focus_window = GetFocus ();
2587 if (focus_window != NULL)
2ba49441 2588 UnregisterHotKey (focus_window, RAW_HOTKEY_ID (msg.wParam));
adcc3809
GV
2589 /* Mark item as erased. NB: this code must be
2590 thread-safe. The next line is okay because the cons
2591 cell is never made into garbage and is not relocated by
2592 GC. */
2ba49441 2593 XSETCAR ((Lisp_Object) ((EMACS_INT) msg.lParam), Qnil);
ccc2d29c
GV
2594 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE, 0, 0))
2595 abort ();
2596 break;
adcc3809
GV
2597 case WM_EMACS_TOGGLE_LOCK_KEY:
2598 {
2599 int vk_code = (int) msg.wParam;
2600 int cur_state = (GetKeyState (vk_code) & 1);
2ba49441 2601 Lisp_Object new_state = (Lisp_Object) ((EMACS_INT) msg.lParam);
adcc3809
GV
2602
2603 /* NB: This code must be thread-safe. It is safe to
2604 call NILP because symbols are not relocated by GC,
2605 and pointer here is not touched by GC (so the markbit
2606 can't be set). Numbers are safe because they are
2607 immediate values. */
2608 if (NILP (new_state)
2609 || (NUMBERP (new_state)
8edb0a6f 2610 && ((XUINT (new_state)) & 1) != cur_state))
adcc3809
GV
2611 {
2612 one_w32_display_info.faked_key = vk_code;
2613
2614 keybd_event ((BYTE) vk_code,
2615 (BYTE) MapVirtualKey (vk_code, 0),
2616 KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
2617 keybd_event ((BYTE) vk_code,
2618 (BYTE) MapVirtualKey (vk_code, 0),
2619 KEYEVENTF_EXTENDEDKEY | 0, 0);
2620 keybd_event ((BYTE) vk_code,
2621 (BYTE) MapVirtualKey (vk_code, 0),
2622 KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
2623 cur_state = !cur_state;
2624 }
2625 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE,
2626 cur_state, 0))
2627 abort ();
2628 }
2629 break;
5dff811e
JR
2630#ifdef MSG_DEBUG
2631 /* Broadcast messages make it here, so you need to be looking
2632 for something in particular for this to be useful. */
1edf84e7 2633 default:
1edf84e7 2634 DebPrint (("msg %x not expected by w32_msg_pump\n", msg.message));
5dff811e 2635#endif
5ac45f98
GV
2636 }
2637 }
2638 else
2639 {
2640 DispatchMessage (&msg);
2641 }
1edf84e7
GV
2642
2643 /* Exit nested loop when our deferred message has completed. */
2644 if (msg_buf->completed)
2645 break;
5ac45f98 2646 }
1edf84e7
GV
2647}
2648
2649deferred_msg * deferred_msg_head;
2650
2651static deferred_msg *
2652find_deferred_msg (HWND hwnd, UINT msg)
2653{
2654 deferred_msg * item;
2655
2656 /* Don't actually need synchronization for read access, since
2657 modification of single pointer is always atomic. */
2658 /* enter_crit (); */
2659
2660 for (item = deferred_msg_head; item != NULL; item = item->next)
2661 if (item->w32msg.msg.hwnd == hwnd
2662 && item->w32msg.msg.message == msg)
2663 break;
2664
2665 /* leave_crit (); */
2666
2667 return item;
2668}
2669
2670static LRESULT
2671send_deferred_msg (deferred_msg * msg_buf,
2672 HWND hwnd,
2673 UINT msg,
2674 WPARAM wParam,
2675 LPARAM lParam)
2676{
2677 /* Only input thread can send deferred messages. */
2678 if (GetCurrentThreadId () != dwWindowsThreadId)
2679 abort ();
2680
2681 /* It is an error to send a message that is already deferred. */
2682 if (find_deferred_msg (hwnd, msg) != NULL)
2683 abort ();
2684
2685 /* Enforced synchronization is not needed because this is the only
2686 function that alters deferred_msg_head, and the following critical
2687 section is guaranteed to only be serially reentered (since only the
2688 input thread can call us). */
2689
2690 /* enter_crit (); */
2691
2692 msg_buf->completed = 0;
2693 msg_buf->next = deferred_msg_head;
2694 deferred_msg_head = msg_buf;
2695 my_post_msg (&msg_buf->w32msg, hwnd, msg, wParam, lParam);
2696
2697 /* leave_crit (); */
2698
2699 /* Start a new nested message loop to process other messages until
2700 this one is completed. */
2701 w32_msg_pump (msg_buf);
2702
2703 deferred_msg_head = msg_buf->next;
2704
2705 return msg_buf->result;
2706}
2707
2708void
2709complete_deferred_msg (HWND hwnd, UINT msg, LRESULT result)
2710{
2711 deferred_msg * msg_buf = find_deferred_msg (hwnd, msg);
2712
2713 if (msg_buf == NULL)
74084731 2714 /* Message may have been cancelled, so don't abort. */
3ef68e6b 2715 return;
1edf84e7
GV
2716
2717 msg_buf->result = result;
2718 msg_buf->completed = 1;
2719
2720 /* Ensure input thread is woken so it notices the completion. */
2721 PostThreadMessage (dwWindowsThreadId, WM_NULL, 0, 0);
2722}
2723
74084731 2724static void
3ef68e6b
AI
2725cancel_all_deferred_msgs ()
2726{
2727 deferred_msg * item;
2728
2729 /* Don't actually need synchronization for read access, since
2730 modification of single pointer is always atomic. */
2731 /* enter_crit (); */
2732
2733 for (item = deferred_msg_head; item != NULL; item = item->next)
2734 {
2735 item->result = 0;
2736 item->completed = 1;
2737 }
2738
2739 /* leave_crit (); */
2740
2741 /* Ensure input thread is woken so it notices the completion. */
2742 PostThreadMessage (dwWindowsThreadId, WM_NULL, 0, 0);
2743}
1edf84e7 2744
992dfd90
JR
2745DWORD WINAPI
2746w32_msg_worker (void *arg)
1edf84e7
GV
2747{
2748 MSG msg;
2749 deferred_msg dummy_buf;
2750
2751 /* Ensure our message queue is created */
7d0393cf 2752
1edf84e7 2753 PeekMessage (&msg, NULL, 0, 0, PM_NOREMOVE);
7d0393cf 2754
1edf84e7
GV
2755 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE, 0, 0))
2756 abort ();
2757
2758 memset (&dummy_buf, 0, sizeof (dummy_buf));
2759 dummy_buf.w32msg.msg.hwnd = NULL;
2760 dummy_buf.w32msg.msg.message = WM_NULL;
2761
23f250f4 2762 /* This is the initial message loop which should only exit when the
1edf84e7
GV
2763 application quits. */
2764 w32_msg_pump (&dummy_buf);
2765
2766 return 0;
5ac45f98
GV
2767}
2768
f0c947b5
JR
2769static void
2770signal_user_input ()
2771{
2772 /* Interrupt any lisp that wants to be interrupted by input. */
2773 if (!NILP (Vthrow_on_input))
2774 {
2775 Vquit_flag = Vthrow_on_input;
2776 /* If we're inside a function that wants immediate quits,
2777 do it now. */
2778 if (immediate_quit && NILP (Vinhibit_quit))
2779 {
2780 immediate_quit = 0;
2781 QUIT;
2782 }
2783 }
2784}
2785
2786
3ef68e6b
AI
2787static void
2788post_character_message (hwnd, msg, wParam, lParam, modifiers)
2789 HWND hwnd;
2790 UINT msg;
2791 WPARAM wParam;
2792 LPARAM lParam;
2793 DWORD modifiers;
2794
2795{
2796 W32Msg wmsg;
2797
2798 wmsg.dwModifiers = modifiers;
2799
2800 /* Detect quit_char and set quit-flag directly. Note that we
2801 still need to post a message to ensure the main thread will be
74084731 2802 woken up if blocked in sys_select, but we do NOT want to post
3ef68e6b
AI
2803 the quit_char message itself (because it will usually be as if
2804 the user had typed quit_char twice). Instead, we post a dummy
2805 message that has no particular effect. */
2806 {
2807 int c = wParam;
2808 if (isalpha (c) && wmsg.dwModifiers == ctrl_modifier)
2809 c = make_ctrl_char (c) & 0377;
7d081355
AI
2810 if (c == quit_char
2811 || (wmsg.dwModifiers == 0 &&
2ba49441 2812 w32_quit_key && wParam == w32_quit_key))
3ef68e6b
AI
2813 {
2814 Vquit_flag = Qt;
2815
2816 /* The choice of message is somewhat arbitrary, as long as
2817 the main thread handler just ignores it. */
2818 msg = WM_NULL;
2819
2820 /* Interrupt any blocking system calls. */
2821 signal_quit ();
2822
2823 /* As a safety precaution, forcibly complete any deferred
2824 messages. This is a kludge, but I don't see any particularly
2825 clean way to handle the situation where a deferred message is
2826 "dropped" in the lisp thread, and will thus never be
2827 completed, eg. by the user trying to activate the menubar
2828 when the lisp thread is busy, and then typing C-g when the
2829 menubar doesn't open promptly (with the result that the
2830 menubar never responds at all because the deferred
2831 WM_INITMENU message is never completed). Another problem
2832 situation is when the lisp thread calls SendMessage (to send
2833 a window manager command) when a message has been deferred;
2834 the lisp thread gets blocked indefinitely waiting for the
2835 deferred message to be completed, which itself is waiting for
2836 the lisp thread to respond.
2837
2838 Note that we don't want to block the input thread waiting for
2839 a reponse from the lisp thread (although that would at least
2840 solve the deadlock problem above), because we want to be able
2841 to receive C-g to interrupt the lisp thread. */
2842 cancel_all_deferred_msgs ();
2843 }
f0c947b5
JR
2844 else
2845 signal_user_input ();
3ef68e6b
AI
2846 }
2847
2848 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
2849}
2850
ee78dc32
GV
2851/* Main window procedure */
2852
7d0393cf 2853LRESULT CALLBACK
fbd6baed 2854w32_wnd_proc (hwnd, msg, wParam, lParam)
ee78dc32
GV
2855 HWND hwnd;
2856 UINT msg;
2857 WPARAM wParam;
2858 LPARAM lParam;
2859{
2860 struct frame *f;
fbd6baed
GV
2861 struct w32_display_info *dpyinfo = &one_w32_display_info;
2862 W32Msg wmsg;
84fb1139 2863 int windows_translate;
576ba81c 2864 int key;
84fb1139 2865
a6085637
KH
2866 /* Note that it is okay to call x_window_to_frame, even though we are
2867 not running in the main lisp thread, because frame deletion
2868 requires the lisp thread to synchronize with this thread. Thus, if
2869 a frame struct is returned, it can be used without concern that the
2870 lisp thread might make it disappear while we are using it.
2871
2872 NB. Walking the frame list in this thread is safe (as long as
2873 writes of Lisp_Object slots are atomic, which they are on Windows).
2874 Although delete-frame can destructively modify the frame list while
2875 we are walking it, a garbage collection cannot occur until after
2876 delete-frame has synchronized with this thread.
2877
2878 It is also safe to use functions that make GDI calls, such as
fbd6baed 2879 w32_clear_rect, because these functions must obtain a DC handle
a6085637
KH
2880 from the frame struct using get_frame_dc which is thread-aware. */
2881
7d0393cf 2882 switch (msg)
ee78dc32
GV
2883 {
2884 case WM_ERASEBKGND:
a6085637
KH
2885 f = x_window_to_frame (dpyinfo, hwnd);
2886 if (f)
2887 {
9badad41 2888 HDC hdc = get_frame_dc (f);
a6085637 2889 GetUpdateRect (hwnd, &wmsg.rect, FALSE);
9badad41
JR
2890 w32_clear_rect (f, hdc, &wmsg.rect);
2891 release_frame_dc (f, hdc);
ce6059da
AI
2892
2893#if defined (W32_DEBUG_DISPLAY)
18f0b342
AI
2894 DebPrint (("WM_ERASEBKGND (frame %p): erasing %d,%d-%d,%d\n",
2895 f,
2896 wmsg.rect.left, wmsg.rect.top,
2897 wmsg.rect.right, wmsg.rect.bottom));
ce6059da 2898#endif /* W32_DEBUG_DISPLAY */
a6085637 2899 }
5ac45f98
GV
2900 return 1;
2901 case WM_PALETTECHANGED:
2902 /* ignore our own changes */
2903 if ((HWND)wParam != hwnd)
2904 {
a6085637
KH
2905 f = x_window_to_frame (dpyinfo, hwnd);
2906 if (f)
2907 /* get_frame_dc will realize our palette and force all
2908 frames to be redrawn if needed. */
2909 release_frame_dc (f, get_frame_dc (f));
5ac45f98
GV
2910 }
2911 return 0;
ee78dc32 2912 case WM_PAINT:
ce6059da 2913 {
55dcfc15
AI
2914 PAINTSTRUCT paintStruct;
2915 RECT update_rect;
aa35b6ad 2916 bzero (&update_rect, sizeof (update_rect));
55dcfc15 2917
18f0b342
AI
2918 f = x_window_to_frame (dpyinfo, hwnd);
2919 if (f == 0)
2920 {
2921 DebPrint (("WM_PAINT received for unknown window %p\n", hwnd));
2922 return 0;
2923 }
2924
55dcfc15
AI
2925 /* MSDN Docs say not to call BeginPaint if GetUpdateRect
2926 fails. Apparently this can happen under some
2927 circumstances. */
aa35b6ad 2928 if (GetUpdateRect (hwnd, &update_rect, FALSE) || !w32_strict_painting)
55dcfc15
AI
2929 {
2930 enter_crit ();
2931 BeginPaint (hwnd, &paintStruct);
2932
aa35b6ad
JR
2933 /* The rectangles returned by GetUpdateRect and BeginPaint
2934 do not always match. Play it safe by assuming both areas
2935 are invalid. */
2936 UnionRect (&(wmsg.rect), &update_rect, &(paintStruct.rcPaint));
55dcfc15
AI
2937
2938#if defined (W32_DEBUG_DISPLAY)
18f0b342
AI
2939 DebPrint (("WM_PAINT (frame %p): painting %d,%d-%d,%d\n",
2940 f,
2941 wmsg.rect.left, wmsg.rect.top,
2942 wmsg.rect.right, wmsg.rect.bottom));
2943 DebPrint ((" [update region is %d,%d-%d,%d]\n",
55dcfc15
AI
2944 update_rect.left, update_rect.top,
2945 update_rect.right, update_rect.bottom));
2946#endif
2947 EndPaint (hwnd, &paintStruct);
2948 leave_crit ();
2949
2950 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
7d0393cf 2951
55dcfc15
AI
2952 return 0;
2953 }
c0611964
AI
2954
2955 /* If GetUpdateRect returns 0 (meaning there is no update
2956 region), assume the whole window needs to be repainted. */
74084731 2957 GetClientRect (hwnd, &wmsg.rect);
c0611964
AI
2958 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
2959 return 0;
ee78dc32 2960 }
a1a80b40 2961
ccc2d29c
GV
2962 case WM_INPUTLANGCHANGE:
2963 /* Inform lisp thread of keyboard layout changes. */
2964 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
2965
2966 /* Clear dead keys in the keyboard state; for simplicity only
2967 preserve modifier key states. */
2968 {
2969 int i;
2970 BYTE keystate[256];
2971
2972 GetKeyboardState (keystate);
2973 for (i = 0; i < 256; i++)
2974 if (1
2975 && i != VK_SHIFT
2976 && i != VK_LSHIFT
2977 && i != VK_RSHIFT
2978 && i != VK_CAPITAL
2979 && i != VK_NUMLOCK
2980 && i != VK_SCROLL
2981 && i != VK_CONTROL
2982 && i != VK_LCONTROL
2983 && i != VK_RCONTROL
2984 && i != VK_MENU
2985 && i != VK_LMENU
2986 && i != VK_RMENU
2987 && i != VK_LWIN
2988 && i != VK_RWIN)
2989 keystate[i] = 0;
2990 SetKeyboardState (keystate);
2991 }
2992 goto dflt;
2993
2994 case WM_HOTKEY:
2995 /* Synchronize hot keys with normal input. */
2996 PostMessage (hwnd, WM_KEYDOWN, HIWORD (lParam), 0);
2997 return (0);
2998
a1a80b40
GV
2999 case WM_KEYUP:
3000 case WM_SYSKEYUP:
3001 record_keyup (wParam, lParam);
3002 goto dflt;
3003
ee78dc32
GV
3004 case WM_KEYDOWN:
3005 case WM_SYSKEYDOWN:
ccc2d29c
GV
3006 /* Ignore keystrokes we fake ourself; see below. */
3007 if (dpyinfo->faked_key == wParam)
3008 {
3009 dpyinfo->faked_key = 0;
576ba81c
AI
3010 /* Make sure TranslateMessage sees them though (as long as
3011 they don't produce WM_CHAR messages). This ensures that
3012 indicator lights are toggled promptly on Windows 9x, for
3013 example. */
bf254037 3014 if (wParam < 256 && lispy_function_keys[wParam])
576ba81c
AI
3015 {
3016 windows_translate = 1;
3017 goto translate;
3018 }
3019 return 0;
ccc2d29c
GV
3020 }
3021
7830e24b
RS
3022 /* Synchronize modifiers with current keystroke. */
3023 sync_modifiers ();
a1a80b40 3024 record_keydown (wParam, lParam);
ccc2d29c 3025 wParam = map_keypad_keys (wParam, (lParam & 0x1000000L) != 0);
84fb1139
KH
3026
3027 windows_translate = 0;
ccc2d29c
GV
3028
3029 switch (wParam)
3030 {
3031 case VK_LWIN:
3032 if (NILP (Vw32_pass_lwindow_to_system))
3033 {
3034 /* Prevent system from acting on keyup (which opens the
3035 Start menu if no other key was pressed) by simulating a
3036 press of Space which we will ignore. */
3037 if (GetAsyncKeyState (wParam) & 1)
3038 {
adcc3809 3039 if (NUMBERP (Vw32_phantom_key_code))
576ba81c 3040 key = XUINT (Vw32_phantom_key_code) & 255;
adcc3809 3041 else
576ba81c
AI
3042 key = VK_SPACE;
3043 dpyinfo->faked_key = key;
3044 keybd_event (key, (BYTE) MapVirtualKey (key, 0), 0, 0);
ccc2d29c
GV
3045 }
3046 }
3047 if (!NILP (Vw32_lwindow_modifier))
3048 return 0;
3049 break;
3050 case VK_RWIN:
3051 if (NILP (Vw32_pass_rwindow_to_system))
3052 {
3053 if (GetAsyncKeyState (wParam) & 1)
3054 {
adcc3809 3055 if (NUMBERP (Vw32_phantom_key_code))
576ba81c 3056 key = XUINT (Vw32_phantom_key_code) & 255;
adcc3809 3057 else
576ba81c
AI
3058 key = VK_SPACE;
3059 dpyinfo->faked_key = key;
3060 keybd_event (key, (BYTE) MapVirtualKey (key, 0), 0, 0);
ccc2d29c
GV
3061 }
3062 }
3063 if (!NILP (Vw32_rwindow_modifier))
3064 return 0;
3065 break;
576ba81c 3066 case VK_APPS:
ccc2d29c
GV
3067 if (!NILP (Vw32_apps_modifier))
3068 return 0;
3069 break;
3070 case VK_MENU:
7d0393cf 3071 if (NILP (Vw32_pass_alt_to_system))
adcc3809
GV
3072 /* Prevent DefWindowProc from activating the menu bar if an
3073 Alt key is pressed and released by itself. */
ccc2d29c 3074 return 0;
84fb1139 3075 windows_translate = 1;
ccc2d29c 3076 break;
7d0393cf 3077 case VK_CAPITAL:
ccc2d29c
GV
3078 /* Decide whether to treat as modifier or function key. */
3079 if (NILP (Vw32_enable_caps_lock))
3080 goto disable_lock_key;
adcc3809
GV
3081 windows_translate = 1;
3082 break;
ccc2d29c
GV
3083 case VK_NUMLOCK:
3084 /* Decide whether to treat as modifier or function key. */
3085 if (NILP (Vw32_enable_num_lock))
3086 goto disable_lock_key;
adcc3809
GV
3087 windows_translate = 1;
3088 break;
ccc2d29c
GV
3089 case VK_SCROLL:
3090 /* Decide whether to treat as modifier or function key. */
3091 if (NILP (Vw32_scroll_lock_modifier))
3092 goto disable_lock_key;
adcc3809
GV
3093 windows_translate = 1;
3094 break;
ccc2d29c 3095 disable_lock_key:
adcc3809
GV
3096 /* Ensure the appropriate lock key state (and indicator light)
3097 remains in the same state. We do this by faking another
3098 press of the relevant key. Apparently, this really is the
3099 only way to toggle the state of the indicator lights. */
3100 dpyinfo->faked_key = wParam;
3101 keybd_event ((BYTE) wParam, (BYTE) MapVirtualKey (wParam, 0),
3102 KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
3103 keybd_event ((BYTE) wParam, (BYTE) MapVirtualKey (wParam, 0),
3104 KEYEVENTF_EXTENDEDKEY | 0, 0);
3105 keybd_event ((BYTE) wParam, (BYTE) MapVirtualKey (wParam, 0),
3106 KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
3107 /* Ensure indicator lights are updated promptly on Windows 9x
3108 (TranslateMessage apparently does this), after forwarding
3109 input event. */
3110 post_character_message (hwnd, msg, wParam, lParam,
3111 w32_get_key_modifiers (wParam, lParam));
3112 windows_translate = 1;
ccc2d29c 3113 break;
7d0393cf 3114 case VK_CONTROL:
ccc2d29c
GV
3115 case VK_SHIFT:
3116 case VK_PROCESSKEY: /* Generated by IME. */
3117 windows_translate = 1;
3118 break;
adcc3809
GV
3119 case VK_CANCEL:
3120 /* Windows maps Ctrl-Pause (aka Ctrl-Break) into VK_CANCEL,
3121 which is confusing for purposes of key binding; convert
3122 VK_CANCEL events into VK_PAUSE events. */
3123 wParam = VK_PAUSE;
3124 break;
3125 case VK_PAUSE:
3126 /* Windows maps Ctrl-NumLock into VK_PAUSE, which is confusing
3127 for purposes of key binding; convert these back into
3128 VK_NUMLOCK events, at least when we want to see NumLock key
3129 presses. (Note that there is never any possibility that
3130 VK_PAUSE with Ctrl really is C-Pause as per above.) */
3131 if (NILP (Vw32_enable_num_lock) && modifier_set (VK_CONTROL))
3132 wParam = VK_NUMLOCK;
3133 break;
ccc2d29c
GV
3134 default:
3135 /* If not defined as a function key, change it to a WM_CHAR message. */
bf254037 3136 if (wParam > 255 || !lispy_function_keys[wParam])
ccc2d29c 3137 {
adcc3809
GV
3138 DWORD modifiers = construct_console_modifiers ();
3139
ccc2d29c
GV
3140 if (!NILP (Vw32_recognize_altgr)
3141 && modifier_set (VK_LCONTROL) && modifier_set (VK_RMENU))
3142 {
3143 /* Always let TranslateMessage handle AltGr key chords;
3144 for some reason, ToAscii doesn't always process AltGr
3145 chords correctly. */
3146 windows_translate = 1;
3147 }
adcc3809 3148 else if ((modifiers & (~SHIFT_PRESSED & ~CAPSLOCK_ON)) != 0)
ccc2d29c 3149 {
adcc3809
GV
3150 /* Handle key chords including any modifiers other
3151 than shift directly, in order to preserve as much
3152 modifier information as possible. */
ccc2d29c
GV
3153 if ('A' <= wParam && wParam <= 'Z')
3154 {
3155 /* Don't translate modified alphabetic keystrokes,
3156 so the user doesn't need to constantly switch
3157 layout to type control or meta keystrokes when
3158 the normal layout translates alphabetic
3159 characters to non-ascii characters. */
3160 if (!modifier_set (VK_SHIFT))
3161 wParam += ('a' - 'A');
3162 msg = WM_CHAR;
3163 }
3164 else
3165 {
3166 /* Try to handle other keystrokes by determining the
3167 base character (ie. translating the base key plus
3168 shift modifier). */
3169 int add;
3170 int isdead = 0;
3171 KEY_EVENT_RECORD key;
7d0393cf 3172
ccc2d29c
GV
3173 key.bKeyDown = TRUE;
3174 key.wRepeatCount = 1;
3175 key.wVirtualKeyCode = wParam;
3176 key.wVirtualScanCode = (lParam & 0xFF0000) >> 16;
3177 key.uChar.AsciiChar = 0;
adcc3809 3178 key.dwControlKeyState = modifiers;
ccc2d29c
GV
3179
3180 add = w32_kbd_patch_key (&key);
3181 /* 0 means an unrecognised keycode, negative means
3182 dead key. Ignore both. */
3183 while (--add >= 0)
3184 {
3185 /* Forward asciified character sequence. */
3186 post_character_message
a313b291
JR
3187 (hwnd, WM_CHAR,
3188 (unsigned char) key.uChar.AsciiChar, lParam,
ccc2d29c
GV
3189 w32_get_key_modifiers (wParam, lParam));
3190 w32_kbd_patch_key (&key);
3191 }
3192 return 0;
3193 }
3194 }
3195 else
3196 {
3197 /* Let TranslateMessage handle everything else. */
3198 windows_translate = 1;
3199 }
3200 }
3201 }
a1a80b40 3202
adcc3809 3203 translate:
84fb1139
KH
3204 if (windows_translate)
3205 {
e9e23e23 3206 MSG windows_msg = { hwnd, msg, wParam, lParam, 0, {0,0} };
e9e23e23
GV
3207 windows_msg.time = GetMessageTime ();
3208 TranslateMessage (&windows_msg);
84fb1139
KH
3209 goto dflt;
3210 }
3211
ee78dc32 3212 /* Fall through */
7d0393cf 3213
ee78dc32
GV
3214 case WM_SYSCHAR:
3215 case WM_CHAR:
ccc2d29c
GV
3216 post_character_message (hwnd, msg, wParam, lParam,
3217 w32_get_key_modifiers (wParam, lParam));
ee78dc32 3218 break;
da36a4d6 3219
820eff5a
JR
3220 case WM_UNICHAR:
3221 /* WM_UNICHAR looks promising from the docs, but the exact
3222 circumstances in which TranslateMessage sends it is one of those
3223 Microsoft secret API things that EU and US courts are supposed
3224 to have put a stop to already. Spy++ shows it being sent to Notepad
3225 and other MS apps, but never to Emacs.
3226
3227 Some third party IMEs send it in accordance with the official
3228 documentation though, so handle it here.
3229
3230 UNICODE_NOCHAR is used to test for support for this message.
3231 TRUE indicates that the message is supported. */
3232 if (wParam == UNICODE_NOCHAR)
3233 return TRUE;
3234
3235 {
3236 W32Msg wmsg;
3237 wmsg.dwModifiers = w32_get_key_modifiers (wParam, lParam);
3238 signal_user_input ();
3239 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3240 }
3241 break;
3242
3243 case WM_IME_CHAR:
3244 /* If we can't get the IME result as unicode, use default processing,
3245 which will at least allow characters decodable in the system locale
3246 get through. */
3247 if (!get_composition_string_fn)
3248 goto dflt;
3249
3250 else if (!ignore_ime_char)
3251 {
3252 wchar_t * buffer;
3253 int size, i;
3254 W32Msg wmsg;
3255 HIMC context = get_ime_context_fn (hwnd);
3256 wmsg.dwModifiers = w32_get_key_modifiers (wParam, lParam);
3257 /* Get buffer size. */
3258 size = get_composition_string_fn (context, GCS_RESULTSTR, buffer, 0);
3259 buffer = alloca(size);
3260 size = get_composition_string_fn (context, GCS_RESULTSTR,
3261 buffer, size);
3262 signal_user_input ();
3263 for (i = 0; i < size / sizeof (wchar_t); i++)
3264 {
3265 my_post_msg (&wmsg, hwnd, WM_UNICHAR, (WPARAM) buffer[i],
3266 lParam);
3267 }
3268 /* We output the whole string above, so ignore following ones
3269 until we are notified of the end of composition. */
3270 ignore_ime_char = 1;
3271 }
3272 break;
3273
3274 case WM_IME_ENDCOMPOSITION:
3275 ignore_ime_char = 0;
3276 goto dflt;
3277
5ac45f98
GV
3278 /* Simulate middle mouse button events when left and right buttons
3279 are used together, but only if user has two button mouse. */
ee78dc32 3280 case WM_LBUTTONDOWN:
5ac45f98 3281 case WM_RBUTTONDOWN:
2ba49441 3282 if (w32_num_mouse_buttons > 2)
5ac45f98
GV
3283 goto handle_plain_button;
3284
3285 {
3286 int this = (msg == WM_LBUTTONDOWN) ? LMOUSE : RMOUSE;
3287 int other = (msg == WM_LBUTTONDOWN) ? RMOUSE : LMOUSE;
3288
3cb20f4a
RS
3289 if (button_state & this)
3290 return 0;
5ac45f98
GV
3291
3292 if (button_state == 0)
3293 SetCapture (hwnd);
3294
3295 button_state |= this;
3296
3297 if (button_state & other)
3298 {
84fb1139 3299 if (mouse_button_timer)
5ac45f98 3300 {
84fb1139
KH
3301 KillTimer (hwnd, mouse_button_timer);
3302 mouse_button_timer = 0;
5ac45f98
GV
3303
3304 /* Generate middle mouse event instead. */
3305 msg = WM_MBUTTONDOWN;
3306 button_state |= MMOUSE;
3307 }
3308 else if (button_state & MMOUSE)
3309 {
3310 /* Ignore button event if we've already generated a
3311 middle mouse down event. This happens if the
3312 user releases and press one of the two buttons
3313 after we've faked a middle mouse event. */
3314 return 0;
3315 }
3316 else
3317 {
3318 /* Flush out saved message. */
84fb1139 3319 post_msg (&saved_mouse_button_msg);
5ac45f98 3320 }
fbd6baed 3321 wmsg.dwModifiers = w32_get_modifiers ();
5ac45f98 3322 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
f5f69b6b 3323 signal_user_input ();
5ac45f98
GV
3324
3325 /* Clear message buffer. */
84fb1139 3326 saved_mouse_button_msg.msg.hwnd = 0;
5ac45f98
GV
3327 }
3328 else
3329 {
3330 /* Hold onto message for now. */
84fb1139 3331 mouse_button_timer =
adcc3809 3332 SetTimer (hwnd, MOUSE_BUTTON_ID,
2ba49441 3333 w32_mouse_button_tolerance, NULL);
84fb1139
KH
3334 saved_mouse_button_msg.msg.hwnd = hwnd;
3335 saved_mouse_button_msg.msg.message = msg;
3336 saved_mouse_button_msg.msg.wParam = wParam;
3337 saved_mouse_button_msg.msg.lParam = lParam;
3338 saved_mouse_button_msg.msg.time = GetMessageTime ();
fbd6baed 3339 saved_mouse_button_msg.dwModifiers = w32_get_modifiers ();
5ac45f98
GV
3340 }
3341 }
3342 return 0;
3343
ee78dc32 3344 case WM_LBUTTONUP:
5ac45f98 3345 case WM_RBUTTONUP:
2ba49441 3346 if (w32_num_mouse_buttons > 2)
5ac45f98
GV
3347 goto handle_plain_button;
3348
3349 {
3350 int this = (msg == WM_LBUTTONUP) ? LMOUSE : RMOUSE;
3351 int other = (msg == WM_LBUTTONUP) ? RMOUSE : LMOUSE;
3352
3cb20f4a
RS
3353 if ((button_state & this) == 0)
3354 return 0;
5ac45f98
GV
3355
3356 button_state &= ~this;
3357
3358 if (button_state & MMOUSE)
3359 {
3360 /* Only generate event when second button is released. */
3361 if ((button_state & other) == 0)
3362 {
3363 msg = WM_MBUTTONUP;
3364 button_state &= ~MMOUSE;
3365
3366 if (button_state) abort ();
3367 }
3368 else
3369 return 0;
3370 }
3371 else
3372 {
3373 /* Flush out saved message if necessary. */
84fb1139 3374 if (saved_mouse_button_msg.msg.hwnd)
5ac45f98 3375 {
84fb1139 3376 post_msg (&saved_mouse_button_msg);
5ac45f98
GV
3377 }
3378 }
fbd6baed 3379 wmsg.dwModifiers = w32_get_modifiers ();
5ac45f98 3380 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
f5f69b6b 3381 signal_user_input ();
5ac45f98
GV
3382
3383 /* Always clear message buffer and cancel timer. */
84fb1139
KH
3384 saved_mouse_button_msg.msg.hwnd = 0;
3385 KillTimer (hwnd, mouse_button_timer);
3386 mouse_button_timer = 0;
5ac45f98
GV
3387
3388 if (button_state == 0)
3389 ReleaseCapture ();
3390 }
3391 return 0;
3392
74214547
JR
3393 case WM_XBUTTONDOWN:
3394 case WM_XBUTTONUP:
3395 if (w32_pass_extra_mouse_buttons_to_system)
3396 goto dflt;
3397 /* else fall through and process them. */
ee78dc32
GV
3398 case WM_MBUTTONDOWN:
3399 case WM_MBUTTONUP:
5ac45f98 3400 handle_plain_button:
ee78dc32
GV
3401 {
3402 BOOL up;
1edf84e7 3403 int button;
ee78dc32 3404
b48f9276
EZ
3405 /* Ignore middle and extra buttons as long as the menu is active. */
3406 f = x_window_to_frame (dpyinfo, hwnd);
3407 if (f && f->output_data.w32->menubar_active)
3408 return 0;
3409
74214547 3410 if (parse_button (msg, HIWORD (wParam), &button, &up))
ee78dc32
GV
3411 {
3412 if (up) ReleaseCapture ();
3413 else SetCapture (hwnd);
7d0393cf 3414 button = (button == 0) ? LMOUSE :
1edf84e7
GV
3415 ((button == 1) ? MMOUSE : RMOUSE);
3416 if (up)
3417 button_state &= ~button;
3418 else
3419 button_state |= button;
ee78dc32
GV
3420 }
3421 }
7d0393cf 3422
fbd6baed 3423 wmsg.dwModifiers = w32_get_modifiers ();
ee78dc32 3424 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
f0c947b5 3425 signal_user_input ();
74214547
JR
3426
3427 /* Need to return true for XBUTTON messages, false for others,
3428 to indicate that we processed the message. */
3429 return (msg == WM_XBUTTONDOWN || msg == WM_XBUTTONUP);
5ac45f98 3430
5ac45f98 3431 case WM_MOUSEMOVE:
f93bd8e4
EZ
3432 /* Ignore mouse movements as long as the menu is active. These
3433 movements are processed by the window manager anyway, and
3434 it's wrong to handle them as if they happened on the
3435 underlying frame. */
3436 f = x_window_to_frame (dpyinfo, hwnd);
3437 if (f && f->output_data.w32->menubar_active)
3438 return 0;
3439
9eb16b62
JR
3440 /* If the mouse has just moved into the frame, start tracking
3441 it, so we will be notified when it leaves the frame. Mouse
3442 tracking only works under W98 and NT4 and later. On earlier
3443 versions, there is no way of telling when the mouse leaves the
3444 frame, so we just have to put up with help-echo and mouse
3445 highlighting remaining while the frame is not active. */
3446 if (track_mouse_event_fn && !track_mouse_window)
3447 {
3448 TRACKMOUSEEVENT tme;
3449 tme.cbSize = sizeof (tme);
3450 tme.dwFlags = TME_LEAVE;
3451 tme.hwndTrack = hwnd;
3452
3453 track_mouse_event_fn (&tme);
3454 track_mouse_window = hwnd;
3455 }
3456 case WM_VSCROLL:
2ba49441 3457 if (w32_mouse_move_interval <= 0
84fb1139
KH
3458 || (msg == WM_MOUSEMOVE && button_state == 0))
3459 {
fbd6baed 3460 wmsg.dwModifiers = w32_get_modifiers ();
84fb1139
KH
3461 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3462 return 0;
3463 }
7d0393cf 3464
84fb1139
KH
3465 /* Hang onto mouse move and scroll messages for a bit, to avoid
3466 sending such events to Emacs faster than it can process them.
3467 If we get more events before the timer from the first message
3468 expires, we just replace the first message. */
3469
3470 if (saved_mouse_move_msg.msg.hwnd == 0)
3471 mouse_move_timer =
adcc3809 3472 SetTimer (hwnd, MOUSE_MOVE_ID,
2ba49441 3473 w32_mouse_move_interval, NULL);
84fb1139
KH
3474
3475 /* Hold onto message for now. */
3476 saved_mouse_move_msg.msg.hwnd = hwnd;
3477 saved_mouse_move_msg.msg.message = msg;
3478 saved_mouse_move_msg.msg.wParam = wParam;
3479 saved_mouse_move_msg.msg.lParam = lParam;
3480 saved_mouse_move_msg.msg.time = GetMessageTime ();
fbd6baed 3481 saved_mouse_move_msg.dwModifiers = w32_get_modifiers ();
7d0393cf 3482
84fb1139
KH
3483 return 0;
3484
1edf84e7 3485 case WM_MOUSEWHEEL:
fd142562 3486 case WM_DROPFILES:
1edf84e7
GV
3487 wmsg.dwModifiers = w32_get_modifiers ();
3488 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
f0c947b5 3489 signal_user_input ();
1edf84e7
GV
3490 return 0;
3491
0b151762
JR
3492 case WM_APPCOMMAND:
3493 if (w32_pass_multimedia_buttons_to_system)
3494 goto dflt;
3495 /* Otherwise, pass to lisp, the same way we do with mousehwheel. */
fd142562 3496 case WM_MOUSEHWHEEL:
cb9e33d4
RS
3497 wmsg.dwModifiers = w32_get_modifiers ();
3498 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
f0c947b5 3499 signal_user_input ();
fd142562
JR
3500 /* Non-zero must be returned when WM_MOUSEHWHEEL messages are
3501 handled, to prevent the system trying to handle it by faking
3502 scroll bar events. */
3503 return 1;
cb9e33d4 3504
84fb1139
KH
3505 case WM_TIMER:
3506 /* Flush out saved messages if necessary. */
3507 if (wParam == mouse_button_timer)
5ac45f98 3508 {
84fb1139
KH
3509 if (saved_mouse_button_msg.msg.hwnd)
3510 {
3511 post_msg (&saved_mouse_button_msg);
f0c947b5 3512 signal_user_input ();
84fb1139
KH
3513 saved_mouse_button_msg.msg.hwnd = 0;
3514 }
3515 KillTimer (hwnd, mouse_button_timer);
3516 mouse_button_timer = 0;
3517 }
3518 else if (wParam == mouse_move_timer)
3519 {
3520 if (saved_mouse_move_msg.msg.hwnd)
3521 {
3522 post_msg (&saved_mouse_move_msg);
3523 saved_mouse_move_msg.msg.hwnd = 0;
3524 }
3525 KillTimer (hwnd, mouse_move_timer);
3526 mouse_move_timer = 0;
5ac45f98 3527 }
48094ace
JR
3528 else if (wParam == menu_free_timer)
3529 {
3530 KillTimer (hwnd, menu_free_timer);
3531 menu_free_timer = 0;
27605fa7 3532 f = x_window_to_frame (dpyinfo, hwnd);
5d22ded9 3533 /* If a popup menu is active, don't wipe its strings. */
58e55497 3534 if (menubar_in_use
5d22ded9 3535 && current_popup_menu == NULL)
48094ace
JR
3536 {
3537 /* Free memory used by owner-drawn and help-echo strings. */
3538 w32_free_menu_strings (hwnd);
3539 f->output_data.w32->menubar_active = 0;
58e55497 3540 menubar_in_use = 0;
48094ace
JR
3541 }
3542 }
d148e14d
JR
3543 else if (wParam == hourglass_timer)
3544 {
3545 KillTimer (hwnd, hourglass_timer);
3546 hourglass_timer = 0;
3547 show_hourglass (x_window_to_frame (dpyinfo, hwnd));
3548 }
5ac45f98 3549 return 0;
7d0393cf 3550
84fb1139
KH
3551 case WM_NCACTIVATE:
3552 /* Windows doesn't send us focus messages when putting up and
e9e23e23 3553 taking down a system popup dialog as for Ctrl-Alt-Del on Windows 95.
84fb1139
KH
3554 The only indication we get that something happened is receiving
3555 this message afterwards. So this is a good time to reset our
3556 keyboard modifiers' state. */
3557 reset_modifiers ();
3558 goto dflt;
da36a4d6 3559
1edf84e7 3560 case WM_INITMENU:
487163ac
AI
3561 button_state = 0;
3562 ReleaseCapture ();
1edf84e7
GV
3563 /* We must ensure menu bar is fully constructed and up to date
3564 before allowing user interaction with it. To achieve this
3565 we send this message to the lisp thread and wait for a
3566 reply (whose value is not actually needed) to indicate that
3567 the menu bar is now ready for use, so we can now return.
3568
3569 To remain responsive in the meantime, we enter a nested message
3570 loop that can process all other messages.
3571
3572 However, we skip all this if the message results from calling
3573 TrackPopupMenu - in fact, we must NOT attempt to send the lisp
3574 thread a message because it is blocked on us at this point. We
3575 set menubar_active before calling TrackPopupMenu to indicate
3576 this (there is no possibility of confusion with real menubar
3577 being active). */
3578
3579 f = x_window_to_frame (dpyinfo, hwnd);
3580 if (f
3581 && (f->output_data.w32->menubar_active
3582 /* We can receive this message even in the absence of a
3583 menubar (ie. when the system menu is activated) - in this
3584 case we do NOT want to forward the message, otherwise it
3585 will cause the menubar to suddenly appear when the user
3586 had requested it to be turned off! */
3587 || f->output_data.w32->menubar_widget == NULL))
3588 return 0;
3589
3590 {
3591 deferred_msg msg_buf;
3592
3593 /* Detect if message has already been deferred; in this case
3594 we cannot return any sensible value to ignore this. */
3595 if (find_deferred_msg (hwnd, msg) != NULL)
3596 abort ();
3597
58e55497 3598 menubar_in_use = 1;
90816b86 3599
1edf84e7
GV
3600 return send_deferred_msg (&msg_buf, hwnd, msg, wParam, lParam);
3601 }
3602
3603 case WM_EXITMENULOOP:
3604 f = x_window_to_frame (dpyinfo, hwnd);
3605
5d22ded9
JR
3606 /* If a menu is still active, check again after a short delay,
3607 since Windows often (always?) sends the WM_EXITMENULOOP
3608 before the corresponding WM_COMMAND message.
3609 Don't do this if a popup menu is active, since it is only
3610 menubar menus that require cleaning up in this way.
3611 */
58e55497 3612 if (f && menubar_in_use && current_popup_menu == NULL)
48094ace 3613 menu_free_timer = SetTimer (hwnd, MENU_FREE_ID, MENU_FREE_DELAY, NULL);
d148e14d
JR
3614
3615 /* If hourglass cursor should be displayed, display it now. */
3616 if (f && f->output_data.w32->hourglass_p)
3617 SetCursor (f->output_data.w32->hourglass_cursor);
3618
1edf84e7
GV
3619 goto dflt;
3620
126f2e35 3621 case WM_MENUSELECT:
4e3a1c61
JR
3622 /* Direct handling of help_echo in menus. Should be safe now
3623 that we generate the help_echo by placing a help event in the
3624 keyboard buffer. */
ca56d953 3625 {
ca56d953
JR
3626 HMENU menu = (HMENU) lParam;
3627 UINT menu_item = (UINT) LOWORD (wParam);
3628 UINT flags = (UINT) HIWORD (wParam);
3629
4e3a1c61 3630 w32_menu_display_help (hwnd, menu, menu_item, flags);
ca56d953 3631 }
126f2e35
JR
3632 return 0;
3633
87996783
GV
3634 case WM_MEASUREITEM:
3635 f = x_window_to_frame (dpyinfo, hwnd);
3636 if (f)
3637 {
3638 MEASUREITEMSTRUCT * pMis = (MEASUREITEMSTRUCT *) lParam;
3639
3640 if (pMis->CtlType == ODT_MENU)
3641 {
3642 /* Work out dimensions for popup menu titles. */
3643 char * title = (char *) pMis->itemData;
3644 HDC hdc = GetDC (hwnd);
3645 HFONT menu_font = GetCurrentObject (hdc, OBJ_FONT);
3646 LOGFONT menu_logfont;
3647 HFONT old_font;
3648 SIZE size;
3649
3650 GetObject (menu_font, sizeof (menu_logfont), &menu_logfont);
3651 menu_logfont.lfWeight = FW_BOLD;
3652 menu_font = CreateFontIndirect (&menu_logfont);
3653 old_font = SelectObject (hdc, menu_font);
3654
dfff8a69
JR
3655 pMis->itemHeight = GetSystemMetrics (SM_CYMENUSIZE);
3656 if (title)
3657 {
b4005349
JR
3658 if (unicode_append_menu)
3659 GetTextExtentPoint32W (hdc, (WCHAR *) title,
3660 wcslen ((WCHAR *) title),
3661 &size);
3662 else
3663 GetTextExtentPoint32 (hdc, title, strlen (title), &size);
3664
dfff8a69
JR
3665 pMis->itemWidth = size.cx;
3666 if (pMis->itemHeight < size.cy)
3667 pMis->itemHeight = size.cy;
3668 }
3669 else
3670 pMis->itemWidth = 0;
87996783
GV
3671
3672 SelectObject (hdc, old_font);
3673 DeleteObject (menu_font);
3674 ReleaseDC (hwnd, hdc);
3675 return TRUE;
3676 }
3677 }
3678 return 0;
3679
3680 case WM_DRAWITEM:
3681 f = x_window_to_frame (dpyinfo, hwnd);
3682 if (f)
3683 {
3684 DRAWITEMSTRUCT * pDis = (DRAWITEMSTRUCT *) lParam;
3685
3686 if (pDis->CtlType == ODT_MENU)
3687 {
3688 /* Draw popup menu title. */
3689 char * title = (char *) pDis->itemData;
212da13b
JR
3690 if (title)
3691 {
3692 HDC hdc = pDis->hDC;
3693 HFONT menu_font = GetCurrentObject (hdc, OBJ_FONT);
3694 LOGFONT menu_logfont;
3695 HFONT old_font;
3696
3697 GetObject (menu_font, sizeof (menu_logfont), &menu_logfont);
3698 menu_logfont.lfWeight = FW_BOLD;
3699 menu_font = CreateFontIndirect (&menu_logfont);
3700 old_font = SelectObject (hdc, menu_font);
3701
b4005349
JR
3702 /* Always draw title as if not selected. */
3703 if (unicode_append_menu)
3704 ExtTextOutW (hdc,
3705 pDis->rcItem.left
3706 + GetSystemMetrics (SM_CXMENUCHECK),
3707 pDis->rcItem.top,
3708 ETO_OPAQUE, &pDis->rcItem,
3709 (WCHAR *) title,
3710 wcslen ((WCHAR *) title), NULL);
3711 else
3712 ExtTextOut (hdc,
3713 pDis->rcItem.left
3714 + GetSystemMetrics (SM_CXMENUCHECK),
3715 pDis->rcItem.top,
3716 ETO_OPAQUE, &pDis->rcItem,
3717 title, strlen (title), NULL);
212da13b
JR
3718
3719 SelectObject (hdc, old_font);
3720 DeleteObject (menu_font);
3721 }
87996783
GV
3722 return TRUE;
3723 }
3724 }
3725 return 0;
3726
1edf84e7
GV
3727#if 0
3728 /* Still not right - can't distinguish between clicks in the
3729 client area of the frame from clicks forwarded from the scroll
3730 bars - may have to hook WM_NCHITTEST to remember the mouse
3731 position and then check if it is in the client area ourselves. */
3732 case WM_MOUSEACTIVATE:
3733 /* Discard the mouse click that activates a frame, allowing the
3734 user to click anywhere without changing point (or worse!).
3735 Don't eat mouse clicks on scrollbars though!! */
3736 if (LOWORD (lParam) == HTCLIENT )
3737 return MA_ACTIVATEANDEAT;
3738 goto dflt;
3739#endif
3740
9eb16b62
JR
3741 case WM_MOUSELEAVE:
3742 /* No longer tracking mouse. */
3743 track_mouse_window = NULL;
3744
1edf84e7 3745 case WM_ACTIVATEAPP:
ccc2d29c 3746 case WM_ACTIVATE:
1edf84e7
GV
3747 case WM_WINDOWPOSCHANGED:
3748 case WM_SHOWWINDOW:
3749 /* Inform lisp thread that a frame might have just been obscured
3750 or exposed, so should recheck visibility of all frames. */
3751 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3752 goto dflt;
3753
da36a4d6 3754 case WM_SETFOCUS:
adcc3809
GV
3755 dpyinfo->faked_key = 0;
3756 reset_modifiers ();
ccc2d29c
GV
3757 register_hot_keys (hwnd);
3758 goto command;
8681157a 3759 case WM_KILLFOCUS:
ccc2d29c 3760 unregister_hot_keys (hwnd);
487163ac
AI
3761 button_state = 0;
3762 ReleaseCapture ();
65906840
JR
3763 /* Relinquish the system caret. */
3764 if (w32_system_caret_hwnd)
3765 {
93f2ca61 3766 w32_visible_system_caret_hwnd = NULL;
d285988b
JR
3767 w32_system_caret_hwnd = NULL;
3768 DestroyCaret ();
65906840 3769 }
48094ace
JR
3770 goto command;
3771 case WM_COMMAND:
58e55497 3772 menubar_in_use = 0;
48094ace
JR
3773 f = x_window_to_frame (dpyinfo, hwnd);
3774 if (f && HIWORD (wParam) == 0)
3775 {
48094ace
JR
3776 if (menu_free_timer)
3777 {
3778 KillTimer (hwnd, menu_free_timer);
7d0393cf 3779 menu_free_timer = 0;
48094ace
JR
3780 }
3781 }
ee78dc32
GV
3782 case WM_MOVE:
3783 case WM_SIZE:
ccc2d29c 3784 command:
fbd6baed 3785 wmsg.dwModifiers = w32_get_modifiers ();
ee78dc32
GV
3786 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3787 goto dflt;
8847d890 3788
d5781bb6
JR
3789 case WM_DESTROY:
3790 CoUninitialize ();
3791 return 0;
3792
8847d890 3793 case WM_CLOSE:
fbd6baed 3794 wmsg.dwModifiers = w32_get_modifiers ();
8847d890
RS
3795 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3796 return 0;
3797
ee78dc32 3798 case WM_WINDOWPOSCHANGING:
bfd6edcc
JR
3799 /* Don't restrict the sizing of tip frames. */
3800 if (hwnd == tip_window)
3801 return 0;
ee78dc32
GV
3802 {
3803 WINDOWPLACEMENT wp;
3804 LPWINDOWPOS lppos = (WINDOWPOS *) lParam;
1edf84e7
GV
3805
3806 wp.length = sizeof (WINDOWPLACEMENT);
ee78dc32 3807 GetWindowPlacement (hwnd, &wp);
7d0393cf 3808
1edf84e7 3809 if (wp.showCmd != SW_SHOWMINIMIZED && (lppos->flags & SWP_NOSIZE) == 0)
ee78dc32
GV
3810 {
3811 RECT rect;
3812 int wdiff;
3813 int hdiff;
1edf84e7
GV
3814 DWORD font_width;
3815 DWORD line_height;
3816 DWORD internal_border;
3817 DWORD scrollbar_extra;
ee78dc32 3818 RECT wr;
7d0393cf 3819
74084731 3820 wp.length = sizeof (wp);
ee78dc32 3821 GetWindowRect (hwnd, &wr);
7d0393cf 3822
3c190163 3823 enter_crit ();
7d0393cf 3824
1edf84e7
GV
3825 font_width = GetWindowLong (hwnd, WND_FONTWIDTH_INDEX);
3826 line_height = GetWindowLong (hwnd, WND_LINEHEIGHT_INDEX);
3827 internal_border = GetWindowLong (hwnd, WND_BORDER_INDEX);
3828 scrollbar_extra = GetWindowLong (hwnd, WND_SCROLLBAR_INDEX);
7d0393cf 3829
3c190163 3830 leave_crit ();
7d0393cf 3831
ee78dc32 3832 memset (&rect, 0, sizeof (rect));
7d0393cf 3833 AdjustWindowRect (&rect, GetWindowLong (hwnd, GWL_STYLE),
ee78dc32
GV
3834 GetMenu (hwnd) != NULL);
3835
1edf84e7
GV
3836 /* Force width and height of client area to be exact
3837 multiples of the character cell dimensions. */
3838 wdiff = (lppos->cx - (rect.right - rect.left)
3839 - 2 * internal_border - scrollbar_extra)
3840 % font_width;
3841 hdiff = (lppos->cy - (rect.bottom - rect.top)
3842 - 2 * internal_border)
3843 % line_height;
7d0393cf 3844
ee78dc32
GV
3845 if (wdiff || hdiff)
3846 {
7d0393cf
JB
3847 /* For right/bottom sizing we can just fix the sizes.
3848 However for top/left sizing we will need to fix the X
ee78dc32 3849 and Y positions as well. */
7d0393cf 3850
8a4c4c7f
JB
3851 int cx_mintrack = GetSystemMetrics (SM_CXMINTRACK);
3852 int cy_mintrack = GetSystemMetrics (SM_CYMINTRACK);
3853
3854 lppos->cx = max (lppos->cx - wdiff, cx_mintrack);
3855 lppos->cy = max (lppos->cy - hdiff, cy_mintrack);
7d0393cf
JB
3856
3857 if (wp.showCmd != SW_SHOWMAXIMIZED
1edf84e7 3858 && (lppos->flags & SWP_NOMOVE) == 0)
ee78dc32
GV
3859 {
3860 if (lppos->x != wr.left || lppos->y != wr.top)
3861 {
3862 lppos->x += wdiff;
3863 lppos->y += hdiff;
3864 }
3865 else
3866 {
3867 lppos->flags |= SWP_NOMOVE;
3868 }
3869 }
7d0393cf 3870
1edf84e7 3871 return 0;
ee78dc32
GV
3872 }
3873 }
3874 }
7d0393cf 3875
ee78dc32 3876 goto dflt;
1edf84e7 3877
b1f918f8 3878 case WM_GETMINMAXINFO:
bf853fee
AI
3879 /* Hack to allow resizing the Emacs frame above the screen size.
3880 Note that Windows 9x limits coordinates to 16-bits. */
3881 ((LPMINMAXINFO) lParam)->ptMaxTrackSize.x = 32767;
3882 ((LPMINMAXINFO) lParam)->ptMaxTrackSize.y = 32767;
b1f918f8
GV
3883 return 0;
3884
c9b2104d
JR
3885 case WM_SETCURSOR:
3886 if (LOWORD (lParam) == HTCLIENT)
d148e14d
JR
3887 {
3888 f = x_window_to_frame (dpyinfo, hwnd);
3889 if (f->output_data.w32->hourglass_p && !menubar_in_use
3890 && !current_popup_menu)
3891 SetCursor (f->output_data.w32->hourglass_cursor);
3892 else
3893 SetCursor (f->output_data.w32->current_cursor);
3894 return 0;
3895 }
c9b2104d 3896 goto dflt;
c922a224 3897
c9b2104d
JR
3898 case WM_EMACS_SETCURSOR:
3899 {
3900 Cursor cursor = (Cursor) wParam;
d148e14d
JR
3901 f = x_window_to_frame (dpyinfo, hwnd);
3902 if (f && cursor)
3903 {
3904 f->output_data.w32->current_cursor = cursor;
3905 if (!f->output_data.w32->hourglass_p)
3906 SetCursor (cursor);
3907 }
c9b2104d
JR
3908 return 0;
3909 }
c922a224 3910
1edf84e7
GV
3911 case WM_EMACS_CREATESCROLLBAR:
3912 return (LRESULT) w32_createscrollbar ((struct frame *) wParam,
3913 (struct scroll_bar *) lParam);
3914
5ac45f98 3915 case WM_EMACS_SHOWWINDOW:
1edf84e7
GV
3916 return ShowWindow ((HWND) wParam, (WPARAM) lParam);
3917
dfdb4047 3918 case WM_EMACS_SETFOREGROUND:
ce6059da
AI
3919 {
3920 HWND foreground_window;
3921 DWORD foreground_thread, retval;
3922
3923 /* On NT 5.0, and apparently Windows 98, it is necessary to
3924 attach to the thread that currently has focus in order to
3925 pull the focus away from it. */
3926 foreground_window = GetForegroundWindow ();
3927 foreground_thread = GetWindowThreadProcessId (foreground_window, NULL);
3928 if (!foreground_window
3929 || foreground_thread == GetCurrentThreadId ()
3930 || !AttachThreadInput (GetCurrentThreadId (),
3931 foreground_thread, TRUE))
3932 foreground_thread = 0;
3933
3934 retval = SetForegroundWindow ((HWND) wParam);
3935
3936 /* Detach from the previous foreground thread. */
3937 if (foreground_thread)
3938 AttachThreadInput (GetCurrentThreadId (),
3939 foreground_thread, FALSE);
3940
3941 return retval;
3942 }
dfdb4047 3943
5ac45f98
GV
3944 case WM_EMACS_SETWINDOWPOS:
3945 {
1edf84e7
GV
3946 WINDOWPOS * pos = (WINDOWPOS *) wParam;
3947 return SetWindowPos (hwnd, pos->hwndInsertAfter,
5ac45f98
GV
3948 pos->x, pos->y, pos->cx, pos->cy, pos->flags);
3949 }
1edf84e7 3950
ee78dc32 3951 case WM_EMACS_DESTROYWINDOW:
cb9e33d4 3952 DragAcceptFiles ((HWND) wParam, FALSE);
1edf84e7
GV
3953 return DestroyWindow ((HWND) wParam);
3954
93f2ca61
JR
3955 case WM_EMACS_HIDE_CARET:
3956 return HideCaret (hwnd);
3957
3958 case WM_EMACS_SHOW_CARET:
3959 return ShowCaret (hwnd);
3960
65906840
JR
3961 case WM_EMACS_DESTROY_CARET:
3962 w32_system_caret_hwnd = NULL;
93f2ca61 3963 w32_visible_system_caret_hwnd = NULL;
65906840
JR
3964 return DestroyCaret ();
3965
3966 case WM_EMACS_TRACK_CARET:
3967 /* If there is currently no system caret, create one. */
3968 if (w32_system_caret_hwnd == NULL)
3969 {
93f2ca61
JR
3970 /* Use the default caret width, and avoid changing it
3971 unneccesarily, as it confuses screen reader software. */
65906840 3972 w32_system_caret_hwnd = hwnd;
93f2ca61 3973 CreateCaret (hwnd, NULL, 0,
65906840
JR
3974 w32_system_caret_height);
3975 }
7d0393cf 3976
93f2ca61
JR
3977 if (!SetCaretPos (w32_system_caret_x, w32_system_caret_y))
3978 return 0;
3979 /* Ensure visible caret gets turned on when requested. */
3980 else if (w32_use_visible_system_caret
3981 && w32_visible_system_caret_hwnd != hwnd)
3982 {
3983 w32_visible_system_caret_hwnd = hwnd;
3984 return ShowCaret (hwnd);
3985 }
3986 /* Ensure visible caret gets turned off when requested. */
3987 else if (!w32_use_visible_system_caret
3988 && w32_visible_system_caret_hwnd)
3989 {
3990 w32_visible_system_caret_hwnd = NULL;
3991 return HideCaret (hwnd);
3992 }
3993 else
3994 return 1;
65906840 3995
1edf84e7
GV
3996 case WM_EMACS_TRACKPOPUPMENU:
3997 {
3998 UINT flags;
3999 POINT *pos;
4000 int retval;
4001 pos = (POINT *)lParam;
4002 flags = TPM_CENTERALIGN;
4003 if (button_state & LMOUSE)
4004 flags |= TPM_LEFTBUTTON;
4005 else if (button_state & RMOUSE)
4006 flags |= TPM_RIGHTBUTTON;
7d0393cf 4007
87996783
GV
4008 /* Remember we did a SetCapture on the initial mouse down event,
4009 so for safety, we make sure the capture is cancelled now. */
4010 ReleaseCapture ();
490822ff 4011 button_state = 0;
87996783 4012
1edf84e7
GV
4013 /* Use menubar_active to indicate that WM_INITMENU is from
4014 TrackPopupMenu below, and should be ignored. */
4015 f = x_window_to_frame (dpyinfo, hwnd);
4016 if (f)
4017 f->output_data.w32->menubar_active = 1;
7d0393cf
JB
4018
4019 if (TrackPopupMenu ((HMENU)wParam, flags, pos->x, pos->y,
1edf84e7
GV
4020 0, hwnd, NULL))
4021 {
4022 MSG amsg;
4023 /* Eat any mouse messages during popupmenu */
4024 while (PeekMessage (&amsg, hwnd, WM_MOUSEFIRST, WM_MOUSELAST,
4025 PM_REMOVE));
4026 /* Get the menu selection, if any */
4027 if (PeekMessage (&amsg, hwnd, WM_COMMAND, WM_COMMAND, PM_REMOVE))
4028 {
4029 retval = LOWORD (amsg.wParam);
4030 }
4031 else
4032 {
4033 retval = 0;
4034 }
1edf84e7
GV
4035 }
4036 else
4037 {
4038 retval = -1;
4039 }
4040
4041 return retval;
4042 }
4043
ee78dc32 4044 default:
93fbe8b7
GV
4045 /* Check for messages registered at runtime. */
4046 if (msg == msh_mousewheel)
4047 {
4048 wmsg.dwModifiers = w32_get_modifiers ();
4049 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
f0c947b5 4050 signal_user_input ();
93fbe8b7
GV
4051 return 0;
4052 }
7d0393cf 4053
ee78dc32
GV
4054 dflt:
4055 return DefWindowProc (hwnd, msg, wParam, lParam);
4056 }
7d0393cf 4057
1edf84e7
GV
4058
4059 /* The most common default return code for handled messages is 0. */
4060 return 0;
ee78dc32
GV
4061}
4062
0962822d 4063static void
ee78dc32
GV
4064my_create_window (f)
4065 struct frame * f;
4066{
4067 MSG msg;
4068
1edf84e7
GV
4069 if (!PostThreadMessage (dwWindowsThreadId, WM_EMACS_CREATEWINDOW, (WPARAM)f, 0))
4070 abort ();
ee78dc32
GV
4071 GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE);
4072}
4073
ca56d953
JR
4074
4075/* Create a tooltip window. Unlike my_create_window, we do not do this
4076 indirectly via the Window thread, as we do not need to process Window
4077 messages for the tooltip. Creating tooltips indirectly also creates
4078 deadlocks when tooltips are created for menu items. */
0962822d 4079static void
ca56d953
JR
4080my_create_tip_window (f)
4081 struct frame *f;
4082{
bfd6edcc 4083 RECT rect;
ca56d953 4084
bfd6edcc 4085 rect.left = rect.top = 0;
be786000
KS
4086 rect.right = FRAME_PIXEL_WIDTH (f);
4087 rect.bottom = FRAME_PIXEL_HEIGHT (f);
bfd6edcc
JR
4088
4089 AdjustWindowRect (&rect, f->output_data.w32->dwStyle,
4090 FRAME_EXTERNAL_MENU_BAR (f));
4091
4092 tip_window = FRAME_W32_WINDOW (f)
ca56d953
JR
4093 = CreateWindow (EMACS_CLASS,
4094 f->namebuf,
4095 f->output_data.w32->dwStyle,
be786000
KS
4096 f->left_pos,
4097 f->top_pos,
bfd6edcc
JR
4098 rect.right - rect.left,
4099 rect.bottom - rect.top,
ca56d953
JR
4100 FRAME_W32_WINDOW (SELECTED_FRAME ()), /* owner */
4101 NULL,
4102 hinst,
4103 NULL);
4104
bfd6edcc 4105 if (tip_window)
ca56d953 4106 {
be786000
KS
4107 SetWindowLong (tip_window, WND_FONTWIDTH_INDEX, FRAME_COLUMN_WIDTH (f));
4108 SetWindowLong (tip_window, WND_LINEHEIGHT_INDEX, FRAME_LINE_HEIGHT (f));
4109 SetWindowLong (tip_window, WND_BORDER_INDEX, FRAME_INTERNAL_BORDER_WIDTH (f));
bfd6edcc
JR
4110 SetWindowLong (tip_window, WND_BACKGROUND_INDEX, FRAME_BACKGROUND_PIXEL (f));
4111
4112 /* Tip frames have no scrollbars. */
4113 SetWindowLong (tip_window, WND_SCROLLBAR_INDEX, 0);
ca56d953
JR
4114
4115 /* Do this to discard the default setting specified by our parent. */
bfd6edcc 4116 ShowWindow (tip_window, SW_HIDE);
ca56d953
JR
4117 }
4118}
4119
4120
fbd6baed 4121/* Create and set up the w32 window for frame F. */
ee78dc32
GV
4122
4123static void
fbd6baed 4124w32_window (f, window_prompting, minibuffer_only)
ee78dc32
GV
4125 struct frame *f;
4126 long window_prompting;
4127 int minibuffer_only;
4128{
4129 BLOCK_INPUT;
4130
4131 /* Use the resource name as the top-level window name
4132 for looking up resources. Make a non-Lisp copy
4133 for the window manager, so GC relocation won't bother it.
4134
4135 Elsewhere we specify the window name for the window manager. */
7d0393cf 4136
ee78dc32 4137 {
d5db4077 4138 char *str = (char *) SDATA (Vx_resource_name);
ee78dc32
GV
4139 f->namebuf = (char *) xmalloc (strlen (str) + 1);
4140 strcpy (f->namebuf, str);
4141 }
4142
4143 my_create_window (f);
4144
4145 validate_x_resource_name ();
4146
4147 /* x_set_name normally ignores requests to set the name if the
4148 requested name is the same as the current name. This is the one
4149 place where that assumption isn't correct; f->name is set, but
4150 the server hasn't been told. */
4151 {
4152 Lisp_Object name;
4153 int explicit = f->explicit_name;
4154
4155 f->explicit_name = 0;
4156 name = f->name;
4157 f->name = Qnil;
4158 x_set_name (f, name, explicit);
4159 }
4160
4161 UNBLOCK_INPUT;
4162
4163 if (!minibuffer_only && FRAME_EXTERNAL_MENU_BAR (f))
4164 initialize_frame_menubar (f);
4165
fbd6baed 4166 if (FRAME_W32_WINDOW (f) == 0)
ee78dc32
GV
4167 error ("Unable to create window");
4168}
4169
4170/* Handle the icon stuff for this window. Perhaps later we might
4171 want an x_set_icon_position which can be called interactively as
4172 well. */
4173
4174static void
4175x_icon (f, parms)
4176 struct frame *f;
4177 Lisp_Object parms;
4178{
4179 Lisp_Object icon_x, icon_y;
4180
e9e23e23 4181 /* Set the position of the icon. Note that Windows 95 groups all
ee78dc32 4182 icons in the tray. */
6fc2811b
JR
4183 icon_x = w32_get_arg (parms, Qicon_left, 0, 0, RES_TYPE_NUMBER);
4184 icon_y = w32_get_arg (parms, Qicon_top, 0, 0, RES_TYPE_NUMBER);
ee78dc32
GV
4185 if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
4186 {
b7826503
PJ
4187 CHECK_NUMBER (icon_x);
4188 CHECK_NUMBER (icon_y);
ee78dc32
GV
4189 }
4190 else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
4191 error ("Both left and top icon corners of icon must be specified");
4192
4193 BLOCK_INPUT;
4194
4195 if (! EQ (icon_x, Qunbound))
4196 x_wm_set_icon_position (f, XINT (icon_x), XINT (icon_y));
4197
1edf84e7
GV
4198#if 0 /* TODO */
4199 /* Start up iconic or window? */
4200 x_wm_set_window_state
6fc2811b 4201 (f, (EQ (w32_get_arg (parms, Qvisibility, 0, 0, RES_TYPE_SYMBOL), Qicon)
1edf84e7
GV
4202 ? IconicState
4203 : NormalState));
4204
d5db4077 4205 x_text_icon (f, (char *) SDATA ((!NILP (f->icon_name)
1edf84e7 4206 ? f->icon_name
d5db4077 4207 : f->name)));
1edf84e7
GV
4208#endif
4209
ee78dc32
GV
4210 UNBLOCK_INPUT;
4211}
4212
6fc2811b
JR
4213
4214static void
4215x_make_gc (f)
4216 struct frame *f;
4217{
4218 XGCValues gc_values;
4219
4220 BLOCK_INPUT;
4221
4222 /* Create the GC's of this frame.
4223 Note that many default values are used. */
4224
4225 /* Normal video */
be786000 4226 gc_values.font = FRAME_FONT (f);
6fc2811b
JR
4227
4228 /* Cursor has cursor-color background, background-color foreground. */
4229 gc_values.foreground = FRAME_BACKGROUND_PIXEL (f);
4230 gc_values.background = f->output_data.w32->cursor_pixel;
4231 f->output_data.w32->cursor_gc
4232 = XCreateGC (NULL, FRAME_W32_WINDOW (f),
4233 (GCFont | GCForeground | GCBackground),
4234 &gc_values);
4235
4236 /* Reliefs. */
4237 f->output_data.w32->white_relief.gc = 0;
4238 f->output_data.w32->black_relief.gc = 0;
4239
4240 UNBLOCK_INPUT;
4241}
4242
4243
937e601e
AI
4244/* Handler for signals raised during x_create_frame and
4245 x_create_top_frame. FRAME is the frame which is partially
4246 constructed. */
4247
4248static Lisp_Object
4249unwind_create_frame (frame)
4250 Lisp_Object frame;
4251{
4252 struct frame *f = XFRAME (frame);
4253
4254 /* If frame is ``official'', nothing to do. */
4255 if (!CONSP (Vframe_list) || !EQ (XCAR (Vframe_list), frame))
4256 {
4257#ifdef GLYPH_DEBUG
4258 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
4259#endif
7d0393cf 4260
937e601e
AI
4261 x_free_frame_resources (f);
4262
4263 /* Check that reference counts are indeed correct. */
4264 xassert (dpyinfo->reference_count == dpyinfo_refcount);
4265 xassert (dpyinfo->image_cache->refcount == image_cache_refcount);
c844a81a
GM
4266
4267 return Qt;
937e601e 4268 }
7d0393cf 4269
937e601e
AI
4270 return Qnil;
4271}
4272
a1fe5c00
JR
4273#ifdef USE_FONT_BACKEND
4274static void
4275x_default_font_parameter (f, parms)
4276 struct frame *f;
4277 Lisp_Object parms;
4278{
4279 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
4280 Lisp_Object font = x_get_arg (dpyinfo, parms, Qfont, "font", "Font",
4281 RES_TYPE_STRING);
4282
4283 if (!STRINGP (font))
4284 {
4285 int i;
4286 static char *names[]
82523155 4287 = { "Courier New-10",
a1fe5c00
JR
4288 "-*-Courier-normal-r-*-*-13-*-*-*-c-*-iso8859-1",
4289 "-*-Fixedsys-normal-r-*-*-12-*-*-*-c-*-iso8859-1",
4290 "Fixedsys",
4291 NULL };
4292
4293 for (i = 0; names[i]; i++)
4294 {
4295 font = font_open_by_name (f, names[i]);
4296 if (! NILP (font))
4297 break;
4298 }
4299 if (NILP (font))
4300 error ("No suitable font was found");
4301 }
4302 x_default_parameter (f, parms, Qfont, font, "font", "Font", RES_TYPE_STRING);
4303}
4304#endif
937e601e 4305
ee78dc32
GV
4306DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
4307 1, 1, 0,
74e1aeec 4308 doc: /* Make a new window, which is called a \"frame\" in Emacs terms.
36458ebd 4309Return an Emacs frame object.
52deb19f 4310PARAMETERS is an alist of frame parameters.
74e1aeec
JR
4311If the parameters specify that the frame should not have a minibuffer,
4312and do not specify a specific minibuffer window to use,
4313then `default-minibuffer-frame' must be a frame whose minibuffer can
4314be shared by the new frame.
4315
4316This function is an internal primitive--use `make-frame' instead. */)
52deb19f
JB
4317 (parameters)
4318 Lisp_Object parameters;
ee78dc32
GV
4319{
4320 struct frame *f;
4321 Lisp_Object frame, tem;
4322 Lisp_Object name;
4323 int minibuffer_only = 0;
4324 long window_prompting = 0;
4325 int width, height;
331379bf 4326 int count = SPECPDL_INDEX ();
1edf84e7 4327 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
ee78dc32 4328 Lisp_Object display;
6fc2811b 4329 struct w32_display_info *dpyinfo = NULL;
ee78dc32
GV
4330 Lisp_Object parent;
4331 struct kboard *kb;
4332
4587b026
GV
4333 check_w32 ();
4334
1da8a031
MR
4335 /* Make copy of frame parameters because the original is in pure
4336 storage now. */
4337 parameters = Fcopy_alist (parameters);
4338
ee78dc32
GV
4339 /* Use this general default value to start with
4340 until we know if this frame has a specified name. */
4341 Vx_resource_name = Vinvocation_name;
4342
52deb19f 4343 display = w32_get_arg (parameters, Qdisplay, 0, 0, RES_TYPE_STRING);
ee78dc32
GV
4344 if (EQ (display, Qunbound))
4345 display = Qnil;
4346 dpyinfo = check_x_display_info (display);
4347#ifdef MULTI_KBOARD
80ca7302 4348 kb = dpyinfo->terminal->kboard;
ee78dc32
GV
4349#else
4350 kb = &the_only_kboard;
4351#endif
4352
52deb19f 4353 name = w32_get_arg (parameters, Qname, "name", "Name", RES_TYPE_STRING);
ee78dc32
GV
4354 if (!STRINGP (name)
4355 && ! EQ (name, Qunbound)
4356 && ! NILP (name))
4357 error ("Invalid frame name--not a string or nil");
4358
4359 if (STRINGP (name))
4360 Vx_resource_name = name;
4361
4362 /* See if parent window is specified. */
52deb19f 4363 parent = w32_get_arg (parameters, Qparent_id, NULL, NULL, RES_TYPE_NUMBER);
ee78dc32
GV
4364 if (EQ (parent, Qunbound))
4365 parent = Qnil;
4366 if (! NILP (parent))
b7826503 4367 CHECK_NUMBER (parent);
ee78dc32 4368
1edf84e7
GV
4369 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
4370 /* No need to protect DISPLAY because that's not used after passing
4371 it to make_frame_without_minibuffer. */
4372 frame = Qnil;
52deb19f
JB
4373 GCPRO4 (parameters, parent, name, frame);
4374 tem = w32_get_arg (parameters, Qminibuffer, "minibuffer", "Minibuffer",
1660f34a 4375 RES_TYPE_SYMBOL);
ee78dc32
GV
4376 if (EQ (tem, Qnone) || NILP (tem))
4377 f = make_frame_without_minibuffer (Qnil, kb, display);
4378 else if (EQ (tem, Qonly))
4379 {
4380 f = make_minibuffer_frame ();
4381 minibuffer_only = 1;
4382 }
4383 else if (WINDOWP (tem))
4384 f = make_frame_without_minibuffer (tem, kb, display);
4385 else
4386 f = make_frame (1);
4387
1edf84e7
GV
4388 XSETFRAME (frame, f);
4389
ee78dc32
GV
4390 /* Note that Windows does support scroll bars. */
4391 FRAME_CAN_HAVE_SCROLL_BARS (f) = 1;
6d906347 4392
5ac45f98 4393 /* By default, make scrollbars the system standard width. */
be786000 4394 FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = GetSystemMetrics (SM_CXVSCROLL);
ee78dc32 4395
2dc8b986
JR
4396 f->terminal = dpyinfo->terminal;
4397 f->terminal->reference_count++;
4398
fbd6baed 4399 f->output_method = output_w32;
6fc2811b
JR
4400 f->output_data.w32 =
4401 (struct w32_output *) xmalloc (sizeof (struct w32_output));
fbd6baed 4402 bzero (f->output_data.w32, sizeof (struct w32_output));
4587b026 4403 FRAME_FONTSET (f) = -1;
937e601e 4404 record_unwind_protect (unwind_create_frame, frame);
4587b026 4405
1edf84e7 4406 f->icon_name
52deb19f 4407 = w32_get_arg (parameters, Qicon_name, "iconName", "Title", RES_TYPE_STRING);
1edf84e7
GV
4408 if (! STRINGP (f->icon_name))
4409 f->icon_name = Qnil;
4410
fbd6baed 4411/* FRAME_W32_DISPLAY_INFO (f) = dpyinfo; */
ee78dc32
GV
4412#ifdef MULTI_KBOARD
4413 FRAME_KBOARD (f) = kb;
4414#endif
4415
4416 /* Specify the parent under which to make this window. */
4417
4418 if (!NILP (parent))
4419 {
1660f34a 4420 f->output_data.w32->parent_desc = (Window) XFASTINT (parent);
fbd6baed 4421 f->output_data.w32->explicit_parent = 1;
ee78dc32
GV
4422 }
4423 else
4424 {
fbd6baed
GV
4425 f->output_data.w32->parent_desc = FRAME_W32_DISPLAY_INFO (f)->root_window;
4426 f->output_data.w32->explicit_parent = 0;
ee78dc32
GV
4427 }
4428
ee78dc32
GV
4429 /* Set the name; the functions to which we pass f expect the name to
4430 be set. */
4431 if (EQ (name, Qunbound) || NILP (name))
4432 {
fbd6baed 4433 f->name = build_string (dpyinfo->w32_id_name);
ee78dc32
GV
4434 f->explicit_name = 0;
4435 }
4436 else
4437 {
4438 f->name = name;
4439 f->explicit_name = 1;
4440 /* use the frame's title when getting resources for this frame. */
4441 specbind (Qx_resource_name, name);
4442 }
4443
82523155
JR
4444 f->resx = dpyinfo->resx;
4445 f->resy = dpyinfo->resy;
4446
a1fe5c00
JR
4447#ifdef USE_FONT_BACKEND
4448 if (enable_font_backend)
4449 {
4450 /* Perhaps, we must allow frame parameter, say `font-backend',
4451 to specify which font backends to use. */
cbfedb1c
JR
4452 if (uniscribe_available)
4453 register_font_driver (&uniscribe_font_driver, f);
a1fe5c00
JR
4454 register_font_driver (&w32font_driver, f);
4455
4456 x_default_parameter (f, parameters, Qfont_backend, Qnil,
4457 "fontBackend", "FontBackend", RES_TYPE_STRING);
4458 }
4459#endif /* USE_FONT_BACKEND */
4460
ee78dc32
GV
4461 /* Extract the window parameters from the supplied values
4462 that are needed to determine window geometry. */
a1fe5c00
JR
4463#ifdef USE_FONT_BACKEND
4464 if (enable_font_backend)
4465 x_default_font_parameter (f, parameters);
4466 else
23f250f4 4467#endif
ee78dc32
GV
4468 {
4469 Lisp_Object font;
4470
52deb19f 4471 font = w32_get_arg (parameters, Qfont, "font", "Font", RES_TYPE_STRING);
6fc2811b 4472
ee78dc32
GV
4473 BLOCK_INPUT;
4474 /* First, try whatever font the caller has specified. */
4475 if (STRINGP (font))
4587b026
GV
4476 {
4477 tem = Fquery_fontset (font, Qnil);
4478 if (STRINGP (tem))
10b4bc33 4479 font = x_new_fontset (f, tem);
4587b026 4480 else
d5db4077 4481 font = x_new_font (f, SDATA (font));
4587b026 4482 }
ee78dc32
GV
4483 /* Try out a font which we hope has bold and italic variations. */
4484 if (!STRINGP (font))
e39649be 4485 font = x_new_font (f, "-*-Courier New-normal-r-*-*-*-100-*-*-c-*-iso8859-1");
ee78dc32 4486 if (! STRINGP (font))
6fc2811b 4487 font = x_new_font (f, "-*-Courier-normal-r-*-*-13-*-*-*-c-*-iso8859-1");
ee78dc32
GV
4488 /* If those didn't work, look for something which will at least work. */
4489 if (! STRINGP (font))
6fc2811b 4490 font = x_new_font (f, "-*-Fixedsys-normal-r-*-*-12-*-*-*-c-*-iso8859-1");
ee78dc32
GV
4491 UNBLOCK_INPUT;
4492 if (! STRINGP (font))
1edf84e7 4493 font = build_string ("Fixedsys");
ee78dc32 4494
52deb19f 4495 x_default_parameter (f, parameters, Qfont, font,
6fc2811b 4496 "font", "Font", RES_TYPE_STRING);
ee78dc32
GV
4497 }
4498
52deb19f 4499 x_default_parameter (f, parameters, Qborder_width, make_number (2),
1660f34a 4500 "borderWidth", "BorderWidth", RES_TYPE_NUMBER);
ee78dc32
GV
4501 /* This defaults to 2 in order to match xterm. We recognize either
4502 internalBorderWidth or internalBorder (which is what xterm calls
4503 it). */
52deb19f 4504 if (NILP (Fassq (Qinternal_border_width, parameters)))
ee78dc32
GV
4505 {
4506 Lisp_Object value;
4507
52deb19f
JB
4508 value = w32_get_arg (parameters, Qinternal_border_width,
4509 "internalBorder", "InternalBorder", RES_TYPE_NUMBER);
ee78dc32 4510 if (! EQ (value, Qunbound))
52deb19f
JB
4511 parameters = Fcons (Fcons (Qinternal_border_width, value),
4512 parameters);
ee78dc32 4513 }
1edf84e7 4514 /* Default internalBorderWidth to 0 on Windows to match other programs. */
52deb19f 4515 x_default_parameter (f, parameters, Qinternal_border_width, make_number (0),
1660f34a 4516 "internalBorderWidth", "InternalBorder", RES_TYPE_NUMBER);
52deb19f 4517 x_default_parameter (f, parameters, Qvertical_scroll_bars, Qright,
1660f34a 4518 "verticalScrollBars", "ScrollBars", RES_TYPE_SYMBOL);
ee78dc32
GV
4519
4520 /* Also do the stuff which must be set before the window exists. */
52deb19f 4521 x_default_parameter (f, parameters, Qforeground_color, build_string ("black"),
6fc2811b 4522 "foreground", "Foreground", RES_TYPE_STRING);
52deb19f 4523 x_default_parameter (f, parameters, Qbackground_color, build_string ("white"),
6fc2811b 4524 "background", "Background", RES_TYPE_STRING);
52deb19f 4525 x_default_parameter (f, parameters, Qmouse_color, build_string ("black"),
6fc2811b 4526 "pointerColor", "Foreground", RES_TYPE_STRING);
52deb19f 4527 x_default_parameter (f, parameters, Qcursor_color, build_string ("black"),
6fc2811b 4528 "cursorColor", "Foreground", RES_TYPE_STRING);
52deb19f 4529 x_default_parameter (f, parameters, Qborder_color, build_string ("black"),
6fc2811b 4530 "borderColor", "BorderColor", RES_TYPE_STRING);
52deb19f 4531 x_default_parameter (f, parameters, Qscreen_gamma, Qnil,
6fc2811b 4532 "screenGamma", "ScreenGamma", RES_TYPE_FLOAT);
52deb19f 4533 x_default_parameter (f, parameters, Qline_spacing, Qnil,
dfff8a69 4534 "lineSpacing", "LineSpacing", RES_TYPE_NUMBER);
52deb19f 4535 x_default_parameter (f, parameters, Qleft_fringe, Qnil,
41c1bdd9 4536 "leftFringe", "LeftFringe", RES_TYPE_NUMBER);
52deb19f 4537 x_default_parameter (f, parameters, Qright_fringe, Qnil,
41c1bdd9 4538 "rightFringe", "RightFringe", RES_TYPE_NUMBER);
6fc2811b 4539
ee78dc32 4540
6fc2811b
JR
4541 /* Init faces before x_default_parameter is called for scroll-bar
4542 parameters because that function calls x_set_scroll_bar_width,
4543 which calls change_frame_size, which calls Fset_window_buffer,
4544 which runs hooks, which call Fvertical_motion. At the end, we
4545 end up in init_iterator with a null face cache, which should not
4546 happen. */
4547 init_frame_faces (f);
7d0393cf 4548
52deb19f 4549 x_default_parameter (f, parameters, Qmenu_bar_lines, make_number (1),
6fc2811b 4550 "menuBar", "MenuBar", RES_TYPE_NUMBER);
52deb19f 4551 x_default_parameter (f, parameters, Qtool_bar_lines, make_number (1),
6fc2811b 4552 "toolBar", "ToolBar", RES_TYPE_NUMBER);
919f1e88 4553
52deb19f 4554 x_default_parameter (f, parameters, Qbuffer_predicate, Qnil,
6fc2811b 4555 "bufferPredicate", "BufferPredicate", RES_TYPE_SYMBOL);
52deb19f 4556 x_default_parameter (f, parameters, Qtitle, Qnil,
6fc2811b 4557 "title", "Title", RES_TYPE_STRING);
52deb19f 4558 x_default_parameter (f, parameters, Qfullscreen, Qnil,
f7b9d4d1 4559 "fullscreen", "Fullscreen", RES_TYPE_SYMBOL);
ee78dc32 4560
fbd6baed
GV
4561 f->output_data.w32->dwStyle = WS_OVERLAPPEDWINDOW;
4562 f->output_data.w32->parent_desc = FRAME_W32_DISPLAY_INFO (f)->root_window;
3cf3436e 4563
c9b2104d
JR
4564 f->output_data.w32->text_cursor = w32_load_cursor (IDC_IBEAM);
4565 f->output_data.w32->nontext_cursor = w32_load_cursor (IDC_ARROW);
4566 f->output_data.w32->modeline_cursor = w32_load_cursor (IDC_ARROW);
7d63e5e3 4567 f->output_data.w32->hand_cursor = w32_load_cursor (IDC_HAND);
c9b2104d
JR
4568 f->output_data.w32->hourglass_cursor = w32_load_cursor (IDC_WAIT);
4569 f->output_data.w32->horizontal_drag_cursor = w32_load_cursor (IDC_SIZEWE);
c9b2104d 4570
d148e14d
JR
4571 f->output_data.w32->current_cursor = f->output_data.w32->nontext_cursor;
4572
52deb19f 4573 window_prompting = x_figure_window_size (f, parameters, 1);
ee78dc32 4574
52deb19f 4575 tem = w32_get_arg (parameters, Qunsplittable, 0, 0, RES_TYPE_BOOLEAN);
6fc2811b
JR
4576 f->no_split = minibuffer_only || EQ (tem, Qt);
4577
fbd6baed 4578 w32_window (f, window_prompting, minibuffer_only);
52deb19f 4579 x_icon (f, parameters);
6fc2811b
JR
4580
4581 x_make_gc (f);
4582
4583 /* Now consider the frame official. */
4584 FRAME_W32_DISPLAY_INFO (f)->reference_count++;
4585 Vframe_list = Fcons (frame, Vframe_list);
ee78dc32
GV
4586
4587 /* We need to do this after creating the window, so that the
4588 icon-creation functions can say whose icon they're describing. */
52deb19f 4589 x_default_parameter (f, parameters, Qicon_type, Qnil,
6fc2811b 4590 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL);
ee78dc32 4591
52deb19f 4592 x_default_parameter (f, parameters, Qauto_raise, Qnil,
6fc2811b 4593 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN);
52deb19f 4594 x_default_parameter (f, parameters, Qauto_lower, Qnil,
6fc2811b 4595 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN);
52deb19f 4596 x_default_parameter (f, parameters, Qcursor_type, Qbox,
6fc2811b 4597 "cursorType", "CursorType", RES_TYPE_SYMBOL);
52deb19f 4598 x_default_parameter (f, parameters, Qscroll_bar_width, Qnil,
6fc2811b 4599 "scrollBarWidth", "ScrollBarWidth", RES_TYPE_NUMBER);
ee78dc32 4600
be786000 4601 /* Dimensions, especially FRAME_LINES (f), must be done via change_frame_size.
ee78dc32 4602 Change will not be effected unless different from the current
be786000
KS
4603 FRAME_LINES (f). */
4604 width = FRAME_COLS (f);
4605 height = FRAME_LINES (f);
dc220243 4606
be786000
KS
4607 FRAME_LINES (f) = 0;
4608 SET_FRAME_COLS (f, 0);
6fc2811b
JR
4609 change_frame_size (f, height, width, 1, 0, 0);
4610
6fc2811b
JR
4611 /* Tell the server what size and position, etc, we want, and how
4612 badly we want them. This should be done after we have the menu
4613 bar so that its size can be taken into account. */
ee78dc32
GV
4614 BLOCK_INPUT;
4615 x_wm_set_size_hint (f, window_prompting, 0);
4616 UNBLOCK_INPUT;
4617
6fc2811b
JR
4618 /* Make the window appear on the frame and enable display, unless
4619 the caller says not to. However, with explicit parent, Emacs
4620 cannot control visibility, so don't try. */
fbd6baed 4621 if (! f->output_data.w32->explicit_parent)
ee78dc32
GV
4622 {
4623 Lisp_Object visibility;
4624
52deb19f 4625 visibility = w32_get_arg (parameters, Qvisibility, 0, 0, RES_TYPE_SYMBOL);
ee78dc32
GV
4626 if (EQ (visibility, Qunbound))
4627 visibility = Qt;
4628
4629 if (EQ (visibility, Qicon))
4630 x_iconify_frame (f);
4631 else if (! NILP (visibility))
4632 x_make_frame_visible (f);
4633 else
4634 /* Must have been Qnil. */
4635 ;
4636 }
55d5acfa
DN
4637
4638 /* Initialize `default-minibuffer-frame' in case this is the first
4639 frame on this terminal. */
4640 if (FRAME_HAS_MINIBUF_P (f)
4641 && (!FRAMEP (kb->Vdefault_minibuffer_frame)
4642 || !FRAME_LIVE_P (XFRAME (kb->Vdefault_minibuffer_frame))))
4643 kb->Vdefault_minibuffer_frame = frame;
4644
4645 /* All remaining specified parameters, which have not been "used"
4646 by x_get_arg and friends, now go in the misc. alist of the frame. */
99784d63 4647 for (tem = parameters; CONSP (tem); tem = XCDR (tem))
55d5acfa
DN
4648 if (CONSP (XCAR (tem)) && !NILP (XCAR (XCAR (tem))))
4649 f->param_alist = Fcons (XCAR (tem), f->param_alist);
4650
6fc2811b 4651 UNGCPRO;
7d0393cf 4652
9e57df62
GM
4653 /* Make sure windows on this frame appear in calls to next-window
4654 and similar functions. */
4655 Vwindow_list = Qnil;
7d0393cf 4656
ee78dc32
GV
4657 return unbind_to (count, frame);
4658}
4659
4660/* FRAME is used only to get a handle on the X display. We don't pass the
4661 display info directly because we're called from frame.c, which doesn't
4662 know about that structure. */
4663Lisp_Object
4664x_get_focus_frame (frame)
4665 struct frame *frame;
4666{
fbd6baed 4667 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (frame);
ee78dc32 4668 Lisp_Object xfocus;
fbd6baed 4669 if (! dpyinfo->w32_focus_frame)
ee78dc32
GV
4670 return Qnil;
4671
fbd6baed 4672 XSETFRAME (xfocus, dpyinfo->w32_focus_frame);
ee78dc32
GV
4673 return xfocus;
4674}
1edf84e7 4675
334a1195 4676DEFUN ("x-focus-frame", Fx_focus_frame, Sx_focus_frame, 1, 1, 0,
74e1aeec 4677 doc: /* Give FRAME input focus, raising to foreground if necessary. */)
1edf84e7
GV
4678 (frame)
4679 Lisp_Object frame;
4680{
4681 x_focus_on_frame (check_x_frame (frame));
4682 return Qnil;
4683}
4684
ee78dc32 4685\f
767b1ff0 4686/* Return the charset portion of a font name. */
74084731
JB
4687char *
4688xlfd_charset_of_font (char * fontname)
767b1ff0
JR
4689{
4690 char *charset, *encoding;
4691
74084731 4692 encoding = strrchr (fontname, '-');
ceb12877 4693 if (!encoding || encoding == fontname)
767b1ff0
JR
4694 return NULL;
4695
478ea067
AI
4696 for (charset = encoding - 1; charset >= fontname; charset--)
4697 if (*charset == '-')
4698 break;
767b1ff0 4699
74084731 4700 if (charset == fontname || strcmp (charset, "-*-*") == 0)
767b1ff0
JR
4701 return NULL;
4702
4703 return charset + 1;
4704}
4705
33d52f9c
GV
4706struct font_info *w32_load_bdf_font (struct frame *f, char *fontname,
4707 int size, char* filename);
8edb0a6f 4708static Lisp_Object w32_list_bdf_fonts (Lisp_Object pattern, int max_names);
c7501041
EZ
4709static BOOL w32_to_x_font (LOGFONT * lplf, char * lpxstr, int len,
4710 char * charset);
4711static BOOL x_to_w32_font (char *lpxstr, LOGFONT *lplogfont);
33d52f9c 4712
8edb0a6f 4713static struct font_info *
74084731 4714w32_load_system_font (f, fontname, size)
55dcfc15
AI
4715 struct frame *f;
4716 char * fontname;
4717 int size;
ee78dc32 4718{
4587b026
GV
4719 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
4720 Lisp_Object font_names;
4721
4587b026
GV
4722 /* Get a list of all the fonts that match this name. Once we
4723 have a list of matching fonts, we compare them against the fonts
4724 we already have loaded by comparing names. */
4725 font_names = w32_list_fonts (f, build_string (fontname), size, 100);
4726
4727 if (!NILP (font_names))
3c190163 4728 {
4587b026
GV
4729 Lisp_Object tail;
4730 int i;
4587b026
GV
4731
4732 /* First check if any are already loaded, as that is cheaper
4733 than loading another one. */
4734 for (i = 0; i < dpyinfo->n_fonts; i++)
8e713be6 4735 for (tail = font_names; CONSP (tail); tail = XCDR (tail))
6fc2811b
JR
4736 if (dpyinfo->font_table[i].name
4737 && (!strcmp (dpyinfo->font_table[i].name,
d5db4077 4738 SDATA (XCAR (tail)))
6fc2811b 4739 || !strcmp (dpyinfo->font_table[i].full_name,
d5db4077 4740 SDATA (XCAR (tail)))))
4587b026 4741 return (dpyinfo->font_table + i);
6fc2811b 4742
d5db4077 4743 fontname = (char *) SDATA (XCAR (font_names));
4587b026 4744 }
1075afa9 4745 else if (w32_strict_fontnames)
5ca0cd71
GV
4746 {
4747 /* If EnumFontFamiliesEx was available, we got a full list of
4748 fonts back so stop now to avoid the possibility of loading a
4749 random font. If we had to fall back to EnumFontFamilies, the
4750 list is incomplete, so continue whether the font we want was
4751 listed or not. */
4752 HMODULE gdi32 = GetModuleHandle ("gdi32.dll");
4753 FARPROC enum_font_families_ex
1075afa9 4754 = GetProcAddress (gdi32, "EnumFontFamiliesExA");
5ca0cd71
GV
4755 if (enum_font_families_ex)
4756 return NULL;
4757 }
4587b026
GV
4758
4759 /* Load the font and add it to the table. */
4760 {
767b1ff0 4761 char *full_name, *encoding, *charset;
4587b026
GV
4762 XFontStruct *font;
4763 struct font_info *fontp;
3c190163 4764 LOGFONT lf;
4587b026 4765 BOOL ok;
19c291d3 4766 int codepage;
6fc2811b 4767 int i;
5ac45f98 4768
4587b026 4769 if (!fontname || !x_to_w32_font (fontname, &lf))
3c190163 4770 return (NULL);
5ac45f98 4771
4587b026
GV
4772 if (!*lf.lfFaceName)
4773 /* If no name was specified for the font, we get a random font
4774 from CreateFontIndirect - this is not particularly
4775 desirable, especially since CreateFontIndirect does not
4776 fill out the missing name in lf, so we never know what we
4777 ended up with. */
4778 return NULL;
4779
c8d88d08 4780 lf.lfQuality = DEFAULT_QUALITY;
d65a9cdc 4781
3c190163 4782 font = (XFontStruct *) xmalloc (sizeof (XFontStruct));
c6be3860 4783 bzero (font, sizeof (*font));
5ac45f98 4784
33d52f9c
GV
4785 /* Set bdf to NULL to indicate that this is a Windows font. */
4786 font->bdf = NULL;
5ac45f98 4787
3c190163 4788 BLOCK_INPUT;
5ac45f98
GV
4789
4790 font->hfont = CreateFontIndirect (&lf);
ee78dc32 4791
7d0393cf 4792 if (font->hfont == NULL)
1a292d24
AI
4793 {
4794 ok = FALSE;
7d0393cf
JB
4795 }
4796 else
1a292d24
AI
4797 {
4798 HDC hdc;
4799 HANDLE oldobj;
19c291d3
AI
4800
4801 codepage = w32_codepage_for_font (fontname);
1a292d24
AI
4802
4803 hdc = GetDC (dpyinfo->root_window);
4804 oldobj = SelectObject (hdc, font->hfont);
5c6682be 4805
1a292d24 4806 ok = GetTextMetrics (hdc, &font->tm);
5c6682be
JR
4807 if (codepage == CP_UNICODE)
4808 font->double_byte_p = 1;
4809 else
8b77111c
AI
4810 {
4811 /* Unfortunately, some fonts (eg. MingLiU, a big5 ttf font)
4812 don't report themselves as double byte fonts, when
4813 patently they are. So instead of trusting
4814 GetFontLanguageInfo, we check the properties of the
4815 codepage directly, since that is ultimately what we are
4816 working from anyway. */
74084731 4817 /* font->double_byte_p = GetFontLanguageInfo (hdc) & GCP_DBCS; */
8b77111c
AI
4818 CPINFO cpi = {0};
4819 GetCPInfo (codepage, &cpi);
4820 font->double_byte_p = cpi.MaxCharSize > 1;
4821 }
5c6682be 4822
1a292d24
AI
4823 SelectObject (hdc, oldobj);
4824 ReleaseDC (dpyinfo->root_window, hdc);
6fc2811b
JR
4825 /* Fill out details in lf according to the font that was
4826 actually loaded. */
4827 lf.lfHeight = font->tm.tmInternalLeading - font->tm.tmHeight;
ad5674f5 4828 lf.lfWidth = font->tm.tmMaxCharWidth;
6fc2811b
JR
4829 lf.lfWeight = font->tm.tmWeight;
4830 lf.lfItalic = font->tm.tmItalic;
4831 lf.lfCharSet = font->tm.tmCharSet;
4832 lf.lfPitchAndFamily = ((font->tm.tmPitchAndFamily & TMPF_FIXED_PITCH)
d88c567c 4833 ? VARIABLE_PITCH : FIXED_PITCH);
6fc2811b
JR
4834 lf.lfOutPrecision = ((font->tm.tmPitchAndFamily & TMPF_VECTOR)
4835 ? OUT_STROKE_PRECIS : OUT_STRING_PRECIS);
c6be3860
AI
4836
4837 w32_cache_char_metrics (font);
1a292d24 4838 }
5ac45f98 4839
1a292d24 4840 UNBLOCK_INPUT;
5ac45f98 4841
4587b026
GV
4842 if (!ok)
4843 {
1a292d24
AI
4844 w32_unload_font (dpyinfo, font);
4845 return (NULL);
4846 }
ee78dc32 4847
6fc2811b
JR
4848 /* Find a free slot in the font table. */
4849 for (i = 0; i < dpyinfo->n_fonts; ++i)
4850 if (dpyinfo->font_table[i].name == NULL)
4851 break;
4852
4853 /* If no free slot found, maybe enlarge the font table. */
4854 if (i == dpyinfo->n_fonts
4855 && dpyinfo->n_fonts == dpyinfo->font_table_size)
4587b026 4856 {
6fc2811b
JR
4857 int sz;
4858 dpyinfo->font_table_size = max (16, 2 * dpyinfo->font_table_size);
4859 sz = dpyinfo->font_table_size * sizeof *dpyinfo->font_table;
4587b026 4860 dpyinfo->font_table
6fc2811b 4861 = (struct font_info *) xrealloc (dpyinfo->font_table, sz);
4587b026
GV
4862 }
4863
6fc2811b
JR
4864 fontp = dpyinfo->font_table + i;
4865 if (i == dpyinfo->n_fonts)
4866 ++dpyinfo->n_fonts;
4587b026
GV
4867
4868 /* Now fill in the slots of *FONTP. */
4869 BLOCK_INPUT;
10b4bc33 4870 bzero (fontp, sizeof (*fontp));
4587b026 4871 fontp->font = font;
6fc2811b 4872 fontp->font_idx = i;
4587b026
GV
4873 fontp->name = (char *) xmalloc (strlen (fontname) + 1);
4874 bcopy (fontname, fontp->name, strlen (fontname) + 1);
4875
77857595 4876 if ((lf.lfPitchAndFamily & 0x03) == FIXED_PITCH)
ad5674f5
JR
4877 {
4878 /* Fixed width font. */
88fce384 4879 fontp->average_width = fontp->space_width = FONT_AVG_WIDTH (font);
ad5674f5
JR
4880 }
4881 else
4882 {
4883 wchar_t space = 32;
4884 XCharStruct* pcm;
4885 pcm = w32_per_char_metric (font, &space, ANSI_FONT);
4886 if (pcm)
4887 fontp->space_width = pcm->width;
4888 else
88fce384 4889 fontp->space_width = FONT_AVG_WIDTH (font);
ad5674f5
JR
4890
4891 fontp->average_width = font->tm.tmAveCharWidth;
4892 }
4893
f1de3410 4894 fontp->charset = -1;
767b1ff0
JR
4895 charset = xlfd_charset_of_font (fontname);
4896
19c291d3
AI
4897 /* Cache the W32 codepage for a font. This makes w32_encode_char
4898 (called for every glyph during redisplay) much faster. */
4899 fontp->codepage = codepage;
4900
4587b026
GV
4901 /* Work out the font's full name. */
4902 full_name = (char *)xmalloc (100);
767b1ff0 4903 if (full_name && w32_to_x_font (&lf, full_name, 100, charset))
4587b026
GV
4904 fontp->full_name = full_name;
4905 else
4906 {
4907 /* If all else fails - just use the name we used to load it. */
4908 xfree (full_name);
4909 fontp->full_name = fontp->name;
4910 }
4911
4912 fontp->size = FONT_WIDTH (font);
4913 fontp->height = FONT_HEIGHT (font);
4914
4915 /* The slot `encoding' specifies how to map a character
4916 code-points (0x20..0x7F or 0x2020..0x7F7F) of each charset to
126f2e35
JR
4917 the font code-points (0:0x20..0x7F, 1:0xA0..0xFF), or
4918 (0:0x20..0x7F, 1:0xA0..0xFF,
4919 (0:0x2020..0x7F7F, 1:0xA0A0..0xFFFF, 3:0x20A0..0x7FFF,
4587b026 4920 2:0xA020..0xFF7F). For the moment, we don't know which charset
10b4bc33 4921 uses this font. So, we set information in fontp->encoding_type
4587b026
GV
4922 which is never used by any charset. If mapping can't be
4923 decided, set FONT_ENCODING_NOT_DECIDED. */
33d52f9c
GV
4924
4925 /* SJIS fonts need to be set to type 4, all others seem to work as
4926 type FONT_ENCODING_NOT_DECIDED. */
4927 encoding = strrchr (fontp->name, '-');
d84b082d 4928 if (encoding && strnicmp (encoding+1, "sjis", 4) == 0)
10b4bc33 4929 fontp->encoding_type = 4;
33d52f9c 4930 else
10b4bc33 4931 fontp->encoding_type = FONT_ENCODING_NOT_DECIDED;
4587b026
GV
4932
4933 /* The following three values are set to 0 under W32, which is
4934 what they get set to if XGetFontProperty fails under X. */
4935 fontp->baseline_offset = 0;
4936 fontp->relative_compose = 0;
33d52f9c 4937 fontp->default_ascent = 0;
4587b026 4938
6fc2811b
JR
4939 /* Set global flag fonts_changed_p to non-zero if the font loaded
4940 has a character with a smaller width than any other character
f7b9d4d1 4941 before, or if the font loaded has a smaller height than any
6fc2811b
JR
4942 other font loaded before. If this happens, it will make a
4943 glyph matrix reallocation necessary. */
f7b9d4d1 4944 fonts_changed_p |= x_compute_min_glyph_bounds (f);
4587b026 4945 UNBLOCK_INPUT;
4587b026
GV
4946 return fontp;
4947 }
4948}
4949
33d52f9c
GV
4950/* Load font named FONTNAME of size SIZE for frame F, and return a
4951 pointer to the structure font_info while allocating it dynamically.
4952 If loading fails, return NULL. */
4953struct font_info *
74084731
JB
4954w32_load_font (f, fontname, size)
4955 struct frame *f;
4956 char * fontname;
4957 int size;
33d52f9c
GV
4958{
4959 Lisp_Object bdf_fonts;
4960 struct font_info *retval = NULL;
63e50ea6 4961 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
33d52f9c 4962
8edb0a6f 4963 bdf_fonts = w32_list_bdf_fonts (build_string (fontname), 1);
33d52f9c
GV
4964
4965 while (!retval && CONSP (bdf_fonts))
4966 {
4967 char *bdf_name, *bdf_file;
4968 Lisp_Object bdf_pair;
63e50ea6 4969 int i;
33d52f9c 4970
d5db4077 4971 bdf_name = SDATA (XCAR (bdf_fonts));
8e713be6 4972 bdf_pair = Fassoc (XCAR (bdf_fonts), Vw32_bdf_filename_alist);
d5db4077 4973 bdf_file = SDATA (XCDR (bdf_pair));
33d52f9c 4974
64f0809d 4975 /* If the font is already loaded, do not load it again. */
63e50ea6
JR
4976 for (i = 0; i < dpyinfo->n_fonts; i++)
4977 {
4978 if ((dpyinfo->font_table[i].name
4979 && !strcmp (dpyinfo->font_table[i].name, bdf_name))
4980 || (dpyinfo->font_table[i].full_name
4981 && !strcmp (dpyinfo->font_table[i].full_name, bdf_name)))
745e0c15 4982 return dpyinfo->font_table + i;
63e50ea6
JR
4983 }
4984
33d52f9c
GV
4985 retval = w32_load_bdf_font (f, bdf_name, size, bdf_file);
4986
8e713be6 4987 bdf_fonts = XCDR (bdf_fonts);
33d52f9c
GV
4988 }
4989
4990 if (retval)
4991 return retval;
4992
74084731 4993 return w32_load_system_font (f, fontname, size);
33d52f9c
GV
4994}
4995
4996
7d0393cf 4997void
fbd6baed
GV
4998w32_unload_font (dpyinfo, font)
4999 struct w32_display_info *dpyinfo;
ee78dc32
GV
5000 XFontStruct * font;
5001{
7d0393cf 5002 if (font)
ee78dc32 5003 {
c6be3860 5004 if (font->per_char) xfree (font->per_char);
33d52f9c
GV
5005 if (font->bdf) w32_free_bdf_font (font->bdf);
5006
74084731 5007 if (font->hfont) DeleteObject (font->hfont);
ee78dc32
GV
5008 xfree (font);
5009 }
5010}
5011
fbd6baed 5012/* The font conversion stuff between x and w32 */
ee78dc32
GV
5013
5014/* X font string is as follows (from faces.el)
5015 * (let ((- "[-?]")
5016 * (foundry "[^-]+")
5017 * (family "[^-]+")
5018 * (weight "\\(bold\\|demibold\\|medium\\)") ; 1
5019 * (weight\? "\\([^-]*\\)") ; 1
5020 * (slant "\\([ior]\\)") ; 2
5021 * (slant\? "\\([^-]?\\)") ; 2
5022 * (swidth "\\([^-]*\\)") ; 3
5023 * (adstyle "[^-]*") ; 4
5024 * (pixelsize "[0-9]+")
5025 * (pointsize "[0-9][0-9]+")
5026 * (resx "[0-9][0-9]+")
5027 * (resy "[0-9][0-9]+")
5028 * (spacing "[cmp?*]")
5029 * (avgwidth "[0-9]+")
5030 * (registry "[^-]+")
5031 * (encoding "[^-]+")
5032 * )
ee78dc32 5033 */
ee78dc32 5034
7d0393cf 5035static LONG
fbd6baed 5036x_to_w32_weight (lpw)
ee78dc32
GV
5037 char * lpw;
5038{
5039 if (!lpw) return (FW_DONTCARE);
5ac45f98 5040
74084731
JB
5041 if (stricmp (lpw, "heavy") == 0) return FW_HEAVY;
5042 else if (stricmp (lpw, "extrabold") == 0) return FW_EXTRABOLD;
5043 else if (stricmp (lpw, "bold") == 0) return FW_BOLD;
5044 else if (stricmp (lpw, "demibold") == 0) return FW_SEMIBOLD;
5045 else if (stricmp (lpw, "semibold") == 0) return FW_SEMIBOLD;
5046 else if (stricmp (lpw, "medium") == 0) return FW_MEDIUM;
5047 else if (stricmp (lpw, "normal") == 0) return FW_NORMAL;
5048 else if (stricmp (lpw, "light") == 0) return FW_LIGHT;
5049 else if (stricmp (lpw, "extralight") == 0) return FW_EXTRALIGHT;
5050 else if (stricmp (lpw, "thin") == 0) return FW_THIN;
ee78dc32 5051 else
5ac45f98 5052 return FW_DONTCARE;
ee78dc32
GV
5053}
5054
5ac45f98 5055
7d0393cf 5056static char *
fbd6baed 5057w32_to_x_weight (fnweight)
ee78dc32
GV
5058 int fnweight;
5059{
5ac45f98
GV
5060 if (fnweight >= FW_HEAVY) return "heavy";
5061 if (fnweight >= FW_EXTRABOLD) return "extrabold";
5062 if (fnweight >= FW_BOLD) return "bold";
03f8fb34 5063 if (fnweight >= FW_SEMIBOLD) return "demibold";
5ac45f98
GV
5064 if (fnweight >= FW_MEDIUM) return "medium";
5065 if (fnweight >= FW_NORMAL) return "normal";
5066 if (fnweight >= FW_LIGHT) return "light";
5067 if (fnweight >= FW_EXTRALIGHT) return "extralight";
5068 if (fnweight >= FW_THIN) return "thin";
5069 else
5070 return "*";
5071}
5072
a1fe5c00 5073LONG
fbd6baed 5074x_to_w32_charset (lpcs)
5ac45f98
GV
5075 char * lpcs;
5076{
767b1ff0 5077 Lisp_Object this_entry, w32_charset;
8b77111c
AI
5078 char *charset;
5079 int len = strlen (lpcs);
5080
5081 /* Support "*-#nnn" format for unknown charsets. */
5082 if (strncmp (lpcs, "*-#", 3) == 0)
5083 return atoi (lpcs + 3);
5084
f1de3410
JR
5085 /* All Windows fonts qualify as unicode. */
5086 if (!strncmp (lpcs, "iso10646", 8))
5087 return DEFAULT_CHARSET;
5088
8b77111c
AI
5089 /* Handle wildcards by ignoring them; eg. treat "big5*-*" as "big5". */
5090 charset = alloca (len + 1);
5091 strcpy (charset, lpcs);
5092 lpcs = strchr (charset, '*');
5093 if (lpcs)
f1de3410 5094 *lpcs = '\0';
4587b026 5095
dfff8a69
JR
5096 /* Look through w32-charset-info-alist for the character set.
5097 Format of each entry is
5098 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
5099 */
74084731 5100 this_entry = Fassoc (build_string (charset), Vw32_charset_info_alist);
4587b026 5101
74084731 5102 if (NILP (this_entry))
767b1ff0
JR
5103 {
5104 /* At startup, we want iso8859-1 fonts to come up properly. */
74084731 5105 if (stricmp (charset, "iso8859-1") == 0)
767b1ff0
JR
5106 return ANSI_CHARSET;
5107 else
5108 return DEFAULT_CHARSET;
5109 }
5110
5111 w32_charset = Fcar (Fcdr (this_entry));
5112
d84b082d 5113 /* Translate Lisp symbol to number. */
2ba49441 5114 if (EQ (w32_charset, Qw32_charset_ansi))
767b1ff0 5115 return ANSI_CHARSET;
2ba49441 5116 if (EQ (w32_charset, Qw32_charset_symbol))
767b1ff0 5117 return SYMBOL_CHARSET;
2ba49441 5118 if (EQ (w32_charset, Qw32_charset_shiftjis))
767b1ff0 5119 return SHIFTJIS_CHARSET;
2ba49441 5120 if (EQ (w32_charset, Qw32_charset_hangeul))
767b1ff0 5121 return HANGEUL_CHARSET;
2ba49441 5122 if (EQ (w32_charset, Qw32_charset_chinesebig5))
767b1ff0 5123 return CHINESEBIG5_CHARSET;
2ba49441 5124 if (EQ (w32_charset, Qw32_charset_gb2312))
767b1ff0 5125 return GB2312_CHARSET;
2ba49441 5126 if (EQ (w32_charset, Qw32_charset_oem))
767b1ff0 5127 return OEM_CHARSET;
dfff8a69 5128#ifdef JOHAB_CHARSET
2ba49441 5129 if (EQ (w32_charset, Qw32_charset_johab))
767b1ff0 5130 return JOHAB_CHARSET;
2ba49441 5131 if (EQ (w32_charset, Qw32_charset_easteurope))
767b1ff0 5132 return EASTEUROPE_CHARSET;
2ba49441 5133 if (EQ (w32_charset, Qw32_charset_turkish))
767b1ff0 5134 return TURKISH_CHARSET;
2ba49441 5135 if (EQ (w32_charset, Qw32_charset_baltic))
767b1ff0 5136 return BALTIC_CHARSET;
2ba49441 5137 if (EQ (w32_charset, Qw32_charset_russian))
767b1ff0 5138 return RUSSIAN_CHARSET;
2ba49441 5139 if (EQ (w32_charset, Qw32_charset_arabic))
767b1ff0 5140 return ARABIC_CHARSET;
2ba49441 5141 if (EQ (w32_charset, Qw32_charset_greek))
767b1ff0 5142 return GREEK_CHARSET;
2ba49441 5143 if (EQ (w32_charset, Qw32_charset_hebrew))
767b1ff0 5144 return HEBREW_CHARSET;
2ba49441 5145 if (EQ (w32_charset, Qw32_charset_vietnamese))
767b1ff0 5146 return VIETNAMESE_CHARSET;
2ba49441 5147 if (EQ (w32_charset, Qw32_charset_thai))
767b1ff0 5148 return THAI_CHARSET;
2ba49441 5149 if (EQ (w32_charset, Qw32_charset_mac))
767b1ff0 5150 return MAC_CHARSET;
dfff8a69 5151#endif /* JOHAB_CHARSET */
5ac45f98 5152#ifdef UNICODE_CHARSET
2ba49441 5153 if (EQ (w32_charset, Qw32_charset_unicode))
767b1ff0 5154 return UNICODE_CHARSET;
5ac45f98 5155#endif
dfff8a69
JR
5156
5157 return DEFAULT_CHARSET;
5ac45f98
GV
5158}
5159
dfff8a69 5160
a1fe5c00 5161char *
f1de3410 5162w32_to_x_charset (fncharset, matching)
5ac45f98 5163 int fncharset;
f1de3410 5164 char *matching;
5ac45f98 5165{
5e905a57 5166 static char buf[32];
767b1ff0 5167 Lisp_Object charset_type;
f1de3410
JR
5168 int match_len = 0;
5169
5170 if (matching)
5171 {
5172 /* If fully specified, accept it as it is. Otherwise use a
5173 substring match. */
5174 char *wildcard = strchr (matching, '*');
5175 if (wildcard)
5176 *wildcard = '\0';
5177 else if (strchr (matching, '-'))
5178 return matching;
5179
5180 match_len = strlen (matching);
5181 }
1edf84e7 5182
5ac45f98
GV
5183 switch (fncharset)
5184 {
767b1ff0
JR
5185 case ANSI_CHARSET:
5186 /* Handle startup case of w32-charset-info-alist not
5187 being set up yet. */
74084731 5188 if (NILP (Vw32_charset_info_alist))
767b1ff0
JR
5189 return "iso8859-1";
5190 charset_type = Qw32_charset_ansi;
5191 break;
5192 case DEFAULT_CHARSET:
5193 charset_type = Qw32_charset_default;
5194 break;
5195 case SYMBOL_CHARSET:
5196 charset_type = Qw32_charset_symbol;
5197 break;
5198 case SHIFTJIS_CHARSET:
5199 charset_type = Qw32_charset_shiftjis;
5200 break;
5201 case HANGEUL_CHARSET:
5202 charset_type = Qw32_charset_hangeul;
5203 break;
5204 case GB2312_CHARSET:
5205 charset_type = Qw32_charset_gb2312;
5206 break;
5207 case CHINESEBIG5_CHARSET:
5208 charset_type = Qw32_charset_chinesebig5;
5209 break;
5210 case OEM_CHARSET:
5211 charset_type = Qw32_charset_oem;
5212 break;
4587b026
GV
5213
5214 /* More recent versions of Windows (95 and NT4.0) define more
5215 character sets. */
5216#ifdef EASTEUROPE_CHARSET
767b1ff0
JR
5217 case EASTEUROPE_CHARSET:
5218 charset_type = Qw32_charset_easteurope;
5219 break;
5220 case TURKISH_CHARSET:
5221 charset_type = Qw32_charset_turkish;
5222 break;
5223 case BALTIC_CHARSET:
5224 charset_type = Qw32_charset_baltic;
5225 break;
33d52f9c 5226 case RUSSIAN_CHARSET:
767b1ff0
JR
5227 charset_type = Qw32_charset_russian;
5228 break;
5229 case ARABIC_CHARSET:
5230 charset_type = Qw32_charset_arabic;
5231 break;
5232 case GREEK_CHARSET:
5233 charset_type = Qw32_charset_greek;
5234 break;
5235 case HEBREW_CHARSET:
5236 charset_type = Qw32_charset_hebrew;
5237 break;
5238 case VIETNAMESE_CHARSET:
5239 charset_type = Qw32_charset_vietnamese;
5240 break;
5241 case THAI_CHARSET:
5242 charset_type = Qw32_charset_thai;
5243 break;
5244 case MAC_CHARSET:
5245 charset_type = Qw32_charset_mac;
5246 break;
5247 case JOHAB_CHARSET:
5248 charset_type = Qw32_charset_johab;
5249 break;
4587b026
GV
5250#endif
5251
5ac45f98 5252#ifdef UNICODE_CHARSET
767b1ff0
JR
5253 case UNICODE_CHARSET:
5254 charset_type = Qw32_charset_unicode;
5255 break;
5ac45f98 5256#endif
767b1ff0
JR
5257 default:
5258 /* Encode numerical value of unknown charset. */
5259 sprintf (buf, "*-#%u", fncharset);
5260 return buf;
5ac45f98 5261 }
7d0393cf 5262
767b1ff0
JR
5263 {
5264 Lisp_Object rest;
5265 char * best_match = NULL;
f1de3410 5266 int matching_found = 0;
767b1ff0
JR
5267
5268 /* Look through w32-charset-info-alist for the character set.
5269 Prefer ISO codepages, and prefer lower numbers in the ISO
5270 range. Only return charsets for codepages which are installed.
5271
5272 Format of each entry is
5273 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
5274 */
5275 for (rest = Vw32_charset_info_alist; CONSP (rest); rest = XCDR (rest))
5276 {
5277 char * x_charset;
5278 Lisp_Object w32_charset;
5279 Lisp_Object codepage;
5280
5281 Lisp_Object this_entry = XCAR (rest);
5282
5283 /* Skip invalid entries in alist. */
5284 if (!CONSP (this_entry) || !STRINGP (XCAR (this_entry))
5285 || !CONSP (XCDR (this_entry))
5286 || !SYMBOLP (XCAR (XCDR (this_entry))))
5287 continue;
5288
d5db4077 5289 x_charset = SDATA (XCAR (this_entry));
767b1ff0
JR
5290 w32_charset = XCAR (XCDR (this_entry));
5291 codepage = XCDR (XCDR (this_entry));
5292
5293 /* Look for Same charset and a valid codepage (or non-int
5294 which means ignore). */
2ba49441
JR
5295 if (EQ (w32_charset, charset_type)
5296 && (!INTEGERP (codepage) || XINT (codepage) == CP_DEFAULT
767b1ff0
JR
5297 || IsValidCodePage (XINT (codepage))))
5298 {
5299 /* If we don't have a match already, then this is the
5300 best. */
5301 if (!best_match)
f1de3410
JR
5302 {
5303 best_match = x_charset;
5304 if (matching && !strnicmp (x_charset, matching, match_len))
5305 matching_found = 1;
5306 }
5307 /* If we already found a match for MATCHING, then
5308 only consider other matches. */
5309 else if (matching_found
5310 && strnicmp (x_charset, matching, match_len))
5311 continue;
5312 /* If this matches what we want, and the best so far doesn't,
5313 then this is better. */
5314 else if (!matching_found && matching
5315 && !strnicmp (x_charset, matching, match_len))
5316 {
5317 best_match = x_charset;
5318 matching_found = 1;
5319 }
5320 /* If this is fully specified, and the best so far isn't,
5321 then this is better. */
5322 else if ((!strchr (best_match, '-') && strchr (x_charset, '-'))
5323 /* If this is an ISO codepage, and the best so far isn't,
5324 then this is better, but only if it fully specifies the
5325 encoding. */
5326 || (strnicmp (best_match, "iso", 3) != 0
5327 && strnicmp (x_charset, "iso", 3) == 0
5328 && strchr (x_charset, '-')))
5329 best_match = x_charset;
767b1ff0
JR
5330 /* If both are ISO8859 codepages, choose the one with the
5331 lowest number in the encoding field. */
d84b082d
JR
5332 else if (strnicmp (best_match, "iso8859-", 8) == 0
5333 && strnicmp (x_charset, "iso8859-", 8) == 0)
767b1ff0
JR
5334 {
5335 int best_enc = atoi (best_match + 8);
5336 int this_enc = atoi (x_charset + 8);
5337 if (this_enc > 0 && this_enc < best_enc)
5338 best_match = x_charset;
7d0393cf 5339 }
767b1ff0
JR
5340 }
5341 }
5342
5343 /* If no match, encode the numeric value. */
5344 if (!best_match)
5345 {
5346 sprintf (buf, "*-#%u", fncharset);
5347 return buf;
5348 }
5349
f1de3410
JR
5350 strncpy (buf, best_match, 31);
5351 /* If the charset is not fully specified, put -0 on the end. */
5352 if (!strchr (best_match, '-'))
5353 {
5354 int pos = strlen (best_match);
5355 /* Charset specifiers shouldn't be very long. If it is a made
5356 up one, truncating it should not do any harm since it isn't
5357 recognized anyway. */
5358 if (pos > 29)
5359 pos = 29;
5360 strcpy (buf + pos, "-0");
5361 }
5e905a57 5362 buf[31] = '\0';
767b1ff0
JR
5363 return buf;
5364 }
ee78dc32
GV
5365}
5366
dfff8a69 5367
d84b082d
JR
5368/* Return all the X charsets that map to a font. */
5369static Lisp_Object
5370w32_to_all_x_charsets (fncharset)
5371 int fncharset;
5372{
5373 static char buf[32];
5374 Lisp_Object charset_type;
5375 Lisp_Object retval = Qnil;
5376
5377 switch (fncharset)
5378 {
5379 case ANSI_CHARSET:
5380 /* Handle startup case of w32-charset-info-alist not
5381 being set up yet. */
74084731 5382 if (NILP (Vw32_charset_info_alist))
d86c35ee
JR
5383 return Fcons (build_string ("iso8859-1"), Qnil);
5384
d84b082d
JR
5385 charset_type = Qw32_charset_ansi;
5386 break;
5387 case DEFAULT_CHARSET:
5388 charset_type = Qw32_charset_default;
5389 break;
5390 case SYMBOL_CHARSET:
5391 charset_type = Qw32_charset_symbol;
5392 break;
5393 case SHIFTJIS_CHARSET:
5394 charset_type = Qw32_charset_shiftjis;
5395 break;
5396 case HANGEUL_CHARSET:
5397 charset_type = Qw32_charset_hangeul;
5398 break;
5399 case GB2312_CHARSET:
5400 charset_type = Qw32_charset_gb2312;
5401 break;
5402 case CHINESEBIG5_CHARSET:
5403 charset_type = Qw32_charset_chinesebig5;
5404 break;
5405 case OEM_CHARSET:
5406 charset_type = Qw32_charset_oem;
5407 break;
5408
5409 /* More recent versions of Windows (95 and NT4.0) define more
5410 character sets. */
5411#ifdef EASTEUROPE_CHARSET
5412 case EASTEUROPE_CHARSET:
5413 charset_type = Qw32_charset_easteurope;
5414 break;
5415 case TURKISH_CHARSET:
5416 charset_type = Qw32_charset_turkish;
5417 break;
5418 case BALTIC_CHARSET:
5419 charset_type = Qw32_charset_baltic;
5420 break;
5421 case RUSSIAN_CHARSET:
5422 charset_type = Qw32_charset_russian;
5423 break;
5424 case ARABIC_CHARSET:
5425 charset_type = Qw32_charset_arabic;
5426 break;
5427 case GREEK_CHARSET:
5428 charset_type = Qw32_charset_greek;
5429 break;
5430 case HEBREW_CHARSET:
5431 charset_type = Qw32_charset_hebrew;
5432 break;
5433 case VIETNAMESE_CHARSET:
5434 charset_type = Qw32_charset_vietnamese;
5435 break;
5436 case THAI_CHARSET:
5437 charset_type = Qw32_charset_thai;
5438 break;
5439 case MAC_CHARSET:
5440 charset_type = Qw32_charset_mac;
5441 break;
5442 case JOHAB_CHARSET:
5443 charset_type = Qw32_charset_johab;
5444 break;
5445#endif
5446
5447#ifdef UNICODE_CHARSET
5448 case UNICODE_CHARSET:
5449 charset_type = Qw32_charset_unicode;
5450 break;
5451#endif
5452 default:
5453 /* Encode numerical value of unknown charset. */
5454 sprintf (buf, "*-#%u", fncharset);
5455 return Fcons (build_string (buf), Qnil);
5456 }
7d0393cf 5457
d84b082d
JR
5458 {
5459 Lisp_Object rest;
5460 /* Look through w32-charset-info-alist for the character set.
f1de3410
JR
5461 Only return fully specified charsets for codepages which are
5462 installed.
d84b082d
JR
5463
5464 Format of each entry in Vw32_charset_info_alist is
5465 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
5466 */
5467 for (rest = Vw32_charset_info_alist; CONSP (rest); rest = XCDR (rest))
5468 {
5469 Lisp_Object x_charset;
5470 Lisp_Object w32_charset;
5471 Lisp_Object codepage;
5472
5473 Lisp_Object this_entry = XCAR (rest);
5474
5475 /* Skip invalid entries in alist. */
5476 if (!CONSP (this_entry) || !STRINGP (XCAR (this_entry))
5477 || !CONSP (XCDR (this_entry))
5478 || !SYMBOLP (XCAR (XCDR (this_entry))))
5479 continue;
5480
5481 x_charset = XCAR (this_entry);
5482 w32_charset = XCAR (XCDR (this_entry));
5483 codepage = XCDR (XCDR (this_entry));
5484
f1de3410
JR
5485 if (!strchr (SDATA (x_charset), '-'))
5486 continue;
5487
d84b082d
JR
5488 /* Look for Same charset and a valid codepage (or non-int
5489 which means ignore). */
2ba49441
JR
5490 if (EQ (w32_charset, charset_type)
5491 && (!INTEGERP (codepage) || XINT (codepage) == CP_DEFAULT
d84b082d
JR
5492 || IsValidCodePage (XINT (codepage))))
5493 {
5494 retval = Fcons (x_charset, retval);
5495 }
5496 }
5497
5498 /* If no match, encode the numeric value. */
5499 if (NILP (retval))
5500 {
5501 sprintf (buf, "*-#%u", fncharset);
5502 return Fcons (build_string (buf), Qnil);
5503 }
5504
5505 return retval;
5506 }
5507}
5508
dfff8a69
JR
5509/* Get the Windows codepage corresponding to the specified font. The
5510 charset info in the font name is used to look up
5511 w32-charset-to-codepage-alist. */
7d0393cf 5512int
dfff8a69
JR
5513w32_codepage_for_font (char *fontname)
5514{
767b1ff0
JR
5515 Lisp_Object codepage, entry;
5516 char *charset_str, *charset, *end;
dfff8a69 5517
767b1ff0
JR
5518 /* Extract charset part of font string. */
5519 charset = xlfd_charset_of_font (fontname);
5520
5521 if (!charset)
ceb12877 5522 return CP_UNKNOWN;
767b1ff0 5523
8b77111c 5524 charset_str = (char *) alloca (strlen (charset) + 1);
767b1ff0
JR
5525 strcpy (charset_str, charset);
5526
8b77111c 5527#if 0
dfff8a69
JR
5528 /* Remove leading "*-". */
5529 if (strncmp ("*-", charset_str, 2) == 0)
5530 charset = charset_str + 2;
5531 else
8b77111c 5532#endif
dfff8a69
JR
5533 charset = charset_str;
5534
5535 /* Stop match at wildcard (including preceding '-'). */
5536 if (end = strchr (charset, '*'))
5537 {
5538 if (end > charset && *(end-1) == '-')
5539 end--;
5540 *end = '\0';
5541 }
5542
f1de3410
JR
5543 if (!strcmp (charset, "iso10646"))
5544 return CP_UNICODE;
5545
5546 if (NILP (Vw32_charset_info_alist))
5547 return CP_DEFAULT;
5548
767b1ff0
JR
5549 entry = Fassoc (build_string(charset), Vw32_charset_info_alist);
5550 if (NILP (entry))
ceb12877 5551 return CP_UNKNOWN;
767b1ff0
JR
5552
5553 codepage = Fcdr (Fcdr (entry));
5554
5555 if (NILP (codepage))
5556 return CP_8BIT;
5557 else if (XFASTINT (codepage) == XFASTINT (Qt))
5558 return CP_UNICODE;
5559 else if (INTEGERP (codepage))
dfff8a69
JR
5560 return XINT (codepage);
5561 else
ceb12877 5562 return CP_UNKNOWN;
dfff8a69
JR
5563}
5564
5565
7d0393cf 5566static BOOL
767b1ff0 5567w32_to_x_font (lplogfont, lpxstr, len, specific_charset)
ee78dc32
GV
5568 LOGFONT * lplogfont;
5569 char * lpxstr;
5570 int len;
767b1ff0 5571 char * specific_charset;
ee78dc32 5572{
6fc2811b 5573 char* fonttype;
f46e6225 5574 char *fontname;
3cb20f4a
RS
5575 char height_pixels[8];
5576 char height_dpi[8];
5577 char width_pixels[8];
4587b026 5578 char *fontname_dash;
ac849ba4
JR
5579 int display_resy = (int) one_w32_display_info.resy;
5580 int display_resx = (int) one_w32_display_info.resx;
f46e6225 5581 struct coding_system coding;
3cb20f4a
RS
5582
5583 if (!lpxstr) abort ();
ee78dc32 5584
3cb20f4a
RS
5585 if (!lplogfont)
5586 return FALSE;
5587
6fc2811b
JR
5588 if (lplogfont->lfOutPrecision == OUT_STRING_PRECIS)
5589 fonttype = "raster";
5590 else if (lplogfont->lfOutPrecision == OUT_STROKE_PRECIS)
5591 fonttype = "outline";
5592 else
5593 fonttype = "unknown";
5594
1fa3a200 5595 setup_coding_system (Fcheck_coding_system (Vlocale_coding_system),
f46e6225 5596 &coding);
aab5ac44
KH
5597 coding.src_multibyte = 0;
5598 coding.dst_multibyte = 1;
f46e6225 5599 coding.mode |= CODING_MODE_LAST_BLOCK;
65413122
KH
5600 /* We explicitely disable composition handling because selection
5601 data should not contain any composition sequence. */
10b4bc33
JR
5602 coding.common_flags &= ~CODING_ANNOTATION_MASK;
5603
5604 coding.dst_bytes = LF_FACESIZE * 2;
5605 coding.destination = (unsigned char *) xmalloc (coding.dst_bytes + 1);
5606 decode_coding_c_string (&coding, lplogfont->lfFaceName,
5607 strlen(lplogfont->lfFaceName), Qnil);
5608 fontname = coding.destination;
f46e6225 5609
f46e6225 5610 *(fontname + coding.produced) = '\0';
4587b026
GV
5611
5612 /* Replace dashes with underscores so the dashes are not
f46e6225 5613 misinterpreted. */
4587b026
GV
5614 fontname_dash = fontname;
5615 while (fontname_dash = strchr (fontname_dash, '-'))
5616 *fontname_dash = '_';
5617
3cb20f4a 5618 if (lplogfont->lfHeight)
ee78dc32 5619 {
1ea40aa2 5620 sprintf (height_pixels, "%u", eabs (lplogfont->lfHeight));
3cb20f4a 5621 sprintf (height_dpi, "%u",
1ea40aa2 5622 eabs (lplogfont->lfHeight) * 720 / display_resy);
5ac45f98
GV
5623 }
5624 else
ee78dc32 5625 {
3cb20f4a
RS
5626 strcpy (height_pixels, "*");
5627 strcpy (height_dpi, "*");
ee78dc32 5628 }
813fa8a8
JR
5629
5630#if 0 /* Never put the width in the xfld. It fails on fonts with
5631 double-width characters. */
3cb20f4a
RS
5632 if (lplogfont->lfWidth)
5633 sprintf (width_pixels, "%u", lplogfont->lfWidth * 10);
5634 else
813fa8a8 5635#endif
3cb20f4a
RS
5636 strcpy (width_pixels, "*");
5637
5638 _snprintf (lpxstr, len - 1,
6fc2811b
JR
5639 "-%s-%s-%s-%c-normal-normal-%s-%s-%d-%d-%c-%s-%s",
5640 fonttype, /* foundry */
4587b026
GV
5641 fontname, /* family */
5642 w32_to_x_weight (lplogfont->lfWeight), /* weight */
5643 lplogfont->lfItalic?'i':'r', /* slant */
5644 /* setwidth name */
5645 /* add style name */
5646 height_pixels, /* pixel size */
5647 height_dpi, /* point size */
33d52f9c
GV
5648 display_resx, /* resx */
5649 display_resy, /* resy */
4587b026
GV
5650 ((lplogfont->lfPitchAndFamily & 0x3) == VARIABLE_PITCH)
5651 ? 'p' : 'c', /* spacing */
5652 width_pixels, /* avg width */
f1de3410 5653 w32_to_x_charset (lplogfont->lfCharSet, specific_charset)
767b1ff0 5654 /* charset registry and encoding */
3cb20f4a
RS
5655 );
5656
ee78dc32
GV
5657 lpxstr[len - 1] = 0; /* just to be sure */
5658 return (TRUE);
5659}
5660
7d0393cf 5661static BOOL
fbd6baed 5662x_to_w32_font (lpxstr, lplogfont)
ee78dc32
GV
5663 char * lpxstr;
5664 LOGFONT * lplogfont;
5665{
f46e6225
GV
5666 struct coding_system coding;
5667
ee78dc32 5668 if (!lplogfont) return (FALSE);
f46e6225 5669
ee78dc32 5670 memset (lplogfont, 0, sizeof (*lplogfont));
5ac45f98 5671
1a292d24 5672 /* Set default value for each field. */
771c47d5 5673#if 1
ee78dc32
GV
5674 lplogfont->lfOutPrecision = OUT_DEFAULT_PRECIS;
5675 lplogfont->lfClipPrecision = CLIP_DEFAULT_PRECIS;
5676 lplogfont->lfQuality = DEFAULT_QUALITY;
5ac45f98
GV
5677#else
5678 /* go for maximum quality */
5679 lplogfont->lfOutPrecision = OUT_STROKE_PRECIS;
5680 lplogfont->lfClipPrecision = CLIP_STROKE_PRECIS;
5681 lplogfont->lfQuality = PROOF_QUALITY;
5682#endif
5683
1a292d24
AI
5684 lplogfont->lfCharSet = DEFAULT_CHARSET;
5685 lplogfont->lfWeight = FW_DONTCARE;
5686 lplogfont->lfPitchAndFamily = DEFAULT_PITCH | FF_DONTCARE;
5687
5ac45f98
GV
5688 if (!lpxstr)
5689 return FALSE;
5690
5691 /* Provide a simple escape mechanism for specifying Windows font names
5692 * directly -- if font spec does not beginning with '-', assume this
5693 * format:
5694 * "<font name>[:height in pixels[:width in pixels[:weight]]]"
5695 */
7d0393cf 5696
5ac45f98
GV
5697 if (*lpxstr == '-')
5698 {
33d52f9c
GV
5699 int fields, tem;
5700 char name[50], weight[20], slant, pitch, pixels[10], height[10],
8b77111c 5701 width[10], resy[10], remainder[50];
5ac45f98 5702 char * encoding;
ac849ba4 5703 int dpi = (int) one_w32_display_info.resy;
5ac45f98
GV
5704
5705 fields = sscanf (lpxstr,
8b77111c 5706 "-%*[^-]-%49[^-]-%19[^-]-%c-%*[^-]-%*[^-]-%9[^-]-%9[^-]-%*[^-]-%9[^-]-%c-%9[^-]-%49s",
33d52f9c 5707 name, weight, &slant, pixels, height, resy, &pitch, width, remainder);
8b77111c
AI
5708 if (fields == EOF)
5709 return (FALSE);
5710
5711 /* In the general case when wildcards cover more than one field,
5712 we don't know which field is which, so don't fill any in.
5713 However, we need to cope with this particular form, which is
5714 generated by font_list_1 (invoked by try_font_list):
5715 "-raster-6x10-*-gb2312*-*"
5716 and make sure to correctly parse the charset field. */
5717 if (fields == 3)
5718 {
5719 fields = sscanf (lpxstr,
5720 "-%*[^-]-%49[^-]-*-%49s",
5721 name, remainder);
5722 }
5723 else if (fields < 9)
5724 {
5725 fields = 0;
5726 remainder[0] = 0;
5727 }
6fc2811b 5728
5ac45f98
GV
5729 if (fields > 0 && name[0] != '*')
5730 {
4f47337f 5731 Lisp_Object string = build_string (name);
f46e6225 5732 setup_coding_system
1fa3a200 5733 (Fcheck_coding_system (Vlocale_coding_system), &coding);
4f47337f 5734 coding.mode |= (CODING_MODE_SAFE_ENCODING | CODING_MODE_LAST_BLOCK);
6b61353c
KH
5735 /* Disable composition/charset annotation. */
5736 coding.common_flags &= ~CODING_ANNOTATION_MASK;
4f47337f
JR
5737 coding.dst_bytes = SCHARS (string) * 2;
5738
5739 coding.destination = (unsigned char *) xmalloc (coding.dst_bytes);
5740 encode_coding_object (&coding, string, 0, 0,
5741 SCHARS (string), SBYTES (string), Qnil);
8ea3e054
RS
5742 if (coding.produced >= LF_FACESIZE)
5743 coding.produced = LF_FACESIZE - 1;
10b4bc33
JR
5744
5745 coding.destination[coding.produced] = '\0';
5746
5747 strcpy (lplogfont->lfFaceName, coding.destination);
5748 xfree (coding.destination);
5ac45f98
GV
5749 }
5750 else
5751 {
6fc2811b 5752 lplogfont->lfFaceName[0] = '\0';
5ac45f98
GV
5753 }
5754
5755 fields--;
5756
fbd6baed 5757 lplogfont->lfWeight = x_to_w32_weight ((fields > 0 ? weight : ""));
5ac45f98
GV
5758
5759 fields--;
5760
c8874f14 5761 lplogfont->lfItalic = (fields > 0 && slant == 'i');
5ac45f98
GV
5762
5763 fields--;
5764
5765 if (fields > 0 && pixels[0] != '*')
5766 lplogfont->lfHeight = atoi (pixels);
5767
5768 fields--;
5ac45f98 5769 fields--;
33d52f9c
GV
5770 if (fields > 0 && resy[0] != '*')
5771 {
6fc2811b 5772 tem = atoi (resy);
33d52f9c
GV
5773 if (tem > 0) dpi = tem;
5774 }
5ac45f98 5775
33d52f9c
GV
5776 if (fields > -1 && lplogfont->lfHeight == 0 && height[0] != '*')
5777 lplogfont->lfHeight = atoi (height) * dpi / 720;
5778
5779 if (fields > 0)
77857595
JR
5780 {
5781 if (pitch == 'p')
5782 lplogfont->lfPitchAndFamily = VARIABLE_PITCH | FF_DONTCARE;
5783 else if (pitch == 'c')
5784 lplogfont->lfPitchAndFamily = FIXED_PITCH | FF_DONTCARE;
5785 }
5ac45f98
GV
5786
5787 fields--;
5788
5789 if (fields > 0 && width[0] != '*')
5790 lplogfont->lfWidth = atoi (width) / 10;
5791
5792 fields--;
5793
4587b026 5794 /* Strip the trailing '-' if present. (it shouldn't be, as it
d88c567c 5795 fails the test against xlfd-tight-regexp in fontset.el). */
3c190163 5796 {
5ac45f98
GV
5797 int len = strlen (remainder);
5798 if (len > 0 && remainder[len-1] == '-')
5799 remainder[len-1] = 0;
ee78dc32 5800 }
5ac45f98 5801 encoding = remainder;
8b77111c 5802#if 0
5ac45f98
GV
5803 if (strncmp (encoding, "*-", 2) == 0)
5804 encoding += 2;
8b77111c
AI
5805#endif
5806 lplogfont->lfCharSet = x_to_w32_charset (encoding);
5ac45f98
GV
5807 }
5808 else
5809 {
5810 int fields;
5811 char name[100], height[10], width[10], weight[20];
a1a80b40 5812
5ac45f98
GV
5813 fields = sscanf (lpxstr,
5814 "%99[^:]:%9[^:]:%9[^:]:%19s",
5815 name, height, width, weight);
5816
5817 if (fields == EOF) return (FALSE);
5818
5819 if (fields > 0)
5820 {
74084731 5821 strncpy (lplogfont->lfFaceName, name, LF_FACESIZE);
5ac45f98
GV
5822 lplogfont->lfFaceName[LF_FACESIZE-1] = 0;
5823 }
5824 else
5825 {
5826 lplogfont->lfFaceName[0] = 0;
5827 }
5828
5829 fields--;
5830
5831 if (fields > 0)
5832 lplogfont->lfHeight = atoi (height);
5833
5834 fields--;
5835
5836 if (fields > 0)
5837 lplogfont->lfWidth = atoi (width);
5838
5839 fields--;
5840
fbd6baed 5841 lplogfont->lfWeight = x_to_w32_weight ((fields > 0 ? weight : ""));
5ac45f98
GV
5842 }
5843
5844 /* This makes TrueType fonts work better. */
1ea40aa2 5845 lplogfont->lfHeight = - eabs (lplogfont->lfHeight);
6fc2811b 5846
ee78dc32
GV
5847 return (TRUE);
5848}
5849
d88c567c
JR
5850/* Strip the pixel height and point height from the given xlfd, and
5851 return the pixel height. If no pixel height is specified, calculate
5852 one from the point height, or if that isn't defined either, return
5853 0 (which usually signifies a scalable font).
5854*/
8edb0a6f
JR
5855static int
5856xlfd_strip_height (char *fontname)
d88c567c 5857{
8edb0a6f 5858 int pixel_height, field_number;
d88c567c
JR
5859 char *read_from, *write_to;
5860
5861 xassert (fontname);
5862
5863 pixel_height = field_number = 0;
5864 write_to = NULL;
5865
5866 /* Look for height fields. */
5867 for (read_from = fontname; *read_from; read_from++)
5868 {
5869 if (*read_from == '-')
5870 {
5871 field_number++;
5872 if (field_number == 7) /* Pixel height. */
5873 {
5874 read_from++;
5875 write_to = read_from;
5876
5877 /* Find end of field. */
5878 for (;*read_from && *read_from != '-'; read_from++)
5879 ;
5880
5881 /* Split the fontname at end of field. */
5882 if (*read_from)
5883 {
5884 *read_from = '\0';
5885 read_from++;
5886 }
5887 pixel_height = atoi (write_to);
5888 /* Blank out field. */
5889 if (read_from > write_to)
5890 {
5891 *write_to = '-';
5892 write_to++;
5893 }
767b1ff0 5894 /* If the pixel height field is at the end (partial xlfd),
d88c567c
JR
5895 return now. */
5896 else
5897 return pixel_height;
5898
5899 /* If we got a pixel height, the point height can be
5900 ignored. Just blank it out and break now. */
5901 if (pixel_height)
5902 {
5903 /* Find end of point size field. */
5904 for (; *read_from && *read_from != '-'; read_from++)
5905 ;
5906
5907 if (*read_from)
5908 read_from++;
5909
5910 /* Blank out the point size field. */
5911 if (read_from > write_to)
5912 {
5913 *write_to = '-';
5914 write_to++;
5915 }
5916 else
5917 return pixel_height;
5918
5919 break;
5920 }
5921 /* If the point height is already blank, break now. */
5922 if (*read_from == '-')
5923 {
5924 read_from++;
5925 break;
5926 }
5927 }
5928 else if (field_number == 8)
5929 {
5930 /* If we didn't get a pixel height, try to get the point
5931 height and convert that. */
5932 int point_size;
5933 char *point_size_start = read_from++;
5934
5935 /* Find end of field. */
5936 for (; *read_from && *read_from != '-'; read_from++)
5937 ;
5938
5939 if (*read_from)
5940 {
5941 *read_from = '\0';
5942 read_from++;
5943 }
5944
5945 point_size = atoi (point_size_start);
5946
5947 /* Convert to pixel height. */
5948 pixel_height = point_size
5949 * one_w32_display_info.height_in / 720;
5950
5951 /* Blank out this field and break. */
5952 *write_to = '-';
5953 write_to++;
5954 break;
5955 }
5956 }
5957 }
5958
5959 /* Shift the rest of the font spec into place. */
5960 if (write_to && read_from > write_to)
5961 {
5962 for (; *read_from; read_from++, write_to++)
5963 *write_to = *read_from;
5964 *write_to = '\0';
5965 }
5966
5967 return pixel_height;
5968}
5969
6fc2811b 5970/* Assume parameter 1 is fully qualified, no wildcards. */
7d0393cf 5971static BOOL
6fc2811b
JR
5972w32_font_match (fontname, pattern)
5973 char * fontname;
5974 char * pattern;
ee78dc32 5975{
6fc2811b 5976 char *ptr;
fe4dcb86 5977 char *font_name_copy;
0424a1b0 5978 char *regex = alloca (strlen (pattern) * 2 + 3);
ee78dc32 5979
fe4dcb86
JR
5980 font_name_copy = alloca (strlen (fontname) + 1);
5981 strcpy (font_name_copy, fontname);
d88c567c 5982
6fc2811b
JR
5983 ptr = regex;
5984 *ptr++ = '^';
ee78dc32 5985
6fc2811b
JR
5986 /* Turn pattern into a regexp and do a regexp match. */
5987 for (; *pattern; pattern++)
5988 {
5989 if (*pattern == '?')
5990 *ptr++ = '.';
5991 else if (*pattern == '*')
5992 {
5993 *ptr++ = '.';
5994 *ptr++ = '*';
5995 }
33d52f9c 5996 else
6fc2811b 5997 *ptr++ = *pattern;
ee78dc32 5998 }
6fc2811b
JR
5999 *ptr = '$';
6000 *(ptr + 1) = '\0';
6001
d88c567c
JR
6002 /* Strip out font heights and compare them seperately, since
6003 rounding error can cause mismatches. This also allows a
6004 comparison between a font that declares only a pixel height and a
6005 pattern that declares the point height.
6006 */
6007 {
6008 int font_height, pattern_height;
6009
6010 font_height = xlfd_strip_height (font_name_copy);
6011 pattern_height = xlfd_strip_height (regex);
6012
6013 /* Compare now, and don't bother doing expensive regexp matching
6014 if the heights differ. */
6015 if (font_height && pattern_height && (font_height != pattern_height))
6016 return FALSE;
6017 }
6018
fe4dcb86 6019 return (fast_string_match_ignore_case (build_string (regex),
74084731 6020 build_string (font_name_copy)) >= 0);
ee78dc32
GV
6021}
6022
5ca0cd71
GV
6023/* Callback functions, and a structure holding info they need, for
6024 listing system fonts on W32. We need one set of functions to do the
6025 job properly, but these don't work on NT 3.51 and earlier, so we
6026 have a second set which don't handle character sets properly to
6027 fall back on.
6028
6029 In both cases, there are two passes made. The first pass gets one
6030 font from each family, the second pass lists all the fonts from
6031 each family. */
6032
7d0393cf 6033typedef struct enumfont_t
ee78dc32
GV
6034{
6035 HDC hdc;
6036 int numFonts;
3cb20f4a 6037 LOGFONT logfont;
ee78dc32 6038 XFontStruct *size_ref;
23afac8f 6039 Lisp_Object pattern;
d84b082d 6040 Lisp_Object list;
ee78dc32
GV
6041} enumfont_t;
6042
d84b082d
JR
6043
6044static void
6045enum_font_maybe_add_to_list (enumfont_t *, LOGFONT *, char *, Lisp_Object);
6046
6047
7d0393cf 6048static int CALLBACK
ee78dc32
GV
6049enum_font_cb2 (lplf, lptm, FontType, lpef)
6050 ENUMLOGFONT * lplf;
6051 NEWTEXTMETRIC * lptm;
6052 int FontType;
6053 enumfont_t * lpef;
6054{
66895301
JR
6055 /* Ignore struck out and underlined versions of fonts. */
6056 if (lplf->elfLogFont.lfStrikeOut || lplf->elfLogFont.lfUnderline)
6057 return 1;
6058
6059 /* Only return fonts with names starting with @ if they were
6060 explicitly specified, since Microsoft uses an initial @ to
6061 denote fonts for vertical writing, without providing a more
6062 convenient way of identifying them. */
6063 if (lplf->elfLogFont.lfFaceName[0] == '@'
6064 && lpef->logfont.lfFaceName[0] != '@')
5e905a57
JR
6065 return 1;
6066
4587b026
GV
6067 /* Check that the character set matches if it was specified */
6068 if (lpef->logfont.lfCharSet != DEFAULT_CHARSET &&
6069 lplf->elfLogFont.lfCharSet != lpef->logfont.lfCharSet)
5e905a57 6070 return 1;
4587b026 6071
6358474d
JR
6072 if (FontType == RASTER_FONTTYPE)
6073 {
6074 /* DBCS raster fonts have problems displaying, so skip them. */
6075 int charset = lplf->elfLogFont.lfCharSet;
6076 if (charset == SHIFTJIS_CHARSET
6077 || charset == HANGEUL_CHARSET
6078 || charset == CHINESEBIG5_CHARSET
6079 || charset == GB2312_CHARSET
6080#ifdef JOHAB_CHARSET
6081 || charset == JOHAB_CHARSET
6082#endif
6083 )
6084 return 1;
6085 }
6086
ee78dc32
GV
6087 {
6088 char buf[100];
4587b026 6089 Lisp_Object width = Qnil;
d84b082d 6090 Lisp_Object charset_list = Qnil;
767b1ff0 6091 char *charset = NULL;
ee78dc32 6092
6fc2811b
JR
6093 /* Truetype fonts do not report their true metrics until loaded */
6094 if (FontType != RASTER_FONTTYPE)
3cb20f4a 6095 {
23afac8f 6096 if (!NILP (lpef->pattern))
6fc2811b
JR
6097 {
6098 /* Scalable fonts are as big as you want them to be. */
6099 lplf->elfLogFont.lfHeight = lpef->logfont.lfHeight;
6100 lplf->elfLogFont.lfWidth = lpef->logfont.lfWidth;
6101 width = make_number (lpef->logfont.lfWidth);
6102 }
6103 else
6104 {
6105 lplf->elfLogFont.lfHeight = 0;
6106 lplf->elfLogFont.lfWidth = 0;
6107 }
3cb20f4a 6108 }
6fc2811b 6109
f46e6225
GV
6110 /* Make sure the height used here is the same as everywhere
6111 else (ie character height, not cell height). */
6fc2811b
JR
6112 if (lplf->elfLogFont.lfHeight > 0)
6113 {
6114 /* lptm can be trusted for RASTER fonts, but not scalable ones. */
6115 if (FontType == RASTER_FONTTYPE)
6116 lplf->elfLogFont.lfHeight = lptm->tmInternalLeading - lptm->tmHeight;
6117 else
6118 lplf->elfLogFont.lfHeight = -lplf->elfLogFont.lfHeight;
6119 }
4587b026 6120
23afac8f 6121 if (!NILP (lpef->pattern))
767b1ff0 6122 {
d5db4077 6123 charset = xlfd_charset_of_font (SDATA (lpef->pattern));
767b1ff0 6124
644cefdf
JR
6125 /* We already checked charsets above, but DEFAULT_CHARSET
6126 slipped through. So only allow exact matches for DEFAULT_CHARSET. */
6127 if (charset
6128 && strncmp (charset, "*-*", 3) != 0
6129 && lpef->logfont.lfCharSet == DEFAULT_CHARSET
f1de3410 6130 && strcmp (charset, w32_to_x_charset (DEFAULT_CHARSET, NULL)) != 0)
644cefdf 6131 return 1;
59c6b61c
JR
6132
6133 /* Reject raster fonts if we are looking for a unicode font. */
6134 if (charset
6135 && FontType == RASTER_FONTTYPE
6136 && strncmp (charset, "iso10646", 8) == 0)
6137 return 1;
767b1ff0
JR
6138 }
6139
d84b082d
JR
6140 if (charset)
6141 charset_list = Fcons (build_string (charset), Qnil);
6142 else
f1de3410
JR
6143 /* Always prefer unicode. */
6144 charset_list
6145 = Fcons (build_string ("iso10646-1"),
6146 w32_to_all_x_charsets (lplf->elfLogFont.lfCharSet));
ee78dc32 6147
d84b082d
JR
6148 /* Loop through the charsets. */
6149 for ( ; CONSP (charset_list); charset_list = Fcdr (charset_list))
ee78dc32 6150 {
d84b082d 6151 Lisp_Object this_charset = Fcar (charset_list);
d5db4077 6152 charset = SDATA (this_charset);
d84b082d 6153
ffe832ea
MB
6154 /* Don't list raster fonts as unicode. */
6155 if (charset
6156 && FontType == RASTER_FONTTYPE
6157 && strncmp (charset, "iso10646", 8) == 0)
6158 continue;
6159
f1de3410
JR
6160 enum_font_maybe_add_to_list (lpef, &(lplf->elfLogFont),
6161 charset, width);
6162
d84b082d
JR
6163 /* List bold and italic variations if w32-enable-synthesized-fonts
6164 is non-nil and this is a plain font. */
6165 if (w32_enable_synthesized_fonts
6166 && lplf->elfLogFont.lfWeight == FW_NORMAL
6167 && lplf->elfLogFont.lfItalic == FALSE)
6168 {
d84b082d
JR
6169 /* bold. */
6170 lplf->elfLogFont.lfWeight = FW_BOLD;
6171 enum_font_maybe_add_to_list (lpef, &(lplf->elfLogFont),
6172 charset, width);
6173 /* bold italic. */
6174 lplf->elfLogFont.lfItalic = TRUE;
6175 enum_font_maybe_add_to_list (lpef, &(lplf->elfLogFont),
6176 charset, width);
6177 /* italic. */
6178 lplf->elfLogFont.lfWeight = FW_NORMAL;
6179 enum_font_maybe_add_to_list (lpef, &(lplf->elfLogFont),
6180 charset, width);
6181 }
ee78dc32
GV
6182 }
6183 }
6fc2811b 6184
5e905a57 6185 return 1;
ee78dc32
GV
6186}
6187
d84b082d
JR
6188static void
6189enum_font_maybe_add_to_list (lpef, logfont, match_charset, width)
6190 enumfont_t * lpef;
6191 LOGFONT * logfont;
6192 char * match_charset;
6193 Lisp_Object width;
6194{
6195 char buf[100];
6196
6197 if (!w32_to_x_font (logfont, buf, 100, match_charset))
6198 return;
6199
23afac8f 6200 if (NILP (lpef->pattern)
d5db4077 6201 || w32_font_match (buf, SDATA (lpef->pattern)))
d84b082d
JR
6202 {
6203 /* Check if we already listed this font. This may happen if
6204 w32_enable_synthesized_fonts is non-nil, and there are real
6205 bold and italic versions of the font. */
6206 Lisp_Object font_name = build_string (buf);
6207 if (NILP (Fmember (font_name, lpef->list)))
6208 {
23afac8f
JR
6209 Lisp_Object entry = Fcons (font_name, width);
6210 lpef->list = Fcons (entry, lpef->list);
d84b082d
JR
6211 lpef->numFonts++;
6212 }
6213 }
6214}
6215
6216
7d0393cf 6217static int CALLBACK
ee78dc32
GV
6218enum_font_cb1 (lplf, lptm, FontType, lpef)
6219 ENUMLOGFONT * lplf;
6220 NEWTEXTMETRIC * lptm;
6221 int FontType;
6222 enumfont_t * lpef;
6223{
6224 return EnumFontFamilies (lpef->hdc,
6225 lplf->elfLogFont.lfFaceName,
6226 (FONTENUMPROC) enum_font_cb2,
6227 (LPARAM) lpef);
6228}
6229
6230
8edb0a6f 6231static int CALLBACK
5ca0cd71
GV
6232enum_fontex_cb2 (lplf, lptm, font_type, lpef)
6233 ENUMLOGFONTEX * lplf;
6234 NEWTEXTMETRICEX * lptm;
6235 int font_type;
6236 enumfont_t * lpef;
6237{
6238 /* We are not interested in the extra info we get back from the 'Ex
6239 version - only the fact that we get character set variations
6240 enumerated seperately. */
6241 return enum_font_cb2 ((ENUMLOGFONT *) lplf, (NEWTEXTMETRIC *) lptm,
6242 font_type, lpef);
6243}
6244
8edb0a6f 6245static int CALLBACK
5ca0cd71
GV
6246enum_fontex_cb1 (lplf, lptm, font_type, lpef)
6247 ENUMLOGFONTEX * lplf;
6248 NEWTEXTMETRICEX * lptm;
6249 int font_type;
6250 enumfont_t * lpef;
6251{
6252 HMODULE gdi32 = GetModuleHandle ("gdi32.dll");
6253 FARPROC enum_font_families_ex
6254 = GetProcAddress ( gdi32, "EnumFontFamiliesExA");
6255 /* We don't really expect EnumFontFamiliesEx to disappear once we
6256 get here, so don't bother handling it gracefully. */
6257 if (enum_font_families_ex == NULL)
6258 error ("gdi32.dll has disappeared!");
6259 return enum_font_families_ex (lpef->hdc,
6260 &lplf->elfLogFont,
6261 (FONTENUMPROC) enum_fontex_cb2,
6262 (LPARAM) lpef, 0);
6263}
6264
4587b026
GV
6265/* Interface to fontset handler. (adapted from mw32font.c in Meadow
6266 and xterm.c in Emacs 20.3) */
6267
74084731
JB
6268static Lisp_Object
6269w32_list_bdf_fonts (Lisp_Object pattern, int max_names)
33d52f9c
GV
6270{
6271 char *fontname, *ptnstr;
6272 Lisp_Object list, tem, newlist = Qnil;
55dcfc15 6273 int n_fonts = 0;
33d52f9c
GV
6274
6275 list = Vw32_bdf_filename_alist;
d5db4077 6276 ptnstr = SDATA (pattern);
33d52f9c 6277
8e713be6 6278 for ( ; CONSP (list); list = XCDR (list))
33d52f9c 6279 {
8e713be6 6280 tem = XCAR (list);
33d52f9c 6281 if (CONSP (tem))
d5db4077 6282 fontname = SDATA (XCAR (tem));
33d52f9c 6283 else if (STRINGP (tem))
d5db4077 6284 fontname = SDATA (tem);
33d52f9c
GV
6285 else
6286 continue;
6287
6288 if (w32_font_match (fontname, ptnstr))
5ca0cd71 6289 {
8e713be6 6290 newlist = Fcons (XCAR (tem), newlist);
5ca0cd71 6291 n_fonts++;
bd11cc09 6292 if (max_names >= 0 && n_fonts >= max_names)
5ca0cd71
GV
6293 break;
6294 }
33d52f9c
GV
6295 }
6296
6297 return newlist;
6298}
6299
5ca0cd71 6300
4587b026
GV
6301/* Return a list of names of available fonts matching PATTERN on frame
6302 F. If SIZE is not 0, it is the size (maximum bound width) of fonts
6303 to be listed. Frame F NULL means we have not yet created any
6304 frame, which means we can't get proper size info, as we don't have
6305 a device context to use for GetTextMetrics.
bd11cc09
JR
6306 MAXNAMES sets a limit on how many fonts to match. If MAXNAMES is
6307 negative, then all matching fonts are returned. */
4587b026
GV
6308
6309Lisp_Object
dc220243
JR
6310w32_list_fonts (f, pattern, size, maxnames)
6311 struct frame *f;
6312 Lisp_Object pattern;
6313 int size;
6314 int maxnames;
4587b026 6315{
6fc2811b 6316 Lisp_Object patterns, key = Qnil, tem, tpat;
4587b026 6317 Lisp_Object list = Qnil, newlist = Qnil, second_best = Qnil;
33d52f9c 6318 struct w32_display_info *dpyinfo = &one_w32_display_info;
5ca0cd71 6319 int n_fonts = 0;
396594fe 6320
4587b026
GV
6321 patterns = Fassoc (pattern, Valternate_fontname_alist);
6322 if (NILP (patterns))
6323 patterns = Fcons (pattern, Qnil);
6324
8e713be6 6325 for (; CONSP (patterns); patterns = XCDR (patterns))
4587b026
GV
6326 {
6327 enumfont_t ef;
767b1ff0 6328 int codepage;
4587b026 6329
8e713be6 6330 tpat = XCAR (patterns);
4587b026 6331
767b1ff0
JR
6332 if (!STRINGP (tpat))
6333 continue;
6334
6335 /* Avoid expensive EnumFontFamilies functions if we are not
6336 going to be able to output one of these anyway. */
d5db4077 6337 codepage = w32_codepage_for_font (SDATA (tpat));
767b1ff0 6338 if (codepage != CP_8BIT && codepage != CP_UNICODE
ceb12877 6339 && codepage != CP_DEFAULT && codepage != CP_UNKNOWN
74084731 6340 && !IsValidCodePage (codepage))
767b1ff0
JR
6341 continue;
6342
4587b026
GV
6343 /* See if we cached the result for this particular query.
6344 The cache is an alist of the form:
6345 ((PATTERN (FONTNAME . WIDTH) ...) ...)
6346 */
8e713be6 6347 if (tem = XCDR (dpyinfo->name_list_element),
33d52f9c 6348 !NILP (list = Fassoc (tpat, tem)))
4587b026
GV
6349 {
6350 list = Fcdr_safe (list);
6351 /* We have a cached list. Don't have to get the list again. */
6352 goto label_cached;
6353 }
6354
6355 BLOCK_INPUT;
6356 /* At first, put PATTERN in the cache. */
23afac8f
JR
6357 ef.pattern = tpat;
6358 ef.list = Qnil;
4587b026 6359 ef.numFonts = 0;
33d52f9c 6360
5ca0cd71
GV
6361 /* Use EnumFontFamiliesEx where it is available, as it knows
6362 about character sets. Fall back to EnumFontFamilies for
6363 older versions of NT that don't support the 'Ex function. */
d5db4077 6364 x_to_w32_font (SDATA (tpat), &ef.logfont);
4587b026 6365 {
5ca0cd71
GV
6366 LOGFONT font_match_pattern;
6367 HMODULE gdi32 = GetModuleHandle ("gdi32.dll");
6368 FARPROC enum_font_families_ex
6369 = GetProcAddress ( gdi32, "EnumFontFamiliesExA");
6370
6371 /* We do our own pattern matching so we can handle wildcards. */
6372 font_match_pattern.lfFaceName[0] = 0;
6373 font_match_pattern.lfPitchAndFamily = 0;
6374 /* We can use the charset, because if it is a wildcard it will
6375 be DEFAULT_CHARSET anyway. */
6376 font_match_pattern.lfCharSet = ef.logfont.lfCharSet;
6377
33d52f9c 6378 ef.hdc = GetDC (dpyinfo->root_window);
4587b026 6379
5ca0cd71
GV
6380 if (enum_font_families_ex)
6381 enum_font_families_ex (ef.hdc,
6382 &font_match_pattern,
6383 (FONTENUMPROC) enum_fontex_cb1,
6384 (LPARAM) &ef, 0);
6385 else
6386 EnumFontFamilies (ef.hdc, NULL, (FONTENUMPROC) enum_font_cb1,
6387 (LPARAM)&ef);
4587b026 6388
33d52f9c 6389 ReleaseDC (dpyinfo->root_window, ef.hdc);
4587b026
GV
6390 }
6391
6392 UNBLOCK_INPUT;
23afac8f 6393 list = ef.list;
4587b026
GV
6394
6395 /* Make a list of the fonts we got back.
6396 Store that in the font cache for the display. */
f3fbd155
KR
6397 XSETCDR (dpyinfo->name_list_element,
6398 Fcons (Fcons (tpat, list),
6399 XCDR (dpyinfo->name_list_element)));
4587b026
GV
6400
6401 label_cached:
6402 if (NILP (list)) continue; /* Try the remaining alternatives. */
6403
6404 newlist = second_best = Qnil;
6405
7d0393cf 6406 /* Make a list of the fonts that have the right width. */
8e713be6 6407 for (; CONSP (list); list = XCDR (list))
4587b026
GV
6408 {
6409 int found_size;
8e713be6 6410 tem = XCAR (list);
4587b026
GV
6411
6412 if (!CONSP (tem))
6413 continue;
8e713be6 6414 if (NILP (XCAR (tem)))
4587b026
GV
6415 continue;
6416 if (!size)
6417 {
8e713be6 6418 newlist = Fcons (XCAR (tem), newlist);
5ca0cd71 6419 n_fonts++;
bd11cc09 6420 if (maxnames >= 0 && n_fonts >= maxnames)
5ca0cd71
GV
6421 break;
6422 else
6423 continue;
4587b026 6424 }
8e713be6 6425 if (!INTEGERP (XCDR (tem)))
4587b026
GV
6426 {
6427 /* Since we don't yet know the size of the font, we must
6428 load it and try GetTextMetrics. */
4587b026
GV
6429 W32FontStruct thisinfo;
6430 LOGFONT lf;
6431 HDC hdc;
6432 HANDLE oldobj;
6433
d5db4077 6434 if (!x_to_w32_font (SDATA (XCAR (tem)), &lf))
4587b026
GV
6435 continue;
6436
6437 BLOCK_INPUT;
33d52f9c 6438 thisinfo.bdf = NULL;
4587b026
GV
6439 thisinfo.hfont = CreateFontIndirect (&lf);
6440 if (thisinfo.hfont == NULL)
6441 continue;
6442
6443 hdc = GetDC (dpyinfo->root_window);
6444 oldobj = SelectObject (hdc, thisinfo.hfont);
6445 if (GetTextMetrics (hdc, &thisinfo.tm))
88fce384 6446 XSETCDR (tem, make_number (FONT_AVG_WIDTH (&thisinfo)));
4587b026 6447 else
f3fbd155 6448 XSETCDR (tem, make_number (0));
4587b026
GV
6449 SelectObject (hdc, oldobj);
6450 ReleaseDC (dpyinfo->root_window, hdc);
74084731 6451 DeleteObject (thisinfo.hfont);
4587b026
GV
6452 UNBLOCK_INPUT;
6453 }
8e713be6 6454 found_size = XINT (XCDR (tem));
4587b026 6455 if (found_size == size)
5ca0cd71 6456 {
8e713be6 6457 newlist = Fcons (XCAR (tem), newlist);
5ca0cd71 6458 n_fonts++;
bd11cc09 6459 if (maxnames >= 0 && n_fonts >= maxnames)
5ca0cd71
GV
6460 break;
6461 }
4587b026
GV
6462 /* keep track of the closest matching size in case
6463 no exact match is found. */
6464 else if (found_size > 0)
6465 {
6466 if (NILP (second_best))
6467 second_best = tem;
7d0393cf 6468
4587b026
GV
6469 else if (found_size < size)
6470 {
8e713be6
KR
6471 if (XINT (XCDR (second_best)) > size
6472 || XINT (XCDR (second_best)) < found_size)
4587b026
GV
6473 second_best = tem;
6474 }
6475 else
6476 {
8e713be6
KR
6477 if (XINT (XCDR (second_best)) > size
6478 && XINT (XCDR (second_best)) >
4587b026
GV
6479 found_size)
6480 second_best = tem;
6481 }
6482 }
6483 }
6484
6485 if (!NILP (newlist))
6486 break;
6487 else if (!NILP (second_best))
6488 {
8e713be6 6489 newlist = Fcons (XCAR (second_best), Qnil);
4587b026
GV
6490 break;
6491 }
6492 }
6493
33d52f9c 6494 /* Include any bdf fonts. */
bd11cc09 6495 if (n_fonts < maxnames || maxnames < 0)
33d52f9c
GV
6496 {
6497 Lisp_Object combined[2];
5ca0cd71 6498 combined[0] = w32_list_bdf_fonts (pattern, maxnames - n_fonts);
33d52f9c 6499 combined[1] = newlist;
74084731 6500 newlist = Fnconc (2, combined);
33d52f9c
GV
6501 }
6502
4587b026
GV
6503 return newlist;
6504}
6505
5ca0cd71 6506
4587b026
GV
6507/* Return a pointer to struct font_info of font FONT_IDX of frame F. */
6508struct font_info *
6509w32_get_font_info (f, font_idx)
6510 FRAME_PTR f;
6511 int font_idx;
6512{
6513 return (FRAME_W32_FONT_TABLE (f) + font_idx);
6514}
6515
6516
6517struct font_info*
6518w32_query_font (struct frame *f, char *fontname)
6519{
6520 int i;
6521 struct font_info *pfi;
6522
6523 pfi = FRAME_W32_FONT_TABLE (f);
6524
6525 for (i = 0; i < one_w32_display_info.n_fonts ;i++, pfi++)
6526 {
74084731 6527 if (stricmp (pfi->name, fontname) == 0) return pfi;
4587b026
GV
6528 }
6529
6530 return NULL;
6531}
6532
6533/* Find a CCL program for a font specified by FONTP, and set the member
6534 `encoder' of the structure. */
6535
6536void
6537w32_find_ccl_program (fontp)
6538 struct font_info *fontp;
6539{
3545439c 6540 Lisp_Object list, elt;
4587b026 6541
8e713be6 6542 for (list = Vfont_ccl_encoder_alist; CONSP (list); list = XCDR (list))
4587b026 6543 {
8e713be6 6544 elt = XCAR (list);
4587b026 6545 if (CONSP (elt)
8e713be6
KR
6546 && STRINGP (XCAR (elt))
6547 && (fast_c_string_match_ignore_case (XCAR (elt), fontp->name)
4587b026 6548 >= 0))
3545439c
KH
6549 break;
6550 }
6551 if (! NILP (list))
6552 {
17eedd00
KH
6553 struct ccl_program *ccl
6554 = (struct ccl_program *) xmalloc (sizeof (struct ccl_program));
3545439c 6555
8e713be6 6556 if (setup_ccl_program (ccl, XCDR (elt)) < 0)
3545439c
KH
6557 xfree (ccl);
6558 else
6559 fontp->font_encoder = ccl;
4587b026
GV
6560 }
6561}
6562
2ba49441 6563/* directory-files from dired.c. */
74084731 6564Lisp_Object Fdirectory_files P_ ((Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object));
2ba49441 6565
4587b026 6566\f
8edb0a6f
JR
6567/* Find BDF files in a specified directory. (use GCPRO when calling,
6568 as this calls lisp to get a directory listing). */
6569static Lisp_Object
6570w32_find_bdf_fonts_in_dir (Lisp_Object directory)
6571{
6572 Lisp_Object filelist, list = Qnil;
6573 char fontname[100];
6574
74084731 6575 if (!STRINGP (directory))
8edb0a6f
JR
6576 return Qnil;
6577
6578 filelist = Fdirectory_files (directory, Qt,
2ba49441 6579 build_string (".*\\.[bB][dD][fF]"), Qt);
8edb0a6f 6580
74084731 6581 for ( ; CONSP (filelist); filelist = XCDR (filelist))
8edb0a6f
JR
6582 {
6583 Lisp_Object filename = XCAR (filelist);
d5db4077 6584 if (w32_BDF_to_x_font (SDATA (filename), fontname, 100))
8edb0a6f
JR
6585 store_in_alist (&list, build_string (fontname), filename);
6586 }
6587 return list;
6588}
6589
6fc2811b
JR
6590DEFUN ("w32-find-bdf-fonts", Fw32_find_bdf_fonts, Sw32_find_bdf_fonts,
6591 1, 1, 0,
52deb19f
JB
6592 doc: /* Return a list of BDF fonts in DIRECTORY.
6593The list is suitable for appending to `w32-bdf-filename-alist'.
6594Fonts which do not contain an xlfd description will not be included
6595in the list. DIRECTORY may be a list of directories. */)
6fc2811b
JR
6596 (directory)
6597 Lisp_Object directory;
6598{
6599 Lisp_Object list = Qnil;
6600 struct gcpro gcpro1, gcpro2;
ee78dc32 6601
6fc2811b
JR
6602 if (!CONSP (directory))
6603 return w32_find_bdf_fonts_in_dir (directory);
ee78dc32 6604
6fc2811b 6605 for ( ; CONSP (directory); directory = XCDR (directory))
ee78dc32 6606 {
6fc2811b
JR
6607 Lisp_Object pair[2];
6608 pair[0] = list;
6609 pair[1] = Qnil;
6610 GCPRO2 (directory, list);
74084731
JB
6611 pair[1] = w32_find_bdf_fonts_in_dir ( XCAR (directory) );
6612 list = Fnconc ( 2, pair );
6fc2811b
JR
6613 UNGCPRO;
6614 }
6615 return list;
6616}
ee78dc32 6617
6fc2811b
JR
6618\f
6619DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1, 2, 0,
74e1aeec 6620 doc: /* Internal function called by `color-defined-p', which see. */)
6fc2811b
JR
6621 (color, frame)
6622 Lisp_Object color, frame;
6623{
6624 XColor foo;
6625 FRAME_PTR f = check_x_frame (frame);
ee78dc32 6626
b7826503 6627 CHECK_STRING (color);
ee78dc32 6628
d5db4077 6629 if (w32_defined_color (f, SDATA (color), &foo, 0))
6fc2811b
JR
6630 return Qt;
6631 else
6632 return Qnil;
6633}
ee78dc32 6634
2d764c78 6635DEFUN ("xw-color-values", Fxw_color_values, Sxw_color_values, 1, 2, 0,
74e1aeec 6636 doc: /* Internal function called by `color-values', which see. */)
ee78dc32
GV
6637 (color, frame)
6638 Lisp_Object color, frame;
6639{
6fc2811b 6640 XColor foo;
ee78dc32
GV
6641 FRAME_PTR f = check_x_frame (frame);
6642
b7826503 6643 CHECK_STRING (color);
ee78dc32 6644
d5db4077 6645 if (w32_defined_color (f, SDATA (color), &foo, 0))
a508663b
KS
6646 return list3 (make_number ((GetRValue (foo.pixel) << 8)
6647 | GetRValue (foo.pixel)),
6648 make_number ((GetGValue (foo.pixel) << 8)
6649 | GetGValue (foo.pixel)),
6650 make_number ((GetBValue (foo.pixel) << 8)
6651 | GetBValue (foo.pixel)));
ee78dc32
GV
6652 else
6653 return Qnil;
6654}
6655
2d764c78 6656DEFUN ("xw-display-color-p", Fxw_display_color_p, Sxw_display_color_p, 0, 1, 0,
74e1aeec 6657 doc: /* Internal function called by `display-color-p', which see. */)
ee78dc32
GV
6658 (display)
6659 Lisp_Object display;
6660{
fbd6baed 6661 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV
6662
6663 if ((dpyinfo->n_planes * dpyinfo->n_cbits) <= 2)
6664 return Qnil;
6665
6666 return Qt;
6667}
6668
74e1aeec
JR
6669DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p,
6670 Sx_display_grayscale_p, 0, 1, 0,
52deb19f 6671 doc: /* Return t if DISPLAY supports shades of gray.
74e1aeec
JR
6672Note that color displays do support shades of gray.
6673The optional argument DISPLAY specifies which display to ask about.
6674DISPLAY should be either a frame or a display name (a string).
6675If omitted or nil, that stands for the selected frame's display. */)
ee78dc32
GV
6676 (display)
6677 Lisp_Object display;
6678{
fbd6baed 6679 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV
6680
6681 if ((dpyinfo->n_planes * dpyinfo->n_cbits) <= 1)
6682 return Qnil;
6683
6684 return Qt;
6685}
6686
74e1aeec
JR
6687DEFUN ("x-display-pixel-width", Fx_display_pixel_width,
6688 Sx_display_pixel_width, 0, 1, 0,
36458ebd 6689 doc: /* Return the width in pixels of DISPLAY.
74e1aeec
JR
6690The optional argument DISPLAY specifies which display to ask about.
6691DISPLAY should be either a frame or a display name (a string).
6692If omitted or nil, that stands for the selected frame's display. */)
ee78dc32
GV
6693 (display)
6694 Lisp_Object display;
6695{
fbd6baed 6696 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV
6697
6698 return make_number (dpyinfo->width);
6699}
6700
6701DEFUN ("x-display-pixel-height", Fx_display_pixel_height,
74e1aeec 6702 Sx_display_pixel_height, 0, 1, 0,
36458ebd 6703 doc: /* Return the height in pixels of DISPLAY.
74e1aeec
JR
6704The optional argument DISPLAY specifies which display to ask about.
6705DISPLAY should be either a frame or a display name (a string).
6706If omitted or nil, that stands for the selected frame's display. */)
ee78dc32
GV
6707 (display)
6708 Lisp_Object display;
6709{
fbd6baed 6710 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV
6711
6712 return make_number (dpyinfo->height);
6713}
6714
6715DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes,
74e1aeec 6716 0, 1, 0,
36458ebd 6717 doc: /* Return the number of bitplanes of DISPLAY.
74e1aeec
JR
6718The optional argument DISPLAY specifies which display to ask about.
6719DISPLAY should be either a frame or a display name (a string).
6720If omitted or nil, that stands for the selected frame's display. */)
ee78dc32
GV
6721 (display)
6722 Lisp_Object display;
6723{
fbd6baed 6724 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV
6725
6726 return make_number (dpyinfo->n_planes * dpyinfo->n_cbits);
6727}
6728
6729DEFUN ("x-display-color-cells", Fx_display_color_cells, Sx_display_color_cells,
74e1aeec 6730 0, 1, 0,
36458ebd 6731 doc: /* Return the number of color cells of DISPLAY.
74e1aeec
JR
6732The optional argument DISPLAY specifies which display to ask about.
6733DISPLAY should be either a frame or a display name (a string).
6734If omitted or nil, that stands for the selected frame's display. */)
ee78dc32
GV
6735 (display)
6736 Lisp_Object display;
6737{
fbd6baed 6738 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV
6739 HDC hdc;
6740 int cap;
6741
5ac45f98
GV
6742 hdc = GetDC (dpyinfo->root_window);
6743 if (dpyinfo->has_palette)
52deb19f 6744 cap = GetDeviceCaps (hdc, SIZEPALETTE);
5ac45f98 6745 else
52deb19f 6746 cap = GetDeviceCaps (hdc, NUMCOLORS);
abf8c61b 6747
007776bc
JB
6748 /* We force 24+ bit depths to 24-bit, both to prevent an overflow
6749 and because probably is more meaningful on Windows anyway */
abf8c61b 6750 if (cap < 0)
74084731 6751 cap = 1 << min (dpyinfo->n_planes * dpyinfo->n_cbits, 24);
7d0393cf 6752
ee78dc32 6753 ReleaseDC (dpyinfo->root_window, hdc);
7d0393cf 6754
ee78dc32
GV
6755 return make_number (cap);
6756}
6757
6758DEFUN ("x-server-max-request-size", Fx_server_max_request_size,
6759 Sx_server_max_request_size,
74e1aeec 6760 0, 1, 0,
36458ebd 6761 doc: /* Return the maximum request size of the server of DISPLAY.
74e1aeec
JR
6762The optional argument DISPLAY specifies which display to ask about.
6763DISPLAY should be either a frame or a display name (a string).
6764If omitted or nil, that stands for the selected frame's display. */)
ee78dc32
GV
6765 (display)
6766 Lisp_Object display;
6767{
fbd6baed 6768 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV
6769
6770 return make_number (1);
6771}
6772
6773DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0,
36458ebd 6774 doc: /* Return the "vendor ID" string of the W32 system (Microsoft).
74e1aeec
JR
6775The optional argument DISPLAY specifies which display to ask about.
6776DISPLAY should be either a frame or a display name (a string).
6777If omitted or nil, that stands for the selected frame's display. */)
ee78dc32
GV
6778 (display)
6779 Lisp_Object display;
6780{
dfff8a69 6781 return build_string ("Microsoft Corp.");
ee78dc32
GV
6782}
6783
6784DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0,
36458ebd 6785 doc: /* Return the version numbers of the server of DISPLAY.
74e1aeec 6786The value is a list of three integers: the major and minor
02b39a28
JB
6787version numbers of the X Protocol in use, and the distributor-specific
6788release number. See also the function `x-server-vendor'.
74e1aeec
JR
6789
6790The optional argument DISPLAY specifies which display to ask about.
6791DISPLAY should be either a frame or a display name (a string).
6792If omitted or nil, that stands for the selected frame's display. */)
ee78dc32
GV
6793 (display)
6794 Lisp_Object display;
6795{
fbd6baed 6796 return Fcons (make_number (w32_major_version),
58e0f0e4
AI
6797 Fcons (make_number (w32_minor_version),
6798 Fcons (make_number (w32_build_number), Qnil)));
ee78dc32
GV
6799}
6800
6801DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0,
36458ebd 6802 doc: /* Return the number of screens on the server of DISPLAY.
74e1aeec
JR
6803The optional argument DISPLAY specifies which display to ask about.
6804DISPLAY should be either a frame or a display name (a string).
6805If omitted or nil, that stands for the selected frame's display. */)
ee78dc32
GV
6806 (display)
6807 Lisp_Object display;
6808{
ee78dc32
GV
6809 return make_number (1);
6810}
6811
74e1aeec
JR
6812DEFUN ("x-display-mm-height", Fx_display_mm_height,
6813 Sx_display_mm_height, 0, 1, 0,
36458ebd 6814 doc: /* Return the height in millimeters of DISPLAY.
74e1aeec
JR
6815The optional argument DISPLAY specifies which display to ask about.
6816DISPLAY should be either a frame or a display name (a string).
6817If omitted or nil, that stands for the selected frame's display. */)
ee78dc32
GV
6818 (display)
6819 Lisp_Object display;
6820{
fbd6baed 6821 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV
6822 HDC hdc;
6823 int cap;
6824
5ac45f98 6825 hdc = GetDC (dpyinfo->root_window);
7d0393cf 6826
ee78dc32 6827 cap = GetDeviceCaps (hdc, VERTSIZE);
7d0393cf 6828
ee78dc32 6829 ReleaseDC (dpyinfo->root_window, hdc);
7d0393cf 6830
ee78dc32
GV
6831 return make_number (cap);
6832}
6833
6834DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0,
36458ebd 6835 doc: /* Return the width in millimeters of DISPLAY.
74e1aeec
JR
6836The optional argument DISPLAY specifies which display to ask about.
6837DISPLAY should be either a frame or a display name (a string).
6838If omitted or nil, that stands for the selected frame's display. */)
ee78dc32
GV
6839 (display)
6840 Lisp_Object display;
6841{
fbd6baed 6842 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV
6843
6844 HDC hdc;
6845 int cap;
6846
5ac45f98 6847 hdc = GetDC (dpyinfo->root_window);
7d0393cf 6848
ee78dc32 6849 cap = GetDeviceCaps (hdc, HORZSIZE);
7d0393cf 6850
ee78dc32 6851 ReleaseDC (dpyinfo->root_window, hdc);
7d0393cf 6852
ee78dc32
GV
6853 return make_number (cap);
6854}
6855
6856DEFUN ("x-display-backing-store", Fx_display_backing_store,
74e1aeec 6857 Sx_display_backing_store, 0, 1, 0,
36458ebd 6858 doc: /* Return an indication of whether DISPLAY does backing store.
74e1aeec
JR
6859The value may be `always', `when-mapped', or `not-useful'.
6860The optional argument DISPLAY specifies which display to ask about.
6861DISPLAY should be either a frame or a display name (a string).
6862If omitted or nil, that stands for the selected frame's display. */)
ee78dc32
GV
6863 (display)
6864 Lisp_Object display;
6865{
6866 return intern ("not-useful");
6867}
6868
6869DEFUN ("x-display-visual-class", Fx_display_visual_class,
74e1aeec 6870 Sx_display_visual_class, 0, 1, 0,
36458ebd 6871 doc: /* Return the visual class of DISPLAY.
74e1aeec
JR
6872The value is one of the symbols `static-gray', `gray-scale',
6873`static-color', `pseudo-color', `true-color', or `direct-color'.
6874
6875The optional argument DISPLAY specifies which display to ask about.
6876DISPLAY should be either a frame or a display name (a string).
6877If omitted or nil, that stands for the selected frame's display. */)
ee78dc32
GV
6878 (display)
6879 Lisp_Object display;
6880{
fbd6baed 6881 struct w32_display_info *dpyinfo = check_x_display_info (display);
abf8c61b 6882 Lisp_Object result = Qnil;
ee78dc32 6883
abf8c61b
AI
6884 if (dpyinfo->has_palette)
6885 result = intern ("pseudo-color");
6886 else if (dpyinfo->n_planes * dpyinfo->n_cbits == 1)
6887 result = intern ("static-grey");
6888 else if (dpyinfo->n_planes * dpyinfo->n_cbits == 4)
6889 result = intern ("static-color");
6890 else if (dpyinfo->n_planes * dpyinfo->n_cbits > 8)
6891 result = intern ("true-color");
ee78dc32 6892
abf8c61b 6893 return result;
ee78dc32
GV
6894}
6895
6896DEFUN ("x-display-save-under", Fx_display_save_under,
74e1aeec 6897 Sx_display_save_under, 0, 1, 0,
02b39a28 6898 doc: /* Return t if DISPLAY supports the save-under feature.
74e1aeec
JR
6899The optional argument DISPLAY specifies which display to ask about.
6900DISPLAY should be either a frame or a display name (a string).
6901If omitted or nil, that stands for the selected frame's display. */)
ee78dc32
GV
6902 (display)
6903 Lisp_Object display;
6904{
6fc2811b
JR
6905 return Qnil;
6906}
6907\f
6908int
6909x_pixel_width (f)
6910 register struct frame *f;
6911{
be786000 6912 return FRAME_PIXEL_WIDTH (f);
6fc2811b
JR
6913}
6914
6915int
6916x_pixel_height (f)
6917 register struct frame *f;
6918{
be786000 6919 return FRAME_PIXEL_HEIGHT (f);
6fc2811b
JR
6920}
6921
6922int
6923x_char_width (f)
6924 register struct frame *f;
6925{
be786000 6926 return FRAME_COLUMN_WIDTH (f);
6fc2811b
JR
6927}
6928
6929int
6930x_char_height (f)
6931 register struct frame *f;
6932{
be786000 6933 return FRAME_LINE_HEIGHT (f);
6fc2811b
JR
6934}
6935
6936int
6937x_screen_planes (f)
6938 register struct frame *f;
6939{
6940 return FRAME_W32_DISPLAY_INFO (f)->n_planes;
6941}
6942\f
6943/* Return the display structure for the display named NAME.
6944 Open a new connection if necessary. */
6945
6946struct w32_display_info *
6947x_display_info_for_name (name)
6948 Lisp_Object name;
6949{
6950 Lisp_Object names;
6951 struct w32_display_info *dpyinfo;
6952
b7826503 6953 CHECK_STRING (name);
6fc2811b
JR
6954
6955 for (dpyinfo = &one_w32_display_info, names = w32_display_name_list;
6956 dpyinfo;
6957 dpyinfo = dpyinfo->next, names = XCDR (names))
6958 {
6959 Lisp_Object tem;
6960 tem = Fstring_equal (XCAR (XCAR (names)), name);
6961 if (!NILP (tem))
6962 return dpyinfo;
6963 }
6964
6965 /* Use this general default value to start with. */
6966 Vx_resource_name = Vinvocation_name;
6967
6968 validate_x_resource_name ();
6969
6970 dpyinfo = w32_term_init (name, (unsigned char *)0,
d5db4077 6971 (char *) SDATA (Vx_resource_name));
6fc2811b
JR
6972
6973 if (dpyinfo == 0)
d5db4077 6974 error ("Cannot connect to server %s", SDATA (name));
6fc2811b
JR
6975
6976 w32_in_use = 1;
6977 XSETFASTINT (Vwindow_system_version, 3);
6978
6979 return dpyinfo;
6980}
6981
6982DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
74e1aeec
JR
6983 1, 3, 0, doc: /* Open a connection to a server.
6984DISPLAY is the name of the display to connect to.
6985Optional second arg XRM-STRING is a string of resources in xrdb format.
6986If the optional third arg MUST-SUCCEED is non-nil,
6987terminate Emacs if we can't open the connection. */)
6fc2811b
JR
6988 (display, xrm_string, must_succeed)
6989 Lisp_Object display, xrm_string, must_succeed;
6990{
6991 unsigned char *xrm_option;
6992 struct w32_display_info *dpyinfo;
6993
74e1aeec
JR
6994 /* If initialization has already been done, return now to avoid
6995 overwriting critical parts of one_w32_display_info. */
6996 if (w32_in_use)
6997 return Qnil;
6998
b7826503 6999 CHECK_STRING (display);
6fc2811b 7000 if (! NILP (xrm_string))
b7826503 7001 CHECK_STRING (xrm_string);
6fc2811b 7002
2dc8b986 7003#if 0
6fc2811b
JR
7004 if (! EQ (Vwindow_system, intern ("w32")))
7005 error ("Not using Microsoft Windows");
2dc8b986 7006#endif
6fc2811b
JR
7007
7008 /* Allow color mapping to be defined externally; first look in user's
7009 HOME directory, then in Emacs etc dir for a file called rgb.txt. */
7010 {
7011 Lisp_Object color_file;
7012 struct gcpro gcpro1;
7013
74084731 7014 color_file = build_string ("~/rgb.txt");
6fc2811b
JR
7015
7016 GCPRO1 (color_file);
7017
7018 if (NILP (Ffile_readable_p (color_file)))
7019 color_file =
7020 Fexpand_file_name (build_string ("rgb.txt"),
7021 Fsymbol_value (intern ("data-directory")));
7022
7023 Vw32_color_map = Fw32_load_color_file (color_file);
7024
7025 UNGCPRO;
7026 }
7027 if (NILP (Vw32_color_map))
7028 Vw32_color_map = Fw32_default_color_map ();
7029
5a8a15ec
JR
7030 /* Merge in system logical colors. */
7031 add_system_logical_colors_to_map (&Vw32_color_map);
7032
6fc2811b 7033 if (! NILP (xrm_string))
d5db4077 7034 xrm_option = (unsigned char *) SDATA (xrm_string);
6fc2811b
JR
7035 else
7036 xrm_option = (unsigned char *) 0;
7037
7038 /* Use this general default value to start with. */
7039 /* First remove .exe suffix from invocation-name - it looks ugly. */
7040 {
7041 char basename[ MAX_PATH ], *str;
7042
d5db4077 7043 strcpy (basename, SDATA (Vinvocation_name));
6fc2811b
JR
7044 str = strrchr (basename, '.');
7045 if (str) *str = 0;
7046 Vinvocation_name = build_string (basename);
7047 }
7048 Vx_resource_name = Vinvocation_name;
7049
7050 validate_x_resource_name ();
7051
7052 /* This is what opens the connection and sets x_current_display.
7053 This also initializes many symbols, such as those used for input. */
7054 dpyinfo = w32_term_init (display, xrm_option,
d5db4077 7055 (char *) SDATA (Vx_resource_name));
6fc2811b
JR
7056
7057 if (dpyinfo == 0)
7058 {
7059 if (!NILP (must_succeed))
7060 fatal ("Cannot connect to server %s.\n",
d5db4077 7061 SDATA (display));
6fc2811b 7062 else
d5db4077 7063 error ("Cannot connect to server %s", SDATA (display));
6fc2811b
JR
7064 }
7065
7066 w32_in_use = 1;
7067
7068 XSETFASTINT (Vwindow_system_version, 3);
7069 return Qnil;
7070}
7071
7072DEFUN ("x-close-connection", Fx_close_connection,
7073 Sx_close_connection, 1, 1, 0,
74e1aeec
JR
7074 doc: /* Close the connection to DISPLAY's server.
7075For DISPLAY, specify either a frame or a display name (a string).
7076If DISPLAY is nil, that stands for the selected frame's display. */)
6fc2811b
JR
7077 (display)
7078 Lisp_Object display;
7079{
7080 struct w32_display_info *dpyinfo = check_x_display_info (display);
7081 int i;
7082
7083 if (dpyinfo->reference_count > 0)
7084 error ("Display still has frames on it");
7085
7086 BLOCK_INPUT;
7087 /* Free the fonts in the font table. */
7088 for (i = 0; i < dpyinfo->n_fonts; i++)
7089 if (dpyinfo->font_table[i].name)
7090 {
126f2e35
JR
7091 if (dpyinfo->font_table[i].name != dpyinfo->font_table[i].full_name)
7092 xfree (dpyinfo->font_table[i].full_name);
6fc2811b 7093 xfree (dpyinfo->font_table[i].name);
6fc2811b
JR
7094 w32_unload_font (dpyinfo, dpyinfo->font_table[i].font);
7095 }
7096 x_destroy_all_bitmaps (dpyinfo);
7097
7098 x_delete_display (dpyinfo);
7099 UNBLOCK_INPUT;
7100
7101 return Qnil;
7102}
7103
7104DEFUN ("x-display-list", Fx_display_list, Sx_display_list, 0, 0, 0,
74e1aeec 7105 doc: /* Return the list of display names that Emacs has connections to. */)
6fc2811b
JR
7106 ()
7107{
7108 Lisp_Object tail, result;
7109
7110 result = Qnil;
99784d63 7111 for (tail = w32_display_name_list; CONSP (tail); tail = XCDR (tail))
6fc2811b
JR
7112 result = Fcons (XCAR (XCAR (tail)), result);
7113
7114 return result;
7115}
7116
7117DEFUN ("x-synchronize", Fx_synchronize, Sx_synchronize, 1, 2, 0,
0a332240
PJ
7118 doc: /* This is a noop on W32 systems. */)
7119 (on, display)
7120 Lisp_Object display, on;
6fc2811b 7121{
6fc2811b
JR
7122 return Qnil;
7123}
7124
6b61353c 7125
6fc2811b 7126\f
6fc2811b 7127/***********************************************************************
6b61353c 7128 Window properties
6fc2811b
JR
7129 ***********************************************************************/
7130
6b61353c
KH
7131DEFUN ("x-change-window-property", Fx_change_window_property,
7132 Sx_change_window_property, 2, 6, 0,
7133 doc: /* Change window property PROP to VALUE on the X window of FRAME.
7134VALUE may be a string or a list of conses, numbers and/or strings.
7135If an element in the list is a string, it is converted to
7136an Atom and the value of the Atom is used. If an element is a cons,
7137it is converted to a 32 bit number where the car is the 16 top bits and the
7138cdr is the lower 16 bits.
7139FRAME nil or omitted means use the selected frame.
7140If TYPE is given and non-nil, it is the name of the type of VALUE.
7141If TYPE is not given or nil, the type is STRING.
7142FORMAT gives the size in bits of each element if VALUE is a list.
7143It must be one of 8, 16 or 32.
7144If VALUE is a string or FORMAT is nil or not given, FORMAT defaults to 8.
7145If OUTER_P is non-nil, the property is changed for the outer X window of
7146FRAME. Default is to change on the edit X window.
7147
7148Value is VALUE. */)
7149 (prop, value, frame, type, format, outer_p)
7150 Lisp_Object prop, value, frame, type, format, outer_p;
7151{
7152#if 0 /* TODO : port window properties to W32 */
7153 struct frame *f = check_x_frame (frame);
7154 Atom prop_atom;
6fc2811b 7155
6b61353c
KH
7156 CHECK_STRING (prop);
7157 CHECK_STRING (value);
6fc2811b 7158
6b61353c
KH
7159 BLOCK_INPUT;
7160 prop_atom = XInternAtom (FRAME_W32_DISPLAY (f), SDATA (prop), False);
7161 XChangeProperty (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f),
7162 prop_atom, XA_STRING, 8, PropModeReplace,
7163 SDATA (value), SCHARS (value));
6fc2811b 7164
6b61353c
KH
7165 /* Make sure the property is set when we return. */
7166 XFlush (FRAME_W32_DISPLAY (f));
7167 UNBLOCK_INPUT;
6fc2811b 7168
6b61353c 7169#endif /* TODO */
6fc2811b 7170
6b61353c
KH
7171 return value;
7172}
dfff8a69 7173
6fc2811b 7174
6b61353c
KH
7175DEFUN ("x-delete-window-property", Fx_delete_window_property,
7176 Sx_delete_window_property, 1, 2, 0,
7177 doc: /* Remove window property PROP from X window of FRAME.
7178FRAME nil or omitted means use the selected frame. Value is PROP. */)
7179 (prop, frame)
7180 Lisp_Object prop, frame;
6fc2811b 7181{
6b61353c 7182#if 0 /* TODO : port window properties to W32 */
6fc2811b 7183
6b61353c
KH
7184 struct frame *f = check_x_frame (frame);
7185 Atom prop_atom;
6fc2811b 7186
6b61353c
KH
7187 CHECK_STRING (prop);
7188 BLOCK_INPUT;
7189 prop_atom = XInternAtom (FRAME_W32_DISPLAY (f), SDATA (prop), False);
7190 XDeleteProperty (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f), prop_atom);
6fc2811b 7191
6b61353c
KH
7192 /* Make sure the property is removed when we return. */
7193 XFlush (FRAME_W32_DISPLAY (f));
7194 UNBLOCK_INPUT;
7195#endif /* TODO */
6fc2811b 7196
6b61353c 7197 return prop;
6fc2811b
JR
7198}
7199
7200
6b61353c
KH
7201DEFUN ("x-window-property", Fx_window_property, Sx_window_property,
7202 1, 2, 0,
7203 doc: /* Value is the value of window property PROP on FRAME.
7204If FRAME is nil or omitted, use the selected frame. Value is nil
7205if FRAME hasn't a property with name PROP or if PROP has no string
7206value. */)
7207 (prop, frame)
7208 Lisp_Object prop, frame;
6fc2811b 7209{
6b61353c
KH
7210#if 0 /* TODO : port window properties to W32 */
7211
7212 struct frame *f = check_x_frame (frame);
7213 Atom prop_atom;
7214 int rc;
7215 Lisp_Object prop_value = Qnil;
7216 char *tmp_data = NULL;
7217 Atom actual_type;
7218 int actual_format;
7219 unsigned long actual_size, bytes_remaining;
7d0393cf 7220
6b61353c
KH
7221 CHECK_STRING (prop);
7222 BLOCK_INPUT;
7223 prop_atom = XInternAtom (FRAME_W32_DISPLAY (f), SDATA (prop), False);
7224 rc = XGetWindowProperty (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f),
7225 prop_atom, 0, 0, False, XA_STRING,
7226 &actual_type, &actual_format, &actual_size,
7227 &bytes_remaining, (unsigned char **) &tmp_data);
7228 if (rc == Success)
6fc2811b 7229 {
6b61353c 7230 int size = bytes_remaining;
3cf3436e 7231
6b61353c
KH
7232 XFree (tmp_data);
7233 tmp_data = NULL;
3cf3436e 7234
6b61353c
KH
7235 rc = XGetWindowProperty (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f),
7236 prop_atom, 0, bytes_remaining,
7237 False, XA_STRING,
7238 &actual_type, &actual_format,
7239 &actual_size, &bytes_remaining,
7240 (unsigned char **) &tmp_data);
7241 if (rc == Success)
7242 prop_value = make_string (tmp_data, size);
6fc2811b 7243
6b61353c
KH
7244 XFree (tmp_data);
7245 }
6fc2811b 7246
6b61353c 7247 UNBLOCK_INPUT;
6fc2811b 7248
6b61353c 7249 return prop_value;
6fc2811b 7250
6b61353c
KH
7251#endif /* TODO */
7252 return Qnil;
6fc2811b
JR
7253}
7254
7255
7256\f
7257/***********************************************************************
6b61353c 7258 Busy cursor
6fc2811b
JR
7259 ***********************************************************************/
7260
6b61353c
KH
7261/* Non-zero means an hourglass cursor is currently shown. */
7262
7263static int hourglass_shown_p;
6fc2811b 7264
6b61353c 7265/* Number of seconds to wait before displaying an hourglass cursor. */
6fc2811b 7266
6b61353c 7267static Lisp_Object Vhourglass_delay;
6fc2811b 7268
6b61353c
KH
7269/* Default number of seconds to wait before displaying an hourglass
7270 cursor. */
6fc2811b 7271
6b61353c 7272#define DEFAULT_HOURGLASS_DELAY 1
6fc2811b 7273
d148e14d 7274/* Return non-zero if houglass timer has been started or hourglass is shown. */
6fc2811b 7275
d148e14d
JR
7276int
7277hourglass_started ()
7278{
7279 return hourglass_shown_p || hourglass_timer;
7280}
6fc2811b 7281
6b61353c 7282/* Cancel a currently active hourglass timer, and start a new one. */
6fc2811b 7283
6b61353c
KH
7284void
7285start_hourglass ()
6fc2811b 7286{
d148e14d
JR
7287 DWORD delay;
7288 int secs, msecs = 0;
7289 struct frame * f = SELECTED_FRAME ();
6fc2811b 7290
30076589
JR
7291 /* No cursors on non GUI frames. */
7292 if (!FRAME_W32_P (f))
7293 return;
7294
6b61353c 7295 cancel_hourglass ();
6fc2811b 7296
6b61353c
KH
7297 if (INTEGERP (Vhourglass_delay)
7298 && XINT (Vhourglass_delay) > 0)
7299 secs = XFASTINT (Vhourglass_delay);
7300 else if (FLOATP (Vhourglass_delay)
7301 && XFLOAT_DATA (Vhourglass_delay) > 0)
6fc2811b 7302 {
6b61353c
KH
7303 Lisp_Object tem;
7304 tem = Ftruncate (Vhourglass_delay, Qnil);
7305 secs = XFASTINT (tem);
d148e14d 7306 msecs = (XFLOAT_DATA (Vhourglass_delay) - secs) * 1000;
6b61353c
KH
7307 }
7308 else
7309 secs = DEFAULT_HOURGLASS_DELAY;
7d0393cf 7310
d148e14d
JR
7311 delay = secs * 1000 + msecs;
7312 hourglass_hwnd = FRAME_W32_WINDOW (f);
7313 hourglass_timer = SetTimer (hourglass_hwnd, HOURGLASS_ID, delay, NULL);
f79e6790
JR
7314}
7315
7316
0af913d7
GM
7317/* Cancel the hourglass cursor timer if active, hide an hourglass
7318 cursor if shown. */
f79e6790
JR
7319
7320void
0af913d7 7321cancel_hourglass ()
f79e6790 7322{
d148e14d 7323 if (hourglass_timer)
dfff8a69 7324 {
d148e14d
JR
7325 KillTimer (hourglass_hwnd, hourglass_timer);
7326 hourglass_timer = 0;
dfff8a69 7327 }
7d0393cf 7328
0af913d7
GM
7329 if (hourglass_shown_p)
7330 hide_hourglass ();
f79e6790
JR
7331}
7332
7333
d148e14d 7334/* Timer function of hourglass_timer.
f79e6790 7335
d148e14d
JR
7336 Display an hourglass cursor. Set the hourglass_p flag in display info
7337 to indicate that an hourglass cursor is shown. */
f79e6790
JR
7338
7339static void
d148e14d
JR
7340show_hourglass (f)
7341 struct frame *f;
6fc2811b 7342{
0af913d7 7343 if (!hourglass_shown_p)
6fc2811b 7344 {
d148e14d
JR
7345 f->output_data.w32->hourglass_p = 1;
7346 if (!menubar_in_use && !current_popup_menu)
7347 SetCursor (f->output_data.w32->hourglass_cursor);
0af913d7 7348 hourglass_shown_p = 1;
f79e6790 7349 }
6fc2811b
JR
7350}
7351
7352
0af913d7 7353/* Hide the hourglass cursor on all frames, if it is currently shown. */
6fc2811b 7354
f79e6790 7355static void
0af913d7 7356hide_hourglass ()
f79e6790 7357{
0af913d7 7358 if (hourglass_shown_p)
6fc2811b 7359 {
d148e14d
JR
7360 struct frame *f = x_window_to_frame (&one_w32_display_info,
7361 hourglass_hwnd);
6fc2811b 7362
d148e14d
JR
7363 f->output_data.w32->hourglass_p = 0;
7364 SetCursor (f->output_data.w32->current_cursor);
0af913d7 7365 hourglass_shown_p = 0;
f79e6790 7366 }
6fc2811b
JR
7367}
7368
7369
7370\f
7371/***********************************************************************
7372 Tool tips
7373 ***********************************************************************/
7374
7375static Lisp_Object x_create_tip_frame P_ ((struct w32_display_info *,
3cf3436e
JR
7376 Lisp_Object, Lisp_Object));
7377static void compute_tip_xy P_ ((struct frame *, Lisp_Object, Lisp_Object,
7378 Lisp_Object, int, int, int *, int *));
7d0393cf 7379
3cf3436e 7380/* The frame of a currently visible tooltip. */
6fc2811b 7381
937e601e 7382Lisp_Object tip_frame;
6fc2811b
JR
7383
7384/* If non-nil, a timer started that hides the last tooltip when it
7385 fires. */
7386
7387Lisp_Object tip_timer;
7388Window tip_window;
7389
3cf3436e
JR
7390/* If non-nil, a vector of 3 elements containing the last args
7391 with which x-show-tip was called. See there. */
7392
7393Lisp_Object last_show_tip_args;
7394
7395/* Maximum size for tooltips; a cons (COLUMNS . ROWS). */
7396
7397Lisp_Object Vx_max_tooltip_size;
7398
7399
937e601e
AI
7400static Lisp_Object
7401unwind_create_tip_frame (frame)
7402 Lisp_Object frame;
7403{
c844a81a
GM
7404 Lisp_Object deleted;
7405
7406 deleted = unwind_create_frame (frame);
7407 if (EQ (deleted, Qt))
7408 {
7409 tip_window = NULL;
7410 tip_frame = Qnil;
7411 }
7d0393cf 7412
c844a81a 7413 return deleted;
937e601e
AI
7414}
7415
7416
6fc2811b 7417/* Create a frame for a tooltip on the display described by DPYINFO.
3cf3436e
JR
7418 PARMS is a list of frame parameters. TEXT is the string to
7419 display in the tip frame. Value is the frame.
937e601e
AI
7420
7421 Note that functions called here, esp. x_default_parameter can
7422 signal errors, for instance when a specified color name is
7423 undefined. We have to make sure that we're in a consistent state
7424 when this happens. */
6fc2811b
JR
7425
7426static Lisp_Object
3cf3436e 7427x_create_tip_frame (dpyinfo, parms, text)
6fc2811b 7428 struct w32_display_info *dpyinfo;
3cf3436e 7429 Lisp_Object parms, text;
6fc2811b 7430{
6fc2811b
JR
7431 struct frame *f;
7432 Lisp_Object frame, tem;
7433 Lisp_Object name;
7434 long window_prompting = 0;
7435 int width, height;
331379bf 7436 int count = SPECPDL_INDEX ();
6fc2811b
JR
7437 struct gcpro gcpro1, gcpro2, gcpro3;
7438 struct kboard *kb;
3cf3436e
JR
7439 int face_change_count_before = face_change_count;
7440 Lisp_Object buffer;
7441 struct buffer *old_buffer;
6fc2811b 7442
ca56d953 7443 check_w32 ();
6fc2811b
JR
7444
7445 /* Use this general default value to start with until we know if
7446 this frame has a specified name. */
7447 Vx_resource_name = Vinvocation_name;
7448
7449#ifdef MULTI_KBOARD
fd142562 7450 kb = dpyinfo->terminal->kboard;
6fc2811b
JR
7451#else
7452 kb = &the_only_kboard;
7453#endif
7454
7455 /* Get the name of the frame to use for resource lookup. */
7456 name = w32_get_arg (parms, Qname, "name", "Name", RES_TYPE_STRING);
7457 if (!STRINGP (name)
7458 && !EQ (name, Qunbound)
7459 && !NILP (name))
7460 error ("Invalid frame name--not a string or nil");
7461 Vx_resource_name = name;
7462
7463 frame = Qnil;
7464 GCPRO3 (parms, name, frame);
9eb16b62
JR
7465 /* Make a frame without minibuffer nor mode-line. */
7466 f = make_frame (0);
7467 f->wants_modeline = 0;
6fc2811b 7468 XSETFRAME (frame, f);
3cf3436e
JR
7469
7470 buffer = Fget_buffer_create (build_string (" *tip*"));
be786000 7471 Fset_window_buffer (FRAME_ROOT_WINDOW (f), buffer, Qnil);
3cf3436e
JR
7472 old_buffer = current_buffer;
7473 set_buffer_internal_1 (XBUFFER (buffer));
7474 current_buffer->truncate_lines = Qnil;
5c2a995d
KH
7475 specbind (Qinhibit_read_only, Qt);
7476 specbind (Qinhibit_modification_hooks, Qt);
3cf3436e
JR
7477 Ferase_buffer ();
7478 Finsert (1, &text);
7479 set_buffer_internal_1 (old_buffer);
7d0393cf 7480
6fc2811b 7481 FRAME_CAN_HAVE_SCROLL_BARS (f) = 0;
937e601e 7482 record_unwind_protect (unwind_create_tip_frame, frame);
6fc2811b 7483
3cf3436e
JR
7484 /* By setting the output method, we're essentially saying that
7485 the frame is live, as per FRAME_LIVE_P. If we get a signal
7486 from this point on, x_destroy_window might screw up reference
7487 counts etc. */
ebbb61be
JR
7488 f->terminal = dpyinfo->terminal;
7489 f->terminal->reference_count++;
d88c567c 7490 f->output_method = output_w32;
6fc2811b
JR
7491 f->output_data.w32 =
7492 (struct w32_output *) xmalloc (sizeof (struct w32_output));
7493 bzero (f->output_data.w32, sizeof (struct w32_output));
ca56d953
JR
7494
7495 FRAME_FONTSET (f) = -1;
6fc2811b
JR
7496 f->icon_name = Qnil;
7497
ca56d953 7498#if 0 /* GLYPH_DEBUG TODO: image support. */
354884c4 7499 image_cache_refcount = FRAME_IMAGE_CACHE (f)->refcount;
937e601e
AI
7500 dpyinfo_refcount = dpyinfo->reference_count;
7501#endif /* GLYPH_DEBUG */
6fc2811b
JR
7502#ifdef MULTI_KBOARD
7503 FRAME_KBOARD (f) = kb;
7504#endif
7505 f->output_data.w32->parent_desc = FRAME_W32_DISPLAY_INFO (f)->root_window;
7506 f->output_data.w32->explicit_parent = 0;
7507
7508 /* Set the name; the functions to which we pass f expect the name to
7509 be set. */
7510 if (EQ (name, Qunbound) || NILP (name))
7511 {
ca56d953 7512 f->name = build_string (dpyinfo->w32_id_name);
6fc2811b
JR
7513 f->explicit_name = 0;
7514 }
7515 else
7516 {
7517 f->name = name;
7518 f->explicit_name = 1;
7519 /* use the frame's title when getting resources for this frame. */
7520 specbind (Qx_resource_name, name);
7521 }
7522
82523155
JR
7523 f->resx = dpyinfo->resx;
7524 f->resy = dpyinfo->resy;
7525
a1fe5c00
JR
7526#ifdef USE_FONT_BACKEND
7527 if (enable_font_backend)
7528 {
7529 /* Perhaps, we must allow frame parameter, say `font-backend',
7530 to specify which font backends to use. */
7531 register_font_driver (&w32font_driver, f);
7532
7533 x_default_parameter (f, parms, Qfont_backend, Qnil,
7534 "fontBackend", "FontBackend", RES_TYPE_STRING);
7535 }
7536#endif /* USE_FONT_BACKEND */
7537
6fc2811b
JR
7538 /* Extract the window parameters from the supplied values
7539 that are needed to determine window geometry. */
a1fe5c00
JR
7540#ifdef USE_FONT_BACKEND
7541 if (enable_font_backend)
7542 x_default_font_parameter (f, parms);
7543 else
7544#endif /* USE_FONT_BACKEND */
6fc2811b
JR
7545 {
7546 Lisp_Object font;
7547
7548 font = w32_get_arg (parms, Qfont, "font", "Font", RES_TYPE_STRING);
7549
7550 BLOCK_INPUT;
7551 /* First, try whatever font the caller has specified. */
7552 if (STRINGP (font))
7553 {
7554 tem = Fquery_fontset (font, Qnil);
7555 if (STRINGP (tem))
10b4bc33 7556 font = x_new_fontset (f, tem);
6fc2811b 7557 else
d5db4077 7558 font = x_new_font (f, SDATA (font));
6fc2811b 7559 }
7d0393cf 7560
6fc2811b
JR
7561 /* Try out a font which we hope has bold and italic variations. */
7562 if (!STRINGP (font))
ca56d953 7563 font = x_new_font (f, "-*-Courier New-normal-r-*-*-*-100-*-*-c-*-iso8859-1");
6fc2811b 7564 if (! STRINGP (font))
ca56d953 7565 font = x_new_font (f, "-*-Courier-normal-r-*-*-13-*-*-*-c-*-iso8859-1");
6fc2811b
JR
7566 /* If those didn't work, look for something which will at least work. */
7567 if (! STRINGP (font))
ca56d953 7568 font = x_new_font (f, "-*-Fixedsys-normal-r-*-*-12-*-*-*-c-*-iso8859-1");
6fc2811b
JR
7569 UNBLOCK_INPUT;
7570 if (! STRINGP (font))
ca56d953 7571 font = build_string ("Fixedsys");
6fc2811b
JR
7572
7573 x_default_parameter (f, parms, Qfont, font,
7574 "font", "Font", RES_TYPE_STRING);
7575 }
7576
7577 x_default_parameter (f, parms, Qborder_width, make_number (2),
7578 "borderWidth", "BorderWidth", RES_TYPE_NUMBER);
6fc2811b
JR
7579 /* This defaults to 2 in order to match xterm. We recognize either
7580 internalBorderWidth or internalBorder (which is what xterm calls
7581 it). */
7582 if (NILP (Fassq (Qinternal_border_width, parms)))
7583 {
7584 Lisp_Object value;
7585
7586 value = w32_get_arg (parms, Qinternal_border_width,
7587 "internalBorder", "internalBorder", RES_TYPE_NUMBER);
7588 if (! EQ (value, Qunbound))
7589 parms = Fcons (Fcons (Qinternal_border_width, value),
7590 parms);
7591 }
bfd6edcc 7592 x_default_parameter (f, parms, Qinternal_border_width, make_number (1),
6fc2811b
JR
7593 "internalBorderWidth", "internalBorderWidth",
7594 RES_TYPE_NUMBER);
7595
7596 /* Also do the stuff which must be set before the window exists. */
7597 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
7598 "foreground", "Foreground", RES_TYPE_STRING);
7599 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
7600 "background", "Background", RES_TYPE_STRING);
7601 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
7602 "pointerColor", "Foreground", RES_TYPE_STRING);
7603 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
7604 "cursorColor", "Foreground", RES_TYPE_STRING);
7605 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
7606 "borderColor", "BorderColor", RES_TYPE_STRING);
7607
7608 /* Init faces before x_default_parameter is called for scroll-bar
7609 parameters because that function calls x_set_scroll_bar_width,
7610 which calls change_frame_size, which calls Fset_window_buffer,
7611 which runs hooks, which call Fvertical_motion. At the end, we
7612 end up in init_iterator with a null face cache, which should not
7613 happen. */
7614 init_frame_faces (f);
ca56d953
JR
7615
7616 f->output_data.w32->dwStyle = WS_BORDER | WS_POPUP | WS_DISABLED;
6fc2811b 7617 f->output_data.w32->parent_desc = FRAME_W32_DISPLAY_INFO (f)->root_window;
9eb16b62 7618
6d906347 7619 window_prompting = x_figure_window_size (f, parms, 0);
6fc2811b 7620
9eb16b62 7621 /* No fringes on tip frame. */
be786000
KS
7622 f->fringe_cols = 0;
7623 f->left_fringe_width = 0;
7624 f->right_fringe_width = 0;
9eb16b62 7625
ca56d953
JR
7626 BLOCK_INPUT;
7627 my_create_tip_window (f);
7628 UNBLOCK_INPUT;
6fc2811b
JR
7629
7630 x_make_gc (f);
7631
7632 x_default_parameter (f, parms, Qauto_raise, Qnil,
7633 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN);
7634 x_default_parameter (f, parms, Qauto_lower, Qnil,
7635 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN);
7636 x_default_parameter (f, parms, Qcursor_type, Qbox,
7637 "cursorType", "CursorType", RES_TYPE_SYMBOL);
7638
be786000 7639 /* Dimensions, especially FRAME_LINES (f), must be done via change_frame_size.
6fc2811b 7640 Change will not be effected unless different from the current
be786000
KS
7641 FRAME_LINES (f). */
7642 width = FRAME_COLS (f);
7643 height = FRAME_LINES (f);
7644 FRAME_LINES (f) = 0;
7645 SET_FRAME_COLS (f, 0);
6fc2811b
JR
7646 change_frame_size (f, height, width, 1, 0, 0);
7647
cd1d850f
JPW
7648 /* Add `tooltip' frame parameter's default value. */
7649 if (NILP (Fframe_parameter (frame, intern ("tooltip"))))
7650 Fmodify_frame_parameters (frame, Fcons (Fcons (intern ("tooltip"), Qt),
7651 Qnil));
7d0393cf 7652
3cf3436e
JR
7653 /* Set up faces after all frame parameters are known. This call
7654 also merges in face attributes specified for new frames.
7655
7656 Frame parameters may be changed if .Xdefaults contains
7657 specifications for the default font. For example, if there is an
7658 `Emacs.default.attributeBackground: pink', the `background-color'
7659 attribute of the frame get's set, which let's the internal border
7660 of the tooltip frame appear in pink. Prevent this. */
7661 {
7662 Lisp_Object bg = Fframe_parameter (frame, Qbackground_color);
7663
7664 /* Set tip_frame here, so that */
7665 tip_frame = frame;
7666 call1 (Qface_set_after_frame_default, frame);
7d0393cf 7667
3cf3436e
JR
7668 if (!EQ (bg, Fframe_parameter (frame, Qbackground_color)))
7669 Fmodify_frame_parameters (frame, Fcons (Fcons (Qbackground_color, bg),
7670 Qnil));
7671 }
7d0393cf 7672
6fc2811b
JR
7673 f->no_split = 1;
7674
7675 UNGCPRO;
7676
7677 /* It is now ok to make the frame official even if we get an error
7678 below. And the frame needs to be on Vframe_list or making it
7679 visible won't work. */
7680 Vframe_list = Fcons (frame, Vframe_list);
7681
7682 /* Now that the frame is official, it counts as a reference to
7683 its display. */
7684 FRAME_W32_DISPLAY_INFO (f)->reference_count++;
ee78dc32 7685
3cf3436e
JR
7686 /* Setting attributes of faces of the tooltip frame from resources
7687 and similar will increment face_change_count, which leads to the
7688 clearing of all current matrices. Since this isn't necessary
7689 here, avoid it by resetting face_change_count to the value it
7690 had before we created the tip frame. */
7691 face_change_count = face_change_count_before;
7692
7693 /* Discard the unwind_protect. */
6fc2811b 7694 return unbind_to (count, frame);
ee78dc32
GV
7695}
7696
3cf3436e
JR
7697
7698/* Compute where to display tip frame F. PARMS is the list of frame
7699 parameters for F. DX and DY are specified offsets from the current
7700 location of the mouse. WIDTH and HEIGHT are the width and height
7701 of the tooltip. Return coordinates relative to the root window of
7702 the display in *ROOT_X, and *ROOT_Y. */
7703
7704static void
7705compute_tip_xy (f, parms, dx, dy, width, height, root_x, root_y)
7706 struct frame *f;
7707 Lisp_Object parms, dx, dy;
7708 int width, height;
7709 int *root_x, *root_y;
7710{
3cf3436e 7711 Lisp_Object left, top;
64f0809d 7712 int min_x, min_y, max_x, max_y;
7d0393cf 7713
3cf3436e
JR
7714 /* User-specified position? */
7715 left = Fcdr (Fassq (Qleft, parms));
7716 top = Fcdr (Fassq (Qtop, parms));
7d0393cf 7717
3cf3436e
JR
7718 /* Move the tooltip window where the mouse pointer is. Resize and
7719 show it. */
ca56d953 7720 if (!INTEGERP (left) || !INTEGERP (top))
3cf3436e 7721 {
ca56d953
JR
7722 POINT pt;
7723
64f0809d
JR
7724 /* Default min and max values. */
7725 min_x = 0;
7726 min_y = 0;
7727 max_x = FRAME_W32_DISPLAY_INFO (f)->width;
7728 max_y = FRAME_W32_DISPLAY_INFO (f)->height;
7729
3cf3436e 7730 BLOCK_INPUT;
ca56d953
JR
7731 GetCursorPos (&pt);
7732 *root_x = pt.x;
7733 *root_y = pt.y;
3cf3436e 7734 UNBLOCK_INPUT;
64f0809d
JR
7735
7736 /* If multiple monitor support is available, constrain the tip onto
7737 the current monitor. This improves the above by allowing negative
7738 co-ordinates if monitor positions are such that they are valid, and
7739 snaps a tooltip onto a single monitor if we are close to the edge
7740 where it would otherwise flow onto the other monitor (or into
7741 nothingness if there is a gap in the overlap). */
7742 if (monitor_from_point_fn && get_monitor_info_fn)
7743 {
7744 struct MONITOR_INFO info;
7745 HMONITOR monitor
7746 = monitor_from_point_fn (pt, MONITOR_DEFAULT_TO_NEAREST);
7747 info.cbSize = sizeof (info);
7748
7749 if (get_monitor_info_fn (monitor, &info))
7750 {
7751 min_x = info.rcWork.left;
7752 min_y = info.rcWork.top;
7753 max_x = info.rcWork.right;
7754 max_y = info.rcWork.bottom;
7755 }
7756 }
3cf3436e
JR
7757 }
7758
7759 if (INTEGERP (top))
7760 *root_y = XINT (top);
64f0809d
JR
7761 else if (*root_y + XINT (dy) <= min_y)
7762 *root_y = min_y; /* Can happen for negative dy */
7763 else if (*root_y + XINT (dy) + height <= max_y)
7e8410d1 7764 /* It fits below the pointer */
3cf3436e 7765 *root_y += XINT (dy);
64f0809d 7766 else if (height + XINT (dy) + min_y <= *root_y)
7e8410d1
JD
7767 /* It fits above the pointer. */
7768 *root_y -= height + XINT (dy);
7769 else
7770 /* Put it on the top. */
64f0809d 7771 *root_y = min_y;
3cf3436e
JR
7772
7773 if (INTEGERP (left))
7774 *root_x = XINT (left);
64f0809d 7775 else if (*root_x + XINT (dx) <= min_x)
bf63eb69 7776 *root_x = 0; /* Can happen for negative dx */
64f0809d 7777 else if (*root_x + XINT (dx) + width <= max_x)
72e4adef
JR
7778 /* It fits to the right of the pointer. */
7779 *root_x += XINT (dx);
64f0809d 7780 else if (width + XINT (dx) + min_x <= *root_x)
72e4adef 7781 /* It fits to the left of the pointer. */
3cf3436e
JR
7782 *root_x -= width + XINT (dx);
7783 else
72e4adef 7784 /* Put it left justified on the screen -- it ought to fit that way. */
64f0809d 7785 *root_x = min_x;
3cf3436e
JR
7786}
7787
7788
71eab8d1 7789DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0,
74e1aeec
JR
7790 doc: /* Show STRING in a \"tooltip\" window on frame FRAME.
7791A tooltip window is a small window displaying a string.
7792
87c891c7
EZ
7793This is an internal function; Lisp code should call `tooltip-show'.
7794
74e1aeec
JR
7795FRAME nil or omitted means use the selected frame.
7796
7797PARMS is an optional list of frame parameters which can be
7798used to change the tooltip's appearance.
7799
ca56d953
JR
7800Automatically hide the tooltip after TIMEOUT seconds. TIMEOUT nil
7801means use the default timeout of 5 seconds.
74e1aeec 7802
52deb19f 7803If the list of frame parameters PARMS contains a `left' parameter,
74e1aeec
JR
7804the tooltip is displayed at that x-position. Otherwise it is
7805displayed at the mouse position, with offset DX added (default is 5 if
7806DX isn't specified). Likewise for the y-position; if a `top' frame
7807parameter is specified, it determines the y-position of the tooltip
7808window, otherwise it is displayed at the mouse position, with offset
7809DY added (default is -10).
7810
7811A tooltip's maximum size is specified by `x-max-tooltip-size'.
7812Text larger than the specified size is clipped. */)
71eab8d1
AI
7813 (string, frame, parms, timeout, dx, dy)
7814 Lisp_Object string, frame, parms, timeout, dx, dy;
ee78dc32 7815{
6fc2811b
JR
7816 struct frame *f;
7817 struct window *w;
3cf3436e 7818 int root_x, root_y;
6fc2811b
JR
7819 struct buffer *old_buffer;
7820 struct text_pos pos;
7821 int i, width, height;
6fc2811b
JR
7822 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
7823 int old_windows_or_buffers_changed = windows_or_buffers_changed;
331379bf 7824 int count = SPECPDL_INDEX ();
7d0393cf 7825
6fc2811b 7826 specbind (Qinhibit_redisplay, Qt);
ee78dc32 7827
dfff8a69 7828 GCPRO4 (string, parms, frame, timeout);
ee78dc32 7829
b7826503 7830 CHECK_STRING (string);
6fc2811b
JR
7831 f = check_x_frame (frame);
7832 if (NILP (timeout))
7833 timeout = make_number (5);
7834 else
b7826503 7835 CHECK_NATNUM (timeout);
ee78dc32 7836
71eab8d1
AI
7837 if (NILP (dx))
7838 dx = make_number (5);
7839 else
b7826503 7840 CHECK_NUMBER (dx);
7d0393cf 7841
71eab8d1 7842 if (NILP (dy))
dc220243 7843 dy = make_number (-10);
71eab8d1 7844 else
b7826503 7845 CHECK_NUMBER (dy);
71eab8d1 7846
dc220243
JR
7847 if (NILP (last_show_tip_args))
7848 last_show_tip_args = Fmake_vector (make_number (3), Qnil);
7849
7850 if (!NILP (tip_frame))
7851 {
7852 Lisp_Object last_string = AREF (last_show_tip_args, 0);
7853 Lisp_Object last_frame = AREF (last_show_tip_args, 1);
7854 Lisp_Object last_parms = AREF (last_show_tip_args, 2);
7855
7856 if (EQ (frame, last_frame)
7857 && !NILP (Fequal (last_string, string))
7858 && !NILP (Fequal (last_parms, parms)))
7859 {
7860 struct frame *f = XFRAME (tip_frame);
7d0393cf 7861
dc220243
JR
7862 /* Only DX and DY have changed. */
7863 if (!NILP (tip_timer))
7864 {
7865 Lisp_Object timer = tip_timer;
7866 tip_timer = Qnil;
7867 call1 (Qcancel_timer, timer);
7868 }
7869
7870 BLOCK_INPUT;
be786000
KS
7871 compute_tip_xy (f, parms, dx, dy, FRAME_PIXEL_WIDTH (f),
7872 FRAME_PIXEL_HEIGHT (f), &root_x, &root_y);
d65a9cdc
JR
7873
7874 /* Put tooltip in topmost group and in position. */
ca56d953
JR
7875 SetWindowPos (FRAME_W32_WINDOW (f), HWND_TOPMOST,
7876 root_x, root_y, 0, 0,
7877 SWP_NOSIZE | SWP_NOACTIVATE);
d65a9cdc
JR
7878
7879 /* Ensure tooltip is on top of other topmost windows (eg menus). */
7880 SetWindowPos (FRAME_W32_WINDOW (f), HWND_TOP,
7881 0, 0, 0, 0,
7882 SWP_NOMOVE | SWP_NOSIZE | SWP_NOACTIVATE);
7883
dc220243
JR
7884 UNBLOCK_INPUT;
7885 goto start_timer;
7886 }
7887 }
7888
6fc2811b
JR
7889 /* Hide a previous tip, if any. */
7890 Fx_hide_tip ();
ee78dc32 7891
dc220243
JR
7892 ASET (last_show_tip_args, 0, string);
7893 ASET (last_show_tip_args, 1, frame);
7894 ASET (last_show_tip_args, 2, parms);
7895
6fc2811b
JR
7896 /* Add default values to frame parameters. */
7897 if (NILP (Fassq (Qname, parms)))
7898 parms = Fcons (Fcons (Qname, build_string ("tooltip")), parms);
7899 if (NILP (Fassq (Qinternal_border_width, parms)))
7900 parms = Fcons (Fcons (Qinternal_border_width, make_number (3)), parms);
7901 if (NILP (Fassq (Qborder_width, parms)))
7902 parms = Fcons (Fcons (Qborder_width, make_number (1)), parms);
7903 if (NILP (Fassq (Qborder_color, parms)))
7904 parms = Fcons (Fcons (Qborder_color, build_string ("lightyellow")), parms);
7905 if (NILP (Fassq (Qbackground_color, parms)))
7906 parms = Fcons (Fcons (Qbackground_color, build_string ("lightyellow")),
7907 parms);
7908
0e3fcdef
JR
7909 /* Block input until the tip has been fully drawn, to avoid crashes
7910 when drawing tips in menus. */
7911 BLOCK_INPUT;
7912
6fc2811b
JR
7913 /* Create a frame for the tooltip, and record it in the global
7914 variable tip_frame. */
ca56d953 7915 frame = x_create_tip_frame (FRAME_W32_DISPLAY_INFO (f), parms, string);
937e601e 7916 f = XFRAME (frame);
6fc2811b 7917
3cf3436e 7918 /* Set up the frame's root window. */
6fc2811b 7919 w = XWINDOW (FRAME_ROOT_WINDOW (f));
be786000 7920 w->left_col = w->top_line = make_number (0);
3cf3436e
JR
7921
7922 if (CONSP (Vx_max_tooltip_size)
7923 && INTEGERP (XCAR (Vx_max_tooltip_size))
7924 && XINT (XCAR (Vx_max_tooltip_size)) > 0
7925 && INTEGERP (XCDR (Vx_max_tooltip_size))
7926 && XINT (XCDR (Vx_max_tooltip_size)) > 0)
7927 {
be786000
KS
7928 w->total_cols = XCAR (Vx_max_tooltip_size);
7929 w->total_lines = XCDR (Vx_max_tooltip_size);
3cf3436e
JR
7930 }
7931 else
7932 {
be786000
KS
7933 w->total_cols = make_number (80);
7934 w->total_lines = make_number (40);
3cf3436e 7935 }
7d0393cf 7936
be786000 7937 FRAME_TOTAL_COLS (f) = XINT (w->total_cols);
6fc2811b
JR
7938 adjust_glyphs (f);
7939 w->pseudo_window_p = 1;
7940
7941 /* Display the tooltip text in a temporary buffer. */
6fc2811b 7942 old_buffer = current_buffer;
3cf3436e
JR
7943 set_buffer_internal_1 (XBUFFER (XWINDOW (FRAME_ROOT_WINDOW (f))->buffer));
7944 current_buffer->truncate_lines = Qnil;
6fc2811b
JR
7945 clear_glyph_matrix (w->desired_matrix);
7946 clear_glyph_matrix (w->current_matrix);
7947 SET_TEXT_POS (pos, BEGV, BEGV_BYTE);
29e95254 7948 try_window (FRAME_ROOT_WINDOW (f), pos, 0);
6fc2811b
JR
7949
7950 /* Compute width and height of the tooltip. */
7951 width = height = 0;
7952 for (i = 0; i < w->desired_matrix->nrows; ++i)
ee78dc32 7953 {
6fc2811b
JR
7954 struct glyph_row *row = &w->desired_matrix->rows[i];
7955 struct glyph *last;
7956 int row_width;
7957
7958 /* Stop at the first empty row at the end. */
7959 if (!row->enabled_p || !row->displays_text_p)
7960 break;
7961
7962 /* Let the row go over the full width of the frame. */
7963 row->full_width_p = 1;
7964
4e3a1c61
JR
7965#ifdef TODO /* Investigate why some fonts need more width than is
7966 calculated for some tooltips. */
6fc2811b
JR
7967 /* There's a glyph at the end of rows that is use to place
7968 the cursor there. Don't include the width of this glyph. */
7969 if (row->used[TEXT_AREA])
7970 {
7971 last = &row->glyphs[TEXT_AREA][row->used[TEXT_AREA] - 1];
7972 row_width = row->pixel_width - last->pixel_width;
7973 }
7974 else
4e3a1c61 7975#endif
6fc2811b 7976 row_width = row->pixel_width;
7d0393cf 7977
ca56d953 7978 /* TODO: find why tips do not draw along baseline as instructed. */
bfd6edcc 7979 height += row->height;
6fc2811b 7980 width = max (width, row_width);
ee78dc32
GV
7981 }
7982
6fc2811b
JR
7983 /* Add the frame's internal border to the width and height the X
7984 window should have. */
7985 height += 2 * FRAME_INTERNAL_BORDER_WIDTH (f);
7986 width += 2 * FRAME_INTERNAL_BORDER_WIDTH (f);
ee78dc32 7987
6fc2811b
JR
7988 /* Move the tooltip window where the mouse pointer is. Resize and
7989 show it. */
3cf3436e 7990 compute_tip_xy (f, parms, dx, dy, width, height, &root_x, &root_y);
71eab8d1 7991
bfd6edcc
JR
7992 {
7993 /* Adjust Window size to take border into account. */
7994 RECT rect;
7995 rect.left = rect.top = 0;
7996 rect.right = width;
7997 rect.bottom = height;
7998 AdjustWindowRect (&rect, f->output_data.w32->dwStyle,
7999 FRAME_EXTERNAL_MENU_BAR (f));
8000
1d79e521
EZ
8001 /* Position and size tooltip, and put it in the topmost group.
8002 The add-on of 3 to the 5th argument is a kludge: without it,
8003 some fonts cause the last character of the tip to be truncated,
8004 for some obscure reason. */
bfd6edcc 8005 SetWindowPos (FRAME_W32_WINDOW (f), HWND_TOPMOST,
1d79e521 8006 root_x, root_y, rect.right - rect.left + 3,
bfd6edcc
JR
8007 rect.bottom - rect.top, SWP_NOACTIVATE);
8008
d65a9cdc
JR
8009 /* Ensure tooltip is on top of other topmost windows (eg menus). */
8010 SetWindowPos (FRAME_W32_WINDOW (f), HWND_TOP,
8011 0, 0, 0, 0,
8012 SWP_NOMOVE | SWP_NOSIZE | SWP_NOACTIVATE);
8013
bfd6edcc
JR
8014 /* Let redisplay know that we have made the frame visible already. */
8015 f->async_visible = 1;
8016
8017 ShowWindow (FRAME_W32_WINDOW (f), SW_SHOWNOACTIVATE);
8018 }
ee78dc32 8019
6fc2811b
JR
8020 /* Draw into the window. */
8021 w->must_be_updated_p = 1;
8022 update_single_window (w, 1);
ee78dc32 8023
0e3fcdef
JR
8024 UNBLOCK_INPUT;
8025
6fc2811b
JR
8026 /* Restore original current buffer. */
8027 set_buffer_internal_1 (old_buffer);
8028 windows_or_buffers_changed = old_windows_or_buffers_changed;
ee78dc32 8029
dc220243 8030 start_timer:
6fc2811b
JR
8031 /* Let the tip disappear after timeout seconds. */
8032 tip_timer = call3 (intern ("run-at-time"), timeout, Qnil,
8033 intern ("x-hide-tip"));
ee78dc32 8034
dfff8a69 8035 UNGCPRO;
6fc2811b 8036 return unbind_to (count, Qnil);
ee78dc32
GV
8037}
8038
ee78dc32 8039
6fc2811b 8040DEFUN ("x-hide-tip", Fx_hide_tip, Sx_hide_tip, 0, 0, 0,
74e1aeec
JR
8041 doc: /* Hide the current tooltip window, if there is any.
8042Value is t if tooltip was open, nil otherwise. */)
6fc2811b
JR
8043 ()
8044{
937e601e
AI
8045 int count;
8046 Lisp_Object deleted, frame, timer;
8047 struct gcpro gcpro1, gcpro2;
8048
8049 /* Return quickly if nothing to do. */
8050 if (NILP (tip_timer) && NILP (tip_frame))
8051 return Qnil;
7d0393cf 8052
937e601e
AI
8053 frame = tip_frame;
8054 timer = tip_timer;
8055 GCPRO2 (frame, timer);
8056 tip_frame = tip_timer = deleted = Qnil;
7d0393cf 8057
331379bf 8058 count = SPECPDL_INDEX ();
6fc2811b 8059 specbind (Qinhibit_redisplay, Qt);
937e601e 8060 specbind (Qinhibit_quit, Qt);
7d0393cf 8061
937e601e 8062 if (!NILP (timer))
dc220243 8063 call1 (Qcancel_timer, timer);
ee78dc32 8064
937e601e 8065 if (FRAMEP (frame))
6fc2811b 8066 {
937e601e
AI
8067 Fdelete_frame (frame, Qnil);
8068 deleted = Qt;
6fc2811b 8069 }
1edf84e7 8070
937e601e
AI
8071 UNGCPRO;
8072 return unbind_to (count, deleted);
6fc2811b 8073}
5ac45f98 8074
5ac45f98 8075
6fc2811b
JR
8076\f
8077/***********************************************************************
8078 File selection dialog
8079 ***********************************************************************/
6fc2811b
JR
8080extern Lisp_Object Qfile_name_history;
8081
1030b26b
JR
8082/* Callback for altering the behaviour of the Open File dialog.
8083 Makes the Filename text field contain "Current Directory" and be
8084 read-only when "Directories" is selected in the filter. This
8085 allows us to work around the fact that the standard Open File
8086 dialog does not support directories. */
8087UINT CALLBACK
8088file_dialog_callback (hwnd, msg, wParam, lParam)
8089 HWND hwnd;
8090 UINT msg;
8091 WPARAM wParam;
8092 LPARAM lParam;
8093{
8094 if (msg == WM_NOTIFY)
8095 {
8096 OFNOTIFY * notify = (OFNOTIFY *)lParam;
8097 /* Detect when the Filter dropdown is changed. */
ef544dc8
JR
8098 if (notify->hdr.code == CDN_TYPECHANGE
8099 || notify->hdr.code == CDN_INITDONE)
1030b26b
JR
8100 {
8101 HWND dialog = GetParent (hwnd);
8102 HWND edit_control = GetDlgItem (dialog, FILE_NAME_TEXT_FIELD);
8103
8104 /* Directories is in index 2. */
8105 if (notify->lpOFN->nFilterIndex == 2)
8106 {
8107 CommDlg_OpenSave_SetControlText (dialog, FILE_NAME_TEXT_FIELD,
8108 "Current Directory");
8109 EnableWindow (edit_control, FALSE);
8110 }
8111 else
8112 {
ef544dc8
JR
8113 /* Don't override default filename on init done. */
8114 if (notify->hdr.code == CDN_TYPECHANGE)
8115 CommDlg_OpenSave_SetControlText (dialog,
8116 FILE_NAME_TEXT_FIELD, "");
1030b26b
JR
8117 EnableWindow (edit_control, TRUE);
8118 }
8119 }
8120 }
8121 return 0;
8122}
8123
7f2b4738
JR
8124/* Since we compile with _WIN32_WINNT set to 0x0400 (for NT4 compatibility)
8125 we end up with the old file dialogs. Define a big enough struct for the
8126 new dialog to trick GetOpenFileName into giving us the new dialogs on
8127 Windows 2000 and XP. */
8128typedef struct
8129{
8130 OPENFILENAME real_details;
8131 void * pReserved;
8132 DWORD dwReserved;
8133 DWORD FlagsEx;
8134} NEWOPENFILENAME;
8135
21517c3d 8136
f9d64bb3 8137DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 5, 0,
74e1aeec
JR
8138 doc: /* Read file name, prompting with PROMPT in directory DIR.
8139Use a file selection dialog.
8140Select DEFAULT-FILENAME in the dialog's file selection box, if
f9d64bb3
JD
8141specified. Ensure that file exists if MUSTMATCH is non-nil.
8142If ONLY-DIR-P is non-nil, the user can only select directories. */)
8143 (prompt, dir, default_filename, mustmatch, only_dir_p)
8144 Lisp_Object prompt, dir, default_filename, mustmatch, only_dir_p;
6fc2811b
JR
8145{
8146 struct frame *f = SELECTED_FRAME ();
8147 Lisp_Object file = Qnil;
aed13378 8148 int count = SPECPDL_INDEX ();
f9d64bb3 8149 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
6fc2811b
JR
8150 char filename[MAX_PATH + 1];
8151 char init_dir[MAX_PATH + 1];
ef544dc8 8152 int default_filter_index = 1; /* 1: All Files, 2: Directories only */
6fc2811b 8153
f9d64bb3 8154 GCPRO6 (prompt, dir, default_filename, mustmatch, only_dir_p, file);
b7826503
PJ
8155 CHECK_STRING (prompt);
8156 CHECK_STRING (dir);
6fc2811b
JR
8157
8158 /* Create the dialog with PROMPT as title, using DIR as initial
8159 directory and using "*" as pattern. */
8160 dir = Fexpand_file_name (dir, Qnil);
dda741ec 8161 strncpy (init_dir, SDATA (ENCODE_FILE (dir)), MAX_PATH);
6fc2811b
JR
8162 init_dir[MAX_PATH] = '\0';
8163 unixtodos_filename (init_dir);
8164
8165 if (STRINGP (default_filename))
8166 {
8167 char *file_name_only;
dda741ec 8168 char *full_path_name = SDATA (ENCODE_FILE (default_filename));
5ac45f98 8169
6fc2811b 8170 unixtodos_filename (full_path_name);
5ac45f98 8171
6fc2811b
JR
8172 file_name_only = strrchr (full_path_name, '\\');
8173 if (!file_name_only)
8174 file_name_only = full_path_name;
8175 else
ef544dc8 8176 file_name_only++;
ee78dc32 8177
6fc2811b
JR
8178 strncpy (filename, file_name_only, MAX_PATH);
8179 filename[MAX_PATH] = '\0';
8180 }
ee78dc32 8181 else
6fc2811b 8182 filename[0] = '\0';
ee78dc32 8183
1030b26b 8184 {
7f2b4738 8185 NEWOPENFILENAME new_file_details;
ba6f3859 8186 BOOL file_opened = FALSE;
7f2b4738 8187 OPENFILENAME * file_details = &new_file_details.real_details;
21517c3d 8188
1030b26b
JR
8189 /* Prevent redisplay. */
8190 specbind (Qinhibit_redisplay, Qt);
8191 BLOCK_INPUT;
ee78dc32 8192
7f2b4738
JR
8193 bzero (&new_file_details, sizeof (new_file_details));
8194 /* Apparently NT4 crashes if you give it an unexpected size.
8195 I'm not sure about Windows 9x, so play it safe. */
8196 if (w32_major_version > 4 && w32_major_version < 95)
843d2458 8197 file_details->lStructSize = sizeof (NEWOPENFILENAME);
7f2b4738 8198 else
843d2458 8199 file_details->lStructSize = sizeof (OPENFILENAME);
7f2b4738
JR
8200
8201 file_details->hwndOwner = FRAME_W32_WINDOW (f);
1030b26b
JR
8202 /* Undocumented Bug in Common File Dialog:
8203 If a filter is not specified, shell links are not resolved. */
7f2b4738
JR
8204 file_details->lpstrFilter = "All Files (*.*)\0*.*\0Directories\0*|*\0\0";
8205 file_details->lpstrFile = filename;
8206 file_details->nMaxFile = sizeof (filename);
8207 file_details->lpstrInitialDir = init_dir;
8208 file_details->lpstrTitle = SDATA (prompt);
ef544dc8 8209
f9d64bb3 8210 if (! NILP (only_dir_p))
ef544dc8
JR
8211 default_filter_index = 2;
8212
7f2b4738 8213 file_details->nFilterIndex = default_filter_index;
ef544dc8 8214
7f2b4738 8215 file_details->Flags = (OFN_HIDEREADONLY | OFN_NOCHANGEDIR
1030b26b
JR
8216 | OFN_EXPLORER | OFN_ENABLEHOOK);
8217 if (!NILP (mustmatch))
7f2b4738
JR
8218 {
8219 /* Require that the path to the parent directory exists. */
8220 file_details->Flags |= OFN_PATHMUSTEXIST;
8221 /* If we are looking for a file, require that it exists. */
8222 if (NILP (only_dir_p))
8223 file_details->Flags |= OFN_FILEMUSTEXIST;
8224 }
1030b26b 8225
7f2b4738 8226 file_details->lpfnHook = (LPOFNHOOKPROC) file_dialog_callback;
1030b26b 8227
7f2b4738 8228 file_opened = GetOpenFileName (file_details);
1030b26b 8229
ba6f3859
JR
8230 UNBLOCK_INPUT;
8231
8232 if (file_opened)
1030b26b
JR
8233 {
8234 dostounix_filename (filename);
7f2b4738
JR
8235
8236 if (file_details->nFilterIndex == 2)
1030b26b 8237 {
ef544dc8 8238 /* "Directories" selected - strip dummy file name. */
1030b26b
JR
8239 char * last = strrchr (filename, '/');
8240 *last = '\0';
8241 }
6fc2811b 8242
74084731 8243 file = DECODE_FILE (build_string (filename));
1030b26b
JR
8244 }
8245 /* User cancelled the dialog without making a selection. */
8246 else if (!CommDlgExtendedError ())
8247 file = Qnil;
8248 /* An error occurred, fallback on reading from the mini-buffer. */
8249 else
8250 file = Fcompleting_read (prompt, intern ("read-file-name-internal"),
8251 dir, mustmatch, dir, Qfile_name_history,
8252 default_filename, Qnil);
8253
1030b26b
JR
8254 file = unbind_to (count, file);
8255 }
ee78dc32 8256
6fc2811b 8257 UNGCPRO;
1edf84e7 8258
6fc2811b
JR
8259 /* Make "Cancel" equivalent to C-g. */
8260 if (NILP (file))
8261 Fsignal (Qquit, Qnil);
ee78dc32 8262
dfff8a69 8263 return unbind_to (count, file);
6fc2811b 8264}
ee78dc32 8265
ee78dc32 8266
6fc2811b 8267\f
6fc2811b
JR
8268/***********************************************************************
8269 w32 specialized functions
8270 ***********************************************************************/
ee78dc32 8271
d84b082d 8272DEFUN ("w32-select-font", Fw32_select_font, Sw32_select_font, 0, 2, 0,
c85eab3a 8273 doc: /* Select a font for the named FRAME using the W32 font dialog.
36458ebd 8274Return an X-style font string corresponding to the selection.
c85eab3a
EZ
8275
8276If FRAME is omitted or nil, it defaults to the selected frame.
8277If INCLUDE-PROPORTIONAL is non-nil, include proportional fonts
8278in the font selection dialog. */)
d84b082d
JR
8279 (frame, include_proportional)
8280 Lisp_Object frame, include_proportional;
ee78dc32
GV
8281{
8282 FRAME_PTR f = check_x_frame (frame);
8283 CHOOSEFONT cf;
8284 LOGFONT lf;
f46e6225
GV
8285 TEXTMETRIC tm;
8286 HDC hdc;
8287 HANDLE oldobj;
ee78dc32
GV
8288 char buf[100];
8289
8290 bzero (&cf, sizeof (cf));
f46e6225 8291 bzero (&lf, sizeof (lf));
ee78dc32
GV
8292
8293 cf.lStructSize = sizeof (cf);
fbd6baed 8294 cf.hwndOwner = FRAME_W32_WINDOW (f);
d84b082d
JR
8295 cf.Flags = CF_FORCEFONTEXIST | CF_SCREENFONTS | CF_NOVERTFONTS;
8296
8297 /* Unless include_proportional is non-nil, limit the selection to
8298 monospaced fonts. */
8299 if (NILP (include_proportional))
8300 cf.Flags |= CF_FIXEDPITCHONLY;
8301
ee78dc32
GV
8302 cf.lpLogFont = &lf;
8303
f46e6225
GV
8304 /* Initialize as much of the font details as we can from the current
8305 default font. */
8306 hdc = GetDC (FRAME_W32_WINDOW (f));
8307 oldobj = SelectObject (hdc, FRAME_FONT (f)->hfont);
8308 GetTextFace (hdc, LF_FACESIZE, lf.lfFaceName);
8309 if (GetTextMetrics (hdc, &tm))
8310 {
8311 lf.lfHeight = tm.tmInternalLeading - tm.tmHeight;
8312 lf.lfWeight = tm.tmWeight;
8313 lf.lfItalic = tm.tmItalic;
8314 lf.lfUnderline = tm.tmUnderlined;
8315 lf.lfStrikeOut = tm.tmStruckOut;
f46e6225
GV
8316 lf.lfCharSet = tm.tmCharSet;
8317 cf.Flags |= CF_INITTOLOGFONTSTRUCT;
8318 }
8319 SelectObject (hdc, oldobj);
6fc2811b 8320 ReleaseDC (FRAME_W32_WINDOW (f), hdc);
f46e6225 8321
767b1ff0 8322 if (!ChooseFont (&cf) || !w32_to_x_font (&lf, buf, 100, NULL))
3c190163 8323 return Qnil;
ee78dc32
GV
8324
8325 return build_string (buf);
8326}
8327
74e1aeec
JR
8328DEFUN ("w32-send-sys-command", Fw32_send_sys_command,
8329 Sw32_send_sys_command, 1, 2, 0,
8330 doc: /* Send frame a Windows WM_SYSCOMMAND message of type COMMAND.
52deb19f 8331Some useful values for COMMAND are #xf030 to maximize frame (#xf020
d84b082d
JR
8332to minimize), #xf120 to restore frame to original size, and #xf100
8333to activate the menubar for keyboard access. #xf140 activates the
74e1aeec
JR
8334screen saver if defined.
8335
8336If optional parameter FRAME is not specified, use selected frame. */)
1edf84e7
GV
8337 (command, frame)
8338 Lisp_Object command, frame;
8339{
1edf84e7
GV
8340 FRAME_PTR f = check_x_frame (frame);
8341
b7826503 8342 CHECK_NUMBER (command);
1edf84e7 8343
ce6059da 8344 PostMessage (FRAME_W32_WINDOW (f), WM_SYSCOMMAND, XINT (command), 0);
1edf84e7
GV
8345
8346 return Qnil;
8347}
8348
55dcfc15 8349DEFUN ("w32-shell-execute", Fw32_shell_execute, Sw32_shell_execute, 2, 4, 0,
74e1aeec
JR
8350 doc: /* Get Windows to perform OPERATION on DOCUMENT.
8351This is a wrapper around the ShellExecute system function, which
8352invokes the application registered to handle OPERATION for DOCUMENT.
74e1aeec 8353
1dccd454
EZ
8354OPERATION is either nil or a string that names a supported operation.
8355What operations can be used depends on the particular DOCUMENT and its
8356handler application, but typically it is one of the following common
8357operations:
8358
8359 \"open\" - open DOCUMENT, which could be a file, a directory, or an
8360 executable program. If it is an application, that
8361 application is launched in the current buffer's default
8362 directory. Otherwise, the application associated with
8363 DOCUMENT is launched in the buffer's default directory.
8364 \"print\" - print DOCUMENT, which must be a file
8365 \"explore\" - start the Windows Explorer on DOCUMENT
8366 \"edit\" - launch an editor and open DOCUMENT for editing; which
8367 editor is launched depends on the association for the
8368 specified DOCUMENT
8369 \"find\" - initiate search starting from DOCUMENT which must specify
8370 a directory
8371 nil - invoke the default OPERATION, or \"open\" if default is
8372 not defined or unavailable
8373
8374DOCUMENT is typically the name of a document file or a URL, but can
8375also be a program executable to run, or a directory to open in the
8376Windows Explorer.
8377
02b39a28
JB
8378If DOCUMENT is a program executable, the optional third arg PARAMETERS
8379can be a string containing command line parameters that will be passed
8380to the program; otherwise, PARAMETERS should be nil or unspecified.
1dccd454 8381
02b39a28 8382Optional fourth argument SHOW-FLAG can be used to control how the
1dccd454 8383application will be displayed when it is invoked. If SHOW-FLAG is nil
02b39a28 8384or unspecified, the application is displayed normally, otherwise it is
1dccd454 8385an integer representing a ShowWindow flag:
74e1aeec
JR
8386
8387 0 - start hidden
8388 1 - start normally
8389 3 - start maximized
8390 6 - start minimized */)
55dcfc15
AI
8391 (operation, document, parameters, show_flag)
8392 Lisp_Object operation, document, parameters, show_flag;
8393{
8394 Lisp_Object current_dir;
8395
b7826503 8396 CHECK_STRING (document);
55dcfc15 8397
3bc143eb 8398 /* Encode filename, current directory and parameters. */
55dcfc15
AI
8399 current_dir = ENCODE_FILE (current_buffer->directory);
8400 document = ENCODE_FILE (document);
3bc143eb
JR
8401 if (STRINGP (parameters))
8402 parameters = ENCODE_SYSTEM (parameters);
8403
55dcfc15 8404 if ((int) ShellExecute (NULL,
6fc2811b 8405 (STRINGP (operation) ?
d5db4077
KR
8406 SDATA (operation) : NULL),
8407 SDATA (document),
55dcfc15 8408 (STRINGP (parameters) ?
d5db4077
KR
8409 SDATA (parameters) : NULL),
8410 SDATA (current_dir),
55dcfc15
AI
8411 (INTEGERP (show_flag) ?
8412 XINT (show_flag) : SW_SHOWDEFAULT))
8413 > 32)
8414 return Qt;
90d97e64 8415 error ("ShellExecute failed: %s", w32_strerror (0));
55dcfc15
AI
8416}
8417
ccc2d29c
GV
8418/* Lookup virtual keycode from string representing the name of a
8419 non-ascii keystroke into the corresponding virtual key, using
8420 lispy_function_keys. */
8421static int
8422lookup_vk_code (char *key)
8423{
8424 int i;
8425
8426 for (i = 0; i < 256; i++)
bf254037 8427 if (lispy_function_keys[i]
ccc2d29c
GV
8428 && strcmp (lispy_function_keys[i], key) == 0)
8429 return i;
8430
8431 return -1;
8432}
8433
8434/* Convert a one-element vector style key sequence to a hot key
8435 definition. */
2ba49441 8436static Lisp_Object
ccc2d29c
GV
8437w32_parse_hot_key (key)
8438 Lisp_Object key;
8439{
8440 /* Copied from Fdefine_key and store_in_keymap. */
8441 register Lisp_Object c;
8442 int vk_code;
8443 int lisp_modifiers;
8444 int w32_modifiers;
8445 struct gcpro gcpro1;
8446
b7826503 8447 CHECK_VECTOR (key);
ccc2d29c
GV
8448
8449 if (XFASTINT (Flength (key)) != 1)
8450 return Qnil;
8451
8452 GCPRO1 (key);
8453
8454 c = Faref (key, make_number (0));
8455
8456 if (CONSP (c) && lucid_event_type_list_p (c))
8457 c = Fevent_convert_list (c);
8458
8459 UNGCPRO;
8460
8461 if (! INTEGERP (c) && ! SYMBOLP (c))
8462 error ("Key definition is invalid");
8463
8464 /* Work out the base key and the modifiers. */
8465 if (SYMBOLP (c))
8466 {
8467 c = parse_modifiers (c);
2ba49441 8468 lisp_modifiers = XINT (Fcar (Fcdr (c)));
ccc2d29c
GV
8469 c = Fcar (c);
8470 if (!SYMBOLP (c))
8471 abort ();
d5db4077 8472 vk_code = lookup_vk_code (SDATA (SYMBOL_NAME (c)));
ccc2d29c
GV
8473 }
8474 else if (INTEGERP (c))
8475 {
8476 lisp_modifiers = XINT (c) & ~CHARACTERBITS;
8477 /* Many ascii characters are their own virtual key code. */
8478 vk_code = XINT (c) & CHARACTERBITS;
8479 }
8480
8481 if (vk_code < 0 || vk_code > 255)
8482 return Qnil;
8483
8484 if ((lisp_modifiers & meta_modifier) != 0
8485 && !NILP (Vw32_alt_is_meta))
8486 lisp_modifiers |= alt_modifier;
8487
71eab8d1
AI
8488 /* Supply defs missing from mingw32. */
8489#ifndef MOD_ALT
8490#define MOD_ALT 0x0001
8491#define MOD_CONTROL 0x0002
8492#define MOD_SHIFT 0x0004
8493#define MOD_WIN 0x0008
8494#endif
8495
ccc2d29c
GV
8496 /* Convert lisp modifiers to Windows hot-key form. */
8497 w32_modifiers = (lisp_modifiers & hyper_modifier) ? MOD_WIN : 0;
8498 w32_modifiers |= (lisp_modifiers & alt_modifier) ? MOD_ALT : 0;
8499 w32_modifiers |= (lisp_modifiers & ctrl_modifier) ? MOD_CONTROL : 0;
8500 w32_modifiers |= (lisp_modifiers & shift_modifier) ? MOD_SHIFT : 0;
8501
8502 return HOTKEY (vk_code, w32_modifiers);
8503}
8504
74e1aeec
JR
8505DEFUN ("w32-register-hot-key", Fw32_register_hot_key,
8506 Sw32_register_hot_key, 1, 1, 0,
8507 doc: /* Register KEY as a hot-key combination.
8508Certain key combinations like Alt-Tab are reserved for system use on
8509Windows, and therefore are normally intercepted by the system. However,
8510most of these key combinations can be received by registering them as
8511hot-keys, overriding their special meaning.
8512
8513KEY must be a one element key definition in vector form that would be
8514acceptable to `define-key' (e.g. [A-tab] for Alt-Tab). The meta
8515modifier is interpreted as Alt if `w32-alt-is-meta' is t, and hyper
8516is always interpreted as the Windows modifier keys.
8517
8518The return value is the hotkey-id if registered, otherwise nil. */)
ccc2d29c
GV
8519 (key)
8520 Lisp_Object key;
8521{
8522 key = w32_parse_hot_key (key);
8523
fb053a1f 8524 if (!NILP (key) && NILP (Fmemq (key, w32_grabbed_keys)))
ccc2d29c
GV
8525 {
8526 /* Reuse an empty slot if possible. */
8527 Lisp_Object item = Fmemq (Qnil, w32_grabbed_keys);
8528
8529 /* Safe to add new key to list, even if we have focus. */
8530 if (NILP (item))
8531 w32_grabbed_keys = Fcons (key, w32_grabbed_keys);
8532 else
f3fbd155 8533 XSETCAR (item, key);
ccc2d29c
GV
8534
8535 /* Notify input thread about new hot-key definition, so that it
8536 takes effect without needing to switch focus. */
2ba49441
JR
8537#ifdef USE_LISP_UNION_TYPE
8538 PostThreadMessage (dwWindowsThreadId, WM_EMACS_REGISTER_HOT_KEY,
8539 (WPARAM) key.i, 0);
8540#else
ccc2d29c
GV
8541 PostThreadMessage (dwWindowsThreadId, WM_EMACS_REGISTER_HOT_KEY,
8542 (WPARAM) key, 0);
2ba49441 8543#endif
ccc2d29c
GV
8544 }
8545
8546 return key;
8547}
8548
74e1aeec
JR
8549DEFUN ("w32-unregister-hot-key", Fw32_unregister_hot_key,
8550 Sw32_unregister_hot_key, 1, 1, 0,
52deb19f 8551 doc: /* Unregister KEY as a hot-key combination. */)
ccc2d29c
GV
8552 (key)
8553 Lisp_Object key;
8554{
8555 Lisp_Object item;
8556
8557 if (!INTEGERP (key))
8558 key = w32_parse_hot_key (key);
8559
8560 item = Fmemq (key, w32_grabbed_keys);
8561
8562 if (!NILP (item))
8563 {
8564 /* Notify input thread about hot-key definition being removed, so
8565 that it takes effect without needing focus switch. */
2ba49441
JR
8566#ifdef USE_LISP_UNION_TYPE
8567 if (PostThreadMessage (dwWindowsThreadId, WM_EMACS_UNREGISTER_HOT_KEY,
8568 (WPARAM) XINT (XCAR (item)), (LPARAM) item.i))
8569#else
ccc2d29c
GV
8570 if (PostThreadMessage (dwWindowsThreadId, WM_EMACS_UNREGISTER_HOT_KEY,
8571 (WPARAM) XINT (XCAR (item)), (LPARAM) item))
2ba49441 8572#endif
ccc2d29c
GV
8573 {
8574 MSG msg;
8575 GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE);
8576 }
8577 return Qt;
8578 }
8579 return Qnil;
8580}
8581
74e1aeec
JR
8582DEFUN ("w32-registered-hot-keys", Fw32_registered_hot_keys,
8583 Sw32_registered_hot_keys, 0, 0, 0,
8584 doc: /* Return list of registered hot-key IDs. */)
ccc2d29c
GV
8585 ()
8586{
74084731 8587 return Fdelq (Qnil, Fcopy_sequence (w32_grabbed_keys));
ccc2d29c
GV
8588}
8589
74e1aeec
JR
8590DEFUN ("w32-reconstruct-hot-key", Fw32_reconstruct_hot_key,
8591 Sw32_reconstruct_hot_key, 1, 1, 0,
52deb19f
JB
8592 doc: /* Convert hot-key ID to a lisp key combination.
8593usage: (w32-reconstruct-hot-key ID) */)
ccc2d29c
GV
8594 (hotkeyid)
8595 Lisp_Object hotkeyid;
8596{
8597 int vk_code, w32_modifiers;
8598 Lisp_Object key;
8599
b7826503 8600 CHECK_NUMBER (hotkeyid);
ccc2d29c
GV
8601
8602 vk_code = HOTKEY_VK_CODE (hotkeyid);
8603 w32_modifiers = HOTKEY_MODIFIERS (hotkeyid);
8604
bf254037 8605 if (vk_code < 256 && lispy_function_keys[vk_code])
ccc2d29c
GV
8606 key = intern (lispy_function_keys[vk_code]);
8607 else
8608 key = make_number (vk_code);
8609
8610 key = Fcons (key, Qnil);
8611 if (w32_modifiers & MOD_SHIFT)
3ef68e6b 8612 key = Fcons (Qshift, key);
ccc2d29c 8613 if (w32_modifiers & MOD_CONTROL)
3ef68e6b 8614 key = Fcons (Qctrl, key);
ccc2d29c 8615 if (w32_modifiers & MOD_ALT)
3ef68e6b 8616 key = Fcons (NILP (Vw32_alt_is_meta) ? Qalt : Qmeta, key);
ccc2d29c 8617 if (w32_modifiers & MOD_WIN)
3ef68e6b 8618 key = Fcons (Qhyper, key);
ccc2d29c
GV
8619
8620 return key;
8621}
adcc3809 8622
74e1aeec
JR
8623DEFUN ("w32-toggle-lock-key", Fw32_toggle_lock_key,
8624 Sw32_toggle_lock_key, 1, 2, 0,
8625 doc: /* Toggle the state of the lock key KEY.
8626KEY can be `capslock', `kp-numlock', or `scroll'.
8627If the optional parameter NEW-STATE is a number, then the state of KEY
8628is set to off if the low bit of NEW-STATE is zero, otherwise on. */)
adcc3809
GV
8629 (key, new_state)
8630 Lisp_Object key, new_state;
8631{
8632 int vk_code;
adcc3809
GV
8633
8634 if (EQ (key, intern ("capslock")))
8635 vk_code = VK_CAPITAL;
8636 else if (EQ (key, intern ("kp-numlock")))
8637 vk_code = VK_NUMLOCK;
8638 else if (EQ (key, intern ("scroll")))
8639 vk_code = VK_SCROLL;
8640 else
8641 return Qnil;
8642
8643 if (!dwWindowsThreadId)
8644 return make_number (w32_console_toggle_lock_key (vk_code, new_state));
8645
2ba49441
JR
8646#ifdef USE_LISP_UNION_TYPE
8647 if (PostThreadMessage (dwWindowsThreadId, WM_EMACS_TOGGLE_LOCK_KEY,
8648 (WPARAM) vk_code, (LPARAM) new_state.i))
8649#else
adcc3809
GV
8650 if (PostThreadMessage (dwWindowsThreadId, WM_EMACS_TOGGLE_LOCK_KEY,
8651 (WPARAM) vk_code, (LPARAM) new_state))
2ba49441 8652#endif
adcc3809
GV
8653 {
8654 MSG msg;
8655 GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE);
8656 return make_number (msg.wParam);
8657 }
8658 return Qnil;
8659}
a01763cb
EZ
8660
8661DEFUN ("w32-window-exists-p", Fw32_window_exists_p, Sw32_window_exists_p,
8662 2, 2, 0,
8663 doc: /* Return non-nil if a window exists with the specified CLASS and NAME.
8664
8665This is a direct interface to the Windows API FindWindow function. */)
8666 (class, name)
8667Lisp_Object class, name;
8668{
8669 HWND hnd;
8670
8671 if (!NILP (class))
8672 CHECK_STRING (class);
8673 if (!NILP (name))
8674 CHECK_STRING (name);
8675
8676 hnd = FindWindow (STRINGP (class) ? ((LPCTSTR) SDATA (class)) : NULL,
8677 STRINGP (name) ? ((LPCTSTR) SDATA (name)) : NULL);
8678 if (!hnd)
8679 return Qnil;
8680 return Qt;
8681}
8682
2c2279c6
JR
8683DEFUN ("w32-battery-status", Fw32_battery_status, Sw32_battery_status, 0, 0, 0,
8684 doc: /* Get power status information from Windows system.
8685
8686The following %-sequences are provided:
8687%L AC line status (verbose)
8688%B Battery status (verbose)
8689%b Battery status, empty means high, `-' means low,
8690 `!' means critical, and `+' means charging
8691%p Battery load percentage
8692%s Remaining time (to charge or discharge) in seconds
8693%m Remaining time (to charge or discharge) in minutes
8694%h Remaining time (to charge or discharge) in hours
8695%t Remaining time (to charge or discharge) in the form `h:min' */)
8696 ()
8697{
8698 Lisp_Object status = Qnil;
8699
8700 SYSTEM_POWER_STATUS system_status;
8701 if (GetSystemPowerStatus (&system_status))
8702 {
8703 Lisp_Object line_status, battery_status, battery_status_symbol;
8704 Lisp_Object load_percentage, seconds, minutes, hours, remain;
8705 Lisp_Object sequences[8];
8706
8707 long seconds_left = (long) system_status.BatteryLifeTime;
8708
8709 if (system_status.ACLineStatus == 0)
8710 line_status = build_string ("off-line");
8711 else if (system_status.ACLineStatus == 1)
8712 line_status = build_string ("on-line");
8713 else
8714 line_status = build_string ("N/A");
8715
8716 if (system_status.BatteryFlag & 128)
8717 {
8718 battery_status = build_string ("N/A");
8719 battery_status_symbol = build_string ("");
8720 }
8721 else if (system_status.BatteryFlag & 8)
8722 {
8723 battery_status = build_string ("charging");
8724 battery_status_symbol = build_string ("+");
8725 if (system_status.BatteryFullLifeTime != -1L)
8726 seconds_left = system_status.BatteryFullLifeTime - seconds_left;
8727 }
8728 else if (system_status.BatteryFlag & 4)
8729 {
8730 battery_status = build_string ("critical");
8731 battery_status_symbol = build_string ("!");
8732 }
8733 else if (system_status.BatteryFlag & 2)
8734 {
8735 battery_status = build_string ("low");
8736 battery_status_symbol = build_string ("-");
8737 }
8738 else if (system_status.BatteryFlag & 1)
8739 {
8740 battery_status = build_string ("high");
8741 battery_status_symbol = build_string ("");
8742 }
8743 else
8744 {
8745 battery_status = build_string ("medium");
8746 battery_status_symbol = build_string ("");
8747 }
8748
8749 if (system_status.BatteryLifePercent > 100)
8750 load_percentage = build_string ("N/A");
8751 else
8752 {
8753 char buffer[16];
8754 _snprintf (buffer, 16, "%d", system_status.BatteryLifePercent);
8755 load_percentage = build_string (buffer);
8756 }
8757
8758 if (seconds_left < 0)
8759 seconds = minutes = hours = remain = build_string ("N/A");
8760 else
8761 {
8762 long m;
8763 float h;
8764 char buffer[16];
8765 _snprintf (buffer, 16, "%ld", seconds_left);
8766 seconds = build_string (buffer);
8767
8768 m = seconds_left / 60;
8769 _snprintf (buffer, 16, "%d", m);
8770 minutes = build_string (buffer);
8771
8772 h = seconds_left / 3600.0;
8773 _snprintf (buffer, 16, "%3.1f", h);
8774 hours = build_string (buffer);
8775
8776 _snprintf (buffer, 16, "%1.0f:%d", h, m);
8777 remain = build_string (buffer);
8778 }
8779 sequences[0] = Fcons (make_number ('L'), line_status);
8780 sequences[1] = Fcons (make_number ('B'), battery_status);
8781 sequences[2] = Fcons (make_number ('b'), battery_status_symbol);
8782 sequences[3] = Fcons (make_number ('p'), load_percentage);
8783 sequences[4] = Fcons (make_number ('s'), seconds);
8784 sequences[5] = Fcons (make_number ('m'), minutes);
8785 sequences[6] = Fcons (make_number ('h'), hours);
8786 sequences[7] = Fcons (make_number ('t'), remain);
8787
8788 status = Flist (8, sequences);
8789 }
8790 return status;
8791}
a01763cb 8792
ee78dc32 8793\f
2254bcde 8794DEFUN ("file-system-info", Ffile_system_info, Sfile_system_info, 1, 1, 0,
74e1aeec
JR
8795 doc: /* Return storage information about the file system FILENAME is on.
8796Value is a list of floats (TOTAL FREE AVAIL), where TOTAL is the total
8797storage of the file system, FREE is the free storage, and AVAIL is the
8798storage available to a non-superuser. All 3 numbers are in bytes.
8799If the underlying system call fails, value is nil. */)
2254bcde
AI
8800 (filename)
8801 Lisp_Object filename;
8802{
8803 Lisp_Object encoded, value;
8804
b7826503 8805 CHECK_STRING (filename);
2254bcde
AI
8806 filename = Fexpand_file_name (filename, Qnil);
8807 encoded = ENCODE_FILE (filename);
8808
8809 value = Qnil;
8810
8811 /* Determining the required information on Windows turns out, sadly,
8812 to be more involved than one would hope. The original Win32 api
8813 call for this will return bogus information on some systems, but we
8814 must dynamically probe for the replacement api, since that was
8815 added rather late on. */
8816 {
8817 HMODULE hKernel = GetModuleHandle ("kernel32");
8818 BOOL (*pfn_GetDiskFreeSpaceEx)
8819 (char *, PULARGE_INTEGER, PULARGE_INTEGER, PULARGE_INTEGER)
8820 = (void *) GetProcAddress (hKernel, "GetDiskFreeSpaceEx");
8821
8822 /* On Windows, we may need to specify the root directory of the
8823 volume holding FILENAME. */
8824 char rootname[MAX_PATH];
d5db4077 8825 char *name = SDATA (encoded);
2254bcde
AI
8826
8827 /* find the root name of the volume if given */
8828 if (isalpha (name[0]) && name[1] == ':')
8829 {
8830 rootname[0] = name[0];
8831 rootname[1] = name[1];
8832 rootname[2] = '\\';
8833 rootname[3] = 0;
8834 }
8835 else if (IS_DIRECTORY_SEP (name[0]) && IS_DIRECTORY_SEP (name[1]))
8836 {
8837 char *str = rootname;
8838 int slashes = 4;
8839 do
8840 {
8841 if (IS_DIRECTORY_SEP (*name) && --slashes == 0)
8842 break;
8843 *str++ = *name++;
8844 }
8845 while ( *name );
8846
8847 *str++ = '\\';
8848 *str = 0;
8849 }
8850
8851 if (pfn_GetDiskFreeSpaceEx)
8852 {
ac849ba4
JR
8853 /* Unsigned large integers cannot be cast to double, so
8854 use signed ones instead. */
2254bcde
AI
8855 LARGE_INTEGER availbytes;
8856 LARGE_INTEGER freebytes;
8857 LARGE_INTEGER totalbytes;
8858
74084731
JB
8859 if (pfn_GetDiskFreeSpaceEx (rootname,
8860 (ULARGE_INTEGER *)&availbytes,
8861 (ULARGE_INTEGER *)&totalbytes,
8862 (ULARGE_INTEGER *)&freebytes))
2254bcde
AI
8863 value = list3 (make_float ((double) totalbytes.QuadPart),
8864 make_float ((double) freebytes.QuadPart),
8865 make_float ((double) availbytes.QuadPart));
8866 }
8867 else
8868 {
8869 DWORD sectors_per_cluster;
8870 DWORD bytes_per_sector;
8871 DWORD free_clusters;
8872 DWORD total_clusters;
8873
74084731
JB
8874 if (GetDiskFreeSpace (rootname,
8875 &sectors_per_cluster,
8876 &bytes_per_sector,
8877 &free_clusters,
8878 &total_clusters))
2254bcde
AI
8879 value = list3 (make_float ((double) total_clusters
8880 * sectors_per_cluster * bytes_per_sector),
8881 make_float ((double) free_clusters
8882 * sectors_per_cluster * bytes_per_sector),
8883 make_float ((double) free_clusters
8884 * sectors_per_cluster * bytes_per_sector));
8885 }
8886 }
8887
8888 return value;
8889}
8890\f
6b61353c
KH
8891DEFUN ("default-printer-name", Fdefault_printer_name, Sdefault_printer_name,
8892 0, 0, 0, doc: /* Return the name of Windows default printer device. */)
8893 ()
8894{
8895 static char pname_buf[256];
8896 int err;
8897 HANDLE hPrn;
8898 PRINTER_INFO_2 *ppi2 = NULL;
8899 DWORD dwNeeded = 0, dwReturned = 0;
8900
8901 /* Retrieve the default string from Win.ini (the registry).
8902 * String will be in form "printername,drivername,portname".
8903 * This is the most portable way to get the default printer. */
8904 if (GetProfileString ("windows", "device", ",,", pname_buf, sizeof (pname_buf)) <= 0)
8905 return Qnil;
8906 /* printername precedes first "," character */
8907 strtok (pname_buf, ",");
8908 /* We want to know more than the printer name */
8909 if (!OpenPrinter (pname_buf, &hPrn, NULL))
8910 return Qnil;
8911 GetPrinter (hPrn, 2, NULL, 0, &dwNeeded);
8912 if (dwNeeded == 0)
8913 {
8914 ClosePrinter (hPrn);
8915 return Qnil;
8916 }
8917 /* Allocate memory for the PRINTER_INFO_2 struct */
8918 ppi2 = (PRINTER_INFO_2 *) xmalloc (dwNeeded);
8919 if (!ppi2)
8920 {
8921 ClosePrinter (hPrn);
8922 return Qnil;
8923 }
74084731 8924 /* Call GetPrinter again with big enouth memory block */
6b61353c
KH
8925 err = GetPrinter (hPrn, 2, (LPBYTE)ppi2, dwNeeded, &dwReturned);
8926 ClosePrinter (hPrn);
8927 if (!err)
8928 {
74084731 8929 xfree (ppi2);
6b61353c
KH
8930 return Qnil;
8931 }
8932
8933 if (ppi2)
8934 {
8935 if (ppi2->Attributes & PRINTER_ATTRIBUTE_SHARED && ppi2->pServerName)
8936 {
8937 /* a remote printer */
8938 if (*ppi2->pServerName == '\\')
74084731 8939 _snprintf (pname_buf, sizeof (pname_buf), "%s\\%s", ppi2->pServerName,
02b39a28 8940 ppi2->pShareName);
6b61353c 8941 else
74084731 8942 _snprintf (pname_buf, sizeof (pname_buf), "\\\\%s\\%s", ppi2->pServerName,
02b39a28 8943 ppi2->pShareName);
6b61353c
KH
8944 pname_buf[sizeof (pname_buf) - 1] = '\0';
8945 }
8946 else
8947 {
8948 /* a local printer */
74084731 8949 strncpy (pname_buf, ppi2->pPortName, sizeof (pname_buf));
6b61353c
KH
8950 pname_buf[sizeof (pname_buf) - 1] = '\0';
8951 /* `pPortName' can include several ports, delimited by ','.
8952 * we only use the first one. */
74084731 8953 strtok (pname_buf, ",");
6b61353c 8954 }
74084731 8955 xfree (ppi2);
6b61353c
KH
8956 }
8957
8958 return build_string (pname_buf);
8959}
8960\f
0e3fcdef
JR
8961/***********************************************************************
8962 Initialization
8963 ***********************************************************************/
8964
52deb19f 8965/* Keep this list in the same order as frame_parms in frame.c.
6d906347
KS
8966 Use 0 for unsupported frame parameters. */
8967
8968frame_parm_handler w32_frame_parm_handlers[] =
8969{
8970 x_set_autoraise,
8971 x_set_autolower,
8972 x_set_background_color,
8973 x_set_border_color,
8974 x_set_border_width,
8975 x_set_cursor_color,
8976 x_set_cursor_type,
8977 x_set_font,
8978 x_set_foreground_color,
8979 x_set_icon_name,
8980 x_set_icon_type,
8981 x_set_internal_border_width,
8982 x_set_menu_bar_lines,
8983 x_set_mouse_color,
8984 x_explicitly_set_name,
8985 x_set_scroll_bar_width,
8986 x_set_title,
8987 x_set_unsplittable,
8988 x_set_vertical_scroll_bars,
8989 x_set_visibility,
8990 x_set_tool_bar_lines,
8991 0, /* x_set_scroll_bar_foreground, */
8992 0, /* x_set_scroll_bar_background, */
8993 x_set_screen_gamma,
8994 x_set_line_spacing,
8995 x_set_fringe_width,
8996 x_set_fringe_width,
8997 0, /* x_set_wait_for_wm, */
8998 x_set_fullscreen,
a1fe5c00
JR
8999#ifdef USE_FONT_BACKEND
9000 x_set_font_backend
9001#endif
6d906347
KS
9002};
9003
0e3fcdef 9004void
fbd6baed 9005syms_of_w32fns ()
ee78dc32 9006{
afc390dc
JR
9007 globals_of_w32fns ();
9008 /* This is zero if not using MS-Windows. */
1edf84e7 9009 w32_in_use = 0;
9eb16b62
JR
9010 track_mouse_window = NULL;
9011
d285988b
JR
9012 w32_visible_system_caret_hwnd = NULL;
9013
4f5b288c
JR
9014 DEFSYM (Qnone, "none");
9015 DEFSYM (Qsuppress_icon, "suppress-icon");
9016 DEFSYM (Qundefined_color, "undefined-color");
9017 DEFSYM (Qcancel_timer, "cancel-timer");
9018 DEFSYM (Qhyper, "hyper");
9019 DEFSYM (Qsuper, "super");
9020 DEFSYM (Qmeta, "meta");
9021 DEFSYM (Qalt, "alt");
9022 DEFSYM (Qctrl, "ctrl");
9023 DEFSYM (Qcontrol, "control");
9024 DEFSYM (Qshift, "shift");
f7b9d4d1 9025 /* This is the end of symbol initialization. */
adcc3809 9026
6fc2811b
JR
9027 /* Text property `display' should be nonsticky by default. */
9028 Vtext_property_default_nonsticky
9029 = Fcons (Fcons (Qdisplay, Qt), Vtext_property_default_nonsticky);
9030
9031
ee78dc32
GV
9032 Fput (Qundefined_color, Qerror_conditions,
9033 Fcons (Qundefined_color, Fcons (Qerror, Qnil)));
9034 Fput (Qundefined_color, Qerror_message,
9035 build_string ("Undefined color"));
9036
ccc2d29c
GV
9037 staticpro (&w32_grabbed_keys);
9038 w32_grabbed_keys = Qnil;
9039
fbd6baed 9040 DEFVAR_LISP ("w32-color-map", &Vw32_color_map,
52deb19f 9041 doc: /* An array of color name mappings for Windows. */);
fbd6baed 9042 Vw32_color_map = Qnil;
ee78dc32 9043
fbd6baed 9044 DEFVAR_LISP ("w32-pass-alt-to-system", &Vw32_pass_alt_to_system,
1133f8e7
EZ
9045 doc: /* Non-nil if Alt key presses are passed on to Windows.
9046When non-nil, for example, Alt pressed and released and then space will
9047open the System menu. When nil, Emacs processes the Alt key events, and
9048then silently swallows them. */);
fbd6baed 9049 Vw32_pass_alt_to_system = Qnil;
da36a4d6 9050
fbd6baed 9051 DEFVAR_LISP ("w32-alt-is-meta", &Vw32_alt_is_meta,
1133f8e7
EZ
9052 doc: /* Non-nil if the Alt key is to be considered the same as the META key.
9053When nil, Emacs will translate the Alt key to the ALT modifier, not to META. */);
fbd6baed 9054 Vw32_alt_is_meta = Qt;
8c205c63 9055
2ba49441
JR
9056 DEFVAR_INT ("w32-quit-key", &w32_quit_key,
9057 doc: /* If non-zero, the virtual key code for an alternative quit key. */);
9058 w32_quit_key = 0;
7d081355 9059
7d0393cf 9060 DEFVAR_LISP ("w32-pass-lwindow-to-system",
ccc2d29c 9061 &Vw32_pass_lwindow_to_system,
1133f8e7
EZ
9062 doc: /* If non-nil, the left \"Windows\" key is passed on to Windows.
9063
9064When non-nil, the Start menu is opened by tapping the key.
9065If you set this to nil, the left \"Windows\" key is processed by Emacs
9066according to the value of `w32-lwindow-modifier', which see.
9067
9068Note that some combinations of the left \"Windows\" key with other keys are
9069caught by Windows at low level, and so binding them in Emacs will have no
9070effect. For example, <lwindow>-r always pops up the Windows Run dialog,
9071<lwindow>-<Pause> pops up the "System Properties" dialog, etc. However, see
9072the doc string of `w32-phantom-key-code'. */);
ccc2d29c
GV
9073 Vw32_pass_lwindow_to_system = Qt;
9074
7d0393cf 9075 DEFVAR_LISP ("w32-pass-rwindow-to-system",
ccc2d29c 9076 &Vw32_pass_rwindow_to_system,
1133f8e7
EZ
9077 doc: /* If non-nil, the right \"Windows\" key is passed on to Windows.
9078
9079When non-nil, the Start menu is opened by tapping the key.
9080If you set this to nil, the right \"Windows\" key is processed by Emacs
9081according to the value of `w32-rwindow-modifier', which see.
9082
9083Note that some combinations of the right \"Windows\" key with other keys are
9084caught by Windows at low level, and so binding them in Emacs will have no
9085effect. For example, <rwindow>-r always pops up the Windows Run dialog,
9086<rwindow>-<Pause> pops up the "System Properties" dialog, etc. However, see
9087the doc string of `w32-phantom-key-code'. */);
ccc2d29c
GV
9088 Vw32_pass_rwindow_to_system = Qt;
9089
2ba49441 9090 DEFVAR_LISP ("w32-phantom-key-code",
adcc3809 9091 &Vw32_phantom_key_code,
2ba49441 9092 doc: /* Virtual key code used to generate \"phantom\" key presses.
74e1aeec
JR
9093Value is a number between 0 and 255.
9094
9095Phantom key presses are generated in order to stop the system from
9096acting on \"Windows\" key events when `w32-pass-lwindow-to-system' or
9097`w32-pass-rwindow-to-system' is nil. */);
ce6059da
AI
9098 /* Although 255 is technically not a valid key code, it works and
9099 means that this hack won't interfere with any real key code. */
2ba49441 9100 XSETINT (Vw32_phantom_key_code, 255);
adcc3809 9101
7d0393cf 9102 DEFVAR_LISP ("w32-enable-num-lock",
ccc2d29c 9103 &Vw32_enable_num_lock,
1133f8e7
EZ
9104 doc: /* If non-nil, the Num Lock key acts normally.
9105Set to nil to handle Num Lock as the `kp-numlock' key. */);
ccc2d29c
GV
9106 Vw32_enable_num_lock = Qt;
9107
7d0393cf 9108 DEFVAR_LISP ("w32-enable-caps-lock",
ccc2d29c 9109 &Vw32_enable_caps_lock,
1133f8e7
EZ
9110 doc: /* If non-nil, the Caps Lock key acts normally.
9111Set to nil to handle Caps Lock as the `capslock' key. */);
ccc2d29c
GV
9112 Vw32_enable_caps_lock = Qt;
9113
9114 DEFVAR_LISP ("w32-scroll-lock-modifier",
9115 &Vw32_scroll_lock_modifier,
1133f8e7 9116 doc: /* Modifier to use for the Scroll Lock ON state.
74e1aeec 9117The value can be hyper, super, meta, alt, control or shift for the
1133f8e7
EZ
9118respective modifier, or nil to handle Scroll Lock as the `scroll' key.
9119Any other value will cause the Scroll Lock key to be ignored. */);
ccc2d29c
GV
9120 Vw32_scroll_lock_modifier = Qt;
9121
9122 DEFVAR_LISP ("w32-lwindow-modifier",
9123 &Vw32_lwindow_modifier,
74e1aeec
JR
9124 doc: /* Modifier to use for the left \"Windows\" key.
9125The value can be hyper, super, meta, alt, control or shift for the
1133f8e7 9126respective modifier, or nil to appear as the `lwindow' key.
74e1aeec 9127Any other value will cause the key to be ignored. */);
ccc2d29c
GV
9128 Vw32_lwindow_modifier = Qnil;
9129
9130 DEFVAR_LISP ("w32-rwindow-modifier",
9131 &Vw32_rwindow_modifier,
74e1aeec
JR
9132 doc: /* Modifier to use for the right \"Windows\" key.
9133The value can be hyper, super, meta, alt, control or shift for the
1133f8e7 9134respective modifier, or nil to appear as the `rwindow' key.
74e1aeec 9135Any other value will cause the key to be ignored. */);
ccc2d29c
GV
9136 Vw32_rwindow_modifier = Qnil;
9137
9138 DEFVAR_LISP ("w32-apps-modifier",
9139 &Vw32_apps_modifier,
74e1aeec
JR
9140 doc: /* Modifier to use for the \"Apps\" key.
9141The value can be hyper, super, meta, alt, control or shift for the
1133f8e7 9142respective modifier, or nil to appear as the `apps' key.
74e1aeec 9143Any other value will cause the key to be ignored. */);
ccc2d29c 9144 Vw32_apps_modifier = Qnil;
da36a4d6 9145
d84b082d 9146 DEFVAR_BOOL ("w32-enable-synthesized-fonts", &w32_enable_synthesized_fonts,
74e1aeec 9147 doc: /* Non-nil enables selection of artificially italicized and bold fonts. */);
d84b082d 9148 w32_enable_synthesized_fonts = 0;
5ac45f98 9149
fbd6baed 9150 DEFVAR_LISP ("w32-enable-palette", &Vw32_enable_palette,
74e1aeec 9151 doc: /* Non-nil enables Windows palette management to map colors exactly. */);
fbd6baed 9152 Vw32_enable_palette = Qt;
5ac45f98 9153
fbd6baed 9154 DEFVAR_INT ("w32-mouse-button-tolerance",
2ba49441 9155 &w32_mouse_button_tolerance,
74e1aeec
JR
9156 doc: /* Analogue of double click interval for faking middle mouse events.
9157The value is the minimum time in milliseconds that must elapse between
1133f8e7 9158left and right button down events before they are considered distinct events.
74e1aeec
JR
9159If both mouse buttons are depressed within this interval, a middle mouse
9160button down event is generated instead. */);
2ba49441 9161 w32_mouse_button_tolerance = GetDoubleClickTime () / 2;
5ac45f98 9162
fbd6baed 9163 DEFVAR_INT ("w32-mouse-move-interval",
2ba49441 9164 &w32_mouse_move_interval,
74e1aeec
JR
9165 doc: /* Minimum interval between mouse move events.
9166The value is the minimum time in milliseconds that must elapse between
9167successive mouse move (or scroll bar drag) events before they are
9168reported as lisp events. */);
2ba49441 9169 w32_mouse_move_interval = 0;
84fb1139 9170
74214547
JR
9171 DEFVAR_BOOL ("w32-pass-extra-mouse-buttons-to-system",
9172 &w32_pass_extra_mouse_buttons_to_system,
1133f8e7 9173 doc: /* If non-nil, the fourth and fifth mouse buttons are passed to Windows.
74214547
JR
9174Recent versions of Windows support mice with up to five buttons.
9175Since most applications don't support these extra buttons, most mouse
9176drivers will allow you to map them to functions at the system level.
9177If this variable is non-nil, Emacs will pass them on, allowing the
9178system to handle them. */);
9179 w32_pass_extra_mouse_buttons_to_system = 0;
9180
0b151762
JR
9181 DEFVAR_BOOL ("w32-pass-multimedia-buttons-to-system",
9182 &w32_pass_multimedia_buttons_to_system,
9183 doc: /* If non-nil, media buttons are passed to Windows.
9184Some modern keyboards contain buttons for controlling media players, web
74084731 9185browsers and other applications. Generally these buttons are handled on a
0b151762
JR
9186system wide basis, but by setting this to nil they are made available
9187to Emacs for binding. Depending on your keyboard, additional keys that
9188may be available are:
9189
9190browser-back, browser-forward, browser-refresh, browser-stop,
9191browser-search, browser-favorites, browser-home,
9192mail, mail-reply, mail-forward, mail-send,
9193app-1, app-2,
9194help, find, new, open, close, save, print, undo, redo, copy, cut, paste,
9195spell-check, correction-list, toggle-dictate-command,
9196media-next, media-previous, media-stop, media-play-pause, media-select,
9197media-play, media-pause, media-record, media-fast-forward, media-rewind,
9198media-channel-up, media-channel-down,
9199volume-mute, volume-up, volume-down,
9200mic-volume-mute, mic-volume-down, mic-volume-up, mic-toggle,
74084731 9201bass-down, bass-boost, bass-up, treble-down, treble-up */);
0b151762
JR
9202 w32_pass_multimedia_buttons_to_system = 1;
9203
ee78dc32 9204 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape,
74e1aeec
JR
9205 doc: /* The shape of the pointer when over text.
9206Changing the value does not affect existing frames
9207unless you set the mouse color. */);
ee78dc32
GV
9208 Vx_pointer_shape = Qnil;
9209
ee78dc32
GV
9210 Vx_nontext_pointer_shape = Qnil;
9211
9212 Vx_mode_pointer_shape = Qnil;
9213
0af913d7 9214 DEFVAR_LISP ("x-hourglass-pointer-shape", &Vx_hourglass_pointer_shape,
74e1aeec
JR
9215 doc: /* The shape of the pointer when Emacs is busy.
9216This variable takes effect when you create a new frame
9217or when you set the mouse color. */);
0af913d7 9218 Vx_hourglass_pointer_shape = Qnil;
6fc2811b 9219
0af913d7 9220 DEFVAR_BOOL ("display-hourglass", &display_hourglass_p,
74e1aeec 9221 doc: /* Non-zero means Emacs displays an hourglass pointer on window systems. */);
0af913d7 9222 display_hourglass_p = 1;
7d0393cf 9223
0af913d7 9224 DEFVAR_LISP ("hourglass-delay", &Vhourglass_delay,
74e1aeec
JR
9225 doc: /* *Seconds to wait before displaying an hourglass pointer.
9226Value must be an integer or float. */);
0af913d7 9227 Vhourglass_delay = make_number (DEFAULT_HOURGLASS_DELAY);
f79e6790 9228
6fc2811b 9229 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
74084731 9230 &Vx_sensitive_text_pointer_shape,
74e1aeec
JR
9231 doc: /* The shape of the pointer when over mouse-sensitive text.
9232This variable takes effect when you create a new frame
9233or when you set the mouse color. */);
ee78dc32
GV
9234 Vx_sensitive_text_pointer_shape = Qnil;
9235
4694d762 9236 DEFVAR_LISP ("x-window-horizontal-drag-cursor",
74084731 9237 &Vx_window_horizontal_drag_shape,
74e1aeec
JR
9238 doc: /* Pointer shape to use for indicating a window can be dragged horizontally.
9239This variable takes effect when you create a new frame
9240or when you set the mouse color. */);
4694d762
JR
9241 Vx_window_horizontal_drag_shape = Qnil;
9242
ee78dc32 9243 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel,
74e1aeec 9244 doc: /* A string indicating the foreground color of the cursor box. */);
ee78dc32
GV
9245 Vx_cursor_fore_pixel = Qnil;
9246
3cf3436e 9247 DEFVAR_LISP ("x-max-tooltip-size", &Vx_max_tooltip_size,
b3700ae7
JR
9248 doc: /* Maximum size for tooltips.
9249Value is a pair (COLUMNS . ROWS). Text larger than this is clipped. */);
3cf3436e 9250 Vx_max_tooltip_size = Fcons (make_number (80), make_number (40));
7d0393cf 9251
ee78dc32 9252 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager,
74e1aeec
JR
9253 doc: /* Non-nil if no window manager is in use.
9254Emacs doesn't try to figure this out; this is always nil
9255unless you set it to something else. */);
ee78dc32
GV
9256 /* We don't have any way to find this out, so set it to nil
9257 and maybe the user would like to set it to t. */
9258 Vx_no_window_manager = Qnil;
9259
4587b026
GV
9260 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
9261 &Vx_pixel_size_width_font_regexp,
74e1aeec
JR
9262 doc: /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'.
9263
9264Since Emacs gets width of a font matching with this regexp from
9265PIXEL_SIZE field of the name, font finding mechanism gets faster for
9266such a font. This is especially effective for such large fonts as
9267Chinese, Japanese, and Korean. */);
4587b026
GV
9268 Vx_pixel_size_width_font_regexp = Qnil;
9269
33d52f9c
GV
9270 DEFVAR_LISP ("w32-bdf-filename-alist",
9271 &Vw32_bdf_filename_alist,
74e1aeec 9272 doc: /* List of bdf fonts and their corresponding filenames. */);
33d52f9c
GV
9273 Vw32_bdf_filename_alist = Qnil;
9274
1075afa9
GV
9275 DEFVAR_BOOL ("w32-strict-fontnames",
9276 &w32_strict_fontnames,
74e1aeec
JR
9277 doc: /* Non-nil means only use fonts that are exact matches for those requested.
9278Default is nil, which allows old fontnames that are not XLFD compliant,
9279and allows third-party CJK display to work by specifying false charset
9280fields to trick Emacs into translating to Big5, SJIS etc.
9281Setting this to t will prevent wrong fonts being selected when
9282fontsets are automatically created. */);
1075afa9
GV
9283 w32_strict_fontnames = 0;
9284
c0611964
AI
9285 DEFVAR_BOOL ("w32-strict-painting",
9286 &w32_strict_painting,
74e1aeec 9287 doc: /* Non-nil means use strict rules for repainting frames.
a8ab3e96 9288Set this to nil to get the old behavior for repainting; this should
74e1aeec 9289only be necessary if the default setting causes problems. */);
c0611964
AI
9290 w32_strict_painting = 1;
9291
dfff8a69
JR
9292 DEFVAR_LISP ("w32-charset-info-alist",
9293 &Vw32_charset_info_alist,
b3700ae7
JR
9294 doc: /* Alist linking Emacs character sets to Windows fonts and codepages.
9295Each entry should be of the form:
74e1aeec
JR
9296
9297 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE))
9298
9299where CHARSET_NAME is a string used in font names to identify the charset,
9300WINDOWS_CHARSET is a symbol that can be one of:
9301w32-charset-ansi, w32-charset-default, w32-charset-symbol,
9302w32-charset-shiftjis, w32-charset-hangeul, w32-charset-gb2312,
9303w32-charset-chinesebig5,
74e1aeec
JR
9304w32-charset-johab, w32-charset-hebrew,
9305w32-charset-arabic, w32-charset-greek, w32-charset-turkish,
9306w32-charset-vietnamese, w32-charset-thai, w32-charset-easteurope,
9307w32-charset-russian, w32-charset-mac, w32-charset-baltic,
74e1aeec 9308w32-charset-unicode,
74e1aeec
JR
9309or w32-charset-oem.
9310CODEPAGE should be an integer specifying the codepage that should be used
9311to display the character set, t to do no translation and output as Unicode,
9312or nil to do no translation and output as 8 bit (or multibyte on far-east
9313versions of Windows) characters. */);
4f5b288c
JR
9314 Vw32_charset_info_alist = Qnil;
9315
9316 DEFSYM (Qw32_charset_ansi, "w32-charset-ansi");
9317 DEFSYM (Qw32_charset_symbol, "w32-charset-symbol");
9318 DEFSYM (Qw32_charset_default, "w32-charset-default");
9319 DEFSYM (Qw32_charset_shiftjis, "w32-charset-shiftjis");
9320 DEFSYM (Qw32_charset_hangeul, "w32-charset-hangeul");
9321 DEFSYM (Qw32_charset_chinesebig5, "w32-charset-chinesebig5");
9322 DEFSYM (Qw32_charset_gb2312, "w32-charset-gb2312");
9323 DEFSYM (Qw32_charset_oem, "w32-charset-oem");
dfff8a69
JR
9324
9325#ifdef JOHAB_CHARSET
9326 {
9327 static int w32_extra_charsets_defined = 1;
74e1aeec
JR
9328 DEFVAR_BOOL ("w32-extra-charsets-defined", &w32_extra_charsets_defined,
9329 doc: /* Internal variable. */);
dfff8a69 9330
4f5b288c
JR
9331 DEFSYM (Qw32_charset_johab, "w32-charset-johab");
9332 DEFSYM (Qw32_charset_easteurope, "w32-charset-easteurope");
9333 DEFSYM (Qw32_charset_turkish, "w32-charset-turkish");
9334 DEFSYM (Qw32_charset_baltic, "w32-charset-baltic");
9335 DEFSYM (Qw32_charset_russian, "w32-charset-russian");
9336 DEFSYM (Qw32_charset_arabic, "w32-charset-arabic");
9337 DEFSYM (Qw32_charset_greek, "w32-charset-greek");
9338 DEFSYM (Qw32_charset_hebrew, "w32-charset-hebrew");
9339 DEFSYM (Qw32_charset_vietnamese, "w32-charset-vietnamese");
9340 DEFSYM (Qw32_charset_thai, "w32-charset-thai");
9341 DEFSYM (Qw32_charset_mac, "w32-charset-mac");
dfff8a69
JR
9342 }
9343#endif
9344
9345#ifdef UNICODE_CHARSET
9346 {
9347 static int w32_unicode_charset_defined = 1;
9348 DEFVAR_BOOL ("w32-unicode-charset-defined",
74e1aeec
JR
9349 &w32_unicode_charset_defined,
9350 doc: /* Internal variable. */);
4f5b288c 9351 DEFSYM (Qw32_charset_unicode, "w32-charset-unicode");
a01763cb 9352 }
dfff8a69
JR
9353#endif
9354
767b1ff0 9355#if 0 /* TODO: Port to W32 */
6fc2811b
JR
9356 defsubr (&Sx_change_window_property);
9357 defsubr (&Sx_delete_window_property);
9358 defsubr (&Sx_window_property);
9359#endif
2d764c78 9360 defsubr (&Sxw_display_color_p);
ee78dc32 9361 defsubr (&Sx_display_grayscale_p);
2d764c78
EZ
9362 defsubr (&Sxw_color_defined_p);
9363 defsubr (&Sxw_color_values);
ee78dc32
GV
9364 defsubr (&Sx_server_max_request_size);
9365 defsubr (&Sx_server_vendor);
9366 defsubr (&Sx_server_version);
9367 defsubr (&Sx_display_pixel_width);
9368 defsubr (&Sx_display_pixel_height);
9369 defsubr (&Sx_display_mm_width);
9370 defsubr (&Sx_display_mm_height);
9371 defsubr (&Sx_display_screens);
9372 defsubr (&Sx_display_planes);
9373 defsubr (&Sx_display_color_cells);
9374 defsubr (&Sx_display_visual_class);
9375 defsubr (&Sx_display_backing_store);
9376 defsubr (&Sx_display_save_under);
ee78dc32 9377 defsubr (&Sx_create_frame);
ee78dc32
GV
9378 defsubr (&Sx_open_connection);
9379 defsubr (&Sx_close_connection);
9380 defsubr (&Sx_display_list);
9381 defsubr (&Sx_synchronize);
334a1195 9382 defsubr (&Sx_focus_frame);
ee78dc32 9383
fbd6baed 9384 /* W32 specific functions */
ee78dc32 9385
fbd6baed
GV
9386 defsubr (&Sw32_select_font);
9387 defsubr (&Sw32_define_rgb_color);
9388 defsubr (&Sw32_default_color_map);
9389 defsubr (&Sw32_load_color_file);
1edf84e7 9390 defsubr (&Sw32_send_sys_command);
55dcfc15 9391 defsubr (&Sw32_shell_execute);
ccc2d29c
GV
9392 defsubr (&Sw32_register_hot_key);
9393 defsubr (&Sw32_unregister_hot_key);
9394 defsubr (&Sw32_registered_hot_keys);
9395 defsubr (&Sw32_reconstruct_hot_key);
adcc3809 9396 defsubr (&Sw32_toggle_lock_key);
a01763cb 9397 defsubr (&Sw32_window_exists_p);
33d52f9c 9398 defsubr (&Sw32_find_bdf_fonts);
2c2279c6 9399 defsubr (&Sw32_battery_status);
4587b026 9400
2254bcde 9401 defsubr (&Sfile_system_info);
6b61353c 9402 defsubr (&Sdefault_printer_name);
2254bcde 9403
4587b026
GV
9404 /* Setting callback functions for fontset handler. */
9405 get_font_info_func = w32_get_font_info;
6fc2811b
JR
9406
9407#if 0 /* This function pointer doesn't seem to be used anywhere.
9408 And the pointer assigned has the wrong type, anyway. */
4587b026 9409 list_fonts_func = w32_list_fonts;
6fc2811b
JR
9410#endif
9411
4587b026
GV
9412 load_font_func = w32_load_font;
9413 find_ccl_program_func = w32_find_ccl_program;
9414 query_font_func = w32_query_font;
9415 set_frame_fontset_func = x_set_font;
10b4bc33 9416 get_font_repertory_func = x_get_font_repertory;
4587b026 9417 check_window_system_func = check_w32;
6fc2811b 9418
463f5630 9419
d148e14d
JR
9420 hourglass_timer = 0;
9421 hourglass_hwnd = NULL;
0af913d7 9422 hourglass_shown_p = 0;
6fc2811b
JR
9423 defsubr (&Sx_show_tip);
9424 defsubr (&Sx_hide_tip);
6fc2811b 9425 tip_timer = Qnil;
57fa2774
JR
9426 staticpro (&tip_timer);
9427 tip_frame = Qnil;
9428 staticpro (&tip_frame);
6fc2811b 9429
ca56d953
JR
9430 last_show_tip_args = Qnil;
9431 staticpro (&last_show_tip_args);
9432
6fc2811b
JR
9433 defsubr (&Sx_file_dialog);
9434}
9435
c922a224 9436
9785d95b
BK
9437/*
9438 globals_of_w32fns is used to initialize those global variables that
9439 must always be initialized on startup even when the global variable
9440 initialized is non zero (see the function main in emacs.c).
9441 globals_of_w32fns is called from syms_of_w32fns when the global
9442 variable initialized is 0 and directly from main when initialized
9443 is non zero.
9444 */
02b39a28
JB
9445void
9446globals_of_w32fns ()
9785d95b
BK
9447{
9448 HMODULE user32_lib = GetModuleHandle ("user32.dll");
ccc0fdaa
JR
9449 /*
9450 TrackMouseEvent not available in all versions of Windows, so must load
9451 it dynamically. Do it once, here, instead of every time it is used.
9785d95b 9452 */
ccc0fdaa
JR
9453 track_mouse_event_fn = (TrackMouseEvent_Proc)
9454 GetProcAddress (user32_lib, "TrackMouseEvent");
9455 /* ditto for GetClipboardSequenceNumber. */
9456 clipboard_sequence_fn = (ClipboardSequence_Proc)
9457 GetProcAddress (user32_lib, "GetClipboardSequenceNumber");
64f0809d
JR
9458
9459 monitor_from_point_fn = (MonitorFromPoint_Proc)
9460 GetProcAddress (user32_lib, "MonitorFromPoint");
9461 get_monitor_info_fn = (GetMonitorInfo_Proc)
9462 GetProcAddress (user32_lib, "GetMonitorInfoA");
9463
820eff5a
JR
9464 {
9465 HMODULE imm32_lib = GetModuleHandle ("imm32.dll");
9466 get_composition_string_fn = (ImmGetCompositionString_Proc)
9467 GetProcAddress (imm32_lib, "ImmGetCompositionStringW");
9468 get_ime_context_fn = (ImmGetContext_Proc)
9469 GetProcAddress (imm32_lib, "ImmGetContext");
9470 }
4bf91535 9471 DEFVAR_INT ("w32-ansi-code-page",
2ba49441 9472 &w32_ansi_code_page,
4bf91535 9473 doc: /* The ANSI code page used by the system. */);
2ba49441 9474 w32_ansi_code_page = GetACP ();
60860eb3
JR
9475
9476 /* MessageBox does not work without this when linked to comctl32.dll 6.0. */
9477 InitCommonControls ();
cbfedb1c
JR
9478
9479#ifdef USE_FONT_BACKEND
9480 syms_of_w32uniscribe ();
9481#endif
9785d95b 9482}
6fc2811b 9483
ee78dc32
GV
9484#undef abort
9485
7d0393cf 9486void
74084731 9487w32_abort ()
ee78dc32 9488{
5ac45f98
GV
9489 int button;
9490 button = MessageBox (NULL,
9491 "A fatal error has occurred!\n\n"
c52e1638 9492 "Would you like to attach a debugger?\n\n"
cb91d111
EZ
9493 "Select YES to debug, NO to abort Emacs"
9494#if __GNUC__
9495 "\n\n(type \"gdb -p <emacs-PID>\" and\n"
9496 "\"continue\" inside GDB before clicking YES.)"
9497#endif
9498 , "Emacs Abort Dialog",
5ac45f98 9499 MB_ICONEXCLAMATION | MB_TASKMODAL
c52e1638 9500 | MB_SETFOREGROUND | MB_YESNO);
5ac45f98
GV
9501 switch (button)
9502 {
c52e1638 9503 case IDYES:
5ac45f98 9504 DebugBreak ();
c52e1638
EZ
9505 exit (2); /* tell the compiler we will never return */
9506 case IDNO:
5ac45f98
GV
9507 default:
9508 abort ();
9509 break;
9510 }
ee78dc32 9511}
d573caac 9512
83c75055
GV
9513/* For convenience when debugging. */
9514int
74084731 9515w32_last_error ()
83c75055
GV
9516{
9517 return GetLastError ();
9518}
6b61353c
KH
9519
9520/* arch-tag: 707589ab-b9be-4638-8cdd-74629cc9b446
9521 (do not change this comment) */