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