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