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