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