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