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