(forms-file): Update for moved forms-d2.dat.
[emacs.git] / src / w32fns.c
bloba927310fffe6817ad59364577c865405f07ff1a3
1 /* Graphical user interface functions for the Microsoft W32 API.
2 Copyright (C) 1989, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000,
3 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
4 Free Software Foundation, Inc.
6 This file is part of GNU Emacs.
8 GNU Emacs is free software; you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation; either version 3, or (at your option)
11 any later version.
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs; see the file COPYING. If not, write to
20 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
21 Boston, MA 02110-1301, USA. */
23 /* Added by Kevin Gallo */
25 #include <config.h>
27 #include <signal.h>
28 #include <stdio.h>
29 #include <limits.h>
30 #include <errno.h>
31 #include <math.h>
33 #include "lisp.h"
34 #include "w32term.h"
35 #include "frame.h"
36 #include "window.h"
37 #include "buffer.h"
38 #include "intervals.h"
39 #include "dispextern.h"
40 #include "keyboard.h"
41 #include "blockinput.h"
42 #include "epaths.h"
43 #include "character.h"
44 #include "charset.h"
45 #include "coding.h"
46 #include "ccl.h"
47 #include "fontset.h"
48 #include "systime.h"
49 #include "termhooks.h"
50 #include "w32heap.h"
52 #include "bitmaps/gray.xbm"
54 #include <commctrl.h>
55 #include <commdlg.h>
56 #include <shellapi.h>
57 #include <ctype.h>
58 #include <winspool.h>
59 #include <objbase.h>
61 #include <dlgs.h>
62 #include <imm.h>
63 #define FILE_NAME_TEXT_FIELD edt1
65 #ifdef USE_FONT_BACKEND
66 #include "font.h"
67 #endif
69 void syms_of_w32fns ();
70 void globals_of_w32fns ();
72 extern void free_frame_menubar ();
73 extern double atof ();
74 extern int w32_console_toggle_lock_key P_ ((int, Lisp_Object));
75 extern void w32_menu_display_help P_ ((HWND, HMENU, UINT, UINT));
76 extern void w32_free_menu_strings P_ ((HWND));
77 extern XCharStruct *w32_per_char_metric P_ ((XFontStruct *, wchar_t *, int));
79 extern int quit_char;
81 extern char *lispy_function_keys[];
83 /* The colormap for converting color names to RGB values */
84 Lisp_Object Vw32_color_map;
86 /* Non nil if alt key presses are passed on to Windows. */
87 Lisp_Object Vw32_pass_alt_to_system;
89 /* Non nil if alt key is translated to meta_modifier, nil if it is translated
90 to alt_modifier. */
91 Lisp_Object Vw32_alt_is_meta;
93 /* If non-zero, the windows virtual key code for an alternative quit key. */
94 int w32_quit_key;
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). */
98 Lisp_Object Vw32_pass_lwindow_to_system;
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). */
102 Lisp_Object Vw32_pass_rwindow_to_system;
104 /* Virtual key code used to generate "phantom" key presses in order
105 to stop system from acting on Windows key events. */
106 Lisp_Object Vw32_phantom_key_code;
108 /* Modifier associated with the left "Windows" key, or nil to act as a
109 normal key. */
110 Lisp_Object Vw32_lwindow_modifier;
112 /* Modifier associated with the right "Windows" key, or nil to act as a
113 normal key. */
114 Lisp_Object Vw32_rwindow_modifier;
116 /* Modifier associated with the "Apps" key, or nil to act as a normal
117 key. */
118 Lisp_Object Vw32_apps_modifier;
120 /* Value is nil if Num Lock acts as a function key. */
121 Lisp_Object Vw32_enable_num_lock;
123 /* Value is nil if Caps Lock acts as a function key. */
124 Lisp_Object Vw32_enable_caps_lock;
126 /* Modifier associated with Scroll Lock, or nil to act as a normal key. */
127 Lisp_Object Vw32_scroll_lock_modifier;
129 /* Switch to control whether we inhibit requests for synthesized bold
130 and italic versions of fonts. */
131 int w32_enable_synthesized_fonts;
133 /* Enable palette management. */
134 Lisp_Object Vw32_enable_palette;
136 /* Control how close left/right button down events must be to
137 be converted to a middle button down event. */
138 int w32_mouse_button_tolerance;
140 /* Minimum interval between mouse movement (and scroll bar drag)
141 events that are passed on to the event loop. */
142 int w32_mouse_move_interval;
144 /* Flag to indicate if XBUTTON events should be passed on to Windows. */
145 static int w32_pass_extra_mouse_buttons_to_system;
147 /* Flag to indicate if media keys should be passed on to Windows. */
148 static int w32_pass_multimedia_buttons_to_system;
150 /* Non nil if no window manager is in use. */
151 Lisp_Object Vx_no_window_manager;
153 /* Non-zero means we're allowed to display a hourglass pointer. */
155 int display_hourglass_p;
157 /* If non-zero, a w32 timer that, when it expires, displays an
158 hourglass cursor on all frames. */
159 static unsigned hourglass_timer = 0;
160 static HWND hourglass_hwnd = NULL;
162 /* The background and shape of the mouse pointer, and shape when not
163 over text or in the modeline. */
165 Lisp_Object Vx_pointer_shape, Vx_nontext_pointer_shape, Vx_mode_pointer_shape;
166 Lisp_Object Vx_hourglass_pointer_shape, Vx_window_horizontal_drag_shape;
168 /* The shape when over mouse-sensitive text. */
170 Lisp_Object Vx_sensitive_text_pointer_shape;
172 #ifndef IDC_HAND
173 #define IDC_HAND MAKEINTRESOURCE(32649)
174 #endif
176 /* Color of chars displayed in cursor box. */
178 Lisp_Object Vx_cursor_fore_pixel;
180 /* Nonzero if using Windows. */
182 static int w32_in_use;
184 /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'. */
186 Lisp_Object Vx_pixel_size_width_font_regexp;
188 /* Alist of bdf fonts and the files that define them. */
189 Lisp_Object Vw32_bdf_filename_alist;
191 /* A flag to control whether fonts are matched strictly or not. */
192 static int w32_strict_fontnames;
194 /* A flag to control whether we should only repaint if GetUpdateRect
195 indicates there is an update region. */
196 static int w32_strict_painting;
198 /* Associative list linking character set strings to Windows codepages. */
199 static Lisp_Object Vw32_charset_info_alist;
201 /* VIETNAMESE_CHARSET is not defined in some versions of MSVC. */
202 #ifndef VIETNAMESE_CHARSET
203 #define VIETNAMESE_CHARSET 163
204 #endif
206 Lisp_Object Qnone;
207 Lisp_Object Qsuppress_icon;
208 Lisp_Object Qundefined_color;
209 Lisp_Object Qcancel_timer;
210 Lisp_Object Qhyper;
211 Lisp_Object Qsuper;
212 Lisp_Object Qmeta;
213 Lisp_Object Qalt;
214 Lisp_Object Qctrl;
215 Lisp_Object Qcontrol;
216 Lisp_Object Qshift;
218 Lisp_Object Qw32_charset_ansi;
219 Lisp_Object Qw32_charset_default;
220 Lisp_Object Qw32_charset_symbol;
221 Lisp_Object Qw32_charset_shiftjis;
222 Lisp_Object Qw32_charset_hangeul;
223 Lisp_Object Qw32_charset_gb2312;
224 Lisp_Object Qw32_charset_chinesebig5;
225 Lisp_Object Qw32_charset_oem;
227 #ifndef JOHAB_CHARSET
228 #define JOHAB_CHARSET 130
229 #endif
230 #ifdef JOHAB_CHARSET
231 Lisp_Object Qw32_charset_easteurope;
232 Lisp_Object Qw32_charset_turkish;
233 Lisp_Object Qw32_charset_baltic;
234 Lisp_Object Qw32_charset_russian;
235 Lisp_Object Qw32_charset_arabic;
236 Lisp_Object Qw32_charset_greek;
237 Lisp_Object Qw32_charset_hebrew;
238 Lisp_Object Qw32_charset_vietnamese;
239 Lisp_Object Qw32_charset_thai;
240 Lisp_Object Qw32_charset_johab;
241 Lisp_Object Qw32_charset_mac;
242 #endif
244 #ifdef UNICODE_CHARSET
245 Lisp_Object Qw32_charset_unicode;
246 #endif
248 /* The ANSI codepage. */
249 int w32_ansi_code_page;
251 /* Prefix for system colors. */
252 #define SYSTEM_COLOR_PREFIX "System"
253 #define SYSTEM_COLOR_PREFIX_LEN (sizeof (SYSTEM_COLOR_PREFIX) - 1)
255 /* State variables for emulating a three button mouse. */
256 #define LMOUSE 1
257 #define MMOUSE 2
258 #define RMOUSE 4
260 static int button_state = 0;
261 static W32Msg saved_mouse_button_msg;
262 static unsigned mouse_button_timer = 0; /* non-zero when timer is active */
263 static W32Msg saved_mouse_move_msg;
264 static unsigned mouse_move_timer = 0;
266 /* Window that is tracking the mouse. */
267 static HWND track_mouse_window;
269 /* Multi-monitor API definitions that are not pulled from the headers
270 since we are compiling for NT 4. */
271 #ifndef MONITOR_DEFAULT_TO_NEAREST
272 #define MONITOR_DEFAULT_TO_NEAREST 2
273 #endif
274 /* MinGW headers define MONITORINFO unconditionally, but MSVC ones don't.
275 To avoid a compile error on one or the other, redefine with a new name. */
276 struct MONITOR_INFO
278 DWORD cbSize;
279 RECT rcMonitor;
280 RECT rcWork;
281 DWORD dwFlags;
284 typedef BOOL (WINAPI * TrackMouseEvent_Proc)
285 (IN OUT LPTRACKMOUSEEVENT lpEventTrack);
286 typedef LONG (WINAPI * ImmGetCompositionString_Proc)
287 (IN HIMC context, IN DWORD index, OUT LPVOID buffer, IN DWORD bufLen);
288 typedef HIMC (WINAPI * ImmGetContext_Proc) (IN HWND window);
289 typedef HMONITOR (WINAPI * MonitorFromPoint_Proc) (IN POINT pt, IN DWORD flags);
290 typedef BOOL (WINAPI * GetMonitorInfo_Proc)
291 (IN HMONITOR monitor, OUT struct MONITOR_INFO* info);
293 TrackMouseEvent_Proc track_mouse_event_fn = NULL;
294 ClipboardSequence_Proc clipboard_sequence_fn = NULL;
295 ImmGetCompositionString_Proc get_composition_string_fn = NULL;
296 ImmGetContext_Proc get_ime_context_fn = NULL;
297 MonitorFromPoint_Proc monitor_from_point_fn = NULL;
298 GetMonitorInfo_Proc get_monitor_info_fn = NULL;
300 extern AppendMenuW_Proc unicode_append_menu;
302 /* Flag to selectively ignore WM_IME_CHAR messages. */
303 static int ignore_ime_char = 0;
305 /* W95 mousewheel handler */
306 unsigned int msh_mousewheel = 0;
308 /* Timers */
309 #define MOUSE_BUTTON_ID 1
310 #define MOUSE_MOVE_ID 2
311 #define MENU_FREE_ID 3
312 #define HOURGLASS_ID 4
313 /* The delay (milliseconds) before a menu is freed after WM_EXITMENULOOP
314 is received. */
315 #define MENU_FREE_DELAY 1000
316 static unsigned menu_free_timer = 0;
318 /* The below are defined in frame.c. */
320 extern Lisp_Object Vwindow_system_version;
322 #ifdef GLYPH_DEBUG
323 int image_cache_refcount, dpyinfo_refcount;
324 #endif
327 /* From w32term.c. */
328 extern int w32_num_mouse_buttons;
329 extern Lisp_Object Vw32_recognize_altgr;
331 extern HWND w32_system_caret_hwnd;
333 extern int w32_system_caret_height;
334 extern int w32_system_caret_x;
335 extern int w32_system_caret_y;
336 extern int w32_use_visible_system_caret;
338 static HWND w32_visible_system_caret_hwnd;
340 /* From w32menu.c */
341 extern HMENU current_popup_menu;
342 static int menubar_in_use = 0;
344 /* From w32uniscribe.c */
345 #ifdef USE_FONT_BACKEND
346 extern void syms_of_w32uniscribe ();
347 extern int uniscribe_available;
348 #endif
350 /* Function prototypes for hourglass support. */
351 static void show_hourglass P_ ((struct frame *));
352 static void hide_hourglass P_ ((void));
356 /* Error if we are not connected to MS-Windows. */
357 void
358 check_w32 ()
360 if (! w32_in_use)
361 error ("MS-Windows not in use or not initialized");
364 /* Nonzero if we can use mouse menus.
365 You should not call this unless HAVE_MENUS is defined. */
368 have_menus_p ()
370 return w32_in_use;
373 /* Extract a frame as a FRAME_PTR, defaulting to the selected frame
374 and checking validity for W32. */
376 FRAME_PTR
377 check_x_frame (frame)
378 Lisp_Object frame;
380 FRAME_PTR f;
382 if (NILP (frame))
383 frame = selected_frame;
384 CHECK_LIVE_FRAME (frame);
385 f = XFRAME (frame);
386 if (! FRAME_W32_P (f))
387 error ("Non-W32 frame used");
388 return f;
391 /* Let the user specify a display with a frame.
392 nil stands for the selected frame--or, if that is not a w32 frame,
393 the first display on the list. */
395 struct w32_display_info *
396 check_x_display_info (frame)
397 Lisp_Object frame;
399 if (NILP (frame))
401 struct frame *sf = XFRAME (selected_frame);
403 if (FRAME_W32_P (sf) && FRAME_LIVE_P (sf))
404 return FRAME_W32_DISPLAY_INFO (sf);
405 else
406 return &one_w32_display_info;
408 else if (STRINGP (frame))
409 return x_display_info_for_name (frame);
410 else
412 FRAME_PTR f;
414 CHECK_LIVE_FRAME (frame);
415 f = XFRAME (frame);
416 if (! FRAME_W32_P (f))
417 error ("Non-W32 frame used");
418 return FRAME_W32_DISPLAY_INFO (f);
422 /* Return the Emacs frame-object corresponding to an w32 window.
423 It could be the frame's main window or an icon window. */
425 /* This function can be called during GC, so use GC_xxx type test macros. */
427 struct frame *
428 x_window_to_frame (dpyinfo, wdesc)
429 struct w32_display_info *dpyinfo;
430 HWND wdesc;
432 Lisp_Object tail, frame;
433 struct frame *f;
435 for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
437 frame = XCAR (tail);
438 if (!FRAMEP (frame))
439 continue;
440 f = XFRAME (frame);
441 if (!FRAME_W32_P (f) || FRAME_W32_DISPLAY_INFO (f) != dpyinfo)
442 continue;
444 if (FRAME_W32_WINDOW (f) == wdesc)
445 return f;
447 return 0;
451 static Lisp_Object unwind_create_frame P_ ((Lisp_Object));
452 static Lisp_Object unwind_create_tip_frame P_ ((Lisp_Object));
453 static void my_create_window P_ ((struct frame *));
454 static void my_create_tip_window P_ ((struct frame *));
456 /* TODO: Native Input Method support; see x_create_im. */
457 void x_set_foreground_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
458 void x_set_background_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
459 void x_set_mouse_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
460 void x_set_cursor_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
461 void x_set_border_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
462 void x_set_cursor_type P_ ((struct frame *, Lisp_Object, Lisp_Object));
463 void x_set_icon_type P_ ((struct frame *, Lisp_Object, Lisp_Object));
464 void x_set_icon_name P_ ((struct frame *, Lisp_Object, Lisp_Object));
465 void x_explicitly_set_name P_ ((struct frame *, Lisp_Object, Lisp_Object));
466 void x_set_menu_bar_lines P_ ((struct frame *, Lisp_Object, Lisp_Object));
467 void x_set_title P_ ((struct frame *, Lisp_Object, Lisp_Object));
468 void x_set_tool_bar_lines P_ ((struct frame *, Lisp_Object, Lisp_Object));
469 static void x_edge_detection P_ ((struct frame *, struct image *, Lisp_Object,
470 Lisp_Object));
475 /* Store the screen positions of frame F into XPTR and YPTR.
476 These are the positions of the containing window manager window,
477 not Emacs's own window. */
479 void
480 x_real_positions (f, xptr, yptr)
481 FRAME_PTR f;
482 int *xptr, *yptr;
484 POINT pt;
485 RECT rect;
487 /* Get the bounds of the WM window. */
488 GetWindowRect (FRAME_W32_WINDOW (f), &rect);
490 pt.x = 0;
491 pt.y = 0;
493 /* Convert (0, 0) in the client area to screen co-ordinates. */
494 ClientToScreen (FRAME_W32_WINDOW (f), &pt);
496 /* Remember x_pixels_diff and y_pixels_diff. */
497 f->x_pixels_diff = pt.x - rect.left;
498 f->y_pixels_diff = pt.y - rect.top;
500 *xptr = rect.left;
501 *yptr = rect.top;
506 DEFUN ("w32-define-rgb-color", Fw32_define_rgb_color,
507 Sw32_define_rgb_color, 4, 4, 0,
508 doc: /* Convert RGB numbers to a windows color reference and associate with NAME.
509 This adds or updates a named color to `w32-color-map', making it
510 available for use. The original entry's RGB ref is returned, or nil
511 if the entry is new. */)
512 (red, green, blue, name)
513 Lisp_Object red, green, blue, name;
515 Lisp_Object rgb;
516 Lisp_Object oldrgb = Qnil;
517 Lisp_Object entry;
519 CHECK_NUMBER (red);
520 CHECK_NUMBER (green);
521 CHECK_NUMBER (blue);
522 CHECK_STRING (name);
524 XSETINT (rgb, RGB (XUINT (red), XUINT (green), XUINT (blue)));
526 BLOCK_INPUT;
528 /* replace existing entry in w32-color-map or add new entry. */
529 entry = Fassoc (name, Vw32_color_map);
530 if (NILP (entry))
532 entry = Fcons (name, rgb);
533 Vw32_color_map = Fcons (entry, Vw32_color_map);
535 else
537 oldrgb = Fcdr (entry);
538 Fsetcdr (entry, rgb);
541 UNBLOCK_INPUT;
543 return (oldrgb);
546 DEFUN ("w32-load-color-file", Fw32_load_color_file,
547 Sw32_load_color_file, 1, 1, 0,
548 doc: /* Create an alist of color entries from an external file.
549 Assign this value to `w32-color-map' to replace the existing color map.
551 The file should define one named RGB color per line like so:
552 R G B name
553 where R,G,B are numbers between 0 and 255 and name is an arbitrary string. */)
554 (filename)
555 Lisp_Object filename;
557 FILE *fp;
558 Lisp_Object cmap = Qnil;
559 Lisp_Object abspath;
561 CHECK_STRING (filename);
562 abspath = Fexpand_file_name (filename, Qnil);
564 fp = fopen (SDATA (filename), "rt");
565 if (fp)
567 char buf[512];
568 int red, green, blue;
569 int num;
571 BLOCK_INPUT;
573 while (fgets (buf, sizeof (buf), fp) != NULL) {
574 if (sscanf (buf, "%u %u %u %n", &red, &green, &blue, &num) == 3)
576 char *name = buf + num;
577 num = strlen (name) - 1;
578 if (name[num] == '\n')
579 name[num] = 0;
580 cmap = Fcons (Fcons (build_string (name),
581 make_number (RGB (red, green, blue))),
582 cmap);
585 fclose (fp);
587 UNBLOCK_INPUT;
590 return cmap;
593 /* The default colors for the w32 color map */
594 typedef struct colormap_t
596 char *name;
597 COLORREF colorref;
598 } colormap_t;
600 colormap_t w32_color_map[] =
602 {"snow" , PALETTERGB (255,250,250)},
603 {"ghost white" , PALETTERGB (248,248,255)},
604 {"GhostWhite" , PALETTERGB (248,248,255)},
605 {"white smoke" , PALETTERGB (245,245,245)},
606 {"WhiteSmoke" , PALETTERGB (245,245,245)},
607 {"gainsboro" , PALETTERGB (220,220,220)},
608 {"floral white" , PALETTERGB (255,250,240)},
609 {"FloralWhite" , PALETTERGB (255,250,240)},
610 {"old lace" , PALETTERGB (253,245,230)},
611 {"OldLace" , PALETTERGB (253,245,230)},
612 {"linen" , PALETTERGB (250,240,230)},
613 {"antique white" , PALETTERGB (250,235,215)},
614 {"AntiqueWhite" , PALETTERGB (250,235,215)},
615 {"papaya whip" , PALETTERGB (255,239,213)},
616 {"PapayaWhip" , PALETTERGB (255,239,213)},
617 {"blanched almond" , PALETTERGB (255,235,205)},
618 {"BlanchedAlmond" , PALETTERGB (255,235,205)},
619 {"bisque" , PALETTERGB (255,228,196)},
620 {"peach puff" , PALETTERGB (255,218,185)},
621 {"PeachPuff" , PALETTERGB (255,218,185)},
622 {"navajo white" , PALETTERGB (255,222,173)},
623 {"NavajoWhite" , PALETTERGB (255,222,173)},
624 {"moccasin" , PALETTERGB (255,228,181)},
625 {"cornsilk" , PALETTERGB (255,248,220)},
626 {"ivory" , PALETTERGB (255,255,240)},
627 {"lemon chiffon" , PALETTERGB (255,250,205)},
628 {"LemonChiffon" , PALETTERGB (255,250,205)},
629 {"seashell" , PALETTERGB (255,245,238)},
630 {"honeydew" , PALETTERGB (240,255,240)},
631 {"mint cream" , PALETTERGB (245,255,250)},
632 {"MintCream" , PALETTERGB (245,255,250)},
633 {"azure" , PALETTERGB (240,255,255)},
634 {"alice blue" , PALETTERGB (240,248,255)},
635 {"AliceBlue" , PALETTERGB (240,248,255)},
636 {"lavender" , PALETTERGB (230,230,250)},
637 {"lavender blush" , PALETTERGB (255,240,245)},
638 {"LavenderBlush" , PALETTERGB (255,240,245)},
639 {"misty rose" , PALETTERGB (255,228,225)},
640 {"MistyRose" , PALETTERGB (255,228,225)},
641 {"white" , PALETTERGB (255,255,255)},
642 {"black" , PALETTERGB ( 0, 0, 0)},
643 {"dark slate gray" , PALETTERGB ( 47, 79, 79)},
644 {"DarkSlateGray" , PALETTERGB ( 47, 79, 79)},
645 {"dark slate grey" , PALETTERGB ( 47, 79, 79)},
646 {"DarkSlateGrey" , PALETTERGB ( 47, 79, 79)},
647 {"dim gray" , PALETTERGB (105,105,105)},
648 {"DimGray" , PALETTERGB (105,105,105)},
649 {"dim grey" , PALETTERGB (105,105,105)},
650 {"DimGrey" , PALETTERGB (105,105,105)},
651 {"slate gray" , PALETTERGB (112,128,144)},
652 {"SlateGray" , PALETTERGB (112,128,144)},
653 {"slate grey" , PALETTERGB (112,128,144)},
654 {"SlateGrey" , PALETTERGB (112,128,144)},
655 {"light slate gray" , PALETTERGB (119,136,153)},
656 {"LightSlateGray" , PALETTERGB (119,136,153)},
657 {"light slate grey" , PALETTERGB (119,136,153)},
658 {"LightSlateGrey" , PALETTERGB (119,136,153)},
659 {"gray" , PALETTERGB (190,190,190)},
660 {"grey" , PALETTERGB (190,190,190)},
661 {"light grey" , PALETTERGB (211,211,211)},
662 {"LightGrey" , PALETTERGB (211,211,211)},
663 {"light gray" , PALETTERGB (211,211,211)},
664 {"LightGray" , PALETTERGB (211,211,211)},
665 {"midnight blue" , PALETTERGB ( 25, 25,112)},
666 {"MidnightBlue" , PALETTERGB ( 25, 25,112)},
667 {"navy" , PALETTERGB ( 0, 0,128)},
668 {"navy blue" , PALETTERGB ( 0, 0,128)},
669 {"NavyBlue" , PALETTERGB ( 0, 0,128)},
670 {"cornflower blue" , PALETTERGB (100,149,237)},
671 {"CornflowerBlue" , PALETTERGB (100,149,237)},
672 {"dark slate blue" , PALETTERGB ( 72, 61,139)},
673 {"DarkSlateBlue" , PALETTERGB ( 72, 61,139)},
674 {"slate blue" , PALETTERGB (106, 90,205)},
675 {"SlateBlue" , PALETTERGB (106, 90,205)},
676 {"medium slate blue" , PALETTERGB (123,104,238)},
677 {"MediumSlateBlue" , PALETTERGB (123,104,238)},
678 {"light slate blue" , PALETTERGB (132,112,255)},
679 {"LightSlateBlue" , PALETTERGB (132,112,255)},
680 {"medium blue" , PALETTERGB ( 0, 0,205)},
681 {"MediumBlue" , PALETTERGB ( 0, 0,205)},
682 {"royal blue" , PALETTERGB ( 65,105,225)},
683 {"RoyalBlue" , PALETTERGB ( 65,105,225)},
684 {"blue" , PALETTERGB ( 0, 0,255)},
685 {"dodger blue" , PALETTERGB ( 30,144,255)},
686 {"DodgerBlue" , PALETTERGB ( 30,144,255)},
687 {"deep sky blue" , PALETTERGB ( 0,191,255)},
688 {"DeepSkyBlue" , PALETTERGB ( 0,191,255)},
689 {"sky blue" , PALETTERGB (135,206,235)},
690 {"SkyBlue" , PALETTERGB (135,206,235)},
691 {"light sky blue" , PALETTERGB (135,206,250)},
692 {"LightSkyBlue" , PALETTERGB (135,206,250)},
693 {"steel blue" , PALETTERGB ( 70,130,180)},
694 {"SteelBlue" , PALETTERGB ( 70,130,180)},
695 {"light steel blue" , PALETTERGB (176,196,222)},
696 {"LightSteelBlue" , PALETTERGB (176,196,222)},
697 {"light blue" , PALETTERGB (173,216,230)},
698 {"LightBlue" , PALETTERGB (173,216,230)},
699 {"powder blue" , PALETTERGB (176,224,230)},
700 {"PowderBlue" , PALETTERGB (176,224,230)},
701 {"pale turquoise" , PALETTERGB (175,238,238)},
702 {"PaleTurquoise" , PALETTERGB (175,238,238)},
703 {"dark turquoise" , PALETTERGB ( 0,206,209)},
704 {"DarkTurquoise" , PALETTERGB ( 0,206,209)},
705 {"medium turquoise" , PALETTERGB ( 72,209,204)},
706 {"MediumTurquoise" , PALETTERGB ( 72,209,204)},
707 {"turquoise" , PALETTERGB ( 64,224,208)},
708 {"cyan" , PALETTERGB ( 0,255,255)},
709 {"light cyan" , PALETTERGB (224,255,255)},
710 {"LightCyan" , PALETTERGB (224,255,255)},
711 {"cadet blue" , PALETTERGB ( 95,158,160)},
712 {"CadetBlue" , PALETTERGB ( 95,158,160)},
713 {"medium aquamarine" , PALETTERGB (102,205,170)},
714 {"MediumAquamarine" , PALETTERGB (102,205,170)},
715 {"aquamarine" , PALETTERGB (127,255,212)},
716 {"dark green" , PALETTERGB ( 0,100, 0)},
717 {"DarkGreen" , PALETTERGB ( 0,100, 0)},
718 {"dark olive green" , PALETTERGB ( 85,107, 47)},
719 {"DarkOliveGreen" , PALETTERGB ( 85,107, 47)},
720 {"dark sea green" , PALETTERGB (143,188,143)},
721 {"DarkSeaGreen" , PALETTERGB (143,188,143)},
722 {"sea green" , PALETTERGB ( 46,139, 87)},
723 {"SeaGreen" , PALETTERGB ( 46,139, 87)},
724 {"medium sea green" , PALETTERGB ( 60,179,113)},
725 {"MediumSeaGreen" , PALETTERGB ( 60,179,113)},
726 {"light sea green" , PALETTERGB ( 32,178,170)},
727 {"LightSeaGreen" , PALETTERGB ( 32,178,170)},
728 {"pale green" , PALETTERGB (152,251,152)},
729 {"PaleGreen" , PALETTERGB (152,251,152)},
730 {"spring green" , PALETTERGB ( 0,255,127)},
731 {"SpringGreen" , PALETTERGB ( 0,255,127)},
732 {"lawn green" , PALETTERGB (124,252, 0)},
733 {"LawnGreen" , PALETTERGB (124,252, 0)},
734 {"green" , PALETTERGB ( 0,255, 0)},
735 {"chartreuse" , PALETTERGB (127,255, 0)},
736 {"medium spring green" , PALETTERGB ( 0,250,154)},
737 {"MediumSpringGreen" , PALETTERGB ( 0,250,154)},
738 {"green yellow" , PALETTERGB (173,255, 47)},
739 {"GreenYellow" , PALETTERGB (173,255, 47)},
740 {"lime green" , PALETTERGB ( 50,205, 50)},
741 {"LimeGreen" , PALETTERGB ( 50,205, 50)},
742 {"yellow green" , PALETTERGB (154,205, 50)},
743 {"YellowGreen" , PALETTERGB (154,205, 50)},
744 {"forest green" , PALETTERGB ( 34,139, 34)},
745 {"ForestGreen" , PALETTERGB ( 34,139, 34)},
746 {"olive drab" , PALETTERGB (107,142, 35)},
747 {"OliveDrab" , PALETTERGB (107,142, 35)},
748 {"dark khaki" , PALETTERGB (189,183,107)},
749 {"DarkKhaki" , PALETTERGB (189,183,107)},
750 {"khaki" , PALETTERGB (240,230,140)},
751 {"pale goldenrod" , PALETTERGB (238,232,170)},
752 {"PaleGoldenrod" , PALETTERGB (238,232,170)},
753 {"light goldenrod yellow" , PALETTERGB (250,250,210)},
754 {"LightGoldenrodYellow" , PALETTERGB (250,250,210)},
755 {"light yellow" , PALETTERGB (255,255,224)},
756 {"LightYellow" , PALETTERGB (255,255,224)},
757 {"yellow" , PALETTERGB (255,255, 0)},
758 {"gold" , PALETTERGB (255,215, 0)},
759 {"light goldenrod" , PALETTERGB (238,221,130)},
760 {"LightGoldenrod" , PALETTERGB (238,221,130)},
761 {"goldenrod" , PALETTERGB (218,165, 32)},
762 {"dark goldenrod" , PALETTERGB (184,134, 11)},
763 {"DarkGoldenrod" , PALETTERGB (184,134, 11)},
764 {"rosy brown" , PALETTERGB (188,143,143)},
765 {"RosyBrown" , PALETTERGB (188,143,143)},
766 {"indian red" , PALETTERGB (205, 92, 92)},
767 {"IndianRed" , PALETTERGB (205, 92, 92)},
768 {"saddle brown" , PALETTERGB (139, 69, 19)},
769 {"SaddleBrown" , PALETTERGB (139, 69, 19)},
770 {"sienna" , PALETTERGB (160, 82, 45)},
771 {"peru" , PALETTERGB (205,133, 63)},
772 {"burlywood" , PALETTERGB (222,184,135)},
773 {"beige" , PALETTERGB (245,245,220)},
774 {"wheat" , PALETTERGB (245,222,179)},
775 {"sandy brown" , PALETTERGB (244,164, 96)},
776 {"SandyBrown" , PALETTERGB (244,164, 96)},
777 {"tan" , PALETTERGB (210,180,140)},
778 {"chocolate" , PALETTERGB (210,105, 30)},
779 {"firebrick" , PALETTERGB (178,34, 34)},
780 {"brown" , PALETTERGB (165,42, 42)},
781 {"dark salmon" , PALETTERGB (233,150,122)},
782 {"DarkSalmon" , PALETTERGB (233,150,122)},
783 {"salmon" , PALETTERGB (250,128,114)},
784 {"light salmon" , PALETTERGB (255,160,122)},
785 {"LightSalmon" , PALETTERGB (255,160,122)},
786 {"orange" , PALETTERGB (255,165, 0)},
787 {"dark orange" , PALETTERGB (255,140, 0)},
788 {"DarkOrange" , PALETTERGB (255,140, 0)},
789 {"coral" , PALETTERGB (255,127, 80)},
790 {"light coral" , PALETTERGB (240,128,128)},
791 {"LightCoral" , PALETTERGB (240,128,128)},
792 {"tomato" , PALETTERGB (255, 99, 71)},
793 {"orange red" , PALETTERGB (255, 69, 0)},
794 {"OrangeRed" , PALETTERGB (255, 69, 0)},
795 {"red" , PALETTERGB (255, 0, 0)},
796 {"hot pink" , PALETTERGB (255,105,180)},
797 {"HotPink" , PALETTERGB (255,105,180)},
798 {"deep pink" , PALETTERGB (255, 20,147)},
799 {"DeepPink" , PALETTERGB (255, 20,147)},
800 {"pink" , PALETTERGB (255,192,203)},
801 {"light pink" , PALETTERGB (255,182,193)},
802 {"LightPink" , PALETTERGB (255,182,193)},
803 {"pale violet red" , PALETTERGB (219,112,147)},
804 {"PaleVioletRed" , PALETTERGB (219,112,147)},
805 {"maroon" , PALETTERGB (176, 48, 96)},
806 {"medium violet red" , PALETTERGB (199, 21,133)},
807 {"MediumVioletRed" , PALETTERGB (199, 21,133)},
808 {"violet red" , PALETTERGB (208, 32,144)},
809 {"VioletRed" , PALETTERGB (208, 32,144)},
810 {"magenta" , PALETTERGB (255, 0,255)},
811 {"violet" , PALETTERGB (238,130,238)},
812 {"plum" , PALETTERGB (221,160,221)},
813 {"orchid" , PALETTERGB (218,112,214)},
814 {"medium orchid" , PALETTERGB (186, 85,211)},
815 {"MediumOrchid" , PALETTERGB (186, 85,211)},
816 {"dark orchid" , PALETTERGB (153, 50,204)},
817 {"DarkOrchid" , PALETTERGB (153, 50,204)},
818 {"dark violet" , PALETTERGB (148, 0,211)},
819 {"DarkViolet" , PALETTERGB (148, 0,211)},
820 {"blue violet" , PALETTERGB (138, 43,226)},
821 {"BlueViolet" , PALETTERGB (138, 43,226)},
822 {"purple" , PALETTERGB (160, 32,240)},
823 {"medium purple" , PALETTERGB (147,112,219)},
824 {"MediumPurple" , PALETTERGB (147,112,219)},
825 {"thistle" , PALETTERGB (216,191,216)},
826 {"gray0" , PALETTERGB ( 0, 0, 0)},
827 {"grey0" , PALETTERGB ( 0, 0, 0)},
828 {"dark grey" , PALETTERGB (169,169,169)},
829 {"DarkGrey" , PALETTERGB (169,169,169)},
830 {"dark gray" , PALETTERGB (169,169,169)},
831 {"DarkGray" , PALETTERGB (169,169,169)},
832 {"dark blue" , PALETTERGB ( 0, 0,139)},
833 {"DarkBlue" , PALETTERGB ( 0, 0,139)},
834 {"dark cyan" , PALETTERGB ( 0,139,139)},
835 {"DarkCyan" , PALETTERGB ( 0,139,139)},
836 {"dark magenta" , PALETTERGB (139, 0,139)},
837 {"DarkMagenta" , PALETTERGB (139, 0,139)},
838 {"dark red" , PALETTERGB (139, 0, 0)},
839 {"DarkRed" , PALETTERGB (139, 0, 0)},
840 {"light green" , PALETTERGB (144,238,144)},
841 {"LightGreen" , PALETTERGB (144,238,144)},
844 DEFUN ("w32-default-color-map", Fw32_default_color_map, Sw32_default_color_map,
845 0, 0, 0, doc: /* Return the default color map. */)
848 int i;
849 colormap_t *pc = w32_color_map;
850 Lisp_Object cmap;
852 BLOCK_INPUT;
854 cmap = Qnil;
856 for (i = 0; i < sizeof (w32_color_map) / sizeof (w32_color_map[0]);
857 pc++, i++)
858 cmap = Fcons (Fcons (build_string (pc->name),
859 make_number (pc->colorref)),
860 cmap);
862 UNBLOCK_INPUT;
864 return (cmap);
867 static Lisp_Object
868 w32_to_x_color (rgb)
869 Lisp_Object rgb;
871 Lisp_Object color;
873 CHECK_NUMBER (rgb);
875 BLOCK_INPUT;
877 color = Frassq (rgb, Vw32_color_map);
879 UNBLOCK_INPUT;
881 if (!NILP (color))
882 return (Fcar (color));
883 else
884 return Qnil;
887 static Lisp_Object
888 w32_color_map_lookup (colorname)
889 char *colorname;
891 Lisp_Object tail, ret = Qnil;
893 BLOCK_INPUT;
895 for (tail = Vw32_color_map; CONSP (tail); tail = XCDR (tail))
897 register Lisp_Object elt, tem;
899 elt = XCAR (tail);
900 if (!CONSP (elt)) continue;
902 tem = Fcar (elt);
904 if (lstrcmpi (SDATA (tem), colorname) == 0)
906 ret = Fcdr (elt);
907 break;
910 QUIT;
914 UNBLOCK_INPUT;
916 return ret;
920 static void
921 add_system_logical_colors_to_map (system_colors)
922 Lisp_Object *system_colors;
924 HKEY colors_key;
926 /* Other registry operations are done with input blocked. */
927 BLOCK_INPUT;
929 /* Look for "Control Panel/Colors" under User and Machine registry
930 settings. */
931 if (RegOpenKeyEx (HKEY_CURRENT_USER, "Control Panel\\Colors", 0,
932 KEY_READ, &colors_key) == ERROR_SUCCESS
933 || RegOpenKeyEx (HKEY_LOCAL_MACHINE, "Control Panel\\Colors", 0,
934 KEY_READ, &colors_key) == ERROR_SUCCESS)
936 /* List all keys. */
937 char color_buffer[64];
938 char full_name_buffer[MAX_PATH + SYSTEM_COLOR_PREFIX_LEN];
939 int index = 0;
940 DWORD name_size, color_size;
941 char *name_buffer = full_name_buffer + SYSTEM_COLOR_PREFIX_LEN;
943 name_size = sizeof (full_name_buffer) - SYSTEM_COLOR_PREFIX_LEN;
944 color_size = sizeof (color_buffer);
946 strcpy (full_name_buffer, SYSTEM_COLOR_PREFIX);
948 while (RegEnumValueA (colors_key, index, name_buffer, &name_size,
949 NULL, NULL, color_buffer, &color_size)
950 == ERROR_SUCCESS)
952 int r, g, b;
953 if (sscanf (color_buffer, " %u %u %u", &r, &g, &b) == 3)
954 *system_colors = Fcons (Fcons (build_string (full_name_buffer),
955 make_number (RGB (r, g, b))),
956 *system_colors);
958 name_size = sizeof (full_name_buffer) - SYSTEM_COLOR_PREFIX_LEN;
959 color_size = sizeof (color_buffer);
960 index++;
962 RegCloseKey (colors_key);
965 UNBLOCK_INPUT;
969 static Lisp_Object
970 x_to_w32_color (colorname)
971 char * colorname;
973 register Lisp_Object ret = Qnil;
975 BLOCK_INPUT;
977 if (colorname[0] == '#')
979 /* Could be an old-style RGB Device specification. */
980 char *color;
981 int size;
982 color = colorname + 1;
984 size = strlen (color);
985 if (size == 3 || size == 6 || size == 9 || size == 12)
987 UINT colorval;
988 int i, pos;
989 pos = 0;
990 size /= 3;
991 colorval = 0;
993 for (i = 0; i < 3; i++)
995 char *end;
996 char t;
997 unsigned long value;
999 /* The check for 'x' in the following conditional takes into
1000 account the fact that strtol allows a "0x" in front of
1001 our numbers, and we don't. */
1002 if (!isxdigit (color[0]) || color[1] == 'x')
1003 break;
1004 t = color[size];
1005 color[size] = '\0';
1006 value = strtoul (color, &end, 16);
1007 color[size] = t;
1008 if (errno == ERANGE || end - color != size)
1009 break;
1010 switch (size)
1012 case 1:
1013 value = value * 0x10;
1014 break;
1015 case 2:
1016 break;
1017 case 3:
1018 value /= 0x10;
1019 break;
1020 case 4:
1021 value /= 0x100;
1022 break;
1024 colorval |= (value << pos);
1025 pos += 0x8;
1026 if (i == 2)
1028 UNBLOCK_INPUT;
1029 XSETINT (ret, colorval);
1030 return ret;
1032 color = end;
1036 else if (strnicmp (colorname, "rgb:", 4) == 0)
1038 char *color;
1039 UINT colorval;
1040 int i, pos;
1041 pos = 0;
1043 colorval = 0;
1044 color = colorname + 4;
1045 for (i = 0; i < 3; i++)
1047 char *end;
1048 unsigned long value;
1050 /* The check for 'x' in the following conditional takes into
1051 account the fact that strtol allows a "0x" in front of
1052 our numbers, and we don't. */
1053 if (!isxdigit (color[0]) || color[1] == 'x')
1054 break;
1055 value = strtoul (color, &end, 16);
1056 if (errno == ERANGE)
1057 break;
1058 switch (end - color)
1060 case 1:
1061 value = value * 0x10 + value;
1062 break;
1063 case 2:
1064 break;
1065 case 3:
1066 value /= 0x10;
1067 break;
1068 case 4:
1069 value /= 0x100;
1070 break;
1071 default:
1072 value = ULONG_MAX;
1074 if (value == ULONG_MAX)
1075 break;
1076 colorval |= (value << pos);
1077 pos += 0x8;
1078 if (i == 2)
1080 if (*end != '\0')
1081 break;
1082 UNBLOCK_INPUT;
1083 XSETINT (ret, colorval);
1084 return ret;
1086 if (*end != '/')
1087 break;
1088 color = end + 1;
1091 else if (strnicmp (colorname, "rgbi:", 5) == 0)
1093 /* This is an RGB Intensity specification. */
1094 char *color;
1095 UINT colorval;
1096 int i, pos;
1097 pos = 0;
1099 colorval = 0;
1100 color = colorname + 5;
1101 for (i = 0; i < 3; i++)
1103 char *end;
1104 double value;
1105 UINT val;
1107 value = strtod (color, &end);
1108 if (errno == ERANGE)
1109 break;
1110 if (value < 0.0 || value > 1.0)
1111 break;
1112 val = (UINT)(0x100 * value);
1113 /* We used 0x100 instead of 0xFF to give a continuous
1114 range between 0.0 and 1.0 inclusive. The next statement
1115 fixes the 1.0 case. */
1116 if (val == 0x100)
1117 val = 0xFF;
1118 colorval |= (val << pos);
1119 pos += 0x8;
1120 if (i == 2)
1122 if (*end != '\0')
1123 break;
1124 UNBLOCK_INPUT;
1125 XSETINT (ret, colorval);
1126 return ret;
1128 if (*end != '/')
1129 break;
1130 color = end + 1;
1133 /* I am not going to attempt to handle any of the CIE color schemes
1134 or TekHVC, since I don't know the algorithms for conversion to
1135 RGB. */
1137 /* If we fail to lookup the color name in w32_color_map, then check the
1138 colorname to see if it can be crudely approximated: If the X color
1139 ends in a number (e.g., "darkseagreen2"), strip the number and
1140 return the result of looking up the base color name. */
1141 ret = w32_color_map_lookup (colorname);
1142 if (NILP (ret))
1144 int len = strlen (colorname);
1146 if (isdigit (colorname[len - 1]))
1148 char *ptr, *approx = alloca (len + 1);
1150 strcpy (approx, colorname);
1151 ptr = &approx[len - 1];
1152 while (ptr > approx && isdigit (*ptr))
1153 *ptr-- = '\0';
1155 ret = w32_color_map_lookup (approx);
1159 UNBLOCK_INPUT;
1160 return ret;
1163 void
1164 w32_regenerate_palette (FRAME_PTR f)
1166 struct w32_palette_entry * list;
1167 LOGPALETTE * log_palette;
1168 HPALETTE new_palette;
1169 int i;
1171 /* don't bother trying to create palette if not supported */
1172 if (! FRAME_W32_DISPLAY_INFO (f)->has_palette)
1173 return;
1175 log_palette = (LOGPALETTE *)
1176 alloca (sizeof (LOGPALETTE) +
1177 FRAME_W32_DISPLAY_INFO (f)->num_colors * sizeof (PALETTEENTRY));
1178 log_palette->palVersion = 0x300;
1179 log_palette->palNumEntries = FRAME_W32_DISPLAY_INFO (f)->num_colors;
1181 list = FRAME_W32_DISPLAY_INFO (f)->color_list;
1182 for (i = 0;
1183 i < FRAME_W32_DISPLAY_INFO (f)->num_colors;
1184 i++, list = list->next)
1185 log_palette->palPalEntry[i] = list->entry;
1187 new_palette = CreatePalette (log_palette);
1189 enter_crit ();
1191 if (FRAME_W32_DISPLAY_INFO (f)->palette)
1192 DeleteObject (FRAME_W32_DISPLAY_INFO (f)->palette);
1193 FRAME_W32_DISPLAY_INFO (f)->palette = new_palette;
1195 /* Realize display palette and garbage all frames. */
1196 release_frame_dc (f, get_frame_dc (f));
1198 leave_crit ();
1201 #define W32_COLOR(pe) RGB (pe.peRed, pe.peGreen, pe.peBlue)
1202 #define SET_W32_COLOR(pe, color) \
1203 do \
1205 pe.peRed = GetRValue (color); \
1206 pe.peGreen = GetGValue (color); \
1207 pe.peBlue = GetBValue (color); \
1208 pe.peFlags = 0; \
1209 } while (0)
1211 #if 0
1212 /* Keep these around in case we ever want to track color usage. */
1213 void
1214 w32_map_color (FRAME_PTR f, COLORREF color)
1216 struct w32_palette_entry * list = FRAME_W32_DISPLAY_INFO (f)->color_list;
1218 if (NILP (Vw32_enable_palette))
1219 return;
1221 /* check if color is already mapped */
1222 while (list)
1224 if (W32_COLOR (list->entry) == color)
1226 ++list->refcount;
1227 return;
1229 list = list->next;
1232 /* not already mapped, so add to list and recreate Windows palette */
1233 list = (struct w32_palette_entry *)
1234 xmalloc (sizeof (struct w32_palette_entry));
1235 SET_W32_COLOR (list->entry, color);
1236 list->refcount = 1;
1237 list->next = FRAME_W32_DISPLAY_INFO (f)->color_list;
1238 FRAME_W32_DISPLAY_INFO (f)->color_list = list;
1239 FRAME_W32_DISPLAY_INFO (f)->num_colors++;
1241 /* set flag that palette must be regenerated */
1242 FRAME_W32_DISPLAY_INFO (f)->regen_palette = TRUE;
1245 void
1246 w32_unmap_color (FRAME_PTR f, COLORREF color)
1248 struct w32_palette_entry * list = FRAME_W32_DISPLAY_INFO (f)->color_list;
1249 struct w32_palette_entry **prev = &FRAME_W32_DISPLAY_INFO (f)->color_list;
1251 if (NILP (Vw32_enable_palette))
1252 return;
1254 /* check if color is already mapped */
1255 while (list)
1257 if (W32_COLOR (list->entry) == color)
1259 if (--list->refcount == 0)
1261 *prev = list->next;
1262 xfree (list);
1263 FRAME_W32_DISPLAY_INFO (f)->num_colors--;
1264 break;
1266 else
1267 return;
1269 prev = &list->next;
1270 list = list->next;
1273 /* set flag that palette must be regenerated */
1274 FRAME_W32_DISPLAY_INFO (f)->regen_palette = TRUE;
1276 #endif
1279 /* Gamma-correct COLOR on frame F. */
1281 void
1282 gamma_correct (f, color)
1283 struct frame *f;
1284 COLORREF *color;
1286 if (f->gamma)
1288 *color = PALETTERGB (
1289 pow (GetRValue (*color) / 255.0, f->gamma) * 255.0 + 0.5,
1290 pow (GetGValue (*color) / 255.0, f->gamma) * 255.0 + 0.5,
1291 pow (GetBValue (*color) / 255.0, f->gamma) * 255.0 + 0.5);
1296 /* Decide if color named COLOR is valid for the display associated with
1297 the selected frame; if so, return the rgb values in COLOR_DEF.
1298 If ALLOC is nonzero, allocate a new colormap cell. */
1301 w32_defined_color (f, color, color_def, alloc)
1302 FRAME_PTR f;
1303 char *color;
1304 XColor *color_def;
1305 int alloc;
1307 register Lisp_Object tem;
1308 COLORREF w32_color_ref;
1310 tem = x_to_w32_color (color);
1312 if (!NILP (tem))
1314 if (f)
1316 /* Apply gamma correction. */
1317 w32_color_ref = XUINT (tem);
1318 gamma_correct (f, &w32_color_ref);
1319 XSETINT (tem, w32_color_ref);
1322 /* Map this color to the palette if it is enabled. */
1323 if (!NILP (Vw32_enable_palette))
1325 struct w32_palette_entry * entry =
1326 one_w32_display_info.color_list;
1327 struct w32_palette_entry ** prev =
1328 &one_w32_display_info.color_list;
1330 /* check if color is already mapped */
1331 while (entry)
1333 if (W32_COLOR (entry->entry) == XUINT (tem))
1334 break;
1335 prev = &entry->next;
1336 entry = entry->next;
1339 if (entry == NULL && alloc)
1341 /* not already mapped, so add to list */
1342 entry = (struct w32_palette_entry *)
1343 xmalloc (sizeof (struct w32_palette_entry));
1344 SET_W32_COLOR (entry->entry, XUINT (tem));
1345 entry->next = NULL;
1346 *prev = entry;
1347 one_w32_display_info.num_colors++;
1349 /* set flag that palette must be regenerated */
1350 one_w32_display_info.regen_palette = TRUE;
1353 /* Ensure COLORREF value is snapped to nearest color in (default)
1354 palette by simulating the PALETTERGB macro. This works whether
1355 or not the display device has a palette. */
1356 w32_color_ref = XUINT (tem) | 0x2000000;
1358 color_def->pixel = w32_color_ref;
1359 color_def->red = GetRValue (w32_color_ref) * 256;
1360 color_def->green = GetGValue (w32_color_ref) * 256;
1361 color_def->blue = GetBValue (w32_color_ref) * 256;
1363 return 1;
1365 else
1367 return 0;
1371 /* Given a string ARG naming a color, compute a pixel value from it
1372 suitable for screen F.
1373 If F is not a color screen, return DEF (default) regardless of what
1374 ARG says. */
1377 x_decode_color (f, arg, def)
1378 FRAME_PTR f;
1379 Lisp_Object arg;
1380 int def;
1382 XColor cdef;
1384 CHECK_STRING (arg);
1386 if (strcmp (SDATA (arg), "black") == 0)
1387 return BLACK_PIX_DEFAULT (f);
1388 else if (strcmp (SDATA (arg), "white") == 0)
1389 return WHITE_PIX_DEFAULT (f);
1391 if ((FRAME_W32_DISPLAY_INFO (f)->n_planes * FRAME_W32_DISPLAY_INFO (f)->n_cbits) == 1)
1392 return def;
1394 /* w32_defined_color is responsible for coping with failures
1395 by looking for a near-miss. */
1396 if (w32_defined_color (f, SDATA (arg), &cdef, 1))
1397 return cdef.pixel;
1399 /* defined_color failed; return an ultimate default. */
1400 return def;
1405 /* Functions called only from `x_set_frame_param'
1406 to set individual parameters.
1408 If FRAME_W32_WINDOW (f) is 0,
1409 the frame is being created and its window does not exist yet.
1410 In that case, just record the parameter's new value
1411 in the standard place; do not attempt to change the window. */
1413 void
1414 x_set_foreground_color (f, arg, oldval)
1415 struct frame *f;
1416 Lisp_Object arg, oldval;
1418 struct w32_output *x = f->output_data.w32;
1419 PIX_TYPE fg, old_fg;
1421 fg = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1422 old_fg = FRAME_FOREGROUND_PIXEL (f);
1423 FRAME_FOREGROUND_PIXEL (f) = fg;
1425 if (FRAME_W32_WINDOW (f) != 0)
1427 if (x->cursor_pixel == old_fg)
1428 x->cursor_pixel = fg;
1430 update_face_from_frame_parameter (f, Qforeground_color, arg);
1431 if (FRAME_VISIBLE_P (f))
1432 redraw_frame (f);
1436 void
1437 x_set_background_color (f, arg, oldval)
1438 struct frame *f;
1439 Lisp_Object arg, oldval;
1441 FRAME_BACKGROUND_PIXEL (f)
1442 = x_decode_color (f, arg, WHITE_PIX_DEFAULT (f));
1444 if (FRAME_W32_WINDOW (f) != 0)
1446 SetWindowLong (FRAME_W32_WINDOW (f), WND_BACKGROUND_INDEX,
1447 FRAME_BACKGROUND_PIXEL (f));
1449 update_face_from_frame_parameter (f, Qbackground_color, arg);
1451 if (FRAME_VISIBLE_P (f))
1452 redraw_frame (f);
1456 void
1457 x_set_mouse_color (f, arg, oldval)
1458 struct frame *f;
1459 Lisp_Object arg, oldval;
1461 Cursor cursor, nontext_cursor, mode_cursor, hand_cursor;
1462 int count;
1463 int mask_color;
1465 if (!EQ (Qnil, arg))
1466 f->output_data.w32->mouse_pixel
1467 = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1468 mask_color = FRAME_BACKGROUND_PIXEL (f);
1470 /* Don't let pointers be invisible. */
1471 if (mask_color == f->output_data.w32->mouse_pixel
1472 && mask_color == FRAME_BACKGROUND_PIXEL (f))
1473 f->output_data.w32->mouse_pixel = FRAME_FOREGROUND_PIXEL (f);
1475 #if 0 /* TODO : cursor changes */
1476 BLOCK_INPUT;
1478 /* It's not okay to crash if the user selects a screwy cursor. */
1479 count = x_catch_errors (FRAME_W32_DISPLAY (f));
1481 if (!EQ (Qnil, Vx_pointer_shape))
1483 CHECK_NUMBER (Vx_pointer_shape);
1484 cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XINT (Vx_pointer_shape));
1486 else
1487 cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_xterm);
1488 x_check_errors (FRAME_W32_DISPLAY (f), "bad text pointer cursor: %s");
1490 if (!EQ (Qnil, Vx_nontext_pointer_shape))
1492 CHECK_NUMBER (Vx_nontext_pointer_shape);
1493 nontext_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f),
1494 XINT (Vx_nontext_pointer_shape));
1496 else
1497 nontext_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_left_ptr);
1498 x_check_errors (FRAME_W32_DISPLAY (f), "bad nontext pointer cursor: %s");
1500 if (!EQ (Qnil, Vx_hourglass_pointer_shape))
1502 CHECK_NUMBER (Vx_hourglass_pointer_shape);
1503 hourglass_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f),
1504 XINT (Vx_hourglass_pointer_shape));
1506 else
1507 hourglass_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_watch);
1508 x_check_errors (FRAME_W32_DISPLAY (f), "bad busy pointer cursor: %s");
1510 x_check_errors (FRAME_W32_DISPLAY (f), "bad nontext pointer cursor: %s");
1511 if (!EQ (Qnil, Vx_mode_pointer_shape))
1513 CHECK_NUMBER (Vx_mode_pointer_shape);
1514 mode_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f),
1515 XINT (Vx_mode_pointer_shape));
1517 else
1518 mode_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_xterm);
1519 x_check_errors (FRAME_W32_DISPLAY (f), "bad modeline pointer cursor: %s");
1521 if (!EQ (Qnil, Vx_sensitive_text_pointer_shape))
1523 CHECK_NUMBER (Vx_sensitive_text_pointer_shape);
1524 hand_cursor
1525 = XCreateFontCursor (FRAME_W32_DISPLAY (f),
1526 XINT (Vx_sensitive_text_pointer_shape));
1528 else
1529 hand_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_crosshair);
1531 if (!NILP (Vx_window_horizontal_drag_shape))
1533 CHECK_NUMBER (Vx_window_horizontal_drag_shape);
1534 horizontal_drag_cursor
1535 = XCreateFontCursor (FRAME_X_DISPLAY (f),
1536 XINT (Vx_window_horizontal_drag_shape));
1538 else
1539 horizontal_drag_cursor
1540 = XCreateFontCursor (FRAME_X_DISPLAY (f), XC_sb_h_double_arrow);
1542 /* Check and report errors with the above calls. */
1543 x_check_errors (FRAME_W32_DISPLAY (f), "can't set cursor shape: %s");
1544 x_uncatch_errors (FRAME_W32_DISPLAY (f), count);
1547 XColor fore_color, back_color;
1549 fore_color.pixel = f->output_data.w32->mouse_pixel;
1550 back_color.pixel = mask_color;
1551 XQueryColor (FRAME_W32_DISPLAY (f),
1552 DefaultColormap (FRAME_W32_DISPLAY (f),
1553 DefaultScreen (FRAME_W32_DISPLAY (f))),
1554 &fore_color);
1555 XQueryColor (FRAME_W32_DISPLAY (f),
1556 DefaultColormap (FRAME_W32_DISPLAY (f),
1557 DefaultScreen (FRAME_W32_DISPLAY (f))),
1558 &back_color);
1559 XRecolorCursor (FRAME_W32_DISPLAY (f), cursor,
1560 &fore_color, &back_color);
1561 XRecolorCursor (FRAME_W32_DISPLAY (f), nontext_cursor,
1562 &fore_color, &back_color);
1563 XRecolorCursor (FRAME_W32_DISPLAY (f), mode_cursor,
1564 &fore_color, &back_color);
1565 XRecolorCursor (FRAME_W32_DISPLAY (f), hand_cursor,
1566 &fore_color, &back_color);
1567 XRecolorCursor (FRAME_W32_DISPLAY (f), hourglass_cursor,
1568 &fore_color, &back_color);
1571 if (FRAME_W32_WINDOW (f) != 0)
1572 XDefineCursor (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f), cursor);
1574 if (cursor != f->output_data.w32->text_cursor && f->output_data.w32->text_cursor != 0)
1575 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->text_cursor);
1576 f->output_data.w32->text_cursor = cursor;
1578 if (nontext_cursor != f->output_data.w32->nontext_cursor
1579 && f->output_data.w32->nontext_cursor != 0)
1580 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->nontext_cursor);
1581 f->output_data.w32->nontext_cursor = nontext_cursor;
1583 if (hourglass_cursor != f->output_data.w32->hourglass_cursor
1584 && f->output_data.w32->hourglass_cursor != 0)
1585 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->hourglass_cursor);
1586 f->output_data.w32->hourglass_cursor = hourglass_cursor;
1588 if (mode_cursor != f->output_data.w32->modeline_cursor
1589 && f->output_data.w32->modeline_cursor != 0)
1590 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->modeline_cursor);
1591 f->output_data.w32->modeline_cursor = mode_cursor;
1593 if (hand_cursor != f->output_data.w32->hand_cursor
1594 && f->output_data.w32->hand_cursor != 0)
1595 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->hand_cursor);
1596 f->output_data.w32->hand_cursor = hand_cursor;
1598 XFlush (FRAME_W32_DISPLAY (f));
1599 UNBLOCK_INPUT;
1601 update_face_from_frame_parameter (f, Qmouse_color, arg);
1602 #endif /* TODO */
1605 void
1606 x_set_cursor_color (f, arg, oldval)
1607 struct frame *f;
1608 Lisp_Object arg, oldval;
1610 unsigned long fore_pixel, pixel;
1612 if (!NILP (Vx_cursor_fore_pixel))
1613 fore_pixel = x_decode_color (f, Vx_cursor_fore_pixel,
1614 WHITE_PIX_DEFAULT (f));
1615 else
1616 fore_pixel = FRAME_BACKGROUND_PIXEL (f);
1618 pixel = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1620 /* Make sure that the cursor color differs from the background color. */
1621 if (pixel == FRAME_BACKGROUND_PIXEL (f))
1623 pixel = f->output_data.w32->mouse_pixel;
1624 if (pixel == fore_pixel)
1625 fore_pixel = FRAME_BACKGROUND_PIXEL (f);
1628 f->output_data.w32->cursor_foreground_pixel = fore_pixel;
1629 f->output_data.w32->cursor_pixel = pixel;
1631 if (FRAME_W32_WINDOW (f) != 0)
1633 BLOCK_INPUT;
1634 /* Update frame's cursor_gc. */
1635 f->output_data.w32->cursor_gc->foreground = fore_pixel;
1636 f->output_data.w32->cursor_gc->background = pixel;
1638 UNBLOCK_INPUT;
1640 if (FRAME_VISIBLE_P (f))
1642 x_update_cursor (f, 0);
1643 x_update_cursor (f, 1);
1647 update_face_from_frame_parameter (f, Qcursor_color, arg);
1650 /* Set the border-color of frame F to pixel value PIX.
1651 Note that this does not fully take effect if done before
1652 F has a window. */
1654 void
1655 x_set_border_pixel (f, pix)
1656 struct frame *f;
1657 int pix;
1660 f->output_data.w32->border_pixel = pix;
1662 if (FRAME_W32_WINDOW (f) != 0 && f->border_width > 0)
1664 if (FRAME_VISIBLE_P (f))
1665 redraw_frame (f);
1669 /* Set the border-color of frame F to value described by ARG.
1670 ARG can be a string naming a color.
1671 The border-color is used for the border that is drawn by the server.
1672 Note that this does not fully take effect if done before
1673 F has a window; it must be redone when the window is created. */
1675 void
1676 x_set_border_color (f, arg, oldval)
1677 struct frame *f;
1678 Lisp_Object arg, oldval;
1680 int pix;
1682 CHECK_STRING (arg);
1683 pix = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1684 x_set_border_pixel (f, pix);
1685 update_face_from_frame_parameter (f, Qborder_color, arg);
1689 void
1690 x_set_cursor_type (f, arg, oldval)
1691 FRAME_PTR f;
1692 Lisp_Object arg, oldval;
1694 set_frame_cursor_types (f, arg);
1696 /* Make sure the cursor gets redrawn. */
1697 cursor_type_changed = 1;
1700 void
1701 x_set_icon_type (f, arg, oldval)
1702 struct frame *f;
1703 Lisp_Object arg, oldval;
1705 int result;
1707 if (NILP (arg) && NILP (oldval))
1708 return;
1710 if (STRINGP (arg) && STRINGP (oldval)
1711 && EQ (Fstring_equal (oldval, arg), Qt))
1712 return;
1714 if (SYMBOLP (arg) && SYMBOLP (oldval) && EQ (arg, oldval))
1715 return;
1717 BLOCK_INPUT;
1719 result = x_bitmap_icon (f, arg);
1720 if (result)
1722 UNBLOCK_INPUT;
1723 error ("No icon window available");
1726 UNBLOCK_INPUT;
1729 void
1730 x_set_icon_name (f, arg, oldval)
1731 struct frame *f;
1732 Lisp_Object arg, oldval;
1734 if (STRINGP (arg))
1736 if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
1737 return;
1739 else if (!NILP (arg) || NILP (oldval))
1740 return;
1742 f->icon_name = arg;
1744 #if 0
1745 if (f->output_data.w32->icon_bitmap != 0)
1746 return;
1748 BLOCK_INPUT;
1750 result = x_text_icon (f,
1751 (char *) SDATA ((!NILP (f->icon_name)
1752 ? f->icon_name
1753 : !NILP (f->title)
1754 ? f->title
1755 : f->name)));
1757 if (result)
1759 UNBLOCK_INPUT;
1760 error ("No icon window available");
1763 /* If the window was unmapped (and its icon was mapped),
1764 the new icon is not mapped, so map the window in its stead. */
1765 if (FRAME_VISIBLE_P (f))
1767 #ifdef USE_X_TOOLKIT
1768 XtPopup (f->output_data.w32->widget, XtGrabNone);
1769 #endif
1770 XMapWindow (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f));
1773 XFlush (FRAME_W32_DISPLAY (f));
1774 UNBLOCK_INPUT;
1775 #endif
1779 void
1780 x_set_menu_bar_lines (f, value, oldval)
1781 struct frame *f;
1782 Lisp_Object value, oldval;
1784 int nlines;
1785 int olines = FRAME_MENU_BAR_LINES (f);
1787 /* Right now, menu bars don't work properly in minibuf-only frames;
1788 most of the commands try to apply themselves to the minibuffer
1789 frame itself, and get an error because you can't switch buffers
1790 in or split the minibuffer window. */
1791 if (FRAME_MINIBUF_ONLY_P (f))
1792 return;
1794 if (INTEGERP (value))
1795 nlines = XINT (value);
1796 else
1797 nlines = 0;
1799 FRAME_MENU_BAR_LINES (f) = 0;
1800 if (nlines)
1801 FRAME_EXTERNAL_MENU_BAR (f) = 1;
1802 else
1804 if (FRAME_EXTERNAL_MENU_BAR (f) == 1)
1805 free_frame_menubar (f);
1806 FRAME_EXTERNAL_MENU_BAR (f) = 0;
1808 /* Adjust the frame size so that the client (text) dimensions
1809 remain the same. This depends on FRAME_EXTERNAL_MENU_BAR being
1810 set correctly. */
1811 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
1812 do_pending_window_change (0);
1814 adjust_glyphs (f);
1818 /* Set the number of lines used for the tool bar of frame F to VALUE.
1819 VALUE not an integer, or < 0 means set the lines to zero. OLDVAL
1820 is the old number of tool bar lines. This function changes the
1821 height of all windows on frame F to match the new tool bar height.
1822 The frame's height doesn't change. */
1824 void
1825 x_set_tool_bar_lines (f, value, oldval)
1826 struct frame *f;
1827 Lisp_Object value, oldval;
1829 int delta, nlines, root_height;
1830 Lisp_Object root_window;
1832 /* Treat tool bars like menu bars. */
1833 if (FRAME_MINIBUF_ONLY_P (f))
1834 return;
1836 /* Use VALUE only if an integer >= 0. */
1837 if (INTEGERP (value) && XINT (value) >= 0)
1838 nlines = XFASTINT (value);
1839 else
1840 nlines = 0;
1842 /* Make sure we redisplay all windows in this frame. */
1843 ++windows_or_buffers_changed;
1845 delta = nlines - FRAME_TOOL_BAR_LINES (f);
1847 /* Don't resize the tool-bar to more than we have room for. */
1848 root_window = FRAME_ROOT_WINDOW (f);
1849 root_height = WINDOW_TOTAL_LINES (XWINDOW (root_window));
1850 if (root_height - delta < 1)
1852 delta = root_height - 1;
1853 nlines = FRAME_TOOL_BAR_LINES (f) + delta;
1856 FRAME_TOOL_BAR_LINES (f) = nlines;
1857 change_window_heights (root_window, delta);
1858 adjust_glyphs (f);
1860 /* We also have to make sure that the internal border at the top of
1861 the frame, below the menu bar or tool bar, is redrawn when the
1862 tool bar disappears. This is so because the internal border is
1863 below the tool bar if one is displayed, but is below the menu bar
1864 if there isn't a tool bar. The tool bar draws into the area
1865 below the menu bar. */
1866 if (FRAME_W32_WINDOW (f) && FRAME_TOOL_BAR_LINES (f) == 0)
1868 clear_frame (f);
1869 clear_current_matrices (f);
1872 /* If the tool bar gets smaller, the internal border below it
1873 has to be cleared. It was formerly part of the display
1874 of the larger tool bar, and updating windows won't clear it. */
1875 if (delta < 0)
1877 int height = FRAME_INTERNAL_BORDER_WIDTH (f);
1878 int width = FRAME_PIXEL_WIDTH (f);
1879 int y = nlines * FRAME_LINE_HEIGHT (f);
1881 BLOCK_INPUT;
1883 HDC hdc = get_frame_dc (f);
1884 w32_clear_area (f, hdc, 0, y, width, height);
1885 release_frame_dc (f, hdc);
1887 UNBLOCK_INPUT;
1889 if (WINDOWP (f->tool_bar_window))
1890 clear_glyph_matrix (XWINDOW (f->tool_bar_window)->current_matrix);
1895 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
1896 w32_id_name.
1898 If EXPLICIT is non-zero, that indicates that lisp code is setting the
1899 name; if NAME is a string, set F's name to NAME and set
1900 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
1902 If EXPLICIT is zero, that indicates that Emacs redisplay code is
1903 suggesting a new name, which lisp code should override; if
1904 F->explicit_name is set, ignore the new name; otherwise, set it. */
1906 void
1907 x_set_name (f, name, explicit)
1908 struct frame *f;
1909 Lisp_Object name;
1910 int explicit;
1912 /* Make sure that requests from lisp code override requests from
1913 Emacs redisplay code. */
1914 if (explicit)
1916 /* If we're switching from explicit to implicit, we had better
1917 update the mode lines and thereby update the title. */
1918 if (f->explicit_name && NILP (name))
1919 update_mode_lines = 1;
1921 f->explicit_name = ! NILP (name);
1923 else if (f->explicit_name)
1924 return;
1926 /* If NAME is nil, set the name to the w32_id_name. */
1927 if (NILP (name))
1929 /* Check for no change needed in this very common case
1930 before we do any consing. */
1931 if (!strcmp (FRAME_W32_DISPLAY_INFO (f)->w32_id_name,
1932 SDATA (f->name)))
1933 return;
1934 name = build_string (FRAME_W32_DISPLAY_INFO (f)->w32_id_name);
1936 else
1937 CHECK_STRING (name);
1939 /* Don't change the name if it's already NAME. */
1940 if (! NILP (Fstring_equal (name, f->name)))
1941 return;
1943 f->name = name;
1945 /* For setting the frame title, the title parameter should override
1946 the name parameter. */
1947 if (! NILP (f->title))
1948 name = f->title;
1950 if (FRAME_W32_WINDOW (f))
1952 if (STRING_MULTIBYTE (name))
1953 name = ENCODE_SYSTEM (name);
1955 BLOCK_INPUT;
1956 SetWindowText (FRAME_W32_WINDOW (f), SDATA (name));
1957 UNBLOCK_INPUT;
1961 /* This function should be called when the user's lisp code has
1962 specified a name for the frame; the name will override any set by the
1963 redisplay code. */
1964 void
1965 x_explicitly_set_name (f, arg, oldval)
1966 FRAME_PTR f;
1967 Lisp_Object arg, oldval;
1969 x_set_name (f, arg, 1);
1972 /* This function should be called by Emacs redisplay code to set the
1973 name; names set this way will never override names set by the user's
1974 lisp code. */
1975 void
1976 x_implicitly_set_name (f, arg, oldval)
1977 FRAME_PTR f;
1978 Lisp_Object arg, oldval;
1980 x_set_name (f, arg, 0);
1983 /* Change the title of frame F to NAME.
1984 If NAME is nil, use the frame name as the title. */
1986 void
1987 x_set_title (f, name, old_name)
1988 struct frame *f;
1989 Lisp_Object name, old_name;
1991 /* Don't change the title if it's already NAME. */
1992 if (EQ (name, f->title))
1993 return;
1995 update_mode_lines = 1;
1997 f->title = name;
1999 if (NILP (name))
2000 name = f->name;
2002 if (FRAME_W32_WINDOW (f))
2004 if (STRING_MULTIBYTE (name))
2005 name = ENCODE_SYSTEM (name);
2007 BLOCK_INPUT;
2008 SetWindowText (FRAME_W32_WINDOW (f), SDATA (name));
2009 UNBLOCK_INPUT;
2014 void x_set_scroll_bar_default_width (f)
2015 struct frame *f;
2017 int wid = FRAME_COLUMN_WIDTH (f);
2019 FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = GetSystemMetrics (SM_CXVSCROLL);
2020 FRAME_CONFIG_SCROLL_BAR_COLS (f) = (FRAME_CONFIG_SCROLL_BAR_WIDTH (f) +
2021 wid - 1) / wid;
2025 /* Subroutines of creating a frame. */
2028 /* Return the value of parameter PARAM.
2030 First search ALIST, then Vdefault_frame_alist, then the X defaults
2031 database, using ATTRIBUTE as the attribute name and CLASS as its class.
2033 Convert the resource to the type specified by desired_type.
2035 If no default is specified, return Qunbound. If you call
2036 w32_get_arg, make sure you deal with Qunbound in a reasonable way,
2037 and don't let it get stored in any Lisp-visible variables! */
2039 static Lisp_Object
2040 w32_get_arg (alist, param, attribute, class, type)
2041 Lisp_Object alist, param;
2042 char *attribute;
2043 char *class;
2044 enum resource_types type;
2046 return x_get_arg (check_x_display_info (Qnil),
2047 alist, param, attribute, class, type);
2051 Cursor
2052 w32_load_cursor (LPCTSTR name)
2054 /* Try first to load cursor from application resource. */
2055 Cursor cursor = LoadImage ((HINSTANCE) GetModuleHandle (NULL),
2056 name, IMAGE_CURSOR, 0, 0,
2057 LR_DEFAULTCOLOR | LR_DEFAULTSIZE | LR_SHARED);
2058 if (!cursor)
2060 /* Then try to load a shared predefined cursor. */
2061 cursor = LoadImage (NULL, name, IMAGE_CURSOR, 0, 0,
2062 LR_DEFAULTCOLOR | LR_DEFAULTSIZE | LR_SHARED);
2064 return cursor;
2067 extern LRESULT CALLBACK w32_wnd_proc ();
2069 static BOOL
2070 w32_init_class (hinst)
2071 HINSTANCE hinst;
2073 WNDCLASS wc;
2075 wc.style = CS_HREDRAW | CS_VREDRAW;
2076 wc.lpfnWndProc = (WNDPROC) w32_wnd_proc;
2077 wc.cbClsExtra = 0;
2078 wc.cbWndExtra = WND_EXTRA_BYTES;
2079 wc.hInstance = hinst;
2080 wc.hIcon = LoadIcon (hinst, EMACS_CLASS);
2081 wc.hCursor = w32_load_cursor (IDC_ARROW);
2082 wc.hbrBackground = NULL; /* GetStockObject (WHITE_BRUSH); */
2083 wc.lpszMenuName = NULL;
2084 wc.lpszClassName = EMACS_CLASS;
2086 return (RegisterClass (&wc));
2089 static HWND
2090 w32_createscrollbar (f, bar)
2091 struct frame *f;
2092 struct scroll_bar * bar;
2094 return (CreateWindow ("SCROLLBAR", "", SBS_VERT | WS_CHILD | WS_VISIBLE,
2095 /* Position and size of scroll bar. */
2096 XINT (bar->left) + VERTICAL_SCROLL_BAR_WIDTH_TRIM,
2097 XINT (bar->top),
2098 XINT (bar->width) - VERTICAL_SCROLL_BAR_WIDTH_TRIM * 2,
2099 XINT (bar->height),
2100 FRAME_W32_WINDOW (f),
2101 NULL,
2102 hinst,
2103 NULL));
2106 static void
2107 w32_createwindow (f)
2108 struct frame *f;
2110 HWND hwnd;
2111 RECT rect;
2112 Lisp_Object top = Qunbound;
2113 Lisp_Object left = Qunbound;
2115 rect.left = rect.top = 0;
2116 rect.right = FRAME_PIXEL_WIDTH (f);
2117 rect.bottom = FRAME_PIXEL_HEIGHT (f);
2119 AdjustWindowRect (&rect, f->output_data.w32->dwStyle,
2120 FRAME_EXTERNAL_MENU_BAR (f));
2122 /* Do first time app init */
2124 if (!hprevinst)
2126 w32_init_class (hinst);
2129 if (f->size_hint_flags & USPosition || f->size_hint_flags & PPosition)
2131 XSETINT (left, f->left_pos);
2132 XSETINT (top, f->top_pos);
2134 else if (EQ (left, Qunbound) && EQ (top, Qunbound))
2136 /* When called with RES_TYPE_NUMBER, w32_get_arg will return zero
2137 for anything that is not a number and is not Qunbound. */
2138 left = w32_get_arg (Qnil, Qleft, "left", "Left", RES_TYPE_NUMBER);
2139 top = w32_get_arg (Qnil, Qtop, "top", "Top", RES_TYPE_NUMBER);
2142 FRAME_W32_WINDOW (f) = hwnd
2143 = CreateWindow (EMACS_CLASS,
2144 f->namebuf,
2145 f->output_data.w32->dwStyle | WS_CLIPCHILDREN,
2146 EQ (left, Qunbound) ? CW_USEDEFAULT : XINT (left),
2147 EQ (top, Qunbound) ? CW_USEDEFAULT : XINT (top),
2148 rect.right - rect.left,
2149 rect.bottom - rect.top,
2150 NULL,
2151 NULL,
2152 hinst,
2153 NULL);
2155 if (hwnd)
2157 SetWindowLong (hwnd, WND_FONTWIDTH_INDEX, FRAME_COLUMN_WIDTH (f));
2158 SetWindowLong (hwnd, WND_LINEHEIGHT_INDEX, FRAME_LINE_HEIGHT (f));
2159 SetWindowLong (hwnd, WND_BORDER_INDEX, FRAME_INTERNAL_BORDER_WIDTH (f));
2160 SetWindowLong (hwnd, WND_SCROLLBAR_INDEX, f->scroll_bar_actual_width);
2161 SetWindowLong (hwnd, WND_BACKGROUND_INDEX, FRAME_BACKGROUND_PIXEL (f));
2163 /* Enable drag-n-drop. */
2164 DragAcceptFiles (hwnd, TRUE);
2166 /* Do this to discard the default setting specified by our parent. */
2167 ShowWindow (hwnd, SW_HIDE);
2169 /* Update frame positions. */
2170 GetWindowRect (hwnd, &rect);
2171 f->left_pos = rect.left;
2172 f->top_pos = rect.top;
2176 static void
2177 my_post_msg (wmsg, hwnd, msg, wParam, lParam)
2178 W32Msg * wmsg;
2179 HWND hwnd;
2180 UINT msg;
2181 WPARAM wParam;
2182 LPARAM lParam;
2184 wmsg->msg.hwnd = hwnd;
2185 wmsg->msg.message = msg;
2186 wmsg->msg.wParam = wParam;
2187 wmsg->msg.lParam = lParam;
2188 wmsg->msg.time = GetMessageTime ();
2190 post_msg (wmsg);
2193 /* GetKeyState and MapVirtualKey on Windows 95 do not actually distinguish
2194 between left and right keys as advertised. We test for this
2195 support dynamically, and set a flag when the support is absent. If
2196 absent, we keep track of the left and right control and alt keys
2197 ourselves. This is particularly necessary on keyboards that rely
2198 upon the AltGr key, which is represented as having the left control
2199 and right alt keys pressed. For these keyboards, we need to know
2200 when the left alt key has been pressed in addition to the AltGr key
2201 so that we can properly support M-AltGr-key sequences (such as M-@
2202 on Swedish keyboards). */
2204 #define EMACS_LCONTROL 0
2205 #define EMACS_RCONTROL 1
2206 #define EMACS_LMENU 2
2207 #define EMACS_RMENU 3
2209 static int modifiers[4];
2210 static int modifiers_recorded;
2211 static int modifier_key_support_tested;
2213 static void
2214 test_modifier_support (unsigned int wparam)
2216 unsigned int l, r;
2218 if (wparam != VK_CONTROL && wparam != VK_MENU)
2219 return;
2220 if (wparam == VK_CONTROL)
2222 l = VK_LCONTROL;
2223 r = VK_RCONTROL;
2225 else
2227 l = VK_LMENU;
2228 r = VK_RMENU;
2230 if (!(GetKeyState (l) & 0x8000) && !(GetKeyState (r) & 0x8000))
2231 modifiers_recorded = 1;
2232 else
2233 modifiers_recorded = 0;
2234 modifier_key_support_tested = 1;
2237 static void
2238 record_keydown (unsigned int wparam, unsigned int lparam)
2240 int i;
2242 if (!modifier_key_support_tested)
2243 test_modifier_support (wparam);
2245 if ((wparam != VK_CONTROL && wparam != VK_MENU) || !modifiers_recorded)
2246 return;
2248 if (wparam == VK_CONTROL)
2249 i = (lparam & 0x1000000) ? EMACS_RCONTROL : EMACS_LCONTROL;
2250 else
2251 i = (lparam & 0x1000000) ? EMACS_RMENU : EMACS_LMENU;
2253 modifiers[i] = 1;
2256 static void
2257 record_keyup (unsigned int wparam, unsigned int lparam)
2259 int i;
2261 if ((wparam != VK_CONTROL && wparam != VK_MENU) || !modifiers_recorded)
2262 return;
2264 if (wparam == VK_CONTROL)
2265 i = (lparam & 0x1000000) ? EMACS_RCONTROL : EMACS_LCONTROL;
2266 else
2267 i = (lparam & 0x1000000) ? EMACS_RMENU : EMACS_LMENU;
2269 modifiers[i] = 0;
2272 /* Emacs can lose focus while a modifier key has been pressed. When
2273 it regains focus, be conservative and clear all modifiers since
2274 we cannot reconstruct the left and right modifier state. */
2275 static void
2276 reset_modifiers ()
2278 SHORT ctrl, alt;
2280 if (GetFocus () == NULL)
2281 /* Emacs doesn't have keyboard focus. Do nothing. */
2282 return;
2284 ctrl = GetAsyncKeyState (VK_CONTROL);
2285 alt = GetAsyncKeyState (VK_MENU);
2287 if (!(ctrl & 0x08000))
2288 /* Clear any recorded control modifier state. */
2289 modifiers[EMACS_RCONTROL] = modifiers[EMACS_LCONTROL] = 0;
2291 if (!(alt & 0x08000))
2292 /* Clear any recorded alt modifier state. */
2293 modifiers[EMACS_RMENU] = modifiers[EMACS_LMENU] = 0;
2295 /* Update the state of all modifier keys, because modifiers used in
2296 hot-key combinations can get stuck on if Emacs loses focus as a
2297 result of a hot-key being pressed. */
2299 BYTE keystate[256];
2301 #define CURRENT_STATE(key) ((GetAsyncKeyState (key) & 0x8000) >> 8)
2303 GetKeyboardState (keystate);
2304 keystate[VK_SHIFT] = CURRENT_STATE (VK_SHIFT);
2305 keystate[VK_CONTROL] = CURRENT_STATE (VK_CONTROL);
2306 keystate[VK_LCONTROL] = CURRENT_STATE (VK_LCONTROL);
2307 keystate[VK_RCONTROL] = CURRENT_STATE (VK_RCONTROL);
2308 keystate[VK_MENU] = CURRENT_STATE (VK_MENU);
2309 keystate[VK_LMENU] = CURRENT_STATE (VK_LMENU);
2310 keystate[VK_RMENU] = CURRENT_STATE (VK_RMENU);
2311 keystate[VK_LWIN] = CURRENT_STATE (VK_LWIN);
2312 keystate[VK_RWIN] = CURRENT_STATE (VK_RWIN);
2313 keystate[VK_APPS] = CURRENT_STATE (VK_APPS);
2314 SetKeyboardState (keystate);
2318 /* Synchronize modifier state with what is reported with the current
2319 keystroke. Even if we cannot distinguish between left and right
2320 modifier keys, we know that, if no modifiers are set, then neither
2321 the left or right modifier should be set. */
2322 static void
2323 sync_modifiers ()
2325 if (!modifiers_recorded)
2326 return;
2328 if (!(GetKeyState (VK_CONTROL) & 0x8000))
2329 modifiers[EMACS_RCONTROL] = modifiers[EMACS_LCONTROL] = 0;
2331 if (!(GetKeyState (VK_MENU) & 0x8000))
2332 modifiers[EMACS_RMENU] = modifiers[EMACS_LMENU] = 0;
2335 static int
2336 modifier_set (int vkey)
2338 if (vkey == VK_CAPITAL || vkey == VK_SCROLL)
2339 return (GetKeyState (vkey) & 0x1);
2340 if (!modifiers_recorded)
2341 return (GetKeyState (vkey) & 0x8000);
2343 switch (vkey)
2345 case VK_LCONTROL:
2346 return modifiers[EMACS_LCONTROL];
2347 case VK_RCONTROL:
2348 return modifiers[EMACS_RCONTROL];
2349 case VK_LMENU:
2350 return modifiers[EMACS_LMENU];
2351 case VK_RMENU:
2352 return modifiers[EMACS_RMENU];
2354 return (GetKeyState (vkey) & 0x8000);
2357 /* Convert between the modifier bits W32 uses and the modifier bits
2358 Emacs uses. */
2360 unsigned int
2361 w32_key_to_modifier (int key)
2363 Lisp_Object key_mapping;
2365 switch (key)
2367 case VK_LWIN:
2368 key_mapping = Vw32_lwindow_modifier;
2369 break;
2370 case VK_RWIN:
2371 key_mapping = Vw32_rwindow_modifier;
2372 break;
2373 case VK_APPS:
2374 key_mapping = Vw32_apps_modifier;
2375 break;
2376 case VK_SCROLL:
2377 key_mapping = Vw32_scroll_lock_modifier;
2378 break;
2379 default:
2380 key_mapping = Qnil;
2383 /* NB. This code runs in the input thread, asychronously to the lisp
2384 thread, so we must be careful to ensure access to lisp data is
2385 thread-safe. The following code is safe because the modifier
2386 variable values are updated atomically from lisp and symbols are
2387 not relocated by GC. Also, we don't have to worry about seeing GC
2388 markbits here. */
2389 if (EQ (key_mapping, Qhyper))
2390 return hyper_modifier;
2391 if (EQ (key_mapping, Qsuper))
2392 return super_modifier;
2393 if (EQ (key_mapping, Qmeta))
2394 return meta_modifier;
2395 if (EQ (key_mapping, Qalt))
2396 return alt_modifier;
2397 if (EQ (key_mapping, Qctrl))
2398 return ctrl_modifier;
2399 if (EQ (key_mapping, Qcontrol)) /* synonym for ctrl */
2400 return ctrl_modifier;
2401 if (EQ (key_mapping, Qshift))
2402 return shift_modifier;
2404 /* Don't generate any modifier if not explicitly requested. */
2405 return 0;
2408 static unsigned int
2409 w32_get_modifiers ()
2411 return ((modifier_set (VK_SHIFT) ? shift_modifier : 0) |
2412 (modifier_set (VK_CONTROL) ? ctrl_modifier : 0) |
2413 (modifier_set (VK_LWIN) ? w32_key_to_modifier (VK_LWIN) : 0) |
2414 (modifier_set (VK_RWIN) ? w32_key_to_modifier (VK_RWIN) : 0) |
2415 (modifier_set (VK_APPS) ? w32_key_to_modifier (VK_APPS) : 0) |
2416 (modifier_set (VK_SCROLL) ? w32_key_to_modifier (VK_SCROLL) : 0) |
2417 (modifier_set (VK_MENU) ?
2418 ((NILP (Vw32_alt_is_meta)) ? alt_modifier : meta_modifier) : 0));
2421 /* We map the VK_* modifiers into console modifier constants
2422 so that we can use the same routines to handle both console
2423 and window input. */
2425 static int
2426 construct_console_modifiers ()
2428 int mods;
2430 mods = 0;
2431 mods |= (modifier_set (VK_SHIFT)) ? SHIFT_PRESSED : 0;
2432 mods |= (modifier_set (VK_CAPITAL)) ? CAPSLOCK_ON : 0;
2433 mods |= (modifier_set (VK_SCROLL)) ? SCROLLLOCK_ON : 0;
2434 mods |= (modifier_set (VK_NUMLOCK)) ? NUMLOCK_ON : 0;
2435 mods |= (modifier_set (VK_LCONTROL)) ? LEFT_CTRL_PRESSED : 0;
2436 mods |= (modifier_set (VK_RCONTROL)) ? RIGHT_CTRL_PRESSED : 0;
2437 mods |= (modifier_set (VK_LMENU)) ? LEFT_ALT_PRESSED : 0;
2438 mods |= (modifier_set (VK_RMENU)) ? RIGHT_ALT_PRESSED : 0;
2439 mods |= (modifier_set (VK_LWIN)) ? LEFT_WIN_PRESSED : 0;
2440 mods |= (modifier_set (VK_RWIN)) ? RIGHT_WIN_PRESSED : 0;
2441 mods |= (modifier_set (VK_APPS)) ? APPS_PRESSED : 0;
2443 return mods;
2446 static int
2447 w32_get_key_modifiers (unsigned int wparam, unsigned int lparam)
2449 int mods;
2451 /* Convert to emacs modifiers. */
2452 mods = w32_kbd_mods_to_emacs (construct_console_modifiers (), wparam);
2454 return mods;
2457 unsigned int
2458 map_keypad_keys (unsigned int virt_key, unsigned int extended)
2460 if (virt_key < VK_CLEAR || virt_key > VK_DELETE)
2461 return virt_key;
2463 if (virt_key == VK_RETURN)
2464 return (extended ? VK_NUMPAD_ENTER : VK_RETURN);
2466 if (virt_key >= VK_PRIOR && virt_key <= VK_DOWN)
2467 return (!extended ? (VK_NUMPAD_PRIOR + (virt_key - VK_PRIOR)) : virt_key);
2469 if (virt_key == VK_INSERT || virt_key == VK_DELETE)
2470 return (!extended ? (VK_NUMPAD_INSERT + (virt_key - VK_INSERT)) : virt_key);
2472 if (virt_key == VK_CLEAR)
2473 return (!extended ? VK_NUMPAD_CLEAR : virt_key);
2475 return virt_key;
2478 /* List of special key combinations which w32 would normally capture,
2479 but Emacs should grab instead. Not directly visible to lisp, to
2480 simplify synchronization. Each item is an integer encoding a virtual
2481 key code and modifier combination to capture. */
2482 static Lisp_Object w32_grabbed_keys;
2484 #define HOTKEY(vk, mods) make_number (((vk) & 255) | ((mods) << 8))
2485 #define HOTKEY_ID(k) (XFASTINT (k) & 0xbfff)
2486 #define HOTKEY_VK_CODE(k) (XFASTINT (k) & 255)
2487 #define HOTKEY_MODIFIERS(k) (XFASTINT (k) >> 8)
2489 #define RAW_HOTKEY_ID(k) ((k) & 0xbfff)
2490 #define RAW_HOTKEY_VK_CODE(k) ((k) & 255)
2491 #define RAW_HOTKEY_MODIFIERS(k) ((k) >> 8)
2493 /* Register hot-keys for reserved key combinations when Emacs has
2494 keyboard focus, since this is the only way Emacs can receive key
2495 combinations like Alt-Tab which are used by the system. */
2497 static void
2498 register_hot_keys (hwnd)
2499 HWND hwnd;
2501 Lisp_Object keylist;
2503 /* Use CONSP, since we are called asynchronously. */
2504 for (keylist = w32_grabbed_keys; CONSP (keylist); keylist = XCDR (keylist))
2506 Lisp_Object key = XCAR (keylist);
2508 /* Deleted entries get set to nil. */
2509 if (!INTEGERP (key))
2510 continue;
2512 RegisterHotKey (hwnd, HOTKEY_ID (key),
2513 HOTKEY_MODIFIERS (key), HOTKEY_VK_CODE (key));
2517 static void
2518 unregister_hot_keys (hwnd)
2519 HWND hwnd;
2521 Lisp_Object keylist;
2523 for (keylist = w32_grabbed_keys; CONSP (keylist); keylist = XCDR (keylist))
2525 Lisp_Object key = XCAR (keylist);
2527 if (!INTEGERP (key))
2528 continue;
2530 UnregisterHotKey (hwnd, HOTKEY_ID (key));
2534 /* Main message dispatch loop. */
2536 static void
2537 w32_msg_pump (deferred_msg * msg_buf)
2539 MSG msg;
2540 int result;
2541 HWND focus_window;
2543 msh_mousewheel = RegisterWindowMessage (MSH_MOUSEWHEEL);
2545 while (GetMessage (&msg, NULL, 0, 0))
2547 if (msg.hwnd == NULL)
2549 switch (msg.message)
2551 case WM_NULL:
2552 /* Produced by complete_deferred_msg; just ignore. */
2553 break;
2554 case WM_EMACS_CREATEWINDOW:
2555 /* Initialize COM for this window. Even though we don't use it,
2556 some third party shell extensions can cause it to be used in
2557 system dialogs, which causes a crash if it is not initialized.
2558 This is a known bug in Windows, which was fixed long ago, but
2559 the patch for XP is not publically available until XP SP3,
2560 and older versions will never be patched. */
2561 CoInitialize (NULL);
2562 w32_createwindow ((struct frame *) msg.wParam);
2563 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE, 0, 0))
2564 abort ();
2565 break;
2566 case WM_EMACS_SETLOCALE:
2567 SetThreadLocale (msg.wParam);
2568 /* Reply is not expected. */
2569 break;
2570 case WM_EMACS_SETKEYBOARDLAYOUT:
2571 result = (int) ActivateKeyboardLayout ((HKL) msg.wParam, 0);
2572 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE,
2573 result, 0))
2574 abort ();
2575 break;
2576 case WM_EMACS_REGISTER_HOT_KEY:
2577 focus_window = GetFocus ();
2578 if (focus_window != NULL)
2579 RegisterHotKey (focus_window,
2580 RAW_HOTKEY_ID (msg.wParam),
2581 RAW_HOTKEY_MODIFIERS (msg.wParam),
2582 RAW_HOTKEY_VK_CODE (msg.wParam));
2583 /* Reply is not expected. */
2584 break;
2585 case WM_EMACS_UNREGISTER_HOT_KEY:
2586 focus_window = GetFocus ();
2587 if (focus_window != NULL)
2588 UnregisterHotKey (focus_window, RAW_HOTKEY_ID (msg.wParam));
2589 /* Mark item as erased. NB: this code must be
2590 thread-safe. The next line is okay because the cons
2591 cell is never made into garbage and is not relocated by
2592 GC. */
2593 XSETCAR ((Lisp_Object) ((EMACS_INT) msg.lParam), Qnil);
2594 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE, 0, 0))
2595 abort ();
2596 break;
2597 case WM_EMACS_TOGGLE_LOCK_KEY:
2599 int vk_code = (int) msg.wParam;
2600 int cur_state = (GetKeyState (vk_code) & 1);
2601 Lisp_Object new_state = (Lisp_Object) ((EMACS_INT) msg.lParam);
2603 /* NB: This code must be thread-safe. It is safe to
2604 call NILP because symbols are not relocated by GC,
2605 and pointer here is not touched by GC (so the markbit
2606 can't be set). Numbers are safe because they are
2607 immediate values. */
2608 if (NILP (new_state)
2609 || (NUMBERP (new_state)
2610 && ((XUINT (new_state)) & 1) != cur_state))
2612 one_w32_display_info.faked_key = vk_code;
2614 keybd_event ((BYTE) vk_code,
2615 (BYTE) MapVirtualKey (vk_code, 0),
2616 KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
2617 keybd_event ((BYTE) vk_code,
2618 (BYTE) MapVirtualKey (vk_code, 0),
2619 KEYEVENTF_EXTENDEDKEY | 0, 0);
2620 keybd_event ((BYTE) vk_code,
2621 (BYTE) MapVirtualKey (vk_code, 0),
2622 KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
2623 cur_state = !cur_state;
2625 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE,
2626 cur_state, 0))
2627 abort ();
2629 break;
2630 #ifdef MSG_DEBUG
2631 /* Broadcast messages make it here, so you need to be looking
2632 for something in particular for this to be useful. */
2633 default:
2634 DebPrint (("msg %x not expected by w32_msg_pump\n", msg.message));
2635 #endif
2638 else
2640 DispatchMessage (&msg);
2643 /* Exit nested loop when our deferred message has completed. */
2644 if (msg_buf->completed)
2645 break;
2649 deferred_msg * deferred_msg_head;
2651 static deferred_msg *
2652 find_deferred_msg (HWND hwnd, UINT msg)
2654 deferred_msg * item;
2656 /* Don't actually need synchronization for read access, since
2657 modification of single pointer is always atomic. */
2658 /* enter_crit (); */
2660 for (item = deferred_msg_head; item != NULL; item = item->next)
2661 if (item->w32msg.msg.hwnd == hwnd
2662 && item->w32msg.msg.message == msg)
2663 break;
2665 /* leave_crit (); */
2667 return item;
2670 static LRESULT
2671 send_deferred_msg (deferred_msg * msg_buf,
2672 HWND hwnd,
2673 UINT msg,
2674 WPARAM wParam,
2675 LPARAM lParam)
2677 /* Only input thread can send deferred messages. */
2678 if (GetCurrentThreadId () != dwWindowsThreadId)
2679 abort ();
2681 /* It is an error to send a message that is already deferred. */
2682 if (find_deferred_msg (hwnd, msg) != NULL)
2683 abort ();
2685 /* Enforced synchronization is not needed because this is the only
2686 function that alters deferred_msg_head, and the following critical
2687 section is guaranteed to only be serially reentered (since only the
2688 input thread can call us). */
2690 /* enter_crit (); */
2692 msg_buf->completed = 0;
2693 msg_buf->next = deferred_msg_head;
2694 deferred_msg_head = msg_buf;
2695 my_post_msg (&msg_buf->w32msg, hwnd, msg, wParam, lParam);
2697 /* leave_crit (); */
2699 /* Start a new nested message loop to process other messages until
2700 this one is completed. */
2701 w32_msg_pump (msg_buf);
2703 deferred_msg_head = msg_buf->next;
2705 return msg_buf->result;
2708 void
2709 complete_deferred_msg (HWND hwnd, UINT msg, LRESULT result)
2711 deferred_msg * msg_buf = find_deferred_msg (hwnd, msg);
2713 if (msg_buf == NULL)
2714 /* Message may have been cancelled, so don't abort. */
2715 return;
2717 msg_buf->result = result;
2718 msg_buf->completed = 1;
2720 /* Ensure input thread is woken so it notices the completion. */
2721 PostThreadMessage (dwWindowsThreadId, WM_NULL, 0, 0);
2724 static void
2725 cancel_all_deferred_msgs ()
2727 deferred_msg * item;
2729 /* Don't actually need synchronization for read access, since
2730 modification of single pointer is always atomic. */
2731 /* enter_crit (); */
2733 for (item = deferred_msg_head; item != NULL; item = item->next)
2735 item->result = 0;
2736 item->completed = 1;
2739 /* leave_crit (); */
2741 /* Ensure input thread is woken so it notices the completion. */
2742 PostThreadMessage (dwWindowsThreadId, WM_NULL, 0, 0);
2745 DWORD WINAPI
2746 w32_msg_worker (void *arg)
2748 MSG msg;
2749 deferred_msg dummy_buf;
2751 /* Ensure our message queue is created */
2753 PeekMessage (&msg, NULL, 0, 0, PM_NOREMOVE);
2755 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE, 0, 0))
2756 abort ();
2758 memset (&dummy_buf, 0, sizeof (dummy_buf));
2759 dummy_buf.w32msg.msg.hwnd = NULL;
2760 dummy_buf.w32msg.msg.message = WM_NULL;
2762 /* This is the inital message loop which should only exit when the
2763 application quits. */
2764 w32_msg_pump (&dummy_buf);
2766 return 0;
2769 static void
2770 signal_user_input ()
2772 /* Interrupt any lisp that wants to be interrupted by input. */
2773 if (!NILP (Vthrow_on_input))
2775 Vquit_flag = Vthrow_on_input;
2776 /* If we're inside a function that wants immediate quits,
2777 do it now. */
2778 if (immediate_quit && NILP (Vinhibit_quit))
2780 immediate_quit = 0;
2781 QUIT;
2787 static void
2788 post_character_message (hwnd, msg, wParam, lParam, modifiers)
2789 HWND hwnd;
2790 UINT msg;
2791 WPARAM wParam;
2792 LPARAM lParam;
2793 DWORD modifiers;
2796 W32Msg wmsg;
2798 wmsg.dwModifiers = modifiers;
2800 /* Detect quit_char and set quit-flag directly. Note that we
2801 still need to post a message to ensure the main thread will be
2802 woken up if blocked in sys_select, but we do NOT want to post
2803 the quit_char message itself (because it will usually be as if
2804 the user had typed quit_char twice). Instead, we post a dummy
2805 message that has no particular effect. */
2807 int c = wParam;
2808 if (isalpha (c) && wmsg.dwModifiers == ctrl_modifier)
2809 c = make_ctrl_char (c) & 0377;
2810 if (c == quit_char
2811 || (wmsg.dwModifiers == 0 &&
2812 w32_quit_key && wParam == w32_quit_key))
2814 Vquit_flag = Qt;
2816 /* The choice of message is somewhat arbitrary, as long as
2817 the main thread handler just ignores it. */
2818 msg = WM_NULL;
2820 /* Interrupt any blocking system calls. */
2821 signal_quit ();
2823 /* As a safety precaution, forcibly complete any deferred
2824 messages. This is a kludge, but I don't see any particularly
2825 clean way to handle the situation where a deferred message is
2826 "dropped" in the lisp thread, and will thus never be
2827 completed, eg. by the user trying to activate the menubar
2828 when the lisp thread is busy, and then typing C-g when the
2829 menubar doesn't open promptly (with the result that the
2830 menubar never responds at all because the deferred
2831 WM_INITMENU message is never completed). Another problem
2832 situation is when the lisp thread calls SendMessage (to send
2833 a window manager command) when a message has been deferred;
2834 the lisp thread gets blocked indefinitely waiting for the
2835 deferred message to be completed, which itself is waiting for
2836 the lisp thread to respond.
2838 Note that we don't want to block the input thread waiting for
2839 a reponse from the lisp thread (although that would at least
2840 solve the deadlock problem above), because we want to be able
2841 to receive C-g to interrupt the lisp thread. */
2842 cancel_all_deferred_msgs ();
2844 else
2845 signal_user_input ();
2848 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
2851 /* Main window procedure */
2853 LRESULT CALLBACK
2854 w32_wnd_proc (hwnd, msg, wParam, lParam)
2855 HWND hwnd;
2856 UINT msg;
2857 WPARAM wParam;
2858 LPARAM lParam;
2860 struct frame *f;
2861 struct w32_display_info *dpyinfo = &one_w32_display_info;
2862 W32Msg wmsg;
2863 int windows_translate;
2864 int key;
2866 /* Note that it is okay to call x_window_to_frame, even though we are
2867 not running in the main lisp thread, because frame deletion
2868 requires the lisp thread to synchronize with this thread. Thus, if
2869 a frame struct is returned, it can be used without concern that the
2870 lisp thread might make it disappear while we are using it.
2872 NB. Walking the frame list in this thread is safe (as long as
2873 writes of Lisp_Object slots are atomic, which they are on Windows).
2874 Although delete-frame can destructively modify the frame list while
2875 we are walking it, a garbage collection cannot occur until after
2876 delete-frame has synchronized with this thread.
2878 It is also safe to use functions that make GDI calls, such as
2879 w32_clear_rect, because these functions must obtain a DC handle
2880 from the frame struct using get_frame_dc which is thread-aware. */
2882 switch (msg)
2884 case WM_ERASEBKGND:
2885 f = x_window_to_frame (dpyinfo, hwnd);
2886 if (f)
2888 HDC hdc = get_frame_dc (f);
2889 GetUpdateRect (hwnd, &wmsg.rect, FALSE);
2890 w32_clear_rect (f, hdc, &wmsg.rect);
2891 release_frame_dc (f, hdc);
2893 #if defined (W32_DEBUG_DISPLAY)
2894 DebPrint (("WM_ERASEBKGND (frame %p): erasing %d,%d-%d,%d\n",
2896 wmsg.rect.left, wmsg.rect.top,
2897 wmsg.rect.right, wmsg.rect.bottom));
2898 #endif /* W32_DEBUG_DISPLAY */
2900 return 1;
2901 case WM_PALETTECHANGED:
2902 /* ignore our own changes */
2903 if ((HWND)wParam != hwnd)
2905 f = x_window_to_frame (dpyinfo, hwnd);
2906 if (f)
2907 /* get_frame_dc will realize our palette and force all
2908 frames to be redrawn if needed. */
2909 release_frame_dc (f, get_frame_dc (f));
2911 return 0;
2912 case WM_PAINT:
2914 PAINTSTRUCT paintStruct;
2915 RECT update_rect;
2916 bzero (&update_rect, sizeof (update_rect));
2918 f = x_window_to_frame (dpyinfo, hwnd);
2919 if (f == 0)
2921 DebPrint (("WM_PAINT received for unknown window %p\n", hwnd));
2922 return 0;
2925 /* MSDN Docs say not to call BeginPaint if GetUpdateRect
2926 fails. Apparently this can happen under some
2927 circumstances. */
2928 if (GetUpdateRect (hwnd, &update_rect, FALSE) || !w32_strict_painting)
2930 enter_crit ();
2931 BeginPaint (hwnd, &paintStruct);
2933 /* The rectangles returned by GetUpdateRect and BeginPaint
2934 do not always match. Play it safe by assuming both areas
2935 are invalid. */
2936 UnionRect (&(wmsg.rect), &update_rect, &(paintStruct.rcPaint));
2938 #if defined (W32_DEBUG_DISPLAY)
2939 DebPrint (("WM_PAINT (frame %p): painting %d,%d-%d,%d\n",
2941 wmsg.rect.left, wmsg.rect.top,
2942 wmsg.rect.right, wmsg.rect.bottom));
2943 DebPrint ((" [update region is %d,%d-%d,%d]\n",
2944 update_rect.left, update_rect.top,
2945 update_rect.right, update_rect.bottom));
2946 #endif
2947 EndPaint (hwnd, &paintStruct);
2948 leave_crit ();
2950 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
2952 return 0;
2955 /* If GetUpdateRect returns 0 (meaning there is no update
2956 region), assume the whole window needs to be repainted. */
2957 GetClientRect (hwnd, &wmsg.rect);
2958 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
2959 return 0;
2962 case WM_INPUTLANGCHANGE:
2963 /* Inform lisp thread of keyboard layout changes. */
2964 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
2966 /* Clear dead keys in the keyboard state; for simplicity only
2967 preserve modifier key states. */
2969 int i;
2970 BYTE keystate[256];
2972 GetKeyboardState (keystate);
2973 for (i = 0; i < 256; i++)
2974 if (1
2975 && i != VK_SHIFT
2976 && i != VK_LSHIFT
2977 && i != VK_RSHIFT
2978 && i != VK_CAPITAL
2979 && i != VK_NUMLOCK
2980 && i != VK_SCROLL
2981 && i != VK_CONTROL
2982 && i != VK_LCONTROL
2983 && i != VK_RCONTROL
2984 && i != VK_MENU
2985 && i != VK_LMENU
2986 && i != VK_RMENU
2987 && i != VK_LWIN
2988 && i != VK_RWIN)
2989 keystate[i] = 0;
2990 SetKeyboardState (keystate);
2992 goto dflt;
2994 case WM_HOTKEY:
2995 /* Synchronize hot keys with normal input. */
2996 PostMessage (hwnd, WM_KEYDOWN, HIWORD (lParam), 0);
2997 return (0);
2999 case WM_KEYUP:
3000 case WM_SYSKEYUP:
3001 record_keyup (wParam, lParam);
3002 goto dflt;
3004 case WM_KEYDOWN:
3005 case WM_SYSKEYDOWN:
3006 /* Ignore keystrokes we fake ourself; see below. */
3007 if (dpyinfo->faked_key == wParam)
3009 dpyinfo->faked_key = 0;
3010 /* Make sure TranslateMessage sees them though (as long as
3011 they don't produce WM_CHAR messages). This ensures that
3012 indicator lights are toggled promptly on Windows 9x, for
3013 example. */
3014 if (wParam < 256 && lispy_function_keys[wParam])
3016 windows_translate = 1;
3017 goto translate;
3019 return 0;
3022 /* Synchronize modifiers with current keystroke. */
3023 sync_modifiers ();
3024 record_keydown (wParam, lParam);
3025 wParam = map_keypad_keys (wParam, (lParam & 0x1000000L) != 0);
3027 windows_translate = 0;
3029 switch (wParam)
3031 case VK_LWIN:
3032 if (NILP (Vw32_pass_lwindow_to_system))
3034 /* Prevent system from acting on keyup (which opens the
3035 Start menu if no other key was pressed) by simulating a
3036 press of Space which we will ignore. */
3037 if (GetAsyncKeyState (wParam) & 1)
3039 if (NUMBERP (Vw32_phantom_key_code))
3040 key = XUINT (Vw32_phantom_key_code) & 255;
3041 else
3042 key = VK_SPACE;
3043 dpyinfo->faked_key = key;
3044 keybd_event (key, (BYTE) MapVirtualKey (key, 0), 0, 0);
3047 if (!NILP (Vw32_lwindow_modifier))
3048 return 0;
3049 break;
3050 case VK_RWIN:
3051 if (NILP (Vw32_pass_rwindow_to_system))
3053 if (GetAsyncKeyState (wParam) & 1)
3055 if (NUMBERP (Vw32_phantom_key_code))
3056 key = XUINT (Vw32_phantom_key_code) & 255;
3057 else
3058 key = VK_SPACE;
3059 dpyinfo->faked_key = key;
3060 keybd_event (key, (BYTE) MapVirtualKey (key, 0), 0, 0);
3063 if (!NILP (Vw32_rwindow_modifier))
3064 return 0;
3065 break;
3066 case VK_APPS:
3067 if (!NILP (Vw32_apps_modifier))
3068 return 0;
3069 break;
3070 case VK_MENU:
3071 if (NILP (Vw32_pass_alt_to_system))
3072 /* Prevent DefWindowProc from activating the menu bar if an
3073 Alt key is pressed and released by itself. */
3074 return 0;
3075 windows_translate = 1;
3076 break;
3077 case VK_CAPITAL:
3078 /* Decide whether to treat as modifier or function key. */
3079 if (NILP (Vw32_enable_caps_lock))
3080 goto disable_lock_key;
3081 windows_translate = 1;
3082 break;
3083 case VK_NUMLOCK:
3084 /* Decide whether to treat as modifier or function key. */
3085 if (NILP (Vw32_enable_num_lock))
3086 goto disable_lock_key;
3087 windows_translate = 1;
3088 break;
3089 case VK_SCROLL:
3090 /* Decide whether to treat as modifier or function key. */
3091 if (NILP (Vw32_scroll_lock_modifier))
3092 goto disable_lock_key;
3093 windows_translate = 1;
3094 break;
3095 disable_lock_key:
3096 /* Ensure the appropriate lock key state (and indicator light)
3097 remains in the same state. We do this by faking another
3098 press of the relevant key. Apparently, this really is the
3099 only way to toggle the state of the indicator lights. */
3100 dpyinfo->faked_key = wParam;
3101 keybd_event ((BYTE) wParam, (BYTE) MapVirtualKey (wParam, 0),
3102 KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
3103 keybd_event ((BYTE) wParam, (BYTE) MapVirtualKey (wParam, 0),
3104 KEYEVENTF_EXTENDEDKEY | 0, 0);
3105 keybd_event ((BYTE) wParam, (BYTE) MapVirtualKey (wParam, 0),
3106 KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
3107 /* Ensure indicator lights are updated promptly on Windows 9x
3108 (TranslateMessage apparently does this), after forwarding
3109 input event. */
3110 post_character_message (hwnd, msg, wParam, lParam,
3111 w32_get_key_modifiers (wParam, lParam));
3112 windows_translate = 1;
3113 break;
3114 case VK_CONTROL:
3115 case VK_SHIFT:
3116 case VK_PROCESSKEY: /* Generated by IME. */
3117 windows_translate = 1;
3118 break;
3119 case VK_CANCEL:
3120 /* Windows maps Ctrl-Pause (aka Ctrl-Break) into VK_CANCEL,
3121 which is confusing for purposes of key binding; convert
3122 VK_CANCEL events into VK_PAUSE events. */
3123 wParam = VK_PAUSE;
3124 break;
3125 case VK_PAUSE:
3126 /* Windows maps Ctrl-NumLock into VK_PAUSE, which is confusing
3127 for purposes of key binding; convert these back into
3128 VK_NUMLOCK events, at least when we want to see NumLock key
3129 presses. (Note that there is never any possibility that
3130 VK_PAUSE with Ctrl really is C-Pause as per above.) */
3131 if (NILP (Vw32_enable_num_lock) && modifier_set (VK_CONTROL))
3132 wParam = VK_NUMLOCK;
3133 break;
3134 default:
3135 /* If not defined as a function key, change it to a WM_CHAR message. */
3136 if (wParam > 255 || !lispy_function_keys[wParam])
3138 DWORD modifiers = construct_console_modifiers ();
3140 if (!NILP (Vw32_recognize_altgr)
3141 && modifier_set (VK_LCONTROL) && modifier_set (VK_RMENU))
3143 /* Always let TranslateMessage handle AltGr key chords;
3144 for some reason, ToAscii doesn't always process AltGr
3145 chords correctly. */
3146 windows_translate = 1;
3148 else if ((modifiers & (~SHIFT_PRESSED & ~CAPSLOCK_ON)) != 0)
3150 /* Handle key chords including any modifiers other
3151 than shift directly, in order to preserve as much
3152 modifier information as possible. */
3153 if ('A' <= wParam && wParam <= 'Z')
3155 /* Don't translate modified alphabetic keystrokes,
3156 so the user doesn't need to constantly switch
3157 layout to type control or meta keystrokes when
3158 the normal layout translates alphabetic
3159 characters to non-ascii characters. */
3160 if (!modifier_set (VK_SHIFT))
3161 wParam += ('a' - 'A');
3162 msg = WM_CHAR;
3164 else
3166 /* Try to handle other keystrokes by determining the
3167 base character (ie. translating the base key plus
3168 shift modifier). */
3169 int add;
3170 int isdead = 0;
3171 KEY_EVENT_RECORD key;
3173 key.bKeyDown = TRUE;
3174 key.wRepeatCount = 1;
3175 key.wVirtualKeyCode = wParam;
3176 key.wVirtualScanCode = (lParam & 0xFF0000) >> 16;
3177 key.uChar.AsciiChar = 0;
3178 key.dwControlKeyState = modifiers;
3180 add = w32_kbd_patch_key (&key);
3181 /* 0 means an unrecognised keycode, negative means
3182 dead key. Ignore both. */
3183 while (--add >= 0)
3185 /* Forward asciified character sequence. */
3186 post_character_message
3187 (hwnd, WM_CHAR,
3188 (unsigned char) key.uChar.AsciiChar, lParam,
3189 w32_get_key_modifiers (wParam, lParam));
3190 w32_kbd_patch_key (&key);
3192 return 0;
3195 else
3197 /* Let TranslateMessage handle everything else. */
3198 windows_translate = 1;
3203 translate:
3204 if (windows_translate)
3206 MSG windows_msg = { hwnd, msg, wParam, lParam, 0, {0,0} };
3207 windows_msg.time = GetMessageTime ();
3208 TranslateMessage (&windows_msg);
3209 goto dflt;
3212 /* Fall through */
3214 case WM_SYSCHAR:
3215 case WM_CHAR:
3216 post_character_message (hwnd, msg, wParam, lParam,
3217 w32_get_key_modifiers (wParam, lParam));
3218 break;
3220 case WM_UNICHAR:
3221 /* WM_UNICHAR looks promising from the docs, but the exact
3222 circumstances in which TranslateMessage sends it is one of those
3223 Microsoft secret API things that EU and US courts are supposed
3224 to have put a stop to already. Spy++ shows it being sent to Notepad
3225 and other MS apps, but never to Emacs.
3227 Some third party IMEs send it in accordance with the official
3228 documentation though, so handle it here.
3230 UNICODE_NOCHAR is used to test for support for this message.
3231 TRUE indicates that the message is supported. */
3232 if (wParam == UNICODE_NOCHAR)
3233 return TRUE;
3236 W32Msg wmsg;
3237 wmsg.dwModifiers = w32_get_key_modifiers (wParam, lParam);
3238 signal_user_input ();
3239 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3241 break;
3243 case WM_IME_CHAR:
3244 /* If we can't get the IME result as unicode, use default processing,
3245 which will at least allow characters decodable in the system locale
3246 get through. */
3247 if (!get_composition_string_fn)
3248 goto dflt;
3250 else if (!ignore_ime_char)
3252 wchar_t * buffer;
3253 int size, i;
3254 W32Msg wmsg;
3255 HIMC context = get_ime_context_fn (hwnd);
3256 wmsg.dwModifiers = w32_get_key_modifiers (wParam, lParam);
3257 /* Get buffer size. */
3258 size = get_composition_string_fn (context, GCS_RESULTSTR, buffer, 0);
3259 buffer = alloca(size);
3260 size = get_composition_string_fn (context, GCS_RESULTSTR,
3261 buffer, size);
3262 signal_user_input ();
3263 for (i = 0; i < size / sizeof (wchar_t); i++)
3265 my_post_msg (&wmsg, hwnd, WM_UNICHAR, (WPARAM) buffer[i],
3266 lParam);
3268 /* We output the whole string above, so ignore following ones
3269 until we are notified of the end of composition. */
3270 ignore_ime_char = 1;
3272 break;
3274 case WM_IME_ENDCOMPOSITION:
3275 ignore_ime_char = 0;
3276 goto dflt;
3278 /* Simulate middle mouse button events when left and right buttons
3279 are used together, but only if user has two button mouse. */
3280 case WM_LBUTTONDOWN:
3281 case WM_RBUTTONDOWN:
3282 if (w32_num_mouse_buttons > 2)
3283 goto handle_plain_button;
3286 int this = (msg == WM_LBUTTONDOWN) ? LMOUSE : RMOUSE;
3287 int other = (msg == WM_LBUTTONDOWN) ? RMOUSE : LMOUSE;
3289 if (button_state & this)
3290 return 0;
3292 if (button_state == 0)
3293 SetCapture (hwnd);
3295 button_state |= this;
3297 if (button_state & other)
3299 if (mouse_button_timer)
3301 KillTimer (hwnd, mouse_button_timer);
3302 mouse_button_timer = 0;
3304 /* Generate middle mouse event instead. */
3305 msg = WM_MBUTTONDOWN;
3306 button_state |= MMOUSE;
3308 else if (button_state & MMOUSE)
3310 /* Ignore button event if we've already generated a
3311 middle mouse down event. This happens if the
3312 user releases and press one of the two buttons
3313 after we've faked a middle mouse event. */
3314 return 0;
3316 else
3318 /* Flush out saved message. */
3319 post_msg (&saved_mouse_button_msg);
3321 wmsg.dwModifiers = w32_get_modifiers ();
3322 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3323 signal_user_input ();
3325 /* Clear message buffer. */
3326 saved_mouse_button_msg.msg.hwnd = 0;
3328 else
3330 /* Hold onto message for now. */
3331 mouse_button_timer =
3332 SetTimer (hwnd, MOUSE_BUTTON_ID,
3333 w32_mouse_button_tolerance, NULL);
3334 saved_mouse_button_msg.msg.hwnd = hwnd;
3335 saved_mouse_button_msg.msg.message = msg;
3336 saved_mouse_button_msg.msg.wParam = wParam;
3337 saved_mouse_button_msg.msg.lParam = lParam;
3338 saved_mouse_button_msg.msg.time = GetMessageTime ();
3339 saved_mouse_button_msg.dwModifiers = w32_get_modifiers ();
3342 return 0;
3344 case WM_LBUTTONUP:
3345 case WM_RBUTTONUP:
3346 if (w32_num_mouse_buttons > 2)
3347 goto handle_plain_button;
3350 int this = (msg == WM_LBUTTONUP) ? LMOUSE : RMOUSE;
3351 int other = (msg == WM_LBUTTONUP) ? RMOUSE : LMOUSE;
3353 if ((button_state & this) == 0)
3354 return 0;
3356 button_state &= ~this;
3358 if (button_state & MMOUSE)
3360 /* Only generate event when second button is released. */
3361 if ((button_state & other) == 0)
3363 msg = WM_MBUTTONUP;
3364 button_state &= ~MMOUSE;
3366 if (button_state) abort ();
3368 else
3369 return 0;
3371 else
3373 /* Flush out saved message if necessary. */
3374 if (saved_mouse_button_msg.msg.hwnd)
3376 post_msg (&saved_mouse_button_msg);
3379 wmsg.dwModifiers = w32_get_modifiers ();
3380 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3381 signal_user_input ();
3383 /* Always clear message buffer and cancel timer. */
3384 saved_mouse_button_msg.msg.hwnd = 0;
3385 KillTimer (hwnd, mouse_button_timer);
3386 mouse_button_timer = 0;
3388 if (button_state == 0)
3389 ReleaseCapture ();
3391 return 0;
3393 case WM_XBUTTONDOWN:
3394 case WM_XBUTTONUP:
3395 if (w32_pass_extra_mouse_buttons_to_system)
3396 goto dflt;
3397 /* else fall through and process them. */
3398 case WM_MBUTTONDOWN:
3399 case WM_MBUTTONUP:
3400 handle_plain_button:
3402 BOOL up;
3403 int button;
3405 /* Ignore middle and extra buttons as long as the menu is active. */
3406 f = x_window_to_frame (dpyinfo, hwnd);
3407 if (f && f->output_data.w32->menubar_active)
3408 return 0;
3410 if (parse_button (msg, HIWORD (wParam), &button, &up))
3412 if (up) ReleaseCapture ();
3413 else SetCapture (hwnd);
3414 button = (button == 0) ? LMOUSE :
3415 ((button == 1) ? MMOUSE : RMOUSE);
3416 if (up)
3417 button_state &= ~button;
3418 else
3419 button_state |= button;
3423 wmsg.dwModifiers = w32_get_modifiers ();
3424 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3425 signal_user_input ();
3427 /* Need to return true for XBUTTON messages, false for others,
3428 to indicate that we processed the message. */
3429 return (msg == WM_XBUTTONDOWN || msg == WM_XBUTTONUP);
3431 case WM_MOUSEMOVE:
3432 /* Ignore mouse movements as long as the menu is active. These
3433 movements are processed by the window manager anyway, and
3434 it's wrong to handle them as if they happened on the
3435 underlying frame. */
3436 f = x_window_to_frame (dpyinfo, hwnd);
3437 if (f && f->output_data.w32->menubar_active)
3438 return 0;
3440 /* If the mouse has just moved into the frame, start tracking
3441 it, so we will be notified when it leaves the frame. Mouse
3442 tracking only works under W98 and NT4 and later. On earlier
3443 versions, there is no way of telling when the mouse leaves the
3444 frame, so we just have to put up with help-echo and mouse
3445 highlighting remaining while the frame is not active. */
3446 if (track_mouse_event_fn && !track_mouse_window)
3448 TRACKMOUSEEVENT tme;
3449 tme.cbSize = sizeof (tme);
3450 tme.dwFlags = TME_LEAVE;
3451 tme.hwndTrack = hwnd;
3453 track_mouse_event_fn (&tme);
3454 track_mouse_window = hwnd;
3456 case WM_VSCROLL:
3457 if (w32_mouse_move_interval <= 0
3458 || (msg == WM_MOUSEMOVE && button_state == 0))
3460 wmsg.dwModifiers = w32_get_modifiers ();
3461 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3462 return 0;
3465 /* Hang onto mouse move and scroll messages for a bit, to avoid
3466 sending such events to Emacs faster than it can process them.
3467 If we get more events before the timer from the first message
3468 expires, we just replace the first message. */
3470 if (saved_mouse_move_msg.msg.hwnd == 0)
3471 mouse_move_timer =
3472 SetTimer (hwnd, MOUSE_MOVE_ID,
3473 w32_mouse_move_interval, NULL);
3475 /* Hold onto message for now. */
3476 saved_mouse_move_msg.msg.hwnd = hwnd;
3477 saved_mouse_move_msg.msg.message = msg;
3478 saved_mouse_move_msg.msg.wParam = wParam;
3479 saved_mouse_move_msg.msg.lParam = lParam;
3480 saved_mouse_move_msg.msg.time = GetMessageTime ();
3481 saved_mouse_move_msg.dwModifiers = w32_get_modifiers ();
3483 return 0;
3485 case WM_MOUSEWHEEL:
3486 case WM_DROPFILES:
3487 wmsg.dwModifiers = w32_get_modifiers ();
3488 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3489 signal_user_input ();
3490 return 0;
3492 case WM_APPCOMMAND:
3493 if (w32_pass_multimedia_buttons_to_system)
3494 goto dflt;
3495 /* Otherwise, pass to lisp, the same way we do with mousehwheel. */
3496 case WM_MOUSEHWHEEL:
3497 wmsg.dwModifiers = w32_get_modifiers ();
3498 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3499 signal_user_input ();
3500 /* Non-zero must be returned when WM_MOUSEHWHEEL messages are
3501 handled, to prevent the system trying to handle it by faking
3502 scroll bar events. */
3503 return 1;
3505 case WM_TIMER:
3506 /* Flush out saved messages if necessary. */
3507 if (wParam == mouse_button_timer)
3509 if (saved_mouse_button_msg.msg.hwnd)
3511 post_msg (&saved_mouse_button_msg);
3512 signal_user_input ();
3513 saved_mouse_button_msg.msg.hwnd = 0;
3515 KillTimer (hwnd, mouse_button_timer);
3516 mouse_button_timer = 0;
3518 else if (wParam == mouse_move_timer)
3520 if (saved_mouse_move_msg.msg.hwnd)
3522 post_msg (&saved_mouse_move_msg);
3523 saved_mouse_move_msg.msg.hwnd = 0;
3525 KillTimer (hwnd, mouse_move_timer);
3526 mouse_move_timer = 0;
3528 else if (wParam == menu_free_timer)
3530 KillTimer (hwnd, menu_free_timer);
3531 menu_free_timer = 0;
3532 f = x_window_to_frame (dpyinfo, hwnd);
3533 /* If a popup menu is active, don't wipe its strings. */
3534 if (menubar_in_use
3535 && current_popup_menu == NULL)
3537 /* Free memory used by owner-drawn and help-echo strings. */
3538 w32_free_menu_strings (hwnd);
3539 f->output_data.w32->menubar_active = 0;
3540 menubar_in_use = 0;
3543 else if (wParam == hourglass_timer)
3545 KillTimer (hwnd, hourglass_timer);
3546 hourglass_timer = 0;
3547 show_hourglass (x_window_to_frame (dpyinfo, hwnd));
3549 return 0;
3551 case WM_NCACTIVATE:
3552 /* Windows doesn't send us focus messages when putting up and
3553 taking down a system popup dialog as for Ctrl-Alt-Del on Windows 95.
3554 The only indication we get that something happened is receiving
3555 this message afterwards. So this is a good time to reset our
3556 keyboard modifiers' state. */
3557 reset_modifiers ();
3558 goto dflt;
3560 case WM_INITMENU:
3561 button_state = 0;
3562 ReleaseCapture ();
3563 /* We must ensure menu bar is fully constructed and up to date
3564 before allowing user interaction with it. To achieve this
3565 we send this message to the lisp thread and wait for a
3566 reply (whose value is not actually needed) to indicate that
3567 the menu bar is now ready for use, so we can now return.
3569 To remain responsive in the meantime, we enter a nested message
3570 loop that can process all other messages.
3572 However, we skip all this if the message results from calling
3573 TrackPopupMenu - in fact, we must NOT attempt to send the lisp
3574 thread a message because it is blocked on us at this point. We
3575 set menubar_active before calling TrackPopupMenu to indicate
3576 this (there is no possibility of confusion with real menubar
3577 being active). */
3579 f = x_window_to_frame (dpyinfo, hwnd);
3580 if (f
3581 && (f->output_data.w32->menubar_active
3582 /* We can receive this message even in the absence of a
3583 menubar (ie. when the system menu is activated) - in this
3584 case we do NOT want to forward the message, otherwise it
3585 will cause the menubar to suddenly appear when the user
3586 had requested it to be turned off! */
3587 || f->output_data.w32->menubar_widget == NULL))
3588 return 0;
3591 deferred_msg msg_buf;
3593 /* Detect if message has already been deferred; in this case
3594 we cannot return any sensible value to ignore this. */
3595 if (find_deferred_msg (hwnd, msg) != NULL)
3596 abort ();
3598 menubar_in_use = 1;
3600 return send_deferred_msg (&msg_buf, hwnd, msg, wParam, lParam);
3603 case WM_EXITMENULOOP:
3604 f = x_window_to_frame (dpyinfo, hwnd);
3606 /* If a menu is still active, check again after a short delay,
3607 since Windows often (always?) sends the WM_EXITMENULOOP
3608 before the corresponding WM_COMMAND message.
3609 Don't do this if a popup menu is active, since it is only
3610 menubar menus that require cleaning up in this way.
3612 if (f && menubar_in_use && current_popup_menu == NULL)
3613 menu_free_timer = SetTimer (hwnd, MENU_FREE_ID, MENU_FREE_DELAY, NULL);
3615 /* If hourglass cursor should be displayed, display it now. */
3616 if (f && f->output_data.w32->hourglass_p)
3617 SetCursor (f->output_data.w32->hourglass_cursor);
3619 goto dflt;
3621 case WM_MENUSELECT:
3622 /* Direct handling of help_echo in menus. Should be safe now
3623 that we generate the help_echo by placing a help event in the
3624 keyboard buffer. */
3626 HMENU menu = (HMENU) lParam;
3627 UINT menu_item = (UINT) LOWORD (wParam);
3628 UINT flags = (UINT) HIWORD (wParam);
3630 w32_menu_display_help (hwnd, menu, menu_item, flags);
3632 return 0;
3634 case WM_MEASUREITEM:
3635 f = x_window_to_frame (dpyinfo, hwnd);
3636 if (f)
3638 MEASUREITEMSTRUCT * pMis = (MEASUREITEMSTRUCT *) lParam;
3640 if (pMis->CtlType == ODT_MENU)
3642 /* Work out dimensions for popup menu titles. */
3643 char * title = (char *) pMis->itemData;
3644 HDC hdc = GetDC (hwnd);
3645 HFONT menu_font = GetCurrentObject (hdc, OBJ_FONT);
3646 LOGFONT menu_logfont;
3647 HFONT old_font;
3648 SIZE size;
3650 GetObject (menu_font, sizeof (menu_logfont), &menu_logfont);
3651 menu_logfont.lfWeight = FW_BOLD;
3652 menu_font = CreateFontIndirect (&menu_logfont);
3653 old_font = SelectObject (hdc, menu_font);
3655 pMis->itemHeight = GetSystemMetrics (SM_CYMENUSIZE);
3656 if (title)
3658 if (unicode_append_menu)
3659 GetTextExtentPoint32W (hdc, (WCHAR *) title,
3660 wcslen ((WCHAR *) title),
3661 &size);
3662 else
3663 GetTextExtentPoint32 (hdc, title, strlen (title), &size);
3665 pMis->itemWidth = size.cx;
3666 if (pMis->itemHeight < size.cy)
3667 pMis->itemHeight = size.cy;
3669 else
3670 pMis->itemWidth = 0;
3672 SelectObject (hdc, old_font);
3673 DeleteObject (menu_font);
3674 ReleaseDC (hwnd, hdc);
3675 return TRUE;
3678 return 0;
3680 case WM_DRAWITEM:
3681 f = x_window_to_frame (dpyinfo, hwnd);
3682 if (f)
3684 DRAWITEMSTRUCT * pDis = (DRAWITEMSTRUCT *) lParam;
3686 if (pDis->CtlType == ODT_MENU)
3688 /* Draw popup menu title. */
3689 char * title = (char *) pDis->itemData;
3690 if (title)
3692 HDC hdc = pDis->hDC;
3693 HFONT menu_font = GetCurrentObject (hdc, OBJ_FONT);
3694 LOGFONT menu_logfont;
3695 HFONT old_font;
3697 GetObject (menu_font, sizeof (menu_logfont), &menu_logfont);
3698 menu_logfont.lfWeight = FW_BOLD;
3699 menu_font = CreateFontIndirect (&menu_logfont);
3700 old_font = SelectObject (hdc, menu_font);
3702 /* Always draw title as if not selected. */
3703 if (unicode_append_menu)
3704 ExtTextOutW (hdc,
3705 pDis->rcItem.left
3706 + GetSystemMetrics (SM_CXMENUCHECK),
3707 pDis->rcItem.top,
3708 ETO_OPAQUE, &pDis->rcItem,
3709 (WCHAR *) title,
3710 wcslen ((WCHAR *) title), NULL);
3711 else
3712 ExtTextOut (hdc,
3713 pDis->rcItem.left
3714 + GetSystemMetrics (SM_CXMENUCHECK),
3715 pDis->rcItem.top,
3716 ETO_OPAQUE, &pDis->rcItem,
3717 title, strlen (title), NULL);
3719 SelectObject (hdc, old_font);
3720 DeleteObject (menu_font);
3722 return TRUE;
3725 return 0;
3727 #if 0
3728 /* Still not right - can't distinguish between clicks in the
3729 client area of the frame from clicks forwarded from the scroll
3730 bars - may have to hook WM_NCHITTEST to remember the mouse
3731 position and then check if it is in the client area ourselves. */
3732 case WM_MOUSEACTIVATE:
3733 /* Discard the mouse click that activates a frame, allowing the
3734 user to click anywhere without changing point (or worse!).
3735 Don't eat mouse clicks on scrollbars though!! */
3736 if (LOWORD (lParam) == HTCLIENT )
3737 return MA_ACTIVATEANDEAT;
3738 goto dflt;
3739 #endif
3741 case WM_MOUSELEAVE:
3742 /* No longer tracking mouse. */
3743 track_mouse_window = NULL;
3745 case WM_ACTIVATEAPP:
3746 case WM_ACTIVATE:
3747 case WM_WINDOWPOSCHANGED:
3748 case WM_SHOWWINDOW:
3749 /* Inform lisp thread that a frame might have just been obscured
3750 or exposed, so should recheck visibility of all frames. */
3751 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3752 goto dflt;
3754 case WM_SETFOCUS:
3755 dpyinfo->faked_key = 0;
3756 reset_modifiers ();
3757 register_hot_keys (hwnd);
3758 goto command;
3759 case WM_KILLFOCUS:
3760 unregister_hot_keys (hwnd);
3761 button_state = 0;
3762 ReleaseCapture ();
3763 /* Relinquish the system caret. */
3764 if (w32_system_caret_hwnd)
3766 w32_visible_system_caret_hwnd = NULL;
3767 w32_system_caret_hwnd = NULL;
3768 DestroyCaret ();
3770 goto command;
3771 case WM_COMMAND:
3772 menubar_in_use = 0;
3773 f = x_window_to_frame (dpyinfo, hwnd);
3774 if (f && HIWORD (wParam) == 0)
3776 if (menu_free_timer)
3778 KillTimer (hwnd, menu_free_timer);
3779 menu_free_timer = 0;
3782 case WM_MOVE:
3783 case WM_SIZE:
3784 command:
3785 wmsg.dwModifiers = w32_get_modifiers ();
3786 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3787 goto dflt;
3789 case WM_DESTROY:
3790 CoUninitialize ();
3791 return 0;
3793 case WM_CLOSE:
3794 wmsg.dwModifiers = w32_get_modifiers ();
3795 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3796 return 0;
3798 case WM_WINDOWPOSCHANGING:
3799 /* Don't restrict the sizing of tip frames. */
3800 if (hwnd == tip_window)
3801 return 0;
3803 WINDOWPLACEMENT wp;
3804 LPWINDOWPOS lppos = (WINDOWPOS *) lParam;
3806 wp.length = sizeof (WINDOWPLACEMENT);
3807 GetWindowPlacement (hwnd, &wp);
3809 if (wp.showCmd != SW_SHOWMINIMIZED && (lppos->flags & SWP_NOSIZE) == 0)
3811 RECT rect;
3812 int wdiff;
3813 int hdiff;
3814 DWORD font_width;
3815 DWORD line_height;
3816 DWORD internal_border;
3817 DWORD scrollbar_extra;
3818 RECT wr;
3820 wp.length = sizeof (wp);
3821 GetWindowRect (hwnd, &wr);
3823 enter_crit ();
3825 font_width = GetWindowLong (hwnd, WND_FONTWIDTH_INDEX);
3826 line_height = GetWindowLong (hwnd, WND_LINEHEIGHT_INDEX);
3827 internal_border = GetWindowLong (hwnd, WND_BORDER_INDEX);
3828 scrollbar_extra = GetWindowLong (hwnd, WND_SCROLLBAR_INDEX);
3830 leave_crit ();
3832 memset (&rect, 0, sizeof (rect));
3833 AdjustWindowRect (&rect, GetWindowLong (hwnd, GWL_STYLE),
3834 GetMenu (hwnd) != NULL);
3836 /* Force width and height of client area to be exact
3837 multiples of the character cell dimensions. */
3838 wdiff = (lppos->cx - (rect.right - rect.left)
3839 - 2 * internal_border - scrollbar_extra)
3840 % font_width;
3841 hdiff = (lppos->cy - (rect.bottom - rect.top)
3842 - 2 * internal_border)
3843 % line_height;
3845 if (wdiff || hdiff)
3847 /* For right/bottom sizing we can just fix the sizes.
3848 However for top/left sizing we will need to fix the X
3849 and Y positions as well. */
3851 int cx_mintrack = GetSystemMetrics (SM_CXMINTRACK);
3852 int cy_mintrack = GetSystemMetrics (SM_CYMINTRACK);
3854 lppos->cx = max (lppos->cx - wdiff, cx_mintrack);
3855 lppos->cy = max (lppos->cy - hdiff, cy_mintrack);
3857 if (wp.showCmd != SW_SHOWMAXIMIZED
3858 && (lppos->flags & SWP_NOMOVE) == 0)
3860 if (lppos->x != wr.left || lppos->y != wr.top)
3862 lppos->x += wdiff;
3863 lppos->y += hdiff;
3865 else
3867 lppos->flags |= SWP_NOMOVE;
3871 return 0;
3876 goto dflt;
3878 case WM_GETMINMAXINFO:
3879 /* Hack to allow resizing the Emacs frame above the screen size.
3880 Note that Windows 9x limits coordinates to 16-bits. */
3881 ((LPMINMAXINFO) lParam)->ptMaxTrackSize.x = 32767;
3882 ((LPMINMAXINFO) lParam)->ptMaxTrackSize.y = 32767;
3883 return 0;
3885 case WM_SETCURSOR:
3886 if (LOWORD (lParam) == HTCLIENT)
3888 f = x_window_to_frame (dpyinfo, hwnd);
3889 if (f->output_data.w32->hourglass_p && !menubar_in_use
3890 && !current_popup_menu)
3891 SetCursor (f->output_data.w32->hourglass_cursor);
3892 else
3893 SetCursor (f->output_data.w32->current_cursor);
3894 return 0;
3896 goto dflt;
3898 case WM_EMACS_SETCURSOR:
3900 Cursor cursor = (Cursor) wParam;
3901 f = x_window_to_frame (dpyinfo, hwnd);
3902 if (f && cursor)
3904 f->output_data.w32->current_cursor = cursor;
3905 if (!f->output_data.w32->hourglass_p)
3906 SetCursor (cursor);
3908 return 0;
3911 case WM_EMACS_CREATESCROLLBAR:
3912 return (LRESULT) w32_createscrollbar ((struct frame *) wParam,
3913 (struct scroll_bar *) lParam);
3915 case WM_EMACS_SHOWWINDOW:
3916 return ShowWindow ((HWND) wParam, (WPARAM) lParam);
3918 case WM_EMACS_SETFOREGROUND:
3920 HWND foreground_window;
3921 DWORD foreground_thread, retval;
3923 /* On NT 5.0, and apparently Windows 98, it is necessary to
3924 attach to the thread that currently has focus in order to
3925 pull the focus away from it. */
3926 foreground_window = GetForegroundWindow ();
3927 foreground_thread = GetWindowThreadProcessId (foreground_window, NULL);
3928 if (!foreground_window
3929 || foreground_thread == GetCurrentThreadId ()
3930 || !AttachThreadInput (GetCurrentThreadId (),
3931 foreground_thread, TRUE))
3932 foreground_thread = 0;
3934 retval = SetForegroundWindow ((HWND) wParam);
3936 /* Detach from the previous foreground thread. */
3937 if (foreground_thread)
3938 AttachThreadInput (GetCurrentThreadId (),
3939 foreground_thread, FALSE);
3941 return retval;
3944 case WM_EMACS_SETWINDOWPOS:
3946 WINDOWPOS * pos = (WINDOWPOS *) wParam;
3947 return SetWindowPos (hwnd, pos->hwndInsertAfter,
3948 pos->x, pos->y, pos->cx, pos->cy, pos->flags);
3951 case WM_EMACS_DESTROYWINDOW:
3952 DragAcceptFiles ((HWND) wParam, FALSE);
3953 return DestroyWindow ((HWND) wParam);
3955 case WM_EMACS_HIDE_CARET:
3956 return HideCaret (hwnd);
3958 case WM_EMACS_SHOW_CARET:
3959 return ShowCaret (hwnd);
3961 case WM_EMACS_DESTROY_CARET:
3962 w32_system_caret_hwnd = NULL;
3963 w32_visible_system_caret_hwnd = NULL;
3964 return DestroyCaret ();
3966 case WM_EMACS_TRACK_CARET:
3967 /* If there is currently no system caret, create one. */
3968 if (w32_system_caret_hwnd == NULL)
3970 /* Use the default caret width, and avoid changing it
3971 unneccesarily, as it confuses screen reader software. */
3972 w32_system_caret_hwnd = hwnd;
3973 CreateCaret (hwnd, NULL, 0,
3974 w32_system_caret_height);
3977 if (!SetCaretPos (w32_system_caret_x, w32_system_caret_y))
3978 return 0;
3979 /* Ensure visible caret gets turned on when requested. */
3980 else if (w32_use_visible_system_caret
3981 && w32_visible_system_caret_hwnd != hwnd)
3983 w32_visible_system_caret_hwnd = hwnd;
3984 return ShowCaret (hwnd);
3986 /* Ensure visible caret gets turned off when requested. */
3987 else if (!w32_use_visible_system_caret
3988 && w32_visible_system_caret_hwnd)
3990 w32_visible_system_caret_hwnd = NULL;
3991 return HideCaret (hwnd);
3993 else
3994 return 1;
3996 case WM_EMACS_TRACKPOPUPMENU:
3998 UINT flags;
3999 POINT *pos;
4000 int retval;
4001 pos = (POINT *)lParam;
4002 flags = TPM_CENTERALIGN;
4003 if (button_state & LMOUSE)
4004 flags |= TPM_LEFTBUTTON;
4005 else if (button_state & RMOUSE)
4006 flags |= TPM_RIGHTBUTTON;
4008 /* Remember we did a SetCapture on the initial mouse down event,
4009 so for safety, we make sure the capture is cancelled now. */
4010 ReleaseCapture ();
4011 button_state = 0;
4013 /* Use menubar_active to indicate that WM_INITMENU is from
4014 TrackPopupMenu below, and should be ignored. */
4015 f = x_window_to_frame (dpyinfo, hwnd);
4016 if (f)
4017 f->output_data.w32->menubar_active = 1;
4019 if (TrackPopupMenu ((HMENU)wParam, flags, pos->x, pos->y,
4020 0, hwnd, NULL))
4022 MSG amsg;
4023 /* Eat any mouse messages during popupmenu */
4024 while (PeekMessage (&amsg, hwnd, WM_MOUSEFIRST, WM_MOUSELAST,
4025 PM_REMOVE));
4026 /* Get the menu selection, if any */
4027 if (PeekMessage (&amsg, hwnd, WM_COMMAND, WM_COMMAND, PM_REMOVE))
4029 retval = LOWORD (amsg.wParam);
4031 else
4033 retval = 0;
4036 else
4038 retval = -1;
4041 return retval;
4044 default:
4045 /* Check for messages registered at runtime. */
4046 if (msg == msh_mousewheel)
4048 wmsg.dwModifiers = w32_get_modifiers ();
4049 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4050 signal_user_input ();
4051 return 0;
4054 dflt:
4055 return DefWindowProc (hwnd, msg, wParam, lParam);
4059 /* The most common default return code for handled messages is 0. */
4060 return 0;
4063 static void
4064 my_create_window (f)
4065 struct frame * f;
4067 MSG msg;
4069 if (!PostThreadMessage (dwWindowsThreadId, WM_EMACS_CREATEWINDOW, (WPARAM)f, 0))
4070 abort ();
4071 GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE);
4075 /* Create a tooltip window. Unlike my_create_window, we do not do this
4076 indirectly via the Window thread, as we do not need to process Window
4077 messages for the tooltip. Creating tooltips indirectly also creates
4078 deadlocks when tooltips are created for menu items. */
4079 static void
4080 my_create_tip_window (f)
4081 struct frame *f;
4083 RECT rect;
4085 rect.left = rect.top = 0;
4086 rect.right = FRAME_PIXEL_WIDTH (f);
4087 rect.bottom = FRAME_PIXEL_HEIGHT (f);
4089 AdjustWindowRect (&rect, f->output_data.w32->dwStyle,
4090 FRAME_EXTERNAL_MENU_BAR (f));
4092 tip_window = FRAME_W32_WINDOW (f)
4093 = CreateWindow (EMACS_CLASS,
4094 f->namebuf,
4095 f->output_data.w32->dwStyle,
4096 f->left_pos,
4097 f->top_pos,
4098 rect.right - rect.left,
4099 rect.bottom - rect.top,
4100 FRAME_W32_WINDOW (SELECTED_FRAME ()), /* owner */
4101 NULL,
4102 hinst,
4103 NULL);
4105 if (tip_window)
4107 SetWindowLong (tip_window, WND_FONTWIDTH_INDEX, FRAME_COLUMN_WIDTH (f));
4108 SetWindowLong (tip_window, WND_LINEHEIGHT_INDEX, FRAME_LINE_HEIGHT (f));
4109 SetWindowLong (tip_window, WND_BORDER_INDEX, FRAME_INTERNAL_BORDER_WIDTH (f));
4110 SetWindowLong (tip_window, WND_BACKGROUND_INDEX, FRAME_BACKGROUND_PIXEL (f));
4112 /* Tip frames have no scrollbars. */
4113 SetWindowLong (tip_window, WND_SCROLLBAR_INDEX, 0);
4115 /* Do this to discard the default setting specified by our parent. */
4116 ShowWindow (tip_window, SW_HIDE);
4121 /* Create and set up the w32 window for frame F. */
4123 static void
4124 w32_window (f, window_prompting, minibuffer_only)
4125 struct frame *f;
4126 long window_prompting;
4127 int minibuffer_only;
4129 BLOCK_INPUT;
4131 /* Use the resource name as the top-level window name
4132 for looking up resources. Make a non-Lisp copy
4133 for the window manager, so GC relocation won't bother it.
4135 Elsewhere we specify the window name for the window manager. */
4138 char *str = (char *) SDATA (Vx_resource_name);
4139 f->namebuf = (char *) xmalloc (strlen (str) + 1);
4140 strcpy (f->namebuf, str);
4143 my_create_window (f);
4145 validate_x_resource_name ();
4147 /* x_set_name normally ignores requests to set the name if the
4148 requested name is the same as the current name. This is the one
4149 place where that assumption isn't correct; f->name is set, but
4150 the server hasn't been told. */
4152 Lisp_Object name;
4153 int explicit = f->explicit_name;
4155 f->explicit_name = 0;
4156 name = f->name;
4157 f->name = Qnil;
4158 x_set_name (f, name, explicit);
4161 UNBLOCK_INPUT;
4163 if (!minibuffer_only && FRAME_EXTERNAL_MENU_BAR (f))
4164 initialize_frame_menubar (f);
4166 if (FRAME_W32_WINDOW (f) == 0)
4167 error ("Unable to create window");
4170 /* Handle the icon stuff for this window. Perhaps later we might
4171 want an x_set_icon_position which can be called interactively as
4172 well. */
4174 static void
4175 x_icon (f, parms)
4176 struct frame *f;
4177 Lisp_Object parms;
4179 Lisp_Object icon_x, icon_y;
4181 /* Set the position of the icon. Note that Windows 95 groups all
4182 icons in the tray. */
4183 icon_x = w32_get_arg (parms, Qicon_left, 0, 0, RES_TYPE_NUMBER);
4184 icon_y = w32_get_arg (parms, Qicon_top, 0, 0, RES_TYPE_NUMBER);
4185 if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
4187 CHECK_NUMBER (icon_x);
4188 CHECK_NUMBER (icon_y);
4190 else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
4191 error ("Both left and top icon corners of icon must be specified");
4193 BLOCK_INPUT;
4195 if (! EQ (icon_x, Qunbound))
4196 x_wm_set_icon_position (f, XINT (icon_x), XINT (icon_y));
4198 #if 0 /* TODO */
4199 /* Start up iconic or window? */
4200 x_wm_set_window_state
4201 (f, (EQ (w32_get_arg (parms, Qvisibility, 0, 0, RES_TYPE_SYMBOL), Qicon)
4202 ? IconicState
4203 : NormalState));
4205 x_text_icon (f, (char *) SDATA ((!NILP (f->icon_name)
4206 ? f->icon_name
4207 : f->name)));
4208 #endif
4210 UNBLOCK_INPUT;
4214 static void
4215 x_make_gc (f)
4216 struct frame *f;
4218 XGCValues gc_values;
4220 BLOCK_INPUT;
4222 /* Create the GC's of this frame.
4223 Note that many default values are used. */
4225 /* Normal video */
4226 gc_values.font = FRAME_FONT (f);
4228 /* Cursor has cursor-color background, background-color foreground. */
4229 gc_values.foreground = FRAME_BACKGROUND_PIXEL (f);
4230 gc_values.background = f->output_data.w32->cursor_pixel;
4231 f->output_data.w32->cursor_gc
4232 = XCreateGC (NULL, FRAME_W32_WINDOW (f),
4233 (GCFont | GCForeground | GCBackground),
4234 &gc_values);
4236 /* Reliefs. */
4237 f->output_data.w32->white_relief.gc = 0;
4238 f->output_data.w32->black_relief.gc = 0;
4240 UNBLOCK_INPUT;
4244 /* Handler for signals raised during x_create_frame and
4245 x_create_top_frame. FRAME is the frame which is partially
4246 constructed. */
4248 static Lisp_Object
4249 unwind_create_frame (frame)
4250 Lisp_Object frame;
4252 struct frame *f = XFRAME (frame);
4254 /* If frame is ``official'', nothing to do. */
4255 if (!CONSP (Vframe_list) || !EQ (XCAR (Vframe_list), frame))
4257 #ifdef GLYPH_DEBUG
4258 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
4259 #endif
4261 x_free_frame_resources (f);
4263 /* Check that reference counts are indeed correct. */
4264 xassert (dpyinfo->reference_count == dpyinfo_refcount);
4265 xassert (dpyinfo->image_cache->refcount == image_cache_refcount);
4267 return Qt;
4270 return Qnil;
4273 #ifdef USE_FONT_BACKEND
4274 static void
4275 x_default_font_parameter (f, parms)
4276 struct frame *f;
4277 Lisp_Object parms;
4279 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
4280 Lisp_Object font = x_get_arg (dpyinfo, parms, Qfont, "font", "Font",
4281 RES_TYPE_STRING);
4283 if (!STRINGP (font))
4285 int i;
4286 static char *names[]
4287 = { "Courier New-10",
4288 "-*-Courier-normal-r-*-*-13-*-*-*-c-*-iso8859-1",
4289 "-*-Fixedsys-normal-r-*-*-12-*-*-*-c-*-iso8859-1",
4290 "Fixedsys",
4291 NULL };
4293 for (i = 0; names[i]; i++)
4295 font = font_open_by_name (f, names[i]);
4296 if (! NILP (font))
4297 break;
4299 if (NILP (font))
4300 error ("No suitable font was found");
4302 x_default_parameter (f, parms, Qfont, font, "font", "Font", RES_TYPE_STRING);
4304 #endif
4306 DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
4307 1, 1, 0,
4308 doc: /* Make a new window, which is called a \"frame\" in Emacs terms.
4309 Return an Emacs frame object.
4310 PARAMETERS is an alist of frame parameters.
4311 If the parameters specify that the frame should not have a minibuffer,
4312 and do not specify a specific minibuffer window to use,
4313 then `default-minibuffer-frame' must be a frame whose minibuffer can
4314 be shared by the new frame.
4316 This function is an internal primitive--use `make-frame' instead. */)
4317 (parameters)
4318 Lisp_Object parameters;
4320 struct frame *f;
4321 Lisp_Object frame, tem;
4322 Lisp_Object name;
4323 int minibuffer_only = 0;
4324 long window_prompting = 0;
4325 int width, height;
4326 int count = SPECPDL_INDEX ();
4327 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
4328 Lisp_Object display;
4329 struct w32_display_info *dpyinfo = NULL;
4330 Lisp_Object parent;
4331 struct kboard *kb;
4333 check_w32 ();
4335 /* Make copy of frame parameters because the original is in pure
4336 storage now. */
4337 parameters = Fcopy_alist (parameters);
4339 /* Use this general default value to start with
4340 until we know if this frame has a specified name. */
4341 Vx_resource_name = Vinvocation_name;
4343 display = w32_get_arg (parameters, Qdisplay, 0, 0, RES_TYPE_STRING);
4344 if (EQ (display, Qunbound))
4345 display = Qnil;
4346 dpyinfo = check_x_display_info (display);
4347 #ifdef MULTI_KBOARD
4348 kb = dpyinfo->terminal->kboard;
4349 #else
4350 kb = &the_only_kboard;
4351 #endif
4353 name = w32_get_arg (parameters, Qname, "name", "Name", RES_TYPE_STRING);
4354 if (!STRINGP (name)
4355 && ! EQ (name, Qunbound)
4356 && ! NILP (name))
4357 error ("Invalid frame name--not a string or nil");
4359 if (STRINGP (name))
4360 Vx_resource_name = name;
4362 /* See if parent window is specified. */
4363 parent = w32_get_arg (parameters, Qparent_id, NULL, NULL, RES_TYPE_NUMBER);
4364 if (EQ (parent, Qunbound))
4365 parent = Qnil;
4366 if (! NILP (parent))
4367 CHECK_NUMBER (parent);
4369 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
4370 /* No need to protect DISPLAY because that's not used after passing
4371 it to make_frame_without_minibuffer. */
4372 frame = Qnil;
4373 GCPRO4 (parameters, parent, name, frame);
4374 tem = w32_get_arg (parameters, Qminibuffer, "minibuffer", "Minibuffer",
4375 RES_TYPE_SYMBOL);
4376 if (EQ (tem, Qnone) || NILP (tem))
4377 f = make_frame_without_minibuffer (Qnil, kb, display);
4378 else if (EQ (tem, Qonly))
4380 f = make_minibuffer_frame ();
4381 minibuffer_only = 1;
4383 else if (WINDOWP (tem))
4384 f = make_frame_without_minibuffer (tem, kb, display);
4385 else
4386 f = make_frame (1);
4388 XSETFRAME (frame, f);
4390 /* Note that Windows does support scroll bars. */
4391 FRAME_CAN_HAVE_SCROLL_BARS (f) = 1;
4393 /* By default, make scrollbars the system standard width. */
4394 FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = GetSystemMetrics (SM_CXVSCROLL);
4396 f->terminal = dpyinfo->terminal;
4397 f->terminal->reference_count++;
4399 f->output_method = output_w32;
4400 f->output_data.w32 =
4401 (struct w32_output *) xmalloc (sizeof (struct w32_output));
4402 bzero (f->output_data.w32, sizeof (struct w32_output));
4403 FRAME_FONTSET (f) = -1;
4404 record_unwind_protect (unwind_create_frame, frame);
4406 f->icon_name
4407 = w32_get_arg (parameters, Qicon_name, "iconName", "Title", RES_TYPE_STRING);
4408 if (! STRINGP (f->icon_name))
4409 f->icon_name = Qnil;
4411 /* FRAME_W32_DISPLAY_INFO (f) = dpyinfo; */
4412 #ifdef MULTI_KBOARD
4413 FRAME_KBOARD (f) = kb;
4414 #endif
4416 /* Specify the parent under which to make this window. */
4418 if (!NILP (parent))
4420 f->output_data.w32->parent_desc = (Window) XFASTINT (parent);
4421 f->output_data.w32->explicit_parent = 1;
4423 else
4425 f->output_data.w32->parent_desc = FRAME_W32_DISPLAY_INFO (f)->root_window;
4426 f->output_data.w32->explicit_parent = 0;
4429 /* Set the name; the functions to which we pass f expect the name to
4430 be set. */
4431 if (EQ (name, Qunbound) || NILP (name))
4433 f->name = build_string (dpyinfo->w32_id_name);
4434 f->explicit_name = 0;
4436 else
4438 f->name = name;
4439 f->explicit_name = 1;
4440 /* use the frame's title when getting resources for this frame. */
4441 specbind (Qx_resource_name, name);
4444 f->resx = dpyinfo->resx;
4445 f->resy = dpyinfo->resy;
4447 #ifdef USE_FONT_BACKEND
4448 if (enable_font_backend)
4450 /* Perhaps, we must allow frame parameter, say `font-backend',
4451 to specify which font backends to use. */
4452 if (uniscribe_available)
4453 register_font_driver (&uniscribe_font_driver, f);
4454 register_font_driver (&w32font_driver, f);
4456 x_default_parameter (f, parameters, Qfont_backend, Qnil,
4457 "fontBackend", "FontBackend", RES_TYPE_STRING);
4459 #endif /* USE_FONT_BACKEND */
4461 /* Extract the window parameters from the supplied values
4462 that are needed to determine window geometry. */
4463 #ifdef USE_FONT_BACKEND
4464 if (enable_font_backend)
4465 x_default_font_parameter (f, parameters);
4466 else
4467 #endif
4469 Lisp_Object font;
4471 font = w32_get_arg (parameters, Qfont, "font", "Font", RES_TYPE_STRING);
4473 BLOCK_INPUT;
4474 /* First, try whatever font the caller has specified. */
4475 if (STRINGP (font))
4477 tem = Fquery_fontset (font, Qnil);
4478 if (STRINGP (tem))
4479 font = x_new_fontset (f, tem);
4480 else
4481 font = x_new_font (f, SDATA (font));
4483 /* Try out a font which we hope has bold and italic variations. */
4484 if (!STRINGP (font))
4485 font = x_new_font (f, "-*-Courier New-normal-r-*-*-*-100-*-*-c-*-iso8859-1");
4486 if (! STRINGP (font))
4487 font = x_new_font (f, "-*-Courier-normal-r-*-*-13-*-*-*-c-*-iso8859-1");
4488 /* If those didn't work, look for something which will at least work. */
4489 if (! STRINGP (font))
4490 font = x_new_font (f, "-*-Fixedsys-normal-r-*-*-12-*-*-*-c-*-iso8859-1");
4491 UNBLOCK_INPUT;
4492 if (! STRINGP (font))
4493 font = build_string ("Fixedsys");
4495 x_default_parameter (f, parameters, Qfont, font,
4496 "font", "Font", RES_TYPE_STRING);
4499 x_default_parameter (f, parameters, Qborder_width, make_number (2),
4500 "borderWidth", "BorderWidth", RES_TYPE_NUMBER);
4501 /* This defaults to 2 in order to match xterm. We recognize either
4502 internalBorderWidth or internalBorder (which is what xterm calls
4503 it). */
4504 if (NILP (Fassq (Qinternal_border_width, parameters)))
4506 Lisp_Object value;
4508 value = w32_get_arg (parameters, Qinternal_border_width,
4509 "internalBorder", "InternalBorder", RES_TYPE_NUMBER);
4510 if (! EQ (value, Qunbound))
4511 parameters = Fcons (Fcons (Qinternal_border_width, value),
4512 parameters);
4514 /* Default internalBorderWidth to 0 on Windows to match other programs. */
4515 x_default_parameter (f, parameters, Qinternal_border_width, make_number (0),
4516 "internalBorderWidth", "InternalBorder", RES_TYPE_NUMBER);
4517 x_default_parameter (f, parameters, Qvertical_scroll_bars, Qright,
4518 "verticalScrollBars", "ScrollBars", RES_TYPE_SYMBOL);
4520 /* Also do the stuff which must be set before the window exists. */
4521 x_default_parameter (f, parameters, Qforeground_color, build_string ("black"),
4522 "foreground", "Foreground", RES_TYPE_STRING);
4523 x_default_parameter (f, parameters, Qbackground_color, build_string ("white"),
4524 "background", "Background", RES_TYPE_STRING);
4525 x_default_parameter (f, parameters, Qmouse_color, build_string ("black"),
4526 "pointerColor", "Foreground", RES_TYPE_STRING);
4527 x_default_parameter (f, parameters, Qcursor_color, build_string ("black"),
4528 "cursorColor", "Foreground", RES_TYPE_STRING);
4529 x_default_parameter (f, parameters, Qborder_color, build_string ("black"),
4530 "borderColor", "BorderColor", RES_TYPE_STRING);
4531 x_default_parameter (f, parameters, Qscreen_gamma, Qnil,
4532 "screenGamma", "ScreenGamma", RES_TYPE_FLOAT);
4533 x_default_parameter (f, parameters, Qline_spacing, Qnil,
4534 "lineSpacing", "LineSpacing", RES_TYPE_NUMBER);
4535 x_default_parameter (f, parameters, Qleft_fringe, Qnil,
4536 "leftFringe", "LeftFringe", RES_TYPE_NUMBER);
4537 x_default_parameter (f, parameters, Qright_fringe, Qnil,
4538 "rightFringe", "RightFringe", RES_TYPE_NUMBER);
4541 /* Init faces before x_default_parameter is called for scroll-bar
4542 parameters because that function calls x_set_scroll_bar_width,
4543 which calls change_frame_size, which calls Fset_window_buffer,
4544 which runs hooks, which call Fvertical_motion. At the end, we
4545 end up in init_iterator with a null face cache, which should not
4546 happen. */
4547 init_frame_faces (f);
4549 x_default_parameter (f, parameters, Qmenu_bar_lines, make_number (1),
4550 "menuBar", "MenuBar", RES_TYPE_NUMBER);
4551 x_default_parameter (f, parameters, Qtool_bar_lines, make_number (1),
4552 "toolBar", "ToolBar", RES_TYPE_NUMBER);
4554 x_default_parameter (f, parameters, Qbuffer_predicate, Qnil,
4555 "bufferPredicate", "BufferPredicate", RES_TYPE_SYMBOL);
4556 x_default_parameter (f, parameters, Qtitle, Qnil,
4557 "title", "Title", RES_TYPE_STRING);
4558 x_default_parameter (f, parameters, Qfullscreen, Qnil,
4559 "fullscreen", "Fullscreen", RES_TYPE_SYMBOL);
4561 f->output_data.w32->dwStyle = WS_OVERLAPPEDWINDOW;
4562 f->output_data.w32->parent_desc = FRAME_W32_DISPLAY_INFO (f)->root_window;
4564 f->output_data.w32->text_cursor = w32_load_cursor (IDC_IBEAM);
4565 f->output_data.w32->nontext_cursor = w32_load_cursor (IDC_ARROW);
4566 f->output_data.w32->modeline_cursor = w32_load_cursor (IDC_ARROW);
4567 f->output_data.w32->hand_cursor = w32_load_cursor (IDC_HAND);
4568 f->output_data.w32->hourglass_cursor = w32_load_cursor (IDC_WAIT);
4569 f->output_data.w32->horizontal_drag_cursor = w32_load_cursor (IDC_SIZEWE);
4571 f->output_data.w32->current_cursor = f->output_data.w32->nontext_cursor;
4573 window_prompting = x_figure_window_size (f, parameters, 1);
4575 tem = w32_get_arg (parameters, Qunsplittable, 0, 0, RES_TYPE_BOOLEAN);
4576 f->no_split = minibuffer_only || EQ (tem, Qt);
4578 w32_window (f, window_prompting, minibuffer_only);
4579 x_icon (f, parameters);
4581 x_make_gc (f);
4583 /* Now consider the frame official. */
4584 FRAME_W32_DISPLAY_INFO (f)->reference_count++;
4585 Vframe_list = Fcons (frame, Vframe_list);
4587 /* We need to do this after creating the window, so that the
4588 icon-creation functions can say whose icon they're describing. */
4589 x_default_parameter (f, parameters, Qicon_type, Qnil,
4590 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL);
4592 x_default_parameter (f, parameters, Qauto_raise, Qnil,
4593 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN);
4594 x_default_parameter (f, parameters, Qauto_lower, Qnil,
4595 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN);
4596 x_default_parameter (f, parameters, Qcursor_type, Qbox,
4597 "cursorType", "CursorType", RES_TYPE_SYMBOL);
4598 x_default_parameter (f, parameters, Qscroll_bar_width, Qnil,
4599 "scrollBarWidth", "ScrollBarWidth", RES_TYPE_NUMBER);
4601 /* Dimensions, especially FRAME_LINES (f), must be done via change_frame_size.
4602 Change will not be effected unless different from the current
4603 FRAME_LINES (f). */
4604 width = FRAME_COLS (f);
4605 height = FRAME_LINES (f);
4607 FRAME_LINES (f) = 0;
4608 SET_FRAME_COLS (f, 0);
4609 change_frame_size (f, height, width, 1, 0, 0);
4611 /* Tell the server what size and position, etc, we want, and how
4612 badly we want them. This should be done after we have the menu
4613 bar so that its size can be taken into account. */
4614 BLOCK_INPUT;
4615 x_wm_set_size_hint (f, window_prompting, 0);
4616 UNBLOCK_INPUT;
4618 /* Make the window appear on the frame and enable display, unless
4619 the caller says not to. However, with explicit parent, Emacs
4620 cannot control visibility, so don't try. */
4621 if (! f->output_data.w32->explicit_parent)
4623 Lisp_Object visibility;
4625 visibility = w32_get_arg (parameters, Qvisibility, 0, 0, RES_TYPE_SYMBOL);
4626 if (EQ (visibility, Qunbound))
4627 visibility = Qt;
4629 if (EQ (visibility, Qicon))
4630 x_iconify_frame (f);
4631 else if (! NILP (visibility))
4632 x_make_frame_visible (f);
4633 else
4634 /* Must have been Qnil. */
4638 /* Initialize `default-minibuffer-frame' in case this is the first
4639 frame on this terminal. */
4640 if (FRAME_HAS_MINIBUF_P (f)
4641 && (!FRAMEP (kb->Vdefault_minibuffer_frame)
4642 || !FRAME_LIVE_P (XFRAME (kb->Vdefault_minibuffer_frame))))
4643 kb->Vdefault_minibuffer_frame = frame;
4645 /* All remaining specified parameters, which have not been "used"
4646 by x_get_arg and friends, now go in the misc. alist of the frame. */
4647 for (tem = parameters; CONSP (tem); tem = XCDR (tem))
4648 if (CONSP (XCAR (tem)) && !NILP (XCAR (XCAR (tem))))
4649 f->param_alist = Fcons (XCAR (tem), f->param_alist);
4651 UNGCPRO;
4653 /* Make sure windows on this frame appear in calls to next-window
4654 and similar functions. */
4655 Vwindow_list = Qnil;
4657 return unbind_to (count, frame);
4660 /* FRAME is used only to get a handle on the X display. We don't pass the
4661 display info directly because we're called from frame.c, which doesn't
4662 know about that structure. */
4663 Lisp_Object
4664 x_get_focus_frame (frame)
4665 struct frame *frame;
4667 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (frame);
4668 Lisp_Object xfocus;
4669 if (! dpyinfo->w32_focus_frame)
4670 return Qnil;
4672 XSETFRAME (xfocus, dpyinfo->w32_focus_frame);
4673 return xfocus;
4676 DEFUN ("x-focus-frame", Fx_focus_frame, Sx_focus_frame, 1, 1, 0,
4677 doc: /* Give FRAME input focus, raising to foreground if necessary. */)
4678 (frame)
4679 Lisp_Object frame;
4681 x_focus_on_frame (check_x_frame (frame));
4682 return Qnil;
4686 /* Return the charset portion of a font name. */
4687 char *
4688 xlfd_charset_of_font (char * fontname)
4690 char *charset, *encoding;
4692 encoding = strrchr (fontname, '-');
4693 if (!encoding || encoding == fontname)
4694 return NULL;
4696 for (charset = encoding - 1; charset >= fontname; charset--)
4697 if (*charset == '-')
4698 break;
4700 if (charset == fontname || strcmp (charset, "-*-*") == 0)
4701 return NULL;
4703 return charset + 1;
4706 struct font_info *w32_load_bdf_font (struct frame *f, char *fontname,
4707 int size, char* filename);
4708 static Lisp_Object w32_list_bdf_fonts (Lisp_Object pattern, int max_names);
4709 static BOOL w32_to_x_font (LOGFONT * lplf, char * lpxstr, int len,
4710 char * charset);
4711 static BOOL x_to_w32_font (char *lpxstr, LOGFONT *lplogfont);
4713 static struct font_info *
4714 w32_load_system_font (f, fontname, size)
4715 struct frame *f;
4716 char * fontname;
4717 int size;
4719 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
4720 Lisp_Object font_names;
4722 /* Get a list of all the fonts that match this name. Once we
4723 have a list of matching fonts, we compare them against the fonts
4724 we already have loaded by comparing names. */
4725 font_names = w32_list_fonts (f, build_string (fontname), size, 100);
4727 if (!NILP (font_names))
4729 Lisp_Object tail;
4730 int i;
4732 /* First check if any are already loaded, as that is cheaper
4733 than loading another one. */
4734 for (i = 0; i < dpyinfo->n_fonts; i++)
4735 for (tail = font_names; CONSP (tail); tail = XCDR (tail))
4736 if (dpyinfo->font_table[i].name
4737 && (!strcmp (dpyinfo->font_table[i].name,
4738 SDATA (XCAR (tail)))
4739 || !strcmp (dpyinfo->font_table[i].full_name,
4740 SDATA (XCAR (tail)))))
4741 return (dpyinfo->font_table + i);
4743 fontname = (char *) SDATA (XCAR (font_names));
4745 else if (w32_strict_fontnames)
4747 /* If EnumFontFamiliesEx was available, we got a full list of
4748 fonts back so stop now to avoid the possibility of loading a
4749 random font. If we had to fall back to EnumFontFamilies, the
4750 list is incomplete, so continue whether the font we want was
4751 listed or not. */
4752 HMODULE gdi32 = GetModuleHandle ("gdi32.dll");
4753 FARPROC enum_font_families_ex
4754 = GetProcAddress (gdi32, "EnumFontFamiliesExA");
4755 if (enum_font_families_ex)
4756 return NULL;
4759 /* Load the font and add it to the table. */
4761 char *full_name, *encoding, *charset;
4762 XFontStruct *font;
4763 struct font_info *fontp;
4764 LOGFONT lf;
4765 BOOL ok;
4766 int codepage;
4767 int i;
4769 if (!fontname || !x_to_w32_font (fontname, &lf))
4770 return (NULL);
4772 if (!*lf.lfFaceName)
4773 /* If no name was specified for the font, we get a random font
4774 from CreateFontIndirect - this is not particularly
4775 desirable, especially since CreateFontIndirect does not
4776 fill out the missing name in lf, so we never know what we
4777 ended up with. */
4778 return NULL;
4780 lf.lfQuality = DEFAULT_QUALITY;
4782 font = (XFontStruct *) xmalloc (sizeof (XFontStruct));
4783 bzero (font, sizeof (*font));
4785 /* Set bdf to NULL to indicate that this is a Windows font. */
4786 font->bdf = NULL;
4788 BLOCK_INPUT;
4790 font->hfont = CreateFontIndirect (&lf);
4792 if (font->hfont == NULL)
4794 ok = FALSE;
4796 else
4798 HDC hdc;
4799 HANDLE oldobj;
4801 codepage = w32_codepage_for_font (fontname);
4803 hdc = GetDC (dpyinfo->root_window);
4804 oldobj = SelectObject (hdc, font->hfont);
4806 ok = GetTextMetrics (hdc, &font->tm);
4807 if (codepage == CP_UNICODE)
4808 font->double_byte_p = 1;
4809 else
4811 /* Unfortunately, some fonts (eg. MingLiU, a big5 ttf font)
4812 don't report themselves as double byte fonts, when
4813 patently they are. So instead of trusting
4814 GetFontLanguageInfo, we check the properties of the
4815 codepage directly, since that is ultimately what we are
4816 working from anyway. */
4817 /* font->double_byte_p = GetFontLanguageInfo (hdc) & GCP_DBCS; */
4818 CPINFO cpi = {0};
4819 GetCPInfo (codepage, &cpi);
4820 font->double_byte_p = cpi.MaxCharSize > 1;
4823 SelectObject (hdc, oldobj);
4824 ReleaseDC (dpyinfo->root_window, hdc);
4825 /* Fill out details in lf according to the font that was
4826 actually loaded. */
4827 lf.lfHeight = font->tm.tmInternalLeading - font->tm.tmHeight;
4828 lf.lfWidth = font->tm.tmMaxCharWidth;
4829 lf.lfWeight = font->tm.tmWeight;
4830 lf.lfItalic = font->tm.tmItalic;
4831 lf.lfCharSet = font->tm.tmCharSet;
4832 lf.lfPitchAndFamily = ((font->tm.tmPitchAndFamily & TMPF_FIXED_PITCH)
4833 ? VARIABLE_PITCH : FIXED_PITCH);
4834 lf.lfOutPrecision = ((font->tm.tmPitchAndFamily & TMPF_VECTOR)
4835 ? OUT_STROKE_PRECIS : OUT_STRING_PRECIS);
4837 w32_cache_char_metrics (font);
4840 UNBLOCK_INPUT;
4842 if (!ok)
4844 w32_unload_font (dpyinfo, font);
4845 return (NULL);
4848 /* Find a free slot in the font table. */
4849 for (i = 0; i < dpyinfo->n_fonts; ++i)
4850 if (dpyinfo->font_table[i].name == NULL)
4851 break;
4853 /* If no free slot found, maybe enlarge the font table. */
4854 if (i == dpyinfo->n_fonts
4855 && dpyinfo->n_fonts == dpyinfo->font_table_size)
4857 int sz;
4858 dpyinfo->font_table_size = max (16, 2 * dpyinfo->font_table_size);
4859 sz = dpyinfo->font_table_size * sizeof *dpyinfo->font_table;
4860 dpyinfo->font_table
4861 = (struct font_info *) xrealloc (dpyinfo->font_table, sz);
4864 fontp = dpyinfo->font_table + i;
4865 if (i == dpyinfo->n_fonts)
4866 ++dpyinfo->n_fonts;
4868 /* Now fill in the slots of *FONTP. */
4869 BLOCK_INPUT;
4870 bzero (fontp, sizeof (*fontp));
4871 fontp->font = font;
4872 fontp->font_idx = i;
4873 fontp->name = (char *) xmalloc (strlen (fontname) + 1);
4874 bcopy (fontname, fontp->name, strlen (fontname) + 1);
4876 if ((lf.lfPitchAndFamily & 0x03) == FIXED_PITCH)
4878 /* Fixed width font. */
4879 fontp->average_width = fontp->space_width = FONT_AVG_WIDTH (font);
4881 else
4883 wchar_t space = 32;
4884 XCharStruct* pcm;
4885 pcm = w32_per_char_metric (font, &space, ANSI_FONT);
4886 if (pcm)
4887 fontp->space_width = pcm->width;
4888 else
4889 fontp->space_width = FONT_AVG_WIDTH (font);
4891 fontp->average_width = font->tm.tmAveCharWidth;
4894 fontp->charset = -1;
4895 charset = xlfd_charset_of_font (fontname);
4897 /* Cache the W32 codepage for a font. This makes w32_encode_char
4898 (called for every glyph during redisplay) much faster. */
4899 fontp->codepage = codepage;
4901 /* Work out the font's full name. */
4902 full_name = (char *)xmalloc (100);
4903 if (full_name && w32_to_x_font (&lf, full_name, 100, charset))
4904 fontp->full_name = full_name;
4905 else
4907 /* If all else fails - just use the name we used to load it. */
4908 xfree (full_name);
4909 fontp->full_name = fontp->name;
4912 fontp->size = FONT_WIDTH (font);
4913 fontp->height = FONT_HEIGHT (font);
4915 /* The slot `encoding' specifies how to map a character
4916 code-points (0x20..0x7F or 0x2020..0x7F7F) of each charset to
4917 the font code-points (0:0x20..0x7F, 1:0xA0..0xFF), or
4918 (0:0x20..0x7F, 1:0xA0..0xFF,
4919 (0:0x2020..0x7F7F, 1:0xA0A0..0xFFFF, 3:0x20A0..0x7FFF,
4920 2:0xA020..0xFF7F). For the moment, we don't know which charset
4921 uses this font. So, we set information in fontp->encoding_type
4922 which is never used by any charset. If mapping can't be
4923 decided, set FONT_ENCODING_NOT_DECIDED. */
4925 /* SJIS fonts need to be set to type 4, all others seem to work as
4926 type FONT_ENCODING_NOT_DECIDED. */
4927 encoding = strrchr (fontp->name, '-');
4928 if (encoding && strnicmp (encoding+1, "sjis", 4) == 0)
4929 fontp->encoding_type = 4;
4930 else
4931 fontp->encoding_type = FONT_ENCODING_NOT_DECIDED;
4933 /* The following three values are set to 0 under W32, which is
4934 what they get set to if XGetFontProperty fails under X. */
4935 fontp->baseline_offset = 0;
4936 fontp->relative_compose = 0;
4937 fontp->default_ascent = 0;
4939 /* Set global flag fonts_changed_p to non-zero if the font loaded
4940 has a character with a smaller width than any other character
4941 before, or if the font loaded has a smaller height than any
4942 other font loaded before. If this happens, it will make a
4943 glyph matrix reallocation necessary. */
4944 fonts_changed_p |= x_compute_min_glyph_bounds (f);
4945 UNBLOCK_INPUT;
4946 return fontp;
4950 /* Load font named FONTNAME of size SIZE for frame F, and return a
4951 pointer to the structure font_info while allocating it dynamically.
4952 If loading fails, return NULL. */
4953 struct font_info *
4954 w32_load_font (f, fontname, size)
4955 struct frame *f;
4956 char * fontname;
4957 int size;
4959 Lisp_Object bdf_fonts;
4960 struct font_info *retval = NULL;
4961 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
4963 bdf_fonts = w32_list_bdf_fonts (build_string (fontname), 1);
4965 while (!retval && CONSP (bdf_fonts))
4967 char *bdf_name, *bdf_file;
4968 Lisp_Object bdf_pair;
4969 int i;
4971 bdf_name = SDATA (XCAR (bdf_fonts));
4972 bdf_pair = Fassoc (XCAR (bdf_fonts), Vw32_bdf_filename_alist);
4973 bdf_file = SDATA (XCDR (bdf_pair));
4975 /* If the font is already loaded, do not load it again. */
4976 for (i = 0; i < dpyinfo->n_fonts; i++)
4978 if ((dpyinfo->font_table[i].name
4979 && !strcmp (dpyinfo->font_table[i].name, bdf_name))
4980 || (dpyinfo->font_table[i].full_name
4981 && !strcmp (dpyinfo->font_table[i].full_name, bdf_name)))
4982 return dpyinfo->font_table + i;
4985 retval = w32_load_bdf_font (f, bdf_name, size, bdf_file);
4987 bdf_fonts = XCDR (bdf_fonts);
4990 if (retval)
4991 return retval;
4993 return w32_load_system_font (f, fontname, size);
4997 void
4998 w32_unload_font (dpyinfo, font)
4999 struct w32_display_info *dpyinfo;
5000 XFontStruct * font;
5002 if (font)
5004 if (font->per_char) xfree (font->per_char);
5005 if (font->bdf) w32_free_bdf_font (font->bdf);
5007 if (font->hfont) DeleteObject (font->hfont);
5008 xfree (font);
5012 /* The font conversion stuff between x and w32 */
5014 /* X font string is as follows (from faces.el)
5015 * (let ((- "[-?]")
5016 * (foundry "[^-]+")
5017 * (family "[^-]+")
5018 * (weight "\\(bold\\|demibold\\|medium\\)") ; 1
5019 * (weight\? "\\([^-]*\\)") ; 1
5020 * (slant "\\([ior]\\)") ; 2
5021 * (slant\? "\\([^-]?\\)") ; 2
5022 * (swidth "\\([^-]*\\)") ; 3
5023 * (adstyle "[^-]*") ; 4
5024 * (pixelsize "[0-9]+")
5025 * (pointsize "[0-9][0-9]+")
5026 * (resx "[0-9][0-9]+")
5027 * (resy "[0-9][0-9]+")
5028 * (spacing "[cmp?*]")
5029 * (avgwidth "[0-9]+")
5030 * (registry "[^-]+")
5031 * (encoding "[^-]+")
5035 static LONG
5036 x_to_w32_weight (lpw)
5037 char * lpw;
5039 if (!lpw) return (FW_DONTCARE);
5041 if (stricmp (lpw, "heavy") == 0) return FW_HEAVY;
5042 else if (stricmp (lpw, "extrabold") == 0) return FW_EXTRABOLD;
5043 else if (stricmp (lpw, "bold") == 0) return FW_BOLD;
5044 else if (stricmp (lpw, "demibold") == 0) return FW_SEMIBOLD;
5045 else if (stricmp (lpw, "semibold") == 0) return FW_SEMIBOLD;
5046 else if (stricmp (lpw, "medium") == 0) return FW_MEDIUM;
5047 else if (stricmp (lpw, "normal") == 0) return FW_NORMAL;
5048 else if (stricmp (lpw, "light") == 0) return FW_LIGHT;
5049 else if (stricmp (lpw, "extralight") == 0) return FW_EXTRALIGHT;
5050 else if (stricmp (lpw, "thin") == 0) return FW_THIN;
5051 else
5052 return FW_DONTCARE;
5056 static char *
5057 w32_to_x_weight (fnweight)
5058 int fnweight;
5060 if (fnweight >= FW_HEAVY) return "heavy";
5061 if (fnweight >= FW_EXTRABOLD) return "extrabold";
5062 if (fnweight >= FW_BOLD) return "bold";
5063 if (fnweight >= FW_SEMIBOLD) return "demibold";
5064 if (fnweight >= FW_MEDIUM) return "medium";
5065 if (fnweight >= FW_NORMAL) return "normal";
5066 if (fnweight >= FW_LIGHT) return "light";
5067 if (fnweight >= FW_EXTRALIGHT) return "extralight";
5068 if (fnweight >= FW_THIN) return "thin";
5069 else
5070 return "*";
5073 LONG
5074 x_to_w32_charset (lpcs)
5075 char * lpcs;
5077 Lisp_Object this_entry, w32_charset;
5078 char *charset;
5079 int len = strlen (lpcs);
5081 /* Support "*-#nnn" format for unknown charsets. */
5082 if (strncmp (lpcs, "*-#", 3) == 0)
5083 return atoi (lpcs + 3);
5085 /* All Windows fonts qualify as unicode. */
5086 if (!strncmp (lpcs, "iso10646", 8))
5087 return DEFAULT_CHARSET;
5089 /* Handle wildcards by ignoring them; eg. treat "big5*-*" as "big5". */
5090 charset = alloca (len + 1);
5091 strcpy (charset, lpcs);
5092 lpcs = strchr (charset, '*');
5093 if (lpcs)
5094 *lpcs = '\0';
5096 /* Look through w32-charset-info-alist for the character set.
5097 Format of each entry is
5098 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
5100 this_entry = Fassoc (build_string (charset), Vw32_charset_info_alist);
5102 if (NILP (this_entry))
5104 /* At startup, we want iso8859-1 fonts to come up properly. */
5105 if (stricmp (charset, "iso8859-1") == 0)
5106 return ANSI_CHARSET;
5107 else
5108 return DEFAULT_CHARSET;
5111 w32_charset = Fcar (Fcdr (this_entry));
5113 /* Translate Lisp symbol to number. */
5114 if (EQ (w32_charset, Qw32_charset_ansi))
5115 return ANSI_CHARSET;
5116 if (EQ (w32_charset, Qw32_charset_symbol))
5117 return SYMBOL_CHARSET;
5118 if (EQ (w32_charset, Qw32_charset_shiftjis))
5119 return SHIFTJIS_CHARSET;
5120 if (EQ (w32_charset, Qw32_charset_hangeul))
5121 return HANGEUL_CHARSET;
5122 if (EQ (w32_charset, Qw32_charset_chinesebig5))
5123 return CHINESEBIG5_CHARSET;
5124 if (EQ (w32_charset, Qw32_charset_gb2312))
5125 return GB2312_CHARSET;
5126 if (EQ (w32_charset, Qw32_charset_oem))
5127 return OEM_CHARSET;
5128 #ifdef JOHAB_CHARSET
5129 if (EQ (w32_charset, Qw32_charset_johab))
5130 return JOHAB_CHARSET;
5131 if (EQ (w32_charset, Qw32_charset_easteurope))
5132 return EASTEUROPE_CHARSET;
5133 if (EQ (w32_charset, Qw32_charset_turkish))
5134 return TURKISH_CHARSET;
5135 if (EQ (w32_charset, Qw32_charset_baltic))
5136 return BALTIC_CHARSET;
5137 if (EQ (w32_charset, Qw32_charset_russian))
5138 return RUSSIAN_CHARSET;
5139 if (EQ (w32_charset, Qw32_charset_arabic))
5140 return ARABIC_CHARSET;
5141 if (EQ (w32_charset, Qw32_charset_greek))
5142 return GREEK_CHARSET;
5143 if (EQ (w32_charset, Qw32_charset_hebrew))
5144 return HEBREW_CHARSET;
5145 if (EQ (w32_charset, Qw32_charset_vietnamese))
5146 return VIETNAMESE_CHARSET;
5147 if (EQ (w32_charset, Qw32_charset_thai))
5148 return THAI_CHARSET;
5149 if (EQ (w32_charset, Qw32_charset_mac))
5150 return MAC_CHARSET;
5151 #endif /* JOHAB_CHARSET */
5152 #ifdef UNICODE_CHARSET
5153 if (EQ (w32_charset, Qw32_charset_unicode))
5154 return UNICODE_CHARSET;
5155 #endif
5157 return DEFAULT_CHARSET;
5161 char *
5162 w32_to_x_charset (fncharset, matching)
5163 int fncharset;
5164 char *matching;
5166 static char buf[32];
5167 Lisp_Object charset_type;
5168 int match_len = 0;
5170 if (matching)
5172 /* If fully specified, accept it as it is. Otherwise use a
5173 substring match. */
5174 char *wildcard = strchr (matching, '*');
5175 if (wildcard)
5176 *wildcard = '\0';
5177 else if (strchr (matching, '-'))
5178 return matching;
5180 match_len = strlen (matching);
5183 switch (fncharset)
5185 case ANSI_CHARSET:
5186 /* Handle startup case of w32-charset-info-alist not
5187 being set up yet. */
5188 if (NILP (Vw32_charset_info_alist))
5189 return "iso8859-1";
5190 charset_type = Qw32_charset_ansi;
5191 break;
5192 case DEFAULT_CHARSET:
5193 charset_type = Qw32_charset_default;
5194 break;
5195 case SYMBOL_CHARSET:
5196 charset_type = Qw32_charset_symbol;
5197 break;
5198 case SHIFTJIS_CHARSET:
5199 charset_type = Qw32_charset_shiftjis;
5200 break;
5201 case HANGEUL_CHARSET:
5202 charset_type = Qw32_charset_hangeul;
5203 break;
5204 case GB2312_CHARSET:
5205 charset_type = Qw32_charset_gb2312;
5206 break;
5207 case CHINESEBIG5_CHARSET:
5208 charset_type = Qw32_charset_chinesebig5;
5209 break;
5210 case OEM_CHARSET:
5211 charset_type = Qw32_charset_oem;
5212 break;
5214 /* More recent versions of Windows (95 and NT4.0) define more
5215 character sets. */
5216 #ifdef EASTEUROPE_CHARSET
5217 case EASTEUROPE_CHARSET:
5218 charset_type = Qw32_charset_easteurope;
5219 break;
5220 case TURKISH_CHARSET:
5221 charset_type = Qw32_charset_turkish;
5222 break;
5223 case BALTIC_CHARSET:
5224 charset_type = Qw32_charset_baltic;
5225 break;
5226 case RUSSIAN_CHARSET:
5227 charset_type = Qw32_charset_russian;
5228 break;
5229 case ARABIC_CHARSET:
5230 charset_type = Qw32_charset_arabic;
5231 break;
5232 case GREEK_CHARSET:
5233 charset_type = Qw32_charset_greek;
5234 break;
5235 case HEBREW_CHARSET:
5236 charset_type = Qw32_charset_hebrew;
5237 break;
5238 case VIETNAMESE_CHARSET:
5239 charset_type = Qw32_charset_vietnamese;
5240 break;
5241 case THAI_CHARSET:
5242 charset_type = Qw32_charset_thai;
5243 break;
5244 case MAC_CHARSET:
5245 charset_type = Qw32_charset_mac;
5246 break;
5247 case JOHAB_CHARSET:
5248 charset_type = Qw32_charset_johab;
5249 break;
5250 #endif
5252 #ifdef UNICODE_CHARSET
5253 case UNICODE_CHARSET:
5254 charset_type = Qw32_charset_unicode;
5255 break;
5256 #endif
5257 default:
5258 /* Encode numerical value of unknown charset. */
5259 sprintf (buf, "*-#%u", fncharset);
5260 return buf;
5264 Lisp_Object rest;
5265 char * best_match = NULL;
5266 int matching_found = 0;
5268 /* Look through w32-charset-info-alist for the character set.
5269 Prefer ISO codepages, and prefer lower numbers in the ISO
5270 range. Only return charsets for codepages which are installed.
5272 Format of each entry is
5273 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
5275 for (rest = Vw32_charset_info_alist; CONSP (rest); rest = XCDR (rest))
5277 char * x_charset;
5278 Lisp_Object w32_charset;
5279 Lisp_Object codepage;
5281 Lisp_Object this_entry = XCAR (rest);
5283 /* Skip invalid entries in alist. */
5284 if (!CONSP (this_entry) || !STRINGP (XCAR (this_entry))
5285 || !CONSP (XCDR (this_entry))
5286 || !SYMBOLP (XCAR (XCDR (this_entry))))
5287 continue;
5289 x_charset = SDATA (XCAR (this_entry));
5290 w32_charset = XCAR (XCDR (this_entry));
5291 codepage = XCDR (XCDR (this_entry));
5293 /* Look for Same charset and a valid codepage (or non-int
5294 which means ignore). */
5295 if (EQ (w32_charset, charset_type)
5296 && (!INTEGERP (codepage) || XINT (codepage) == CP_DEFAULT
5297 || IsValidCodePage (XINT (codepage))))
5299 /* If we don't have a match already, then this is the
5300 best. */
5301 if (!best_match)
5303 best_match = x_charset;
5304 if (matching && !strnicmp (x_charset, matching, match_len))
5305 matching_found = 1;
5307 /* If we already found a match for MATCHING, then
5308 only consider other matches. */
5309 else if (matching_found
5310 && strnicmp (x_charset, matching, match_len))
5311 continue;
5312 /* If this matches what we want, and the best so far doesn't,
5313 then this is better. */
5314 else if (!matching_found && matching
5315 && !strnicmp (x_charset, matching, match_len))
5317 best_match = x_charset;
5318 matching_found = 1;
5320 /* If this is fully specified, and the best so far isn't,
5321 then this is better. */
5322 else if ((!strchr (best_match, '-') && strchr (x_charset, '-'))
5323 /* If this is an ISO codepage, and the best so far isn't,
5324 then this is better, but only if it fully specifies the
5325 encoding. */
5326 || (strnicmp (best_match, "iso", 3) != 0
5327 && strnicmp (x_charset, "iso", 3) == 0
5328 && strchr (x_charset, '-')))
5329 best_match = x_charset;
5330 /* If both are ISO8859 codepages, choose the one with the
5331 lowest number in the encoding field. */
5332 else if (strnicmp (best_match, "iso8859-", 8) == 0
5333 && strnicmp (x_charset, "iso8859-", 8) == 0)
5335 int best_enc = atoi (best_match + 8);
5336 int this_enc = atoi (x_charset + 8);
5337 if (this_enc > 0 && this_enc < best_enc)
5338 best_match = x_charset;
5343 /* If no match, encode the numeric value. */
5344 if (!best_match)
5346 sprintf (buf, "*-#%u", fncharset);
5347 return buf;
5350 strncpy (buf, best_match, 31);
5351 /* If the charset is not fully specified, put -0 on the end. */
5352 if (!strchr (best_match, '-'))
5354 int pos = strlen (best_match);
5355 /* Charset specifiers shouldn't be very long. If it is a made
5356 up one, truncating it should not do any harm since it isn't
5357 recognized anyway. */
5358 if (pos > 29)
5359 pos = 29;
5360 strcpy (buf + pos, "-0");
5362 buf[31] = '\0';
5363 return buf;
5368 /* Return all the X charsets that map to a font. */
5369 static Lisp_Object
5370 w32_to_all_x_charsets (fncharset)
5371 int fncharset;
5373 static char buf[32];
5374 Lisp_Object charset_type;
5375 Lisp_Object retval = Qnil;
5377 switch (fncharset)
5379 case ANSI_CHARSET:
5380 /* Handle startup case of w32-charset-info-alist not
5381 being set up yet. */
5382 if (NILP (Vw32_charset_info_alist))
5383 return Fcons (build_string ("iso8859-1"), Qnil);
5385 charset_type = Qw32_charset_ansi;
5386 break;
5387 case DEFAULT_CHARSET:
5388 charset_type = Qw32_charset_default;
5389 break;
5390 case SYMBOL_CHARSET:
5391 charset_type = Qw32_charset_symbol;
5392 break;
5393 case SHIFTJIS_CHARSET:
5394 charset_type = Qw32_charset_shiftjis;
5395 break;
5396 case HANGEUL_CHARSET:
5397 charset_type = Qw32_charset_hangeul;
5398 break;
5399 case GB2312_CHARSET:
5400 charset_type = Qw32_charset_gb2312;
5401 break;
5402 case CHINESEBIG5_CHARSET:
5403 charset_type = Qw32_charset_chinesebig5;
5404 break;
5405 case OEM_CHARSET:
5406 charset_type = Qw32_charset_oem;
5407 break;
5409 /* More recent versions of Windows (95 and NT4.0) define more
5410 character sets. */
5411 #ifdef EASTEUROPE_CHARSET
5412 case EASTEUROPE_CHARSET:
5413 charset_type = Qw32_charset_easteurope;
5414 break;
5415 case TURKISH_CHARSET:
5416 charset_type = Qw32_charset_turkish;
5417 break;
5418 case BALTIC_CHARSET:
5419 charset_type = Qw32_charset_baltic;
5420 break;
5421 case RUSSIAN_CHARSET:
5422 charset_type = Qw32_charset_russian;
5423 break;
5424 case ARABIC_CHARSET:
5425 charset_type = Qw32_charset_arabic;
5426 break;
5427 case GREEK_CHARSET:
5428 charset_type = Qw32_charset_greek;
5429 break;
5430 case HEBREW_CHARSET:
5431 charset_type = Qw32_charset_hebrew;
5432 break;
5433 case VIETNAMESE_CHARSET:
5434 charset_type = Qw32_charset_vietnamese;
5435 break;
5436 case THAI_CHARSET:
5437 charset_type = Qw32_charset_thai;
5438 break;
5439 case MAC_CHARSET:
5440 charset_type = Qw32_charset_mac;
5441 break;
5442 case JOHAB_CHARSET:
5443 charset_type = Qw32_charset_johab;
5444 break;
5445 #endif
5447 #ifdef UNICODE_CHARSET
5448 case UNICODE_CHARSET:
5449 charset_type = Qw32_charset_unicode;
5450 break;
5451 #endif
5452 default:
5453 /* Encode numerical value of unknown charset. */
5454 sprintf (buf, "*-#%u", fncharset);
5455 return Fcons (build_string (buf), Qnil);
5459 Lisp_Object rest;
5460 /* Look through w32-charset-info-alist for the character set.
5461 Only return fully specified charsets for codepages which are
5462 installed.
5464 Format of each entry in Vw32_charset_info_alist is
5465 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
5467 for (rest = Vw32_charset_info_alist; CONSP (rest); rest = XCDR (rest))
5469 Lisp_Object x_charset;
5470 Lisp_Object w32_charset;
5471 Lisp_Object codepage;
5473 Lisp_Object this_entry = XCAR (rest);
5475 /* Skip invalid entries in alist. */
5476 if (!CONSP (this_entry) || !STRINGP (XCAR (this_entry))
5477 || !CONSP (XCDR (this_entry))
5478 || !SYMBOLP (XCAR (XCDR (this_entry))))
5479 continue;
5481 x_charset = XCAR (this_entry);
5482 w32_charset = XCAR (XCDR (this_entry));
5483 codepage = XCDR (XCDR (this_entry));
5485 if (!strchr (SDATA (x_charset), '-'))
5486 continue;
5488 /* Look for Same charset and a valid codepage (or non-int
5489 which means ignore). */
5490 if (EQ (w32_charset, charset_type)
5491 && (!INTEGERP (codepage) || XINT (codepage) == CP_DEFAULT
5492 || IsValidCodePage (XINT (codepage))))
5494 retval = Fcons (x_charset, retval);
5498 /* If no match, encode the numeric value. */
5499 if (NILP (retval))
5501 sprintf (buf, "*-#%u", fncharset);
5502 return Fcons (build_string (buf), Qnil);
5505 return retval;
5509 /* Get the Windows codepage corresponding to the specified font. The
5510 charset info in the font name is used to look up
5511 w32-charset-to-codepage-alist. */
5513 w32_codepage_for_font (char *fontname)
5515 Lisp_Object codepage, entry;
5516 char *charset_str, *charset, *end;
5518 /* Extract charset part of font string. */
5519 charset = xlfd_charset_of_font (fontname);
5521 if (!charset)
5522 return CP_UNKNOWN;
5524 charset_str = (char *) alloca (strlen (charset) + 1);
5525 strcpy (charset_str, charset);
5527 #if 0
5528 /* Remove leading "*-". */
5529 if (strncmp ("*-", charset_str, 2) == 0)
5530 charset = charset_str + 2;
5531 else
5532 #endif
5533 charset = charset_str;
5535 /* Stop match at wildcard (including preceding '-'). */
5536 if (end = strchr (charset, '*'))
5538 if (end > charset && *(end-1) == '-')
5539 end--;
5540 *end = '\0';
5543 if (!strcmp (charset, "iso10646"))
5544 return CP_UNICODE;
5546 if (NILP (Vw32_charset_info_alist))
5547 return CP_DEFAULT;
5549 entry = Fassoc (build_string(charset), Vw32_charset_info_alist);
5550 if (NILP (entry))
5551 return CP_UNKNOWN;
5553 codepage = Fcdr (Fcdr (entry));
5555 if (NILP (codepage))
5556 return CP_8BIT;
5557 else if (XFASTINT (codepage) == XFASTINT (Qt))
5558 return CP_UNICODE;
5559 else if (INTEGERP (codepage))
5560 return XINT (codepage);
5561 else
5562 return CP_UNKNOWN;
5566 static BOOL
5567 w32_to_x_font (lplogfont, lpxstr, len, specific_charset)
5568 LOGFONT * lplogfont;
5569 char * lpxstr;
5570 int len;
5571 char * specific_charset;
5573 char* fonttype;
5574 char *fontname;
5575 char height_pixels[8];
5576 char height_dpi[8];
5577 char width_pixels[8];
5578 char *fontname_dash;
5579 int display_resy = (int) one_w32_display_info.resy;
5580 int display_resx = (int) one_w32_display_info.resx;
5581 struct coding_system coding;
5583 if (!lpxstr) abort ();
5585 if (!lplogfont)
5586 return FALSE;
5588 if (lplogfont->lfOutPrecision == OUT_STRING_PRECIS)
5589 fonttype = "raster";
5590 else if (lplogfont->lfOutPrecision == OUT_STROKE_PRECIS)
5591 fonttype = "outline";
5592 else
5593 fonttype = "unknown";
5595 setup_coding_system (Fcheck_coding_system (Vlocale_coding_system),
5596 &coding);
5597 coding.src_multibyte = 0;
5598 coding.dst_multibyte = 1;
5599 coding.mode |= CODING_MODE_LAST_BLOCK;
5600 /* We explicitely disable composition handling because selection
5601 data should not contain any composition sequence. */
5602 coding.common_flags &= ~CODING_ANNOTATION_MASK;
5604 coding.dst_bytes = LF_FACESIZE * 2;
5605 coding.destination = (unsigned char *) xmalloc (coding.dst_bytes + 1);
5606 decode_coding_c_string (&coding, lplogfont->lfFaceName,
5607 strlen(lplogfont->lfFaceName), Qnil);
5608 fontname = coding.destination;
5610 *(fontname + coding.produced) = '\0';
5612 /* Replace dashes with underscores so the dashes are not
5613 misinterpreted. */
5614 fontname_dash = fontname;
5615 while (fontname_dash = strchr (fontname_dash, '-'))
5616 *fontname_dash = '_';
5618 if (lplogfont->lfHeight)
5620 sprintf (height_pixels, "%u", eabs (lplogfont->lfHeight));
5621 sprintf (height_dpi, "%u",
5622 eabs (lplogfont->lfHeight) * 720 / display_resy);
5624 else
5626 strcpy (height_pixels, "*");
5627 strcpy (height_dpi, "*");
5630 #if 0 /* Never put the width in the xfld. It fails on fonts with
5631 double-width characters. */
5632 if (lplogfont->lfWidth)
5633 sprintf (width_pixels, "%u", lplogfont->lfWidth * 10);
5634 else
5635 #endif
5636 strcpy (width_pixels, "*");
5638 _snprintf (lpxstr, len - 1,
5639 "-%s-%s-%s-%c-normal-normal-%s-%s-%d-%d-%c-%s-%s",
5640 fonttype, /* foundry */
5641 fontname, /* family */
5642 w32_to_x_weight (lplogfont->lfWeight), /* weight */
5643 lplogfont->lfItalic?'i':'r', /* slant */
5644 /* setwidth name */
5645 /* add style name */
5646 height_pixels, /* pixel size */
5647 height_dpi, /* point size */
5648 display_resx, /* resx */
5649 display_resy, /* resy */
5650 ((lplogfont->lfPitchAndFamily & 0x3) == VARIABLE_PITCH)
5651 ? 'p' : 'c', /* spacing */
5652 width_pixels, /* avg width */
5653 w32_to_x_charset (lplogfont->lfCharSet, specific_charset)
5654 /* charset registry and encoding */
5657 lpxstr[len - 1] = 0; /* just to be sure */
5658 return (TRUE);
5661 static BOOL
5662 x_to_w32_font (lpxstr, lplogfont)
5663 char * lpxstr;
5664 LOGFONT * lplogfont;
5666 struct coding_system coding;
5668 if (!lplogfont) return (FALSE);
5670 memset (lplogfont, 0, sizeof (*lplogfont));
5672 /* Set default value for each field. */
5673 #if 1
5674 lplogfont->lfOutPrecision = OUT_DEFAULT_PRECIS;
5675 lplogfont->lfClipPrecision = CLIP_DEFAULT_PRECIS;
5676 lplogfont->lfQuality = DEFAULT_QUALITY;
5677 #else
5678 /* go for maximum quality */
5679 lplogfont->lfOutPrecision = OUT_STROKE_PRECIS;
5680 lplogfont->lfClipPrecision = CLIP_STROKE_PRECIS;
5681 lplogfont->lfQuality = PROOF_QUALITY;
5682 #endif
5684 lplogfont->lfCharSet = DEFAULT_CHARSET;
5685 lplogfont->lfWeight = FW_DONTCARE;
5686 lplogfont->lfPitchAndFamily = DEFAULT_PITCH | FF_DONTCARE;
5688 if (!lpxstr)
5689 return FALSE;
5691 /* Provide a simple escape mechanism for specifying Windows font names
5692 * directly -- if font spec does not beginning with '-', assume this
5693 * format:
5694 * "<font name>[:height in pixels[:width in pixels[:weight]]]"
5697 if (*lpxstr == '-')
5699 int fields, tem;
5700 char name[50], weight[20], slant, pitch, pixels[10], height[10],
5701 width[10], resy[10], remainder[50];
5702 char * encoding;
5703 int dpi = (int) one_w32_display_info.resy;
5705 fields = sscanf (lpxstr,
5706 "-%*[^-]-%49[^-]-%19[^-]-%c-%*[^-]-%*[^-]-%9[^-]-%9[^-]-%*[^-]-%9[^-]-%c-%9[^-]-%49s",
5707 name, weight, &slant, pixels, height, resy, &pitch, width, remainder);
5708 if (fields == EOF)
5709 return (FALSE);
5711 /* In the general case when wildcards cover more than one field,
5712 we don't know which field is which, so don't fill any in.
5713 However, we need to cope with this particular form, which is
5714 generated by font_list_1 (invoked by try_font_list):
5715 "-raster-6x10-*-gb2312*-*"
5716 and make sure to correctly parse the charset field. */
5717 if (fields == 3)
5719 fields = sscanf (lpxstr,
5720 "-%*[^-]-%49[^-]-*-%49s",
5721 name, remainder);
5723 else if (fields < 9)
5725 fields = 0;
5726 remainder[0] = 0;
5729 if (fields > 0 && name[0] != '*')
5731 Lisp_Object string = build_string (name);
5732 setup_coding_system
5733 (Fcheck_coding_system (Vlocale_coding_system), &coding);
5734 coding.mode |= (CODING_MODE_SAFE_ENCODING | CODING_MODE_LAST_BLOCK);
5735 /* Disable composition/charset annotation. */
5736 coding.common_flags &= ~CODING_ANNOTATION_MASK;
5737 coding.dst_bytes = SCHARS (string) * 2;
5739 coding.destination = (unsigned char *) xmalloc (coding.dst_bytes);
5740 encode_coding_object (&coding, string, 0, 0,
5741 SCHARS (string), SBYTES (string), Qnil);
5742 if (coding.produced >= LF_FACESIZE)
5743 coding.produced = LF_FACESIZE - 1;
5745 coding.destination[coding.produced] = '\0';
5747 strcpy (lplogfont->lfFaceName, coding.destination);
5748 xfree (coding.destination);
5750 else
5752 lplogfont->lfFaceName[0] = '\0';
5755 fields--;
5757 lplogfont->lfWeight = x_to_w32_weight ((fields > 0 ? weight : ""));
5759 fields--;
5761 lplogfont->lfItalic = (fields > 0 && slant == 'i');
5763 fields--;
5765 if (fields > 0 && pixels[0] != '*')
5766 lplogfont->lfHeight = atoi (pixels);
5768 fields--;
5769 fields--;
5770 if (fields > 0 && resy[0] != '*')
5772 tem = atoi (resy);
5773 if (tem > 0) dpi = tem;
5776 if (fields > -1 && lplogfont->lfHeight == 0 && height[0] != '*')
5777 lplogfont->lfHeight = atoi (height) * dpi / 720;
5779 if (fields > 0)
5781 if (pitch == 'p')
5782 lplogfont->lfPitchAndFamily = VARIABLE_PITCH | FF_DONTCARE;
5783 else if (pitch == 'c')
5784 lplogfont->lfPitchAndFamily = FIXED_PITCH | FF_DONTCARE;
5787 fields--;
5789 if (fields > 0 && width[0] != '*')
5790 lplogfont->lfWidth = atoi (width) / 10;
5792 fields--;
5794 /* Strip the trailing '-' if present. (it shouldn't be, as it
5795 fails the test against xlfd-tight-regexp in fontset.el). */
5797 int len = strlen (remainder);
5798 if (len > 0 && remainder[len-1] == '-')
5799 remainder[len-1] = 0;
5801 encoding = remainder;
5802 #if 0
5803 if (strncmp (encoding, "*-", 2) == 0)
5804 encoding += 2;
5805 #endif
5806 lplogfont->lfCharSet = x_to_w32_charset (encoding);
5808 else
5810 int fields;
5811 char name[100], height[10], width[10], weight[20];
5813 fields = sscanf (lpxstr,
5814 "%99[^:]:%9[^:]:%9[^:]:%19s",
5815 name, height, width, weight);
5817 if (fields == EOF) return (FALSE);
5819 if (fields > 0)
5821 strncpy (lplogfont->lfFaceName, name, LF_FACESIZE);
5822 lplogfont->lfFaceName[LF_FACESIZE-1] = 0;
5824 else
5826 lplogfont->lfFaceName[0] = 0;
5829 fields--;
5831 if (fields > 0)
5832 lplogfont->lfHeight = atoi (height);
5834 fields--;
5836 if (fields > 0)
5837 lplogfont->lfWidth = atoi (width);
5839 fields--;
5841 lplogfont->lfWeight = x_to_w32_weight ((fields > 0 ? weight : ""));
5844 /* This makes TrueType fonts work better. */
5845 lplogfont->lfHeight = - eabs (lplogfont->lfHeight);
5847 return (TRUE);
5850 /* Strip the pixel height and point height from the given xlfd, and
5851 return the pixel height. If no pixel height is specified, calculate
5852 one from the point height, or if that isn't defined either, return
5853 0 (which usually signifies a scalable font).
5855 static int
5856 xlfd_strip_height (char *fontname)
5858 int pixel_height, field_number;
5859 char *read_from, *write_to;
5861 xassert (fontname);
5863 pixel_height = field_number = 0;
5864 write_to = NULL;
5866 /* Look for height fields. */
5867 for (read_from = fontname; *read_from; read_from++)
5869 if (*read_from == '-')
5871 field_number++;
5872 if (field_number == 7) /* Pixel height. */
5874 read_from++;
5875 write_to = read_from;
5877 /* Find end of field. */
5878 for (;*read_from && *read_from != '-'; read_from++)
5881 /* Split the fontname at end of field. */
5882 if (*read_from)
5884 *read_from = '\0';
5885 read_from++;
5887 pixel_height = atoi (write_to);
5888 /* Blank out field. */
5889 if (read_from > write_to)
5891 *write_to = '-';
5892 write_to++;
5894 /* If the pixel height field is at the end (partial xlfd),
5895 return now. */
5896 else
5897 return pixel_height;
5899 /* If we got a pixel height, the point height can be
5900 ignored. Just blank it out and break now. */
5901 if (pixel_height)
5903 /* Find end of point size field. */
5904 for (; *read_from && *read_from != '-'; read_from++)
5907 if (*read_from)
5908 read_from++;
5910 /* Blank out the point size field. */
5911 if (read_from > write_to)
5913 *write_to = '-';
5914 write_to++;
5916 else
5917 return pixel_height;
5919 break;
5921 /* If the point height is already blank, break now. */
5922 if (*read_from == '-')
5924 read_from++;
5925 break;
5928 else if (field_number == 8)
5930 /* If we didn't get a pixel height, try to get the point
5931 height and convert that. */
5932 int point_size;
5933 char *point_size_start = read_from++;
5935 /* Find end of field. */
5936 for (; *read_from && *read_from != '-'; read_from++)
5939 if (*read_from)
5941 *read_from = '\0';
5942 read_from++;
5945 point_size = atoi (point_size_start);
5947 /* Convert to pixel height. */
5948 pixel_height = point_size
5949 * one_w32_display_info.height_in / 720;
5951 /* Blank out this field and break. */
5952 *write_to = '-';
5953 write_to++;
5954 break;
5959 /* Shift the rest of the font spec into place. */
5960 if (write_to && read_from > write_to)
5962 for (; *read_from; read_from++, write_to++)
5963 *write_to = *read_from;
5964 *write_to = '\0';
5967 return pixel_height;
5970 /* Assume parameter 1 is fully qualified, no wildcards. */
5971 static BOOL
5972 w32_font_match (fontname, pattern)
5973 char * fontname;
5974 char * pattern;
5976 char *ptr;
5977 char *font_name_copy;
5978 char *regex = alloca (strlen (pattern) * 2 + 3);
5980 font_name_copy = alloca (strlen (fontname) + 1);
5981 strcpy (font_name_copy, fontname);
5983 ptr = regex;
5984 *ptr++ = '^';
5986 /* Turn pattern into a regexp and do a regexp match. */
5987 for (; *pattern; pattern++)
5989 if (*pattern == '?')
5990 *ptr++ = '.';
5991 else if (*pattern == '*')
5993 *ptr++ = '.';
5994 *ptr++ = '*';
5996 else
5997 *ptr++ = *pattern;
5999 *ptr = '$';
6000 *(ptr + 1) = '\0';
6002 /* Strip out font heights and compare them seperately, since
6003 rounding error can cause mismatches. This also allows a
6004 comparison between a font that declares only a pixel height and a
6005 pattern that declares the point height.
6008 int font_height, pattern_height;
6010 font_height = xlfd_strip_height (font_name_copy);
6011 pattern_height = xlfd_strip_height (regex);
6013 /* Compare now, and don't bother doing expensive regexp matching
6014 if the heights differ. */
6015 if (font_height && pattern_height && (font_height != pattern_height))
6016 return FALSE;
6019 return (fast_string_match_ignore_case (build_string (regex),
6020 build_string (font_name_copy)) >= 0);
6023 /* Callback functions, and a structure holding info they need, for
6024 listing system fonts on W32. We need one set of functions to do the
6025 job properly, but these don't work on NT 3.51 and earlier, so we
6026 have a second set which don't handle character sets properly to
6027 fall back on.
6029 In both cases, there are two passes made. The first pass gets one
6030 font from each family, the second pass lists all the fonts from
6031 each family. */
6033 typedef struct enumfont_t
6035 HDC hdc;
6036 int numFonts;
6037 LOGFONT logfont;
6038 XFontStruct *size_ref;
6039 Lisp_Object pattern;
6040 Lisp_Object list;
6041 } enumfont_t;
6044 static void
6045 enum_font_maybe_add_to_list (enumfont_t *, LOGFONT *, char *, Lisp_Object);
6048 static int CALLBACK
6049 enum_font_cb2 (lplf, lptm, FontType, lpef)
6050 ENUMLOGFONT * lplf;
6051 NEWTEXTMETRIC * lptm;
6052 int FontType;
6053 enumfont_t * lpef;
6055 /* Ignore struck out and underlined versions of fonts. */
6056 if (lplf->elfLogFont.lfStrikeOut || lplf->elfLogFont.lfUnderline)
6057 return 1;
6059 /* Only return fonts with names starting with @ if they were
6060 explicitly specified, since Microsoft uses an initial @ to
6061 denote fonts for vertical writing, without providing a more
6062 convenient way of identifying them. */
6063 if (lplf->elfLogFont.lfFaceName[0] == '@'
6064 && lpef->logfont.lfFaceName[0] != '@')
6065 return 1;
6067 /* Check that the character set matches if it was specified */
6068 if (lpef->logfont.lfCharSet != DEFAULT_CHARSET &&
6069 lplf->elfLogFont.lfCharSet != lpef->logfont.lfCharSet)
6070 return 1;
6072 if (FontType == RASTER_FONTTYPE)
6074 /* DBCS raster fonts have problems displaying, so skip them. */
6075 int charset = lplf->elfLogFont.lfCharSet;
6076 if (charset == SHIFTJIS_CHARSET
6077 || charset == HANGEUL_CHARSET
6078 || charset == CHINESEBIG5_CHARSET
6079 || charset == GB2312_CHARSET
6080 #ifdef JOHAB_CHARSET
6081 || charset == JOHAB_CHARSET
6082 #endif
6084 return 1;
6088 char buf[100];
6089 Lisp_Object width = Qnil;
6090 Lisp_Object charset_list = Qnil;
6091 char *charset = NULL;
6093 /* Truetype fonts do not report their true metrics until loaded */
6094 if (FontType != RASTER_FONTTYPE)
6096 if (!NILP (lpef->pattern))
6098 /* Scalable fonts are as big as you want them to be. */
6099 lplf->elfLogFont.lfHeight = lpef->logfont.lfHeight;
6100 lplf->elfLogFont.lfWidth = lpef->logfont.lfWidth;
6101 width = make_number (lpef->logfont.lfWidth);
6103 else
6105 lplf->elfLogFont.lfHeight = 0;
6106 lplf->elfLogFont.lfWidth = 0;
6110 /* Make sure the height used here is the same as everywhere
6111 else (ie character height, not cell height). */
6112 if (lplf->elfLogFont.lfHeight > 0)
6114 /* lptm can be trusted for RASTER fonts, but not scalable ones. */
6115 if (FontType == RASTER_FONTTYPE)
6116 lplf->elfLogFont.lfHeight = lptm->tmInternalLeading - lptm->tmHeight;
6117 else
6118 lplf->elfLogFont.lfHeight = -lplf->elfLogFont.lfHeight;
6121 if (!NILP (lpef->pattern))
6123 charset = xlfd_charset_of_font (SDATA (lpef->pattern));
6125 /* We already checked charsets above, but DEFAULT_CHARSET
6126 slipped through. So only allow exact matches for DEFAULT_CHARSET. */
6127 if (charset
6128 && strncmp (charset, "*-*", 3) != 0
6129 && lpef->logfont.lfCharSet == DEFAULT_CHARSET
6130 && strcmp (charset, w32_to_x_charset (DEFAULT_CHARSET, NULL)) != 0)
6131 return 1;
6133 /* Reject raster fonts if we are looking for a unicode font. */
6134 if (charset
6135 && FontType == RASTER_FONTTYPE
6136 && strncmp (charset, "iso10646", 8) == 0)
6137 return 1;
6140 if (charset)
6141 charset_list = Fcons (build_string (charset), Qnil);
6142 else
6143 /* Always prefer unicode. */
6144 charset_list
6145 = Fcons (build_string ("iso10646-1"),
6146 w32_to_all_x_charsets (lplf->elfLogFont.lfCharSet));
6148 /* Loop through the charsets. */
6149 for ( ; CONSP (charset_list); charset_list = Fcdr (charset_list))
6151 Lisp_Object this_charset = Fcar (charset_list);
6152 charset = SDATA (this_charset);
6154 /* Don't list raster fonts as unicode. */
6155 if (charset
6156 && FontType == RASTER_FONTTYPE
6157 && strncmp (charset, "iso10646", 8) == 0)
6158 continue;
6160 enum_font_maybe_add_to_list (lpef, &(lplf->elfLogFont),
6161 charset, width);
6163 /* List bold and italic variations if w32-enable-synthesized-fonts
6164 is non-nil and this is a plain font. */
6165 if (w32_enable_synthesized_fonts
6166 && lplf->elfLogFont.lfWeight == FW_NORMAL
6167 && lplf->elfLogFont.lfItalic == FALSE)
6169 /* bold. */
6170 lplf->elfLogFont.lfWeight = FW_BOLD;
6171 enum_font_maybe_add_to_list (lpef, &(lplf->elfLogFont),
6172 charset, width);
6173 /* bold italic. */
6174 lplf->elfLogFont.lfItalic = TRUE;
6175 enum_font_maybe_add_to_list (lpef, &(lplf->elfLogFont),
6176 charset, width);
6177 /* italic. */
6178 lplf->elfLogFont.lfWeight = FW_NORMAL;
6179 enum_font_maybe_add_to_list (lpef, &(lplf->elfLogFont),
6180 charset, width);
6185 return 1;
6188 static void
6189 enum_font_maybe_add_to_list (lpef, logfont, match_charset, width)
6190 enumfont_t * lpef;
6191 LOGFONT * logfont;
6192 char * match_charset;
6193 Lisp_Object width;
6195 char buf[100];
6197 if (!w32_to_x_font (logfont, buf, 100, match_charset))
6198 return;
6200 if (NILP (lpef->pattern)
6201 || w32_font_match (buf, SDATA (lpef->pattern)))
6203 /* Check if we already listed this font. This may happen if
6204 w32_enable_synthesized_fonts is non-nil, and there are real
6205 bold and italic versions of the font. */
6206 Lisp_Object font_name = build_string (buf);
6207 if (NILP (Fmember (font_name, lpef->list)))
6209 Lisp_Object entry = Fcons (font_name, width);
6210 lpef->list = Fcons (entry, lpef->list);
6211 lpef->numFonts++;
6217 static int CALLBACK
6218 enum_font_cb1 (lplf, lptm, FontType, lpef)
6219 ENUMLOGFONT * lplf;
6220 NEWTEXTMETRIC * lptm;
6221 int FontType;
6222 enumfont_t * lpef;
6224 return EnumFontFamilies (lpef->hdc,
6225 lplf->elfLogFont.lfFaceName,
6226 (FONTENUMPROC) enum_font_cb2,
6227 (LPARAM) lpef);
6231 static int CALLBACK
6232 enum_fontex_cb2 (lplf, lptm, font_type, lpef)
6233 ENUMLOGFONTEX * lplf;
6234 NEWTEXTMETRICEX * lptm;
6235 int font_type;
6236 enumfont_t * lpef;
6238 /* We are not interested in the extra info we get back from the 'Ex
6239 version - only the fact that we get character set variations
6240 enumerated seperately. */
6241 return enum_font_cb2 ((ENUMLOGFONT *) lplf, (NEWTEXTMETRIC *) lptm,
6242 font_type, lpef);
6245 static int CALLBACK
6246 enum_fontex_cb1 (lplf, lptm, font_type, lpef)
6247 ENUMLOGFONTEX * lplf;
6248 NEWTEXTMETRICEX * lptm;
6249 int font_type;
6250 enumfont_t * lpef;
6252 HMODULE gdi32 = GetModuleHandle ("gdi32.dll");
6253 FARPROC enum_font_families_ex
6254 = GetProcAddress ( gdi32, "EnumFontFamiliesExA");
6255 /* We don't really expect EnumFontFamiliesEx to disappear once we
6256 get here, so don't bother handling it gracefully. */
6257 if (enum_font_families_ex == NULL)
6258 error ("gdi32.dll has disappeared!");
6259 return enum_font_families_ex (lpef->hdc,
6260 &lplf->elfLogFont,
6261 (FONTENUMPROC) enum_fontex_cb2,
6262 (LPARAM) lpef, 0);
6265 /* Interface to fontset handler. (adapted from mw32font.c in Meadow
6266 and xterm.c in Emacs 20.3) */
6268 static Lisp_Object
6269 w32_list_bdf_fonts (Lisp_Object pattern, int max_names)
6271 char *fontname, *ptnstr;
6272 Lisp_Object list, tem, newlist = Qnil;
6273 int n_fonts = 0;
6275 list = Vw32_bdf_filename_alist;
6276 ptnstr = SDATA (pattern);
6278 for ( ; CONSP (list); list = XCDR (list))
6280 tem = XCAR (list);
6281 if (CONSP (tem))
6282 fontname = SDATA (XCAR (tem));
6283 else if (STRINGP (tem))
6284 fontname = SDATA (tem);
6285 else
6286 continue;
6288 if (w32_font_match (fontname, ptnstr))
6290 newlist = Fcons (XCAR (tem), newlist);
6291 n_fonts++;
6292 if (max_names >= 0 && n_fonts >= max_names)
6293 break;
6297 return newlist;
6301 /* Return a list of names of available fonts matching PATTERN on frame
6302 F. If SIZE is not 0, it is the size (maximum bound width) of fonts
6303 to be listed. Frame F NULL means we have not yet created any
6304 frame, which means we can't get proper size info, as we don't have
6305 a device context to use for GetTextMetrics.
6306 MAXNAMES sets a limit on how many fonts to match. If MAXNAMES is
6307 negative, then all matching fonts are returned. */
6309 Lisp_Object
6310 w32_list_fonts (f, pattern, size, maxnames)
6311 struct frame *f;
6312 Lisp_Object pattern;
6313 int size;
6314 int maxnames;
6316 Lisp_Object patterns, key = Qnil, tem, tpat;
6317 Lisp_Object list = Qnil, newlist = Qnil, second_best = Qnil;
6318 struct w32_display_info *dpyinfo = &one_w32_display_info;
6319 int n_fonts = 0;
6321 patterns = Fassoc (pattern, Valternate_fontname_alist);
6322 if (NILP (patterns))
6323 patterns = Fcons (pattern, Qnil);
6325 for (; CONSP (patterns); patterns = XCDR (patterns))
6327 enumfont_t ef;
6328 int codepage;
6330 tpat = XCAR (patterns);
6332 if (!STRINGP (tpat))
6333 continue;
6335 /* Avoid expensive EnumFontFamilies functions if we are not
6336 going to be able to output one of these anyway. */
6337 codepage = w32_codepage_for_font (SDATA (tpat));
6338 if (codepage != CP_8BIT && codepage != CP_UNICODE
6339 && codepage != CP_DEFAULT && codepage != CP_UNKNOWN
6340 && !IsValidCodePage (codepage))
6341 continue;
6343 /* See if we cached the result for this particular query.
6344 The cache is an alist of the form:
6345 ((PATTERN (FONTNAME . WIDTH) ...) ...)
6347 if (tem = XCDR (dpyinfo->name_list_element),
6348 !NILP (list = Fassoc (tpat, tem)))
6350 list = Fcdr_safe (list);
6351 /* We have a cached list. Don't have to get the list again. */
6352 goto label_cached;
6355 BLOCK_INPUT;
6356 /* At first, put PATTERN in the cache. */
6357 ef.pattern = tpat;
6358 ef.list = Qnil;
6359 ef.numFonts = 0;
6361 /* Use EnumFontFamiliesEx where it is available, as it knows
6362 about character sets. Fall back to EnumFontFamilies for
6363 older versions of NT that don't support the 'Ex function. */
6364 x_to_w32_font (SDATA (tpat), &ef.logfont);
6366 LOGFONT font_match_pattern;
6367 HMODULE gdi32 = GetModuleHandle ("gdi32.dll");
6368 FARPROC enum_font_families_ex
6369 = GetProcAddress ( gdi32, "EnumFontFamiliesExA");
6371 /* We do our own pattern matching so we can handle wildcards. */
6372 font_match_pattern.lfFaceName[0] = 0;
6373 font_match_pattern.lfPitchAndFamily = 0;
6374 /* We can use the charset, because if it is a wildcard it will
6375 be DEFAULT_CHARSET anyway. */
6376 font_match_pattern.lfCharSet = ef.logfont.lfCharSet;
6378 ef.hdc = GetDC (dpyinfo->root_window);
6380 if (enum_font_families_ex)
6381 enum_font_families_ex (ef.hdc,
6382 &font_match_pattern,
6383 (FONTENUMPROC) enum_fontex_cb1,
6384 (LPARAM) &ef, 0);
6385 else
6386 EnumFontFamilies (ef.hdc, NULL, (FONTENUMPROC) enum_font_cb1,
6387 (LPARAM)&ef);
6389 ReleaseDC (dpyinfo->root_window, ef.hdc);
6392 UNBLOCK_INPUT;
6393 list = ef.list;
6395 /* Make a list of the fonts we got back.
6396 Store that in the font cache for the display. */
6397 XSETCDR (dpyinfo->name_list_element,
6398 Fcons (Fcons (tpat, list),
6399 XCDR (dpyinfo->name_list_element)));
6401 label_cached:
6402 if (NILP (list)) continue; /* Try the remaining alternatives. */
6404 newlist = second_best = Qnil;
6406 /* Make a list of the fonts that have the right width. */
6407 for (; CONSP (list); list = XCDR (list))
6409 int found_size;
6410 tem = XCAR (list);
6412 if (!CONSP (tem))
6413 continue;
6414 if (NILP (XCAR (tem)))
6415 continue;
6416 if (!size)
6418 newlist = Fcons (XCAR (tem), newlist);
6419 n_fonts++;
6420 if (maxnames >= 0 && n_fonts >= maxnames)
6421 break;
6422 else
6423 continue;
6425 if (!INTEGERP (XCDR (tem)))
6427 /* Since we don't yet know the size of the font, we must
6428 load it and try GetTextMetrics. */
6429 W32FontStruct thisinfo;
6430 LOGFONT lf;
6431 HDC hdc;
6432 HANDLE oldobj;
6434 if (!x_to_w32_font (SDATA (XCAR (tem)), &lf))
6435 continue;
6437 BLOCK_INPUT;
6438 thisinfo.bdf = NULL;
6439 thisinfo.hfont = CreateFontIndirect (&lf);
6440 if (thisinfo.hfont == NULL)
6441 continue;
6443 hdc = GetDC (dpyinfo->root_window);
6444 oldobj = SelectObject (hdc, thisinfo.hfont);
6445 if (GetTextMetrics (hdc, &thisinfo.tm))
6446 XSETCDR (tem, make_number (FONT_AVG_WIDTH (&thisinfo)));
6447 else
6448 XSETCDR (tem, make_number (0));
6449 SelectObject (hdc, oldobj);
6450 ReleaseDC (dpyinfo->root_window, hdc);
6451 DeleteObject (thisinfo.hfont);
6452 UNBLOCK_INPUT;
6454 found_size = XINT (XCDR (tem));
6455 if (found_size == size)
6457 newlist = Fcons (XCAR (tem), newlist);
6458 n_fonts++;
6459 if (maxnames >= 0 && n_fonts >= maxnames)
6460 break;
6462 /* keep track of the closest matching size in case
6463 no exact match is found. */
6464 else if (found_size > 0)
6466 if (NILP (second_best))
6467 second_best = tem;
6469 else if (found_size < size)
6471 if (XINT (XCDR (second_best)) > size
6472 || XINT (XCDR (second_best)) < found_size)
6473 second_best = tem;
6475 else
6477 if (XINT (XCDR (second_best)) > size
6478 && XINT (XCDR (second_best)) >
6479 found_size)
6480 second_best = tem;
6485 if (!NILP (newlist))
6486 break;
6487 else if (!NILP (second_best))
6489 newlist = Fcons (XCAR (second_best), Qnil);
6490 break;
6494 /* Include any bdf fonts. */
6495 if (n_fonts < maxnames || maxnames < 0)
6497 Lisp_Object combined[2];
6498 combined[0] = w32_list_bdf_fonts (pattern, maxnames - n_fonts);
6499 combined[1] = newlist;
6500 newlist = Fnconc (2, combined);
6503 return newlist;
6507 /* Return a pointer to struct font_info of font FONT_IDX of frame F. */
6508 struct font_info *
6509 w32_get_font_info (f, font_idx)
6510 FRAME_PTR f;
6511 int font_idx;
6513 return (FRAME_W32_FONT_TABLE (f) + font_idx);
6517 struct font_info*
6518 w32_query_font (struct frame *f, char *fontname)
6520 int i;
6521 struct font_info *pfi;
6523 pfi = FRAME_W32_FONT_TABLE (f);
6525 for (i = 0; i < one_w32_display_info.n_fonts ;i++, pfi++)
6527 if (stricmp (pfi->name, fontname) == 0) return pfi;
6530 return NULL;
6533 /* Find a CCL program for a font specified by FONTP, and set the member
6534 `encoder' of the structure. */
6536 void
6537 w32_find_ccl_program (fontp)
6538 struct font_info *fontp;
6540 Lisp_Object list, elt;
6542 for (list = Vfont_ccl_encoder_alist; CONSP (list); list = XCDR (list))
6544 elt = XCAR (list);
6545 if (CONSP (elt)
6546 && STRINGP (XCAR (elt))
6547 && (fast_c_string_match_ignore_case (XCAR (elt), fontp->name)
6548 >= 0))
6549 break;
6551 if (! NILP (list))
6553 struct ccl_program *ccl
6554 = (struct ccl_program *) xmalloc (sizeof (struct ccl_program));
6556 if (setup_ccl_program (ccl, XCDR (elt)) < 0)
6557 xfree (ccl);
6558 else
6559 fontp->font_encoder = ccl;
6563 /* directory-files from dired.c. */
6564 Lisp_Object Fdirectory_files P_ ((Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object));
6567 /* Find BDF files in a specified directory. (use GCPRO when calling,
6568 as this calls lisp to get a directory listing). */
6569 static Lisp_Object
6570 w32_find_bdf_fonts_in_dir (Lisp_Object directory)
6572 Lisp_Object filelist, list = Qnil;
6573 char fontname[100];
6575 if (!STRINGP (directory))
6576 return Qnil;
6578 filelist = Fdirectory_files (directory, Qt,
6579 build_string (".*\\.[bB][dD][fF]"), Qt);
6581 for ( ; CONSP (filelist); filelist = XCDR (filelist))
6583 Lisp_Object filename = XCAR (filelist);
6584 if (w32_BDF_to_x_font (SDATA (filename), fontname, 100))
6585 store_in_alist (&list, build_string (fontname), filename);
6587 return list;
6590 DEFUN ("w32-find-bdf-fonts", Fw32_find_bdf_fonts, Sw32_find_bdf_fonts,
6591 1, 1, 0,
6592 doc: /* Return a list of BDF fonts in DIRECTORY.
6593 The list is suitable for appending to `w32-bdf-filename-alist'.
6594 Fonts which do not contain an xlfd description will not be included
6595 in the list. DIRECTORY may be a list of directories. */)
6596 (directory)
6597 Lisp_Object directory;
6599 Lisp_Object list = Qnil;
6600 struct gcpro gcpro1, gcpro2;
6602 if (!CONSP (directory))
6603 return w32_find_bdf_fonts_in_dir (directory);
6605 for ( ; CONSP (directory); directory = XCDR (directory))
6607 Lisp_Object pair[2];
6608 pair[0] = list;
6609 pair[1] = Qnil;
6610 GCPRO2 (directory, list);
6611 pair[1] = w32_find_bdf_fonts_in_dir ( XCAR (directory) );
6612 list = Fnconc ( 2, pair );
6613 UNGCPRO;
6615 return list;
6619 DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1, 2, 0,
6620 doc: /* Internal function called by `color-defined-p', which see. */)
6621 (color, frame)
6622 Lisp_Object color, frame;
6624 XColor foo;
6625 FRAME_PTR f = check_x_frame (frame);
6627 CHECK_STRING (color);
6629 if (w32_defined_color (f, SDATA (color), &foo, 0))
6630 return Qt;
6631 else
6632 return Qnil;
6635 DEFUN ("xw-color-values", Fxw_color_values, Sxw_color_values, 1, 2, 0,
6636 doc: /* Internal function called by `color-values', which see. */)
6637 (color, frame)
6638 Lisp_Object color, frame;
6640 XColor foo;
6641 FRAME_PTR f = check_x_frame (frame);
6643 CHECK_STRING (color);
6645 if (w32_defined_color (f, SDATA (color), &foo, 0))
6646 return list3 (make_number ((GetRValue (foo.pixel) << 8)
6647 | GetRValue (foo.pixel)),
6648 make_number ((GetGValue (foo.pixel) << 8)
6649 | GetGValue (foo.pixel)),
6650 make_number ((GetBValue (foo.pixel) << 8)
6651 | GetBValue (foo.pixel)));
6652 else
6653 return Qnil;
6656 DEFUN ("xw-display-color-p", Fxw_display_color_p, Sxw_display_color_p, 0, 1, 0,
6657 doc: /* Internal function called by `display-color-p', which see. */)
6658 (display)
6659 Lisp_Object display;
6661 struct w32_display_info *dpyinfo = check_x_display_info (display);
6663 if ((dpyinfo->n_planes * dpyinfo->n_cbits) <= 2)
6664 return Qnil;
6666 return Qt;
6669 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p,
6670 Sx_display_grayscale_p, 0, 1, 0,
6671 doc: /* Return t if DISPLAY supports shades of gray.
6672 Note that color displays do support shades of gray.
6673 The optional argument DISPLAY specifies which display to ask about.
6674 DISPLAY should be either a frame or a display name (a string).
6675 If omitted or nil, that stands for the selected frame's display. */)
6676 (display)
6677 Lisp_Object display;
6679 struct w32_display_info *dpyinfo = check_x_display_info (display);
6681 if ((dpyinfo->n_planes * dpyinfo->n_cbits) <= 1)
6682 return Qnil;
6684 return Qt;
6687 DEFUN ("x-display-pixel-width", Fx_display_pixel_width,
6688 Sx_display_pixel_width, 0, 1, 0,
6689 doc: /* Return the width in pixels of DISPLAY.
6690 The optional argument DISPLAY specifies which display to ask about.
6691 DISPLAY should be either a frame or a display name (a string).
6692 If omitted or nil, that stands for the selected frame's display. */)
6693 (display)
6694 Lisp_Object display;
6696 struct w32_display_info *dpyinfo = check_x_display_info (display);
6698 return make_number (dpyinfo->width);
6701 DEFUN ("x-display-pixel-height", Fx_display_pixel_height,
6702 Sx_display_pixel_height, 0, 1, 0,
6703 doc: /* Return the height in pixels of DISPLAY.
6704 The optional argument DISPLAY specifies which display to ask about.
6705 DISPLAY should be either a frame or a display name (a string).
6706 If omitted or nil, that stands for the selected frame's display. */)
6707 (display)
6708 Lisp_Object display;
6710 struct w32_display_info *dpyinfo = check_x_display_info (display);
6712 return make_number (dpyinfo->height);
6715 DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes,
6716 0, 1, 0,
6717 doc: /* Return the number of bitplanes of DISPLAY.
6718 The optional argument DISPLAY specifies which display to ask about.
6719 DISPLAY should be either a frame or a display name (a string).
6720 If omitted or nil, that stands for the selected frame's display. */)
6721 (display)
6722 Lisp_Object display;
6724 struct w32_display_info *dpyinfo = check_x_display_info (display);
6726 return make_number (dpyinfo->n_planes * dpyinfo->n_cbits);
6729 DEFUN ("x-display-color-cells", Fx_display_color_cells, Sx_display_color_cells,
6730 0, 1, 0,
6731 doc: /* Return the number of color cells of DISPLAY.
6732 The optional argument DISPLAY specifies which display to ask about.
6733 DISPLAY should be either a frame or a display name (a string).
6734 If omitted or nil, that stands for the selected frame's display. */)
6735 (display)
6736 Lisp_Object display;
6738 struct w32_display_info *dpyinfo = check_x_display_info (display);
6739 HDC hdc;
6740 int cap;
6742 hdc = GetDC (dpyinfo->root_window);
6743 if (dpyinfo->has_palette)
6744 cap = GetDeviceCaps (hdc, SIZEPALETTE);
6745 else
6746 cap = GetDeviceCaps (hdc, NUMCOLORS);
6748 /* We force 24+ bit depths to 24-bit, both to prevent an overflow
6749 and because probably is more meaningful on Windows anyway */
6750 if (cap < 0)
6751 cap = 1 << min (dpyinfo->n_planes * dpyinfo->n_cbits, 24);
6753 ReleaseDC (dpyinfo->root_window, hdc);
6755 return make_number (cap);
6758 DEFUN ("x-server-max-request-size", Fx_server_max_request_size,
6759 Sx_server_max_request_size,
6760 0, 1, 0,
6761 doc: /* Return the maximum request size of the server of DISPLAY.
6762 The optional argument DISPLAY specifies which display to ask about.
6763 DISPLAY should be either a frame or a display name (a string).
6764 If omitted or nil, that stands for the selected frame's display. */)
6765 (display)
6766 Lisp_Object display;
6768 struct w32_display_info *dpyinfo = check_x_display_info (display);
6770 return make_number (1);
6773 DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0,
6774 doc: /* Return the "vendor ID" string of the W32 system (Microsoft).
6775 The optional argument DISPLAY specifies which display to ask about.
6776 DISPLAY should be either a frame or a display name (a string).
6777 If omitted or nil, that stands for the selected frame's display. */)
6778 (display)
6779 Lisp_Object display;
6781 return build_string ("Microsoft Corp.");
6784 DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0,
6785 doc: /* Return the version numbers of the server of DISPLAY.
6786 The value is a list of three integers: the major and minor
6787 version numbers of the X Protocol in use, and the distributor-specific
6788 release number. See also the function `x-server-vendor'.
6790 The optional argument DISPLAY specifies which display to ask about.
6791 DISPLAY should be either a frame or a display name (a string).
6792 If omitted or nil, that stands for the selected frame's display. */)
6793 (display)
6794 Lisp_Object display;
6796 return Fcons (make_number (w32_major_version),
6797 Fcons (make_number (w32_minor_version),
6798 Fcons (make_number (w32_build_number), Qnil)));
6801 DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0,
6802 doc: /* Return the number of screens on the server of DISPLAY.
6803 The optional argument DISPLAY specifies which display to ask about.
6804 DISPLAY should be either a frame or a display name (a string).
6805 If omitted or nil, that stands for the selected frame's display. */)
6806 (display)
6807 Lisp_Object display;
6809 return make_number (1);
6812 DEFUN ("x-display-mm-height", Fx_display_mm_height,
6813 Sx_display_mm_height, 0, 1, 0,
6814 doc: /* Return the height in millimeters of DISPLAY.
6815 The optional argument DISPLAY specifies which display to ask about.
6816 DISPLAY should be either a frame or a display name (a string).
6817 If omitted or nil, that stands for the selected frame's display. */)
6818 (display)
6819 Lisp_Object display;
6821 struct w32_display_info *dpyinfo = check_x_display_info (display);
6822 HDC hdc;
6823 int cap;
6825 hdc = GetDC (dpyinfo->root_window);
6827 cap = GetDeviceCaps (hdc, VERTSIZE);
6829 ReleaseDC (dpyinfo->root_window, hdc);
6831 return make_number (cap);
6834 DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0,
6835 doc: /* Return the width in millimeters of DISPLAY.
6836 The optional argument DISPLAY specifies which display to ask about.
6837 DISPLAY should be either a frame or a display name (a string).
6838 If omitted or nil, that stands for the selected frame's display. */)
6839 (display)
6840 Lisp_Object display;
6842 struct w32_display_info *dpyinfo = check_x_display_info (display);
6844 HDC hdc;
6845 int cap;
6847 hdc = GetDC (dpyinfo->root_window);
6849 cap = GetDeviceCaps (hdc, HORZSIZE);
6851 ReleaseDC (dpyinfo->root_window, hdc);
6853 return make_number (cap);
6856 DEFUN ("x-display-backing-store", Fx_display_backing_store,
6857 Sx_display_backing_store, 0, 1, 0,
6858 doc: /* Return an indication of whether DISPLAY does backing store.
6859 The value may be `always', `when-mapped', or `not-useful'.
6860 The optional argument DISPLAY specifies which display to ask about.
6861 DISPLAY should be either a frame or a display name (a string).
6862 If omitted or nil, that stands for the selected frame's display. */)
6863 (display)
6864 Lisp_Object display;
6866 return intern ("not-useful");
6869 DEFUN ("x-display-visual-class", Fx_display_visual_class,
6870 Sx_display_visual_class, 0, 1, 0,
6871 doc: /* Return the visual class of DISPLAY.
6872 The value is one of the symbols `static-gray', `gray-scale',
6873 `static-color', `pseudo-color', `true-color', or `direct-color'.
6875 The optional argument DISPLAY specifies which display to ask about.
6876 DISPLAY should be either a frame or a display name (a string).
6877 If omitted or nil, that stands for the selected frame's display. */)
6878 (display)
6879 Lisp_Object display;
6881 struct w32_display_info *dpyinfo = check_x_display_info (display);
6882 Lisp_Object result = Qnil;
6884 if (dpyinfo->has_palette)
6885 result = intern ("pseudo-color");
6886 else if (dpyinfo->n_planes * dpyinfo->n_cbits == 1)
6887 result = intern ("static-grey");
6888 else if (dpyinfo->n_planes * dpyinfo->n_cbits == 4)
6889 result = intern ("static-color");
6890 else if (dpyinfo->n_planes * dpyinfo->n_cbits > 8)
6891 result = intern ("true-color");
6893 return result;
6896 DEFUN ("x-display-save-under", Fx_display_save_under,
6897 Sx_display_save_under, 0, 1, 0,
6898 doc: /* Return t if DISPLAY supports the save-under feature.
6899 The optional argument DISPLAY specifies which display to ask about.
6900 DISPLAY should be either a frame or a display name (a string).
6901 If omitted or nil, that stands for the selected frame's display. */)
6902 (display)
6903 Lisp_Object display;
6905 return Qnil;
6909 x_pixel_width (f)
6910 register struct frame *f;
6912 return FRAME_PIXEL_WIDTH (f);
6916 x_pixel_height (f)
6917 register struct frame *f;
6919 return FRAME_PIXEL_HEIGHT (f);
6923 x_char_width (f)
6924 register struct frame *f;
6926 return FRAME_COLUMN_WIDTH (f);
6930 x_char_height (f)
6931 register struct frame *f;
6933 return FRAME_LINE_HEIGHT (f);
6937 x_screen_planes (f)
6938 register struct frame *f;
6940 return FRAME_W32_DISPLAY_INFO (f)->n_planes;
6943 /* Return the display structure for the display named NAME.
6944 Open a new connection if necessary. */
6946 struct w32_display_info *
6947 x_display_info_for_name (name)
6948 Lisp_Object name;
6950 Lisp_Object names;
6951 struct w32_display_info *dpyinfo;
6953 CHECK_STRING (name);
6955 for (dpyinfo = &one_w32_display_info, names = w32_display_name_list;
6956 dpyinfo;
6957 dpyinfo = dpyinfo->next, names = XCDR (names))
6959 Lisp_Object tem;
6960 tem = Fstring_equal (XCAR (XCAR (names)), name);
6961 if (!NILP (tem))
6962 return dpyinfo;
6965 /* Use this general default value to start with. */
6966 Vx_resource_name = Vinvocation_name;
6968 validate_x_resource_name ();
6970 dpyinfo = w32_term_init (name, (unsigned char *)0,
6971 (char *) SDATA (Vx_resource_name));
6973 if (dpyinfo == 0)
6974 error ("Cannot connect to server %s", SDATA (name));
6976 w32_in_use = 1;
6977 XSETFASTINT (Vwindow_system_version, 3);
6979 return dpyinfo;
6982 DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
6983 1, 3, 0, doc: /* Open a connection to a server.
6984 DISPLAY is the name of the display to connect to.
6985 Optional second arg XRM-STRING is a string of resources in xrdb format.
6986 If the optional third arg MUST-SUCCEED is non-nil,
6987 terminate Emacs if we can't open the connection. */)
6988 (display, xrm_string, must_succeed)
6989 Lisp_Object display, xrm_string, must_succeed;
6991 unsigned char *xrm_option;
6992 struct w32_display_info *dpyinfo;
6994 /* If initialization has already been done, return now to avoid
6995 overwriting critical parts of one_w32_display_info. */
6996 if (w32_in_use)
6997 return Qnil;
6999 CHECK_STRING (display);
7000 if (! NILP (xrm_string))
7001 CHECK_STRING (xrm_string);
7003 #if 0
7004 if (! EQ (Vwindow_system, intern ("w32")))
7005 error ("Not using Microsoft Windows");
7006 #endif
7008 /* Allow color mapping to be defined externally; first look in user's
7009 HOME directory, then in Emacs etc dir for a file called rgb.txt. */
7011 Lisp_Object color_file;
7012 struct gcpro gcpro1;
7014 color_file = build_string ("~/rgb.txt");
7016 GCPRO1 (color_file);
7018 if (NILP (Ffile_readable_p (color_file)))
7019 color_file =
7020 Fexpand_file_name (build_string ("rgb.txt"),
7021 Fsymbol_value (intern ("data-directory")));
7023 Vw32_color_map = Fw32_load_color_file (color_file);
7025 UNGCPRO;
7027 if (NILP (Vw32_color_map))
7028 Vw32_color_map = Fw32_default_color_map ();
7030 /* Merge in system logical colors. */
7031 add_system_logical_colors_to_map (&Vw32_color_map);
7033 if (! NILP (xrm_string))
7034 xrm_option = (unsigned char *) SDATA (xrm_string);
7035 else
7036 xrm_option = (unsigned char *) 0;
7038 /* Use this general default value to start with. */
7039 /* First remove .exe suffix from invocation-name - it looks ugly. */
7041 char basename[ MAX_PATH ], *str;
7043 strcpy (basename, SDATA (Vinvocation_name));
7044 str = strrchr (basename, '.');
7045 if (str) *str = 0;
7046 Vinvocation_name = build_string (basename);
7048 Vx_resource_name = Vinvocation_name;
7050 validate_x_resource_name ();
7052 /* This is what opens the connection and sets x_current_display.
7053 This also initializes many symbols, such as those used for input. */
7054 dpyinfo = w32_term_init (display, xrm_option,
7055 (char *) SDATA (Vx_resource_name));
7057 if (dpyinfo == 0)
7059 if (!NILP (must_succeed))
7060 fatal ("Cannot connect to server %s.\n",
7061 SDATA (display));
7062 else
7063 error ("Cannot connect to server %s", SDATA (display));
7066 w32_in_use = 1;
7068 XSETFASTINT (Vwindow_system_version, 3);
7069 return Qnil;
7072 DEFUN ("x-close-connection", Fx_close_connection,
7073 Sx_close_connection, 1, 1, 0,
7074 doc: /* Close the connection to DISPLAY's server.
7075 For DISPLAY, specify either a frame or a display name (a string).
7076 If DISPLAY is nil, that stands for the selected frame's display. */)
7077 (display)
7078 Lisp_Object display;
7080 struct w32_display_info *dpyinfo = check_x_display_info (display);
7081 int i;
7083 if (dpyinfo->reference_count > 0)
7084 error ("Display still has frames on it");
7086 BLOCK_INPUT;
7087 /* Free the fonts in the font table. */
7088 for (i = 0; i < dpyinfo->n_fonts; i++)
7089 if (dpyinfo->font_table[i].name)
7091 if (dpyinfo->font_table[i].name != dpyinfo->font_table[i].full_name)
7092 xfree (dpyinfo->font_table[i].full_name);
7093 xfree (dpyinfo->font_table[i].name);
7094 w32_unload_font (dpyinfo, dpyinfo->font_table[i].font);
7096 x_destroy_all_bitmaps (dpyinfo);
7098 x_delete_display (dpyinfo);
7099 UNBLOCK_INPUT;
7101 return Qnil;
7104 DEFUN ("x-display-list", Fx_display_list, Sx_display_list, 0, 0, 0,
7105 doc: /* Return the list of display names that Emacs has connections to. */)
7108 Lisp_Object tail, result;
7110 result = Qnil;
7111 for (tail = w32_display_name_list; CONSP (tail); tail = XCDR (tail))
7112 result = Fcons (XCAR (XCAR (tail)), result);
7114 return result;
7117 DEFUN ("x-synchronize", Fx_synchronize, Sx_synchronize, 1, 2, 0,
7118 doc: /* This is a noop on W32 systems. */)
7119 (on, display)
7120 Lisp_Object display, on;
7122 return Qnil;
7127 /***********************************************************************
7128 Window properties
7129 ***********************************************************************/
7131 DEFUN ("x-change-window-property", Fx_change_window_property,
7132 Sx_change_window_property, 2, 6, 0,
7133 doc: /* Change window property PROP to VALUE on the X window of FRAME.
7134 VALUE may be a string or a list of conses, numbers and/or strings.
7135 If an element in the list is a string, it is converted to
7136 an Atom and the value of the Atom is used. If an element is a cons,
7137 it is converted to a 32 bit number where the car is the 16 top bits and the
7138 cdr is the lower 16 bits.
7139 FRAME nil or omitted means use the selected frame.
7140 If TYPE is given and non-nil, it is the name of the type of VALUE.
7141 If TYPE is not given or nil, the type is STRING.
7142 FORMAT gives the size in bits of each element if VALUE is a list.
7143 It must be one of 8, 16 or 32.
7144 If VALUE is a string or FORMAT is nil or not given, FORMAT defaults to 8.
7145 If OUTER_P is non-nil, the property is changed for the outer X window of
7146 FRAME. Default is to change on the edit X window.
7148 Value is VALUE. */)
7149 (prop, value, frame, type, format, outer_p)
7150 Lisp_Object prop, value, frame, type, format, outer_p;
7152 #if 0 /* TODO : port window properties to W32 */
7153 struct frame *f = check_x_frame (frame);
7154 Atom prop_atom;
7156 CHECK_STRING (prop);
7157 CHECK_STRING (value);
7159 BLOCK_INPUT;
7160 prop_atom = XInternAtom (FRAME_W32_DISPLAY (f), SDATA (prop), False);
7161 XChangeProperty (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f),
7162 prop_atom, XA_STRING, 8, PropModeReplace,
7163 SDATA (value), SCHARS (value));
7165 /* Make sure the property is set when we return. */
7166 XFlush (FRAME_W32_DISPLAY (f));
7167 UNBLOCK_INPUT;
7169 #endif /* TODO */
7171 return value;
7175 DEFUN ("x-delete-window-property", Fx_delete_window_property,
7176 Sx_delete_window_property, 1, 2, 0,
7177 doc: /* Remove window property PROP from X window of FRAME.
7178 FRAME nil or omitted means use the selected frame. Value is PROP. */)
7179 (prop, frame)
7180 Lisp_Object prop, frame;
7182 #if 0 /* TODO : port window properties to W32 */
7184 struct frame *f = check_x_frame (frame);
7185 Atom prop_atom;
7187 CHECK_STRING (prop);
7188 BLOCK_INPUT;
7189 prop_atom = XInternAtom (FRAME_W32_DISPLAY (f), SDATA (prop), False);
7190 XDeleteProperty (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f), prop_atom);
7192 /* Make sure the property is removed when we return. */
7193 XFlush (FRAME_W32_DISPLAY (f));
7194 UNBLOCK_INPUT;
7195 #endif /* TODO */
7197 return prop;
7201 DEFUN ("x-window-property", Fx_window_property, Sx_window_property,
7202 1, 2, 0,
7203 doc: /* Value is the value of window property PROP on FRAME.
7204 If FRAME is nil or omitted, use the selected frame. Value is nil
7205 if FRAME hasn't a property with name PROP or if PROP has no string
7206 value. */)
7207 (prop, frame)
7208 Lisp_Object prop, frame;
7210 #if 0 /* TODO : port window properties to W32 */
7212 struct frame *f = check_x_frame (frame);
7213 Atom prop_atom;
7214 int rc;
7215 Lisp_Object prop_value = Qnil;
7216 char *tmp_data = NULL;
7217 Atom actual_type;
7218 int actual_format;
7219 unsigned long actual_size, bytes_remaining;
7221 CHECK_STRING (prop);
7222 BLOCK_INPUT;
7223 prop_atom = XInternAtom (FRAME_W32_DISPLAY (f), SDATA (prop), False);
7224 rc = XGetWindowProperty (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f),
7225 prop_atom, 0, 0, False, XA_STRING,
7226 &actual_type, &actual_format, &actual_size,
7227 &bytes_remaining, (unsigned char **) &tmp_data);
7228 if (rc == Success)
7230 int size = bytes_remaining;
7232 XFree (tmp_data);
7233 tmp_data = NULL;
7235 rc = XGetWindowProperty (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f),
7236 prop_atom, 0, bytes_remaining,
7237 False, XA_STRING,
7238 &actual_type, &actual_format,
7239 &actual_size, &bytes_remaining,
7240 (unsigned char **) &tmp_data);
7241 if (rc == Success)
7242 prop_value = make_string (tmp_data, size);
7244 XFree (tmp_data);
7247 UNBLOCK_INPUT;
7249 return prop_value;
7251 #endif /* TODO */
7252 return Qnil;
7257 /***********************************************************************
7258 Busy cursor
7259 ***********************************************************************/
7261 /* Non-zero means an hourglass cursor is currently shown. */
7263 static int hourglass_shown_p;
7265 /* Number of seconds to wait before displaying an hourglass cursor. */
7267 static Lisp_Object Vhourglass_delay;
7269 /* Default number of seconds to wait before displaying an hourglass
7270 cursor. */
7272 #define DEFAULT_HOURGLASS_DELAY 1
7274 /* Return non-zero if houglass timer has been started or hourglass is shown. */
7277 hourglass_started ()
7279 return hourglass_shown_p || hourglass_timer;
7282 /* Cancel a currently active hourglass timer, and start a new one. */
7284 void
7285 start_hourglass ()
7287 DWORD delay;
7288 int secs, msecs = 0;
7289 struct frame * f = SELECTED_FRAME ();
7291 /* No cursors on non GUI frames. */
7292 if (!FRAME_W32_P (f))
7293 return;
7295 cancel_hourglass ();
7297 if (INTEGERP (Vhourglass_delay)
7298 && XINT (Vhourglass_delay) > 0)
7299 secs = XFASTINT (Vhourglass_delay);
7300 else if (FLOATP (Vhourglass_delay)
7301 && XFLOAT_DATA (Vhourglass_delay) > 0)
7303 Lisp_Object tem;
7304 tem = Ftruncate (Vhourglass_delay, Qnil);
7305 secs = XFASTINT (tem);
7306 msecs = (XFLOAT_DATA (Vhourglass_delay) - secs) * 1000;
7308 else
7309 secs = DEFAULT_HOURGLASS_DELAY;
7311 delay = secs * 1000 + msecs;
7312 hourglass_hwnd = FRAME_W32_WINDOW (f);
7313 hourglass_timer = SetTimer (hourglass_hwnd, HOURGLASS_ID, delay, NULL);
7317 /* Cancel the hourglass cursor timer if active, hide an hourglass
7318 cursor if shown. */
7320 void
7321 cancel_hourglass ()
7323 if (hourglass_timer)
7325 KillTimer (hourglass_hwnd, hourglass_timer);
7326 hourglass_timer = 0;
7329 if (hourglass_shown_p)
7330 hide_hourglass ();
7334 /* Timer function of hourglass_timer.
7336 Display an hourglass cursor. Set the hourglass_p flag in display info
7337 to indicate that an hourglass cursor is shown. */
7339 static void
7340 show_hourglass (f)
7341 struct frame *f;
7343 if (!hourglass_shown_p)
7345 f->output_data.w32->hourglass_p = 1;
7346 if (!menubar_in_use && !current_popup_menu)
7347 SetCursor (f->output_data.w32->hourglass_cursor);
7348 hourglass_shown_p = 1;
7353 /* Hide the hourglass cursor on all frames, if it is currently shown. */
7355 static void
7356 hide_hourglass ()
7358 if (hourglass_shown_p)
7360 struct frame *f = x_window_to_frame (&one_w32_display_info,
7361 hourglass_hwnd);
7363 f->output_data.w32->hourglass_p = 0;
7364 SetCursor (f->output_data.w32->current_cursor);
7365 hourglass_shown_p = 0;
7371 /***********************************************************************
7372 Tool tips
7373 ***********************************************************************/
7375 static Lisp_Object x_create_tip_frame P_ ((struct w32_display_info *,
7376 Lisp_Object, Lisp_Object));
7377 static void compute_tip_xy P_ ((struct frame *, Lisp_Object, Lisp_Object,
7378 Lisp_Object, int, int, int *, int *));
7380 /* The frame of a currently visible tooltip. */
7382 Lisp_Object tip_frame;
7384 /* If non-nil, a timer started that hides the last tooltip when it
7385 fires. */
7387 Lisp_Object tip_timer;
7388 Window tip_window;
7390 /* If non-nil, a vector of 3 elements containing the last args
7391 with which x-show-tip was called. See there. */
7393 Lisp_Object last_show_tip_args;
7395 /* Maximum size for tooltips; a cons (COLUMNS . ROWS). */
7397 Lisp_Object Vx_max_tooltip_size;
7400 static Lisp_Object
7401 unwind_create_tip_frame (frame)
7402 Lisp_Object frame;
7404 Lisp_Object deleted;
7406 deleted = unwind_create_frame (frame);
7407 if (EQ (deleted, Qt))
7409 tip_window = NULL;
7410 tip_frame = Qnil;
7413 return deleted;
7417 /* Create a frame for a tooltip on the display described by DPYINFO.
7418 PARMS is a list of frame parameters. TEXT is the string to
7419 display in the tip frame. Value is the frame.
7421 Note that functions called here, esp. x_default_parameter can
7422 signal errors, for instance when a specified color name is
7423 undefined. We have to make sure that we're in a consistent state
7424 when this happens. */
7426 static Lisp_Object
7427 x_create_tip_frame (dpyinfo, parms, text)
7428 struct w32_display_info *dpyinfo;
7429 Lisp_Object parms, text;
7431 struct frame *f;
7432 Lisp_Object frame, tem;
7433 Lisp_Object name;
7434 long window_prompting = 0;
7435 int width, height;
7436 int count = SPECPDL_INDEX ();
7437 struct gcpro gcpro1, gcpro2, gcpro3;
7438 struct kboard *kb;
7439 int face_change_count_before = face_change_count;
7440 Lisp_Object buffer;
7441 struct buffer *old_buffer;
7443 check_w32 ();
7445 /* Use this general default value to start with until we know if
7446 this frame has a specified name. */
7447 Vx_resource_name = Vinvocation_name;
7449 #ifdef MULTI_KBOARD
7450 kb = dpyinfo->terminal->kboard;
7451 #else
7452 kb = &the_only_kboard;
7453 #endif
7455 /* Get the name of the frame to use for resource lookup. */
7456 name = w32_get_arg (parms, Qname, "name", "Name", RES_TYPE_STRING);
7457 if (!STRINGP (name)
7458 && !EQ (name, Qunbound)
7459 && !NILP (name))
7460 error ("Invalid frame name--not a string or nil");
7461 Vx_resource_name = name;
7463 frame = Qnil;
7464 GCPRO3 (parms, name, frame);
7465 /* Make a frame without minibuffer nor mode-line. */
7466 f = make_frame (0);
7467 f->wants_modeline = 0;
7468 XSETFRAME (frame, f);
7470 buffer = Fget_buffer_create (build_string (" *tip*"));
7471 Fset_window_buffer (FRAME_ROOT_WINDOW (f), buffer, Qnil);
7472 old_buffer = current_buffer;
7473 set_buffer_internal_1 (XBUFFER (buffer));
7474 current_buffer->truncate_lines = Qnil;
7475 specbind (Qinhibit_read_only, Qt);
7476 specbind (Qinhibit_modification_hooks, Qt);
7477 Ferase_buffer ();
7478 Finsert (1, &text);
7479 set_buffer_internal_1 (old_buffer);
7481 FRAME_CAN_HAVE_SCROLL_BARS (f) = 0;
7482 record_unwind_protect (unwind_create_tip_frame, frame);
7484 /* By setting the output method, we're essentially saying that
7485 the frame is live, as per FRAME_LIVE_P. If we get a signal
7486 from this point on, x_destroy_window might screw up reference
7487 counts etc. */
7488 f->terminal = dpyinfo->terminal;
7489 f->terminal->reference_count++;
7490 f->output_method = output_w32;
7491 f->output_data.w32 =
7492 (struct w32_output *) xmalloc (sizeof (struct w32_output));
7493 bzero (f->output_data.w32, sizeof (struct w32_output));
7495 FRAME_FONTSET (f) = -1;
7496 f->icon_name = Qnil;
7498 #if 0 /* GLYPH_DEBUG TODO: image support. */
7499 image_cache_refcount = FRAME_IMAGE_CACHE (f)->refcount;
7500 dpyinfo_refcount = dpyinfo->reference_count;
7501 #endif /* GLYPH_DEBUG */
7502 #ifdef MULTI_KBOARD
7503 FRAME_KBOARD (f) = kb;
7504 #endif
7505 f->output_data.w32->parent_desc = FRAME_W32_DISPLAY_INFO (f)->root_window;
7506 f->output_data.w32->explicit_parent = 0;
7508 /* Set the name; the functions to which we pass f expect the name to
7509 be set. */
7510 if (EQ (name, Qunbound) || NILP (name))
7512 f->name = build_string (dpyinfo->w32_id_name);
7513 f->explicit_name = 0;
7515 else
7517 f->name = name;
7518 f->explicit_name = 1;
7519 /* use the frame's title when getting resources for this frame. */
7520 specbind (Qx_resource_name, name);
7523 f->resx = dpyinfo->resx;
7524 f->resy = dpyinfo->resy;
7526 #ifdef USE_FONT_BACKEND
7527 if (enable_font_backend)
7529 /* Perhaps, we must allow frame parameter, say `font-backend',
7530 to specify which font backends to use. */
7531 register_font_driver (&w32font_driver, f);
7533 x_default_parameter (f, parms, Qfont_backend, Qnil,
7534 "fontBackend", "FontBackend", RES_TYPE_STRING);
7536 #endif /* USE_FONT_BACKEND */
7538 /* Extract the window parameters from the supplied values
7539 that are needed to determine window geometry. */
7540 #ifdef USE_FONT_BACKEND
7541 if (enable_font_backend)
7542 x_default_font_parameter (f, parms);
7543 else
7544 #endif /* USE_FONT_BACKEND */
7546 Lisp_Object font;
7548 font = w32_get_arg (parms, Qfont, "font", "Font", RES_TYPE_STRING);
7550 BLOCK_INPUT;
7551 /* First, try whatever font the caller has specified. */
7552 if (STRINGP (font))
7554 tem = Fquery_fontset (font, Qnil);
7555 if (STRINGP (tem))
7556 font = x_new_fontset (f, tem);
7557 else
7558 font = x_new_font (f, SDATA (font));
7561 /* Try out a font which we hope has bold and italic variations. */
7562 if (!STRINGP (font))
7563 font = x_new_font (f, "-*-Courier New-normal-r-*-*-*-100-*-*-c-*-iso8859-1");
7564 if (! STRINGP (font))
7565 font = x_new_font (f, "-*-Courier-normal-r-*-*-13-*-*-*-c-*-iso8859-1");
7566 /* If those didn't work, look for something which will at least work. */
7567 if (! STRINGP (font))
7568 font = x_new_font (f, "-*-Fixedsys-normal-r-*-*-12-*-*-*-c-*-iso8859-1");
7569 UNBLOCK_INPUT;
7570 if (! STRINGP (font))
7571 font = build_string ("Fixedsys");
7573 x_default_parameter (f, parms, Qfont, font,
7574 "font", "Font", RES_TYPE_STRING);
7577 x_default_parameter (f, parms, Qborder_width, make_number (2),
7578 "borderWidth", "BorderWidth", RES_TYPE_NUMBER);
7579 /* This defaults to 2 in order to match xterm. We recognize either
7580 internalBorderWidth or internalBorder (which is what xterm calls
7581 it). */
7582 if (NILP (Fassq (Qinternal_border_width, parms)))
7584 Lisp_Object value;
7586 value = w32_get_arg (parms, Qinternal_border_width,
7587 "internalBorder", "internalBorder", RES_TYPE_NUMBER);
7588 if (! EQ (value, Qunbound))
7589 parms = Fcons (Fcons (Qinternal_border_width, value),
7590 parms);
7592 x_default_parameter (f, parms, Qinternal_border_width, make_number (1),
7593 "internalBorderWidth", "internalBorderWidth",
7594 RES_TYPE_NUMBER);
7596 /* Also do the stuff which must be set before the window exists. */
7597 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
7598 "foreground", "Foreground", RES_TYPE_STRING);
7599 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
7600 "background", "Background", RES_TYPE_STRING);
7601 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
7602 "pointerColor", "Foreground", RES_TYPE_STRING);
7603 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
7604 "cursorColor", "Foreground", RES_TYPE_STRING);
7605 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
7606 "borderColor", "BorderColor", RES_TYPE_STRING);
7608 /* Init faces before x_default_parameter is called for scroll-bar
7609 parameters because that function calls x_set_scroll_bar_width,
7610 which calls change_frame_size, which calls Fset_window_buffer,
7611 which runs hooks, which call Fvertical_motion. At the end, we
7612 end up in init_iterator with a null face cache, which should not
7613 happen. */
7614 init_frame_faces (f);
7616 f->output_data.w32->dwStyle = WS_BORDER | WS_POPUP | WS_DISABLED;
7617 f->output_data.w32->parent_desc = FRAME_W32_DISPLAY_INFO (f)->root_window;
7619 window_prompting = x_figure_window_size (f, parms, 0);
7621 /* No fringes on tip frame. */
7622 f->fringe_cols = 0;
7623 f->left_fringe_width = 0;
7624 f->right_fringe_width = 0;
7626 BLOCK_INPUT;
7627 my_create_tip_window (f);
7628 UNBLOCK_INPUT;
7630 x_make_gc (f);
7632 x_default_parameter (f, parms, Qauto_raise, Qnil,
7633 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN);
7634 x_default_parameter (f, parms, Qauto_lower, Qnil,
7635 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN);
7636 x_default_parameter (f, parms, Qcursor_type, Qbox,
7637 "cursorType", "CursorType", RES_TYPE_SYMBOL);
7639 /* Dimensions, especially FRAME_LINES (f), must be done via change_frame_size.
7640 Change will not be effected unless different from the current
7641 FRAME_LINES (f). */
7642 width = FRAME_COLS (f);
7643 height = FRAME_LINES (f);
7644 FRAME_LINES (f) = 0;
7645 SET_FRAME_COLS (f, 0);
7646 change_frame_size (f, height, width, 1, 0, 0);
7648 /* Add `tooltip' frame parameter's default value. */
7649 if (NILP (Fframe_parameter (frame, intern ("tooltip"))))
7650 Fmodify_frame_parameters (frame, Fcons (Fcons (intern ("tooltip"), Qt),
7651 Qnil));
7653 /* Set up faces after all frame parameters are known. This call
7654 also merges in face attributes specified for new frames.
7656 Frame parameters may be changed if .Xdefaults contains
7657 specifications for the default font. For example, if there is an
7658 `Emacs.default.attributeBackground: pink', the `background-color'
7659 attribute of the frame get's set, which let's the internal border
7660 of the tooltip frame appear in pink. Prevent this. */
7662 Lisp_Object bg = Fframe_parameter (frame, Qbackground_color);
7664 /* Set tip_frame here, so that */
7665 tip_frame = frame;
7666 call1 (Qface_set_after_frame_default, frame);
7668 if (!EQ (bg, Fframe_parameter (frame, Qbackground_color)))
7669 Fmodify_frame_parameters (frame, Fcons (Fcons (Qbackground_color, bg),
7670 Qnil));
7673 f->no_split = 1;
7675 UNGCPRO;
7677 /* It is now ok to make the frame official even if we get an error
7678 below. And the frame needs to be on Vframe_list or making it
7679 visible won't work. */
7680 Vframe_list = Fcons (frame, Vframe_list);
7682 /* Now that the frame is official, it counts as a reference to
7683 its display. */
7684 FRAME_W32_DISPLAY_INFO (f)->reference_count++;
7686 /* Setting attributes of faces of the tooltip frame from resources
7687 and similar will increment face_change_count, which leads to the
7688 clearing of all current matrices. Since this isn't necessary
7689 here, avoid it by resetting face_change_count to the value it
7690 had before we created the tip frame. */
7691 face_change_count = face_change_count_before;
7693 /* Discard the unwind_protect. */
7694 return unbind_to (count, frame);
7698 /* Compute where to display tip frame F. PARMS is the list of frame
7699 parameters for F. DX and DY are specified offsets from the current
7700 location of the mouse. WIDTH and HEIGHT are the width and height
7701 of the tooltip. Return coordinates relative to the root window of
7702 the display in *ROOT_X, and *ROOT_Y. */
7704 static void
7705 compute_tip_xy (f, parms, dx, dy, width, height, root_x, root_y)
7706 struct frame *f;
7707 Lisp_Object parms, dx, dy;
7708 int width, height;
7709 int *root_x, *root_y;
7711 Lisp_Object left, top;
7712 int min_x, min_y, max_x, max_y;
7714 /* User-specified position? */
7715 left = Fcdr (Fassq (Qleft, parms));
7716 top = Fcdr (Fassq (Qtop, parms));
7718 /* Move the tooltip window where the mouse pointer is. Resize and
7719 show it. */
7720 if (!INTEGERP (left) || !INTEGERP (top))
7722 POINT pt;
7724 /* Default min and max values. */
7725 min_x = 0;
7726 min_y = 0;
7727 max_x = FRAME_W32_DISPLAY_INFO (f)->width;
7728 max_y = FRAME_W32_DISPLAY_INFO (f)->height;
7730 BLOCK_INPUT;
7731 GetCursorPos (&pt);
7732 *root_x = pt.x;
7733 *root_y = pt.y;
7734 UNBLOCK_INPUT;
7736 /* If multiple monitor support is available, constrain the tip onto
7737 the current monitor. This improves the above by allowing negative
7738 co-ordinates if monitor positions are such that they are valid, and
7739 snaps a tooltip onto a single monitor if we are close to the edge
7740 where it would otherwise flow onto the other monitor (or into
7741 nothingness if there is a gap in the overlap). */
7742 if (monitor_from_point_fn && get_monitor_info_fn)
7744 struct MONITOR_INFO info;
7745 HMONITOR monitor
7746 = monitor_from_point_fn (pt, MONITOR_DEFAULT_TO_NEAREST);
7747 info.cbSize = sizeof (info);
7749 if (get_monitor_info_fn (monitor, &info))
7751 min_x = info.rcWork.left;
7752 min_y = info.rcWork.top;
7753 max_x = info.rcWork.right;
7754 max_y = info.rcWork.bottom;
7759 if (INTEGERP (top))
7760 *root_y = XINT (top);
7761 else if (*root_y + XINT (dy) <= min_y)
7762 *root_y = min_y; /* Can happen for negative dy */
7763 else if (*root_y + XINT (dy) + height <= max_y)
7764 /* It fits below the pointer */
7765 *root_y += XINT (dy);
7766 else if (height + XINT (dy) + min_y <= *root_y)
7767 /* It fits above the pointer. */
7768 *root_y -= height + XINT (dy);
7769 else
7770 /* Put it on the top. */
7771 *root_y = min_y;
7773 if (INTEGERP (left))
7774 *root_x = XINT (left);
7775 else if (*root_x + XINT (dx) <= min_x)
7776 *root_x = 0; /* Can happen for negative dx */
7777 else if (*root_x + XINT (dx) + width <= max_x)
7778 /* It fits to the right of the pointer. */
7779 *root_x += XINT (dx);
7780 else if (width + XINT (dx) + min_x <= *root_x)
7781 /* It fits to the left of the pointer. */
7782 *root_x -= width + XINT (dx);
7783 else
7784 /* Put it left justified on the screen -- it ought to fit that way. */
7785 *root_x = min_x;
7789 DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0,
7790 doc: /* Show STRING in a \"tooltip\" window on frame FRAME.
7791 A tooltip window is a small window displaying a string.
7793 This is an internal function; Lisp code should call `tooltip-show'.
7795 FRAME nil or omitted means use the selected frame.
7797 PARMS is an optional list of frame parameters which can be
7798 used to change the tooltip's appearance.
7800 Automatically hide the tooltip after TIMEOUT seconds. TIMEOUT nil
7801 means use the default timeout of 5 seconds.
7803 If the list of frame parameters PARMS contains a `left' parameter,
7804 the tooltip is displayed at that x-position. Otherwise it is
7805 displayed at the mouse position, with offset DX added (default is 5 if
7806 DX isn't specified). Likewise for the y-position; if a `top' frame
7807 parameter is specified, it determines the y-position of the tooltip
7808 window, otherwise it is displayed at the mouse position, with offset
7809 DY added (default is -10).
7811 A tooltip's maximum size is specified by `x-max-tooltip-size'.
7812 Text larger than the specified size is clipped. */)
7813 (string, frame, parms, timeout, dx, dy)
7814 Lisp_Object string, frame, parms, timeout, dx, dy;
7816 struct frame *f;
7817 struct window *w;
7818 int root_x, root_y;
7819 struct buffer *old_buffer;
7820 struct text_pos pos;
7821 int i, width, height;
7822 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
7823 int old_windows_or_buffers_changed = windows_or_buffers_changed;
7824 int count = SPECPDL_INDEX ();
7826 specbind (Qinhibit_redisplay, Qt);
7828 GCPRO4 (string, parms, frame, timeout);
7830 CHECK_STRING (string);
7831 f = check_x_frame (frame);
7832 if (NILP (timeout))
7833 timeout = make_number (5);
7834 else
7835 CHECK_NATNUM (timeout);
7837 if (NILP (dx))
7838 dx = make_number (5);
7839 else
7840 CHECK_NUMBER (dx);
7842 if (NILP (dy))
7843 dy = make_number (-10);
7844 else
7845 CHECK_NUMBER (dy);
7847 if (NILP (last_show_tip_args))
7848 last_show_tip_args = Fmake_vector (make_number (3), Qnil);
7850 if (!NILP (tip_frame))
7852 Lisp_Object last_string = AREF (last_show_tip_args, 0);
7853 Lisp_Object last_frame = AREF (last_show_tip_args, 1);
7854 Lisp_Object last_parms = AREF (last_show_tip_args, 2);
7856 if (EQ (frame, last_frame)
7857 && !NILP (Fequal (last_string, string))
7858 && !NILP (Fequal (last_parms, parms)))
7860 struct frame *f = XFRAME (tip_frame);
7862 /* Only DX and DY have changed. */
7863 if (!NILP (tip_timer))
7865 Lisp_Object timer = tip_timer;
7866 tip_timer = Qnil;
7867 call1 (Qcancel_timer, timer);
7870 BLOCK_INPUT;
7871 compute_tip_xy (f, parms, dx, dy, FRAME_PIXEL_WIDTH (f),
7872 FRAME_PIXEL_HEIGHT (f), &root_x, &root_y);
7874 /* Put tooltip in topmost group and in position. */
7875 SetWindowPos (FRAME_W32_WINDOW (f), HWND_TOPMOST,
7876 root_x, root_y, 0, 0,
7877 SWP_NOSIZE | SWP_NOACTIVATE);
7879 /* Ensure tooltip is on top of other topmost windows (eg menus). */
7880 SetWindowPos (FRAME_W32_WINDOW (f), HWND_TOP,
7881 0, 0, 0, 0,
7882 SWP_NOMOVE | SWP_NOSIZE | SWP_NOACTIVATE);
7884 UNBLOCK_INPUT;
7885 goto start_timer;
7889 /* Hide a previous tip, if any. */
7890 Fx_hide_tip ();
7892 ASET (last_show_tip_args, 0, string);
7893 ASET (last_show_tip_args, 1, frame);
7894 ASET (last_show_tip_args, 2, parms);
7896 /* Add default values to frame parameters. */
7897 if (NILP (Fassq (Qname, parms)))
7898 parms = Fcons (Fcons (Qname, build_string ("tooltip")), parms);
7899 if (NILP (Fassq (Qinternal_border_width, parms)))
7900 parms = Fcons (Fcons (Qinternal_border_width, make_number (3)), parms);
7901 if (NILP (Fassq (Qborder_width, parms)))
7902 parms = Fcons (Fcons (Qborder_width, make_number (1)), parms);
7903 if (NILP (Fassq (Qborder_color, parms)))
7904 parms = Fcons (Fcons (Qborder_color, build_string ("lightyellow")), parms);
7905 if (NILP (Fassq (Qbackground_color, parms)))
7906 parms = Fcons (Fcons (Qbackground_color, build_string ("lightyellow")),
7907 parms);
7909 /* Block input until the tip has been fully drawn, to avoid crashes
7910 when drawing tips in menus. */
7911 BLOCK_INPUT;
7913 /* Create a frame for the tooltip, and record it in the global
7914 variable tip_frame. */
7915 frame = x_create_tip_frame (FRAME_W32_DISPLAY_INFO (f), parms, string);
7916 f = XFRAME (frame);
7918 /* Set up the frame's root window. */
7919 w = XWINDOW (FRAME_ROOT_WINDOW (f));
7920 w->left_col = w->top_line = make_number (0);
7922 if (CONSP (Vx_max_tooltip_size)
7923 && INTEGERP (XCAR (Vx_max_tooltip_size))
7924 && XINT (XCAR (Vx_max_tooltip_size)) > 0
7925 && INTEGERP (XCDR (Vx_max_tooltip_size))
7926 && XINT (XCDR (Vx_max_tooltip_size)) > 0)
7928 w->total_cols = XCAR (Vx_max_tooltip_size);
7929 w->total_lines = XCDR (Vx_max_tooltip_size);
7931 else
7933 w->total_cols = make_number (80);
7934 w->total_lines = make_number (40);
7937 FRAME_TOTAL_COLS (f) = XINT (w->total_cols);
7938 adjust_glyphs (f);
7939 w->pseudo_window_p = 1;
7941 /* Display the tooltip text in a temporary buffer. */
7942 old_buffer = current_buffer;
7943 set_buffer_internal_1 (XBUFFER (XWINDOW (FRAME_ROOT_WINDOW (f))->buffer));
7944 current_buffer->truncate_lines = Qnil;
7945 clear_glyph_matrix (w->desired_matrix);
7946 clear_glyph_matrix (w->current_matrix);
7947 SET_TEXT_POS (pos, BEGV, BEGV_BYTE);
7948 try_window (FRAME_ROOT_WINDOW (f), pos, 0);
7950 /* Compute width and height of the tooltip. */
7951 width = height = 0;
7952 for (i = 0; i < w->desired_matrix->nrows; ++i)
7954 struct glyph_row *row = &w->desired_matrix->rows[i];
7955 struct glyph *last;
7956 int row_width;
7958 /* Stop at the first empty row at the end. */
7959 if (!row->enabled_p || !row->displays_text_p)
7960 break;
7962 /* Let the row go over the full width of the frame. */
7963 row->full_width_p = 1;
7965 #ifdef TODO /* Investigate why some fonts need more width than is
7966 calculated for some tooltips. */
7967 /* There's a glyph at the end of rows that is use to place
7968 the cursor there. Don't include the width of this glyph. */
7969 if (row->used[TEXT_AREA])
7971 last = &row->glyphs[TEXT_AREA][row->used[TEXT_AREA] - 1];
7972 row_width = row->pixel_width - last->pixel_width;
7974 else
7975 #endif
7976 row_width = row->pixel_width;
7978 /* TODO: find why tips do not draw along baseline as instructed. */
7979 height += row->height;
7980 width = max (width, row_width);
7983 /* Add the frame's internal border to the width and height the X
7984 window should have. */
7985 height += 2 * FRAME_INTERNAL_BORDER_WIDTH (f);
7986 width += 2 * FRAME_INTERNAL_BORDER_WIDTH (f);
7988 /* Move the tooltip window where the mouse pointer is. Resize and
7989 show it. */
7990 compute_tip_xy (f, parms, dx, dy, width, height, &root_x, &root_y);
7993 /* Adjust Window size to take border into account. */
7994 RECT rect;
7995 rect.left = rect.top = 0;
7996 rect.right = width;
7997 rect.bottom = height;
7998 AdjustWindowRect (&rect, f->output_data.w32->dwStyle,
7999 FRAME_EXTERNAL_MENU_BAR (f));
8001 /* Position and size tooltip, and put it in the topmost group.
8002 The add-on of 3 to the 5th argument is a kludge: without it,
8003 some fonts cause the last character of the tip to be truncated,
8004 for some obscure reason. */
8005 SetWindowPos (FRAME_W32_WINDOW (f), HWND_TOPMOST,
8006 root_x, root_y, rect.right - rect.left + 3,
8007 rect.bottom - rect.top, SWP_NOACTIVATE);
8009 /* Ensure tooltip is on top of other topmost windows (eg menus). */
8010 SetWindowPos (FRAME_W32_WINDOW (f), HWND_TOP,
8011 0, 0, 0, 0,
8012 SWP_NOMOVE | SWP_NOSIZE | SWP_NOACTIVATE);
8014 /* Let redisplay know that we have made the frame visible already. */
8015 f->async_visible = 1;
8017 ShowWindow (FRAME_W32_WINDOW (f), SW_SHOWNOACTIVATE);
8020 /* Draw into the window. */
8021 w->must_be_updated_p = 1;
8022 update_single_window (w, 1);
8024 UNBLOCK_INPUT;
8026 /* Restore original current buffer. */
8027 set_buffer_internal_1 (old_buffer);
8028 windows_or_buffers_changed = old_windows_or_buffers_changed;
8030 start_timer:
8031 /* Let the tip disappear after timeout seconds. */
8032 tip_timer = call3 (intern ("run-at-time"), timeout, Qnil,
8033 intern ("x-hide-tip"));
8035 UNGCPRO;
8036 return unbind_to (count, Qnil);
8040 DEFUN ("x-hide-tip", Fx_hide_tip, Sx_hide_tip, 0, 0, 0,
8041 doc: /* Hide the current tooltip window, if there is any.
8042 Value is t if tooltip was open, nil otherwise. */)
8045 int count;
8046 Lisp_Object deleted, frame, timer;
8047 struct gcpro gcpro1, gcpro2;
8049 /* Return quickly if nothing to do. */
8050 if (NILP (tip_timer) && NILP (tip_frame))
8051 return Qnil;
8053 frame = tip_frame;
8054 timer = tip_timer;
8055 GCPRO2 (frame, timer);
8056 tip_frame = tip_timer = deleted = Qnil;
8058 count = SPECPDL_INDEX ();
8059 specbind (Qinhibit_redisplay, Qt);
8060 specbind (Qinhibit_quit, Qt);
8062 if (!NILP (timer))
8063 call1 (Qcancel_timer, timer);
8065 if (FRAMEP (frame))
8067 Fdelete_frame (frame, Qnil);
8068 deleted = Qt;
8071 UNGCPRO;
8072 return unbind_to (count, deleted);
8077 /***********************************************************************
8078 File selection dialog
8079 ***********************************************************************/
8080 extern Lisp_Object Qfile_name_history;
8082 /* Callback for altering the behaviour of the Open File dialog.
8083 Makes the Filename text field contain "Current Directory" and be
8084 read-only when "Directories" is selected in the filter. This
8085 allows us to work around the fact that the standard Open File
8086 dialog does not support directories. */
8087 UINT CALLBACK
8088 file_dialog_callback (hwnd, msg, wParam, lParam)
8089 HWND hwnd;
8090 UINT msg;
8091 WPARAM wParam;
8092 LPARAM lParam;
8094 if (msg == WM_NOTIFY)
8096 OFNOTIFY * notify = (OFNOTIFY *)lParam;
8097 /* Detect when the Filter dropdown is changed. */
8098 if (notify->hdr.code == CDN_TYPECHANGE
8099 || notify->hdr.code == CDN_INITDONE)
8101 HWND dialog = GetParent (hwnd);
8102 HWND edit_control = GetDlgItem (dialog, FILE_NAME_TEXT_FIELD);
8104 /* Directories is in index 2. */
8105 if (notify->lpOFN->nFilterIndex == 2)
8107 CommDlg_OpenSave_SetControlText (dialog, FILE_NAME_TEXT_FIELD,
8108 "Current Directory");
8109 EnableWindow (edit_control, FALSE);
8111 else
8113 /* Don't override default filename on init done. */
8114 if (notify->hdr.code == CDN_TYPECHANGE)
8115 CommDlg_OpenSave_SetControlText (dialog,
8116 FILE_NAME_TEXT_FIELD, "");
8117 EnableWindow (edit_control, TRUE);
8121 return 0;
8124 /* Since we compile with _WIN32_WINNT set to 0x0400 (for NT4 compatibility)
8125 we end up with the old file dialogs. Define a big enough struct for the
8126 new dialog to trick GetOpenFileName into giving us the new dialogs on
8127 Windows 2000 and XP. */
8128 typedef struct
8130 OPENFILENAME real_details;
8131 void * pReserved;
8132 DWORD dwReserved;
8133 DWORD FlagsEx;
8134 } NEWOPENFILENAME;
8137 DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 5, 0,
8138 doc: /* Read file name, prompting with PROMPT in directory DIR.
8139 Use a file selection dialog.
8140 Select DEFAULT-FILENAME in the dialog's file selection box, if
8141 specified. Ensure that file exists if MUSTMATCH is non-nil.
8142 If ONLY-DIR-P is non-nil, the user can only select directories. */)
8143 (prompt, dir, default_filename, mustmatch, only_dir_p)
8144 Lisp_Object prompt, dir, default_filename, mustmatch, only_dir_p;
8146 struct frame *f = SELECTED_FRAME ();
8147 Lisp_Object file = Qnil;
8148 int count = SPECPDL_INDEX ();
8149 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
8150 char filename[MAX_PATH + 1];
8151 char init_dir[MAX_PATH + 1];
8152 int default_filter_index = 1; /* 1: All Files, 2: Directories only */
8154 GCPRO6 (prompt, dir, default_filename, mustmatch, only_dir_p, file);
8155 CHECK_STRING (prompt);
8156 CHECK_STRING (dir);
8158 /* Create the dialog with PROMPT as title, using DIR as initial
8159 directory and using "*" as pattern. */
8160 dir = Fexpand_file_name (dir, Qnil);
8161 strncpy (init_dir, SDATA (ENCODE_FILE (dir)), MAX_PATH);
8162 init_dir[MAX_PATH] = '\0';
8163 unixtodos_filename (init_dir);
8165 if (STRINGP (default_filename))
8167 char *file_name_only;
8168 char *full_path_name = SDATA (ENCODE_FILE (default_filename));
8170 unixtodos_filename (full_path_name);
8172 file_name_only = strrchr (full_path_name, '\\');
8173 if (!file_name_only)
8174 file_name_only = full_path_name;
8175 else
8176 file_name_only++;
8178 strncpy (filename, file_name_only, MAX_PATH);
8179 filename[MAX_PATH] = '\0';
8181 else
8182 filename[0] = '\0';
8185 NEWOPENFILENAME new_file_details;
8186 BOOL file_opened = FALSE;
8187 OPENFILENAME * file_details = &new_file_details.real_details;
8189 /* Prevent redisplay. */
8190 specbind (Qinhibit_redisplay, Qt);
8191 BLOCK_INPUT;
8193 bzero (&new_file_details, sizeof (new_file_details));
8194 /* Apparently NT4 crashes if you give it an unexpected size.
8195 I'm not sure about Windows 9x, so play it safe. */
8196 if (w32_major_version > 4 && w32_major_version < 95)
8197 file_details->lStructSize = sizeof (NEWOPENFILENAME);
8198 else
8199 file_details->lStructSize = sizeof (OPENFILENAME);
8201 file_details->hwndOwner = FRAME_W32_WINDOW (f);
8202 /* Undocumented Bug in Common File Dialog:
8203 If a filter is not specified, shell links are not resolved. */
8204 file_details->lpstrFilter = "All Files (*.*)\0*.*\0Directories\0*|*\0\0";
8205 file_details->lpstrFile = filename;
8206 file_details->nMaxFile = sizeof (filename);
8207 file_details->lpstrInitialDir = init_dir;
8208 file_details->lpstrTitle = SDATA (prompt);
8210 if (! NILP (only_dir_p))
8211 default_filter_index = 2;
8213 file_details->nFilterIndex = default_filter_index;
8215 file_details->Flags = (OFN_HIDEREADONLY | OFN_NOCHANGEDIR
8216 | OFN_EXPLORER | OFN_ENABLEHOOK);
8217 if (!NILP (mustmatch))
8219 /* Require that the path to the parent directory exists. */
8220 file_details->Flags |= OFN_PATHMUSTEXIST;
8221 /* If we are looking for a file, require that it exists. */
8222 if (NILP (only_dir_p))
8223 file_details->Flags |= OFN_FILEMUSTEXIST;
8226 file_details->lpfnHook = (LPOFNHOOKPROC) file_dialog_callback;
8228 file_opened = GetOpenFileName (file_details);
8230 UNBLOCK_INPUT;
8232 if (file_opened)
8234 dostounix_filename (filename);
8236 if (file_details->nFilterIndex == 2)
8238 /* "Directories" selected - strip dummy file name. */
8239 char * last = strrchr (filename, '/');
8240 *last = '\0';
8243 file = DECODE_FILE (build_string (filename));
8245 /* User cancelled the dialog without making a selection. */
8246 else if (!CommDlgExtendedError ())
8247 file = Qnil;
8248 /* An error occurred, fallback on reading from the mini-buffer. */
8249 else
8250 file = Fcompleting_read (prompt, intern ("read-file-name-internal"),
8251 dir, mustmatch, dir, Qfile_name_history,
8252 default_filename, Qnil);
8254 file = unbind_to (count, file);
8257 UNGCPRO;
8259 /* Make "Cancel" equivalent to C-g. */
8260 if (NILP (file))
8261 Fsignal (Qquit, Qnil);
8263 return unbind_to (count, file);
8268 /***********************************************************************
8269 w32 specialized functions
8270 ***********************************************************************/
8272 DEFUN ("w32-select-font", Fw32_select_font, Sw32_select_font, 0, 2, 0,
8273 doc: /* Select a font for the named FRAME using the W32 font dialog.
8274 Return an X-style font string corresponding to the selection.
8276 If FRAME is omitted or nil, it defaults to the selected frame.
8277 If INCLUDE-PROPORTIONAL is non-nil, include proportional fonts
8278 in the font selection dialog. */)
8279 (frame, include_proportional)
8280 Lisp_Object frame, include_proportional;
8282 FRAME_PTR f = check_x_frame (frame);
8283 CHOOSEFONT cf;
8284 LOGFONT lf;
8285 TEXTMETRIC tm;
8286 HDC hdc;
8287 HANDLE oldobj;
8288 char buf[100];
8290 bzero (&cf, sizeof (cf));
8291 bzero (&lf, sizeof (lf));
8293 cf.lStructSize = sizeof (cf);
8294 cf.hwndOwner = FRAME_W32_WINDOW (f);
8295 cf.Flags = CF_FORCEFONTEXIST | CF_SCREENFONTS | CF_NOVERTFONTS;
8297 /* Unless include_proportional is non-nil, limit the selection to
8298 monospaced fonts. */
8299 if (NILP (include_proportional))
8300 cf.Flags |= CF_FIXEDPITCHONLY;
8302 cf.lpLogFont = &lf;
8304 /* Initialize as much of the font details as we can from the current
8305 default font. */
8306 hdc = GetDC (FRAME_W32_WINDOW (f));
8307 oldobj = SelectObject (hdc, FRAME_FONT (f)->hfont);
8308 GetTextFace (hdc, LF_FACESIZE, lf.lfFaceName);
8309 if (GetTextMetrics (hdc, &tm))
8311 lf.lfHeight = tm.tmInternalLeading - tm.tmHeight;
8312 lf.lfWeight = tm.tmWeight;
8313 lf.lfItalic = tm.tmItalic;
8314 lf.lfUnderline = tm.tmUnderlined;
8315 lf.lfStrikeOut = tm.tmStruckOut;
8316 lf.lfCharSet = tm.tmCharSet;
8317 cf.Flags |= CF_INITTOLOGFONTSTRUCT;
8319 SelectObject (hdc, oldobj);
8320 ReleaseDC (FRAME_W32_WINDOW (f), hdc);
8322 if (!ChooseFont (&cf) || !w32_to_x_font (&lf, buf, 100, NULL))
8323 return Qnil;
8325 return build_string (buf);
8328 DEFUN ("w32-send-sys-command", Fw32_send_sys_command,
8329 Sw32_send_sys_command, 1, 2, 0,
8330 doc: /* Send frame a Windows WM_SYSCOMMAND message of type COMMAND.
8331 Some useful values for COMMAND are #xf030 to maximize frame (#xf020
8332 to minimize), #xf120 to restore frame to original size, and #xf100
8333 to activate the menubar for keyboard access. #xf140 activates the
8334 screen saver if defined.
8336 If optional parameter FRAME is not specified, use selected frame. */)
8337 (command, frame)
8338 Lisp_Object command, frame;
8340 FRAME_PTR f = check_x_frame (frame);
8342 CHECK_NUMBER (command);
8344 PostMessage (FRAME_W32_WINDOW (f), WM_SYSCOMMAND, XINT (command), 0);
8346 return Qnil;
8349 DEFUN ("w32-shell-execute", Fw32_shell_execute, Sw32_shell_execute, 2, 4, 0,
8350 doc: /* Get Windows to perform OPERATION on DOCUMENT.
8351 This is a wrapper around the ShellExecute system function, which
8352 invokes the application registered to handle OPERATION for DOCUMENT.
8354 OPERATION is either nil or a string that names a supported operation.
8355 What operations can be used depends on the particular DOCUMENT and its
8356 handler application, but typically it is one of the following common
8357 operations:
8359 \"open\" - open DOCUMENT, which could be a file, a directory, or an
8360 executable program. If it is an application, that
8361 application is launched in the current buffer's default
8362 directory. Otherwise, the application associated with
8363 DOCUMENT is launched in the buffer's default directory.
8364 \"print\" - print DOCUMENT, which must be a file
8365 \"explore\" - start the Windows Explorer on DOCUMENT
8366 \"edit\" - launch an editor and open DOCUMENT for editing; which
8367 editor is launched depends on the association for the
8368 specified DOCUMENT
8369 \"find\" - initiate search starting from DOCUMENT which must specify
8370 a directory
8371 nil - invoke the default OPERATION, or \"open\" if default is
8372 not defined or unavailable
8374 DOCUMENT is typically the name of a document file or a URL, but can
8375 also be a program executable to run, or a directory to open in the
8376 Windows Explorer.
8378 If DOCUMENT is a program executable, the optional third arg PARAMETERS
8379 can be a string containing command line parameters that will be passed
8380 to the program; otherwise, PARAMETERS should be nil or unspecified.
8382 Optional fourth argument SHOW-FLAG can be used to control how the
8383 application will be displayed when it is invoked. If SHOW-FLAG is nil
8384 or unspecified, the application is displayed normally, otherwise it is
8385 an integer representing a ShowWindow flag:
8387 0 - start hidden
8388 1 - start normally
8389 3 - start maximized
8390 6 - start minimized */)
8391 (operation, document, parameters, show_flag)
8392 Lisp_Object operation, document, parameters, show_flag;
8394 Lisp_Object current_dir;
8396 CHECK_STRING (document);
8398 /* Encode filename, current directory and parameters. */
8399 current_dir = ENCODE_FILE (current_buffer->directory);
8400 document = ENCODE_FILE (document);
8401 if (STRINGP (parameters))
8402 parameters = ENCODE_SYSTEM (parameters);
8404 if ((int) ShellExecute (NULL,
8405 (STRINGP (operation) ?
8406 SDATA (operation) : NULL),
8407 SDATA (document),
8408 (STRINGP (parameters) ?
8409 SDATA (parameters) : NULL),
8410 SDATA (current_dir),
8411 (INTEGERP (show_flag) ?
8412 XINT (show_flag) : SW_SHOWDEFAULT))
8413 > 32)
8414 return Qt;
8415 error ("ShellExecute failed: %s", w32_strerror (0));
8418 /* Lookup virtual keycode from string representing the name of a
8419 non-ascii keystroke into the corresponding virtual key, using
8420 lispy_function_keys. */
8421 static int
8422 lookup_vk_code (char *key)
8424 int i;
8426 for (i = 0; i < 256; i++)
8427 if (lispy_function_keys[i]
8428 && strcmp (lispy_function_keys[i], key) == 0)
8429 return i;
8431 return -1;
8434 /* Convert a one-element vector style key sequence to a hot key
8435 definition. */
8436 static Lisp_Object
8437 w32_parse_hot_key (key)
8438 Lisp_Object key;
8440 /* Copied from Fdefine_key and store_in_keymap. */
8441 register Lisp_Object c;
8442 int vk_code;
8443 int lisp_modifiers;
8444 int w32_modifiers;
8445 struct gcpro gcpro1;
8447 CHECK_VECTOR (key);
8449 if (XFASTINT (Flength (key)) != 1)
8450 return Qnil;
8452 GCPRO1 (key);
8454 c = Faref (key, make_number (0));
8456 if (CONSP (c) && lucid_event_type_list_p (c))
8457 c = Fevent_convert_list (c);
8459 UNGCPRO;
8461 if (! INTEGERP (c) && ! SYMBOLP (c))
8462 error ("Key definition is invalid");
8464 /* Work out the base key and the modifiers. */
8465 if (SYMBOLP (c))
8467 c = parse_modifiers (c);
8468 lisp_modifiers = XINT (Fcar (Fcdr (c)));
8469 c = Fcar (c);
8470 if (!SYMBOLP (c))
8471 abort ();
8472 vk_code = lookup_vk_code (SDATA (SYMBOL_NAME (c)));
8474 else if (INTEGERP (c))
8476 lisp_modifiers = XINT (c) & ~CHARACTERBITS;
8477 /* Many ascii characters are their own virtual key code. */
8478 vk_code = XINT (c) & CHARACTERBITS;
8481 if (vk_code < 0 || vk_code > 255)
8482 return Qnil;
8484 if ((lisp_modifiers & meta_modifier) != 0
8485 && !NILP (Vw32_alt_is_meta))
8486 lisp_modifiers |= alt_modifier;
8488 /* Supply defs missing from mingw32. */
8489 #ifndef MOD_ALT
8490 #define MOD_ALT 0x0001
8491 #define MOD_CONTROL 0x0002
8492 #define MOD_SHIFT 0x0004
8493 #define MOD_WIN 0x0008
8494 #endif
8496 /* Convert lisp modifiers to Windows hot-key form. */
8497 w32_modifiers = (lisp_modifiers & hyper_modifier) ? MOD_WIN : 0;
8498 w32_modifiers |= (lisp_modifiers & alt_modifier) ? MOD_ALT : 0;
8499 w32_modifiers |= (lisp_modifiers & ctrl_modifier) ? MOD_CONTROL : 0;
8500 w32_modifiers |= (lisp_modifiers & shift_modifier) ? MOD_SHIFT : 0;
8502 return HOTKEY (vk_code, w32_modifiers);
8505 DEFUN ("w32-register-hot-key", Fw32_register_hot_key,
8506 Sw32_register_hot_key, 1, 1, 0,
8507 doc: /* Register KEY as a hot-key combination.
8508 Certain key combinations like Alt-Tab are reserved for system use on
8509 Windows, and therefore are normally intercepted by the system. However,
8510 most of these key combinations can be received by registering them as
8511 hot-keys, overriding their special meaning.
8513 KEY must be a one element key definition in vector form that would be
8514 acceptable to `define-key' (e.g. [A-tab] for Alt-Tab). The meta
8515 modifier is interpreted as Alt if `w32-alt-is-meta' is t, and hyper
8516 is always interpreted as the Windows modifier keys.
8518 The return value is the hotkey-id if registered, otherwise nil. */)
8519 (key)
8520 Lisp_Object key;
8522 key = w32_parse_hot_key (key);
8524 if (!NILP (key) && NILP (Fmemq (key, w32_grabbed_keys)))
8526 /* Reuse an empty slot if possible. */
8527 Lisp_Object item = Fmemq (Qnil, w32_grabbed_keys);
8529 /* Safe to add new key to list, even if we have focus. */
8530 if (NILP (item))
8531 w32_grabbed_keys = Fcons (key, w32_grabbed_keys);
8532 else
8533 XSETCAR (item, key);
8535 /* Notify input thread about new hot-key definition, so that it
8536 takes effect without needing to switch focus. */
8537 #ifdef USE_LISP_UNION_TYPE
8538 PostThreadMessage (dwWindowsThreadId, WM_EMACS_REGISTER_HOT_KEY,
8539 (WPARAM) key.i, 0);
8540 #else
8541 PostThreadMessage (dwWindowsThreadId, WM_EMACS_REGISTER_HOT_KEY,
8542 (WPARAM) key, 0);
8543 #endif
8546 return key;
8549 DEFUN ("w32-unregister-hot-key", Fw32_unregister_hot_key,
8550 Sw32_unregister_hot_key, 1, 1, 0,
8551 doc: /* Unregister KEY as a hot-key combination. */)
8552 (key)
8553 Lisp_Object key;
8555 Lisp_Object item;
8557 if (!INTEGERP (key))
8558 key = w32_parse_hot_key (key);
8560 item = Fmemq (key, w32_grabbed_keys);
8562 if (!NILP (item))
8564 /* Notify input thread about hot-key definition being removed, so
8565 that it takes effect without needing focus switch. */
8566 #ifdef USE_LISP_UNION_TYPE
8567 if (PostThreadMessage (dwWindowsThreadId, WM_EMACS_UNREGISTER_HOT_KEY,
8568 (WPARAM) XINT (XCAR (item)), (LPARAM) item.i))
8569 #else
8570 if (PostThreadMessage (dwWindowsThreadId, WM_EMACS_UNREGISTER_HOT_KEY,
8571 (WPARAM) XINT (XCAR (item)), (LPARAM) item))
8572 #endif
8574 MSG msg;
8575 GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE);
8577 return Qt;
8579 return Qnil;
8582 DEFUN ("w32-registered-hot-keys", Fw32_registered_hot_keys,
8583 Sw32_registered_hot_keys, 0, 0, 0,
8584 doc: /* Return list of registered hot-key IDs. */)
8587 return Fdelq (Qnil, Fcopy_sequence (w32_grabbed_keys));
8590 DEFUN ("w32-reconstruct-hot-key", Fw32_reconstruct_hot_key,
8591 Sw32_reconstruct_hot_key, 1, 1, 0,
8592 doc: /* Convert hot-key ID to a lisp key combination.
8593 usage: (w32-reconstruct-hot-key ID) */)
8594 (hotkeyid)
8595 Lisp_Object hotkeyid;
8597 int vk_code, w32_modifiers;
8598 Lisp_Object key;
8600 CHECK_NUMBER (hotkeyid);
8602 vk_code = HOTKEY_VK_CODE (hotkeyid);
8603 w32_modifiers = HOTKEY_MODIFIERS (hotkeyid);
8605 if (vk_code < 256 && lispy_function_keys[vk_code])
8606 key = intern (lispy_function_keys[vk_code]);
8607 else
8608 key = make_number (vk_code);
8610 key = Fcons (key, Qnil);
8611 if (w32_modifiers & MOD_SHIFT)
8612 key = Fcons (Qshift, key);
8613 if (w32_modifiers & MOD_CONTROL)
8614 key = Fcons (Qctrl, key);
8615 if (w32_modifiers & MOD_ALT)
8616 key = Fcons (NILP (Vw32_alt_is_meta) ? Qalt : Qmeta, key);
8617 if (w32_modifiers & MOD_WIN)
8618 key = Fcons (Qhyper, key);
8620 return key;
8623 DEFUN ("w32-toggle-lock-key", Fw32_toggle_lock_key,
8624 Sw32_toggle_lock_key, 1, 2, 0,
8625 doc: /* Toggle the state of the lock key KEY.
8626 KEY can be `capslock', `kp-numlock', or `scroll'.
8627 If the optional parameter NEW-STATE is a number, then the state of KEY
8628 is set to off if the low bit of NEW-STATE is zero, otherwise on. */)
8629 (key, new_state)
8630 Lisp_Object key, new_state;
8632 int vk_code;
8634 if (EQ (key, intern ("capslock")))
8635 vk_code = VK_CAPITAL;
8636 else if (EQ (key, intern ("kp-numlock")))
8637 vk_code = VK_NUMLOCK;
8638 else if (EQ (key, intern ("scroll")))
8639 vk_code = VK_SCROLL;
8640 else
8641 return Qnil;
8643 if (!dwWindowsThreadId)
8644 return make_number (w32_console_toggle_lock_key (vk_code, new_state));
8646 #ifdef USE_LISP_UNION_TYPE
8647 if (PostThreadMessage (dwWindowsThreadId, WM_EMACS_TOGGLE_LOCK_KEY,
8648 (WPARAM) vk_code, (LPARAM) new_state.i))
8649 #else
8650 if (PostThreadMessage (dwWindowsThreadId, WM_EMACS_TOGGLE_LOCK_KEY,
8651 (WPARAM) vk_code, (LPARAM) new_state))
8652 #endif
8654 MSG msg;
8655 GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE);
8656 return make_number (msg.wParam);
8658 return Qnil;
8661 DEFUN ("w32-window-exists-p", Fw32_window_exists_p, Sw32_window_exists_p,
8662 2, 2, 0,
8663 doc: /* Return non-nil if a window exists with the specified CLASS and NAME.
8665 This is a direct interface to the Windows API FindWindow function. */)
8666 (class, name)
8667 Lisp_Object class, name;
8669 HWND hnd;
8671 if (!NILP (class))
8672 CHECK_STRING (class);
8673 if (!NILP (name))
8674 CHECK_STRING (name);
8676 hnd = FindWindow (STRINGP (class) ? ((LPCTSTR) SDATA (class)) : NULL,
8677 STRINGP (name) ? ((LPCTSTR) SDATA (name)) : NULL);
8678 if (!hnd)
8679 return Qnil;
8680 return Qt;
8685 DEFUN ("file-system-info", Ffile_system_info, Sfile_system_info, 1, 1, 0,
8686 doc: /* Return storage information about the file system FILENAME is on.
8687 Value is a list of floats (TOTAL FREE AVAIL), where TOTAL is the total
8688 storage of the file system, FREE is the free storage, and AVAIL is the
8689 storage available to a non-superuser. All 3 numbers are in bytes.
8690 If the underlying system call fails, value is nil. */)
8691 (filename)
8692 Lisp_Object filename;
8694 Lisp_Object encoded, value;
8696 CHECK_STRING (filename);
8697 filename = Fexpand_file_name (filename, Qnil);
8698 encoded = ENCODE_FILE (filename);
8700 value = Qnil;
8702 /* Determining the required information on Windows turns out, sadly,
8703 to be more involved than one would hope. The original Win32 api
8704 call for this will return bogus information on some systems, but we
8705 must dynamically probe for the replacement api, since that was
8706 added rather late on. */
8708 HMODULE hKernel = GetModuleHandle ("kernel32");
8709 BOOL (*pfn_GetDiskFreeSpaceEx)
8710 (char *, PULARGE_INTEGER, PULARGE_INTEGER, PULARGE_INTEGER)
8711 = (void *) GetProcAddress (hKernel, "GetDiskFreeSpaceEx");
8713 /* On Windows, we may need to specify the root directory of the
8714 volume holding FILENAME. */
8715 char rootname[MAX_PATH];
8716 char *name = SDATA (encoded);
8718 /* find the root name of the volume if given */
8719 if (isalpha (name[0]) && name[1] == ':')
8721 rootname[0] = name[0];
8722 rootname[1] = name[1];
8723 rootname[2] = '\\';
8724 rootname[3] = 0;
8726 else if (IS_DIRECTORY_SEP (name[0]) && IS_DIRECTORY_SEP (name[1]))
8728 char *str = rootname;
8729 int slashes = 4;
8732 if (IS_DIRECTORY_SEP (*name) && --slashes == 0)
8733 break;
8734 *str++ = *name++;
8736 while ( *name );
8738 *str++ = '\\';
8739 *str = 0;
8742 if (pfn_GetDiskFreeSpaceEx)
8744 /* Unsigned large integers cannot be cast to double, so
8745 use signed ones instead. */
8746 LARGE_INTEGER availbytes;
8747 LARGE_INTEGER freebytes;
8748 LARGE_INTEGER totalbytes;
8750 if (pfn_GetDiskFreeSpaceEx (rootname,
8751 (ULARGE_INTEGER *)&availbytes,
8752 (ULARGE_INTEGER *)&totalbytes,
8753 (ULARGE_INTEGER *)&freebytes))
8754 value = list3 (make_float ((double) totalbytes.QuadPart),
8755 make_float ((double) freebytes.QuadPart),
8756 make_float ((double) availbytes.QuadPart));
8758 else
8760 DWORD sectors_per_cluster;
8761 DWORD bytes_per_sector;
8762 DWORD free_clusters;
8763 DWORD total_clusters;
8765 if (GetDiskFreeSpace (rootname,
8766 &sectors_per_cluster,
8767 &bytes_per_sector,
8768 &free_clusters,
8769 &total_clusters))
8770 value = list3 (make_float ((double) total_clusters
8771 * sectors_per_cluster * bytes_per_sector),
8772 make_float ((double) free_clusters
8773 * sectors_per_cluster * bytes_per_sector),
8774 make_float ((double) free_clusters
8775 * sectors_per_cluster * bytes_per_sector));
8779 return value;
8782 DEFUN ("default-printer-name", Fdefault_printer_name, Sdefault_printer_name,
8783 0, 0, 0, doc: /* Return the name of Windows default printer device. */)
8786 static char pname_buf[256];
8787 int err;
8788 HANDLE hPrn;
8789 PRINTER_INFO_2 *ppi2 = NULL;
8790 DWORD dwNeeded = 0, dwReturned = 0;
8792 /* Retrieve the default string from Win.ini (the registry).
8793 * String will be in form "printername,drivername,portname".
8794 * This is the most portable way to get the default printer. */
8795 if (GetProfileString ("windows", "device", ",,", pname_buf, sizeof (pname_buf)) <= 0)
8796 return Qnil;
8797 /* printername precedes first "," character */
8798 strtok (pname_buf, ",");
8799 /* We want to know more than the printer name */
8800 if (!OpenPrinter (pname_buf, &hPrn, NULL))
8801 return Qnil;
8802 GetPrinter (hPrn, 2, NULL, 0, &dwNeeded);
8803 if (dwNeeded == 0)
8805 ClosePrinter (hPrn);
8806 return Qnil;
8808 /* Allocate memory for the PRINTER_INFO_2 struct */
8809 ppi2 = (PRINTER_INFO_2 *) xmalloc (dwNeeded);
8810 if (!ppi2)
8812 ClosePrinter (hPrn);
8813 return Qnil;
8815 /* Call GetPrinter again with big enouth memory block */
8816 err = GetPrinter (hPrn, 2, (LPBYTE)ppi2, dwNeeded, &dwReturned);
8817 ClosePrinter (hPrn);
8818 if (!err)
8820 xfree (ppi2);
8821 return Qnil;
8824 if (ppi2)
8826 if (ppi2->Attributes & PRINTER_ATTRIBUTE_SHARED && ppi2->pServerName)
8828 /* a remote printer */
8829 if (*ppi2->pServerName == '\\')
8830 _snprintf (pname_buf, sizeof (pname_buf), "%s\\%s", ppi2->pServerName,
8831 ppi2->pShareName);
8832 else
8833 _snprintf (pname_buf, sizeof (pname_buf), "\\\\%s\\%s", ppi2->pServerName,
8834 ppi2->pShareName);
8835 pname_buf[sizeof (pname_buf) - 1] = '\0';
8837 else
8839 /* a local printer */
8840 strncpy (pname_buf, ppi2->pPortName, sizeof (pname_buf));
8841 pname_buf[sizeof (pname_buf) - 1] = '\0';
8842 /* `pPortName' can include several ports, delimited by ','.
8843 * we only use the first one. */
8844 strtok (pname_buf, ",");
8846 xfree (ppi2);
8849 return build_string (pname_buf);
8852 /***********************************************************************
8853 Initialization
8854 ***********************************************************************/
8856 /* Keep this list in the same order as frame_parms in frame.c.
8857 Use 0 for unsupported frame parameters. */
8859 frame_parm_handler w32_frame_parm_handlers[] =
8861 x_set_autoraise,
8862 x_set_autolower,
8863 x_set_background_color,
8864 x_set_border_color,
8865 x_set_border_width,
8866 x_set_cursor_color,
8867 x_set_cursor_type,
8868 x_set_font,
8869 x_set_foreground_color,
8870 x_set_icon_name,
8871 x_set_icon_type,
8872 x_set_internal_border_width,
8873 x_set_menu_bar_lines,
8874 x_set_mouse_color,
8875 x_explicitly_set_name,
8876 x_set_scroll_bar_width,
8877 x_set_title,
8878 x_set_unsplittable,
8879 x_set_vertical_scroll_bars,
8880 x_set_visibility,
8881 x_set_tool_bar_lines,
8882 0, /* x_set_scroll_bar_foreground, */
8883 0, /* x_set_scroll_bar_background, */
8884 x_set_screen_gamma,
8885 x_set_line_spacing,
8886 x_set_fringe_width,
8887 x_set_fringe_width,
8888 0, /* x_set_wait_for_wm, */
8889 x_set_fullscreen,
8890 #ifdef USE_FONT_BACKEND
8891 x_set_font_backend
8892 #endif
8895 void
8896 syms_of_w32fns ()
8898 globals_of_w32fns ();
8899 /* This is zero if not using MS-Windows. */
8900 w32_in_use = 0;
8901 track_mouse_window = NULL;
8903 w32_visible_system_caret_hwnd = NULL;
8905 DEFSYM (Qnone, "none");
8906 DEFSYM (Qsuppress_icon, "suppress-icon");
8907 DEFSYM (Qundefined_color, "undefined-color");
8908 DEFSYM (Qcancel_timer, "cancel-timer");
8909 DEFSYM (Qhyper, "hyper");
8910 DEFSYM (Qsuper, "super");
8911 DEFSYM (Qmeta, "meta");
8912 DEFSYM (Qalt, "alt");
8913 DEFSYM (Qctrl, "ctrl");
8914 DEFSYM (Qcontrol, "control");
8915 DEFSYM (Qshift, "shift");
8916 /* This is the end of symbol initialization. */
8918 /* Text property `display' should be nonsticky by default. */
8919 Vtext_property_default_nonsticky
8920 = Fcons (Fcons (Qdisplay, Qt), Vtext_property_default_nonsticky);
8923 Fput (Qundefined_color, Qerror_conditions,
8924 Fcons (Qundefined_color, Fcons (Qerror, Qnil)));
8925 Fput (Qundefined_color, Qerror_message,
8926 build_string ("Undefined color"));
8928 staticpro (&w32_grabbed_keys);
8929 w32_grabbed_keys = Qnil;
8931 DEFVAR_LISP ("w32-color-map", &Vw32_color_map,
8932 doc: /* An array of color name mappings for Windows. */);
8933 Vw32_color_map = Qnil;
8935 DEFVAR_LISP ("w32-pass-alt-to-system", &Vw32_pass_alt_to_system,
8936 doc: /* Non-nil if Alt key presses are passed on to Windows.
8937 When non-nil, for example, Alt pressed and released and then space will
8938 open the System menu. When nil, Emacs processes the Alt key events, and
8939 then silently swallows them. */);
8940 Vw32_pass_alt_to_system = Qnil;
8942 DEFVAR_LISP ("w32-alt-is-meta", &Vw32_alt_is_meta,
8943 doc: /* Non-nil if the Alt key is to be considered the same as the META key.
8944 When nil, Emacs will translate the Alt key to the ALT modifier, not to META. */);
8945 Vw32_alt_is_meta = Qt;
8947 DEFVAR_INT ("w32-quit-key", &w32_quit_key,
8948 doc: /* If non-zero, the virtual key code for an alternative quit key. */);
8949 w32_quit_key = 0;
8951 DEFVAR_LISP ("w32-pass-lwindow-to-system",
8952 &Vw32_pass_lwindow_to_system,
8953 doc: /* If non-nil, the left \"Windows\" key is passed on to Windows.
8955 When non-nil, the Start menu is opened by tapping the key.
8956 If you set this to nil, the left \"Windows\" key is processed by Emacs
8957 according to the value of `w32-lwindow-modifier', which see.
8959 Note that some combinations of the left \"Windows\" key with other keys are
8960 caught by Windows at low level, and so binding them in Emacs will have no
8961 effect. For example, <lwindow>-r always pops up the Windows Run dialog,
8962 <lwindow>-<Pause> pops up the "System Properties" dialog, etc. However, see
8963 the doc string of `w32-phantom-key-code'. */);
8964 Vw32_pass_lwindow_to_system = Qt;
8966 DEFVAR_LISP ("w32-pass-rwindow-to-system",
8967 &Vw32_pass_rwindow_to_system,
8968 doc: /* If non-nil, the right \"Windows\" key is passed on to Windows.
8970 When non-nil, the Start menu is opened by tapping the key.
8971 If you set this to nil, the right \"Windows\" key is processed by Emacs
8972 according to the value of `w32-rwindow-modifier', which see.
8974 Note that some combinations of the right \"Windows\" key with other keys are
8975 caught by Windows at low level, and so binding them in Emacs will have no
8976 effect. For example, <rwindow>-r always pops up the Windows Run dialog,
8977 <rwindow>-<Pause> pops up the "System Properties" dialog, etc. However, see
8978 the doc string of `w32-phantom-key-code'. */);
8979 Vw32_pass_rwindow_to_system = Qt;
8981 DEFVAR_LISP ("w32-phantom-key-code",
8982 &Vw32_phantom_key_code,
8983 doc: /* Virtual key code used to generate \"phantom\" key presses.
8984 Value is a number between 0 and 255.
8986 Phantom key presses are generated in order to stop the system from
8987 acting on \"Windows\" key events when `w32-pass-lwindow-to-system' or
8988 `w32-pass-rwindow-to-system' is nil. */);
8989 /* Although 255 is technically not a valid key code, it works and
8990 means that this hack won't interfere with any real key code. */
8991 XSETINT (Vw32_phantom_key_code, 255);
8993 DEFVAR_LISP ("w32-enable-num-lock",
8994 &Vw32_enable_num_lock,
8995 doc: /* If non-nil, the Num Lock key acts normally.
8996 Set to nil to handle Num Lock as the `kp-numlock' key. */);
8997 Vw32_enable_num_lock = Qt;
8999 DEFVAR_LISP ("w32-enable-caps-lock",
9000 &Vw32_enable_caps_lock,
9001 doc: /* If non-nil, the Caps Lock key acts normally.
9002 Set to nil to handle Caps Lock as the `capslock' key. */);
9003 Vw32_enable_caps_lock = Qt;
9005 DEFVAR_LISP ("w32-scroll-lock-modifier",
9006 &Vw32_scroll_lock_modifier,
9007 doc: /* Modifier to use for the Scroll Lock ON state.
9008 The value can be hyper, super, meta, alt, control or shift for the
9009 respective modifier, or nil to handle Scroll Lock as the `scroll' key.
9010 Any other value will cause the Scroll Lock key to be ignored. */);
9011 Vw32_scroll_lock_modifier = Qt;
9013 DEFVAR_LISP ("w32-lwindow-modifier",
9014 &Vw32_lwindow_modifier,
9015 doc: /* Modifier to use for the left \"Windows\" key.
9016 The value can be hyper, super, meta, alt, control or shift for the
9017 respective modifier, or nil to appear as the `lwindow' key.
9018 Any other value will cause the key to be ignored. */);
9019 Vw32_lwindow_modifier = Qnil;
9021 DEFVAR_LISP ("w32-rwindow-modifier",
9022 &Vw32_rwindow_modifier,
9023 doc: /* Modifier to use for the right \"Windows\" key.
9024 The value can be hyper, super, meta, alt, control or shift for the
9025 respective modifier, or nil to appear as the `rwindow' key.
9026 Any other value will cause the key to be ignored. */);
9027 Vw32_rwindow_modifier = Qnil;
9029 DEFVAR_LISP ("w32-apps-modifier",
9030 &Vw32_apps_modifier,
9031 doc: /* Modifier to use for the \"Apps\" key.
9032 The value can be hyper, super, meta, alt, control or shift for the
9033 respective modifier, or nil to appear as the `apps' key.
9034 Any other value will cause the key to be ignored. */);
9035 Vw32_apps_modifier = Qnil;
9037 DEFVAR_BOOL ("w32-enable-synthesized-fonts", &w32_enable_synthesized_fonts,
9038 doc: /* Non-nil enables selection of artificially italicized and bold fonts. */);
9039 w32_enable_synthesized_fonts = 0;
9041 DEFVAR_LISP ("w32-enable-palette", &Vw32_enable_palette,
9042 doc: /* Non-nil enables Windows palette management to map colors exactly. */);
9043 Vw32_enable_palette = Qt;
9045 DEFVAR_INT ("w32-mouse-button-tolerance",
9046 &w32_mouse_button_tolerance,
9047 doc: /* Analogue of double click interval for faking middle mouse events.
9048 The value is the minimum time in milliseconds that must elapse between
9049 left and right button down events before they are considered distinct events.
9050 If both mouse buttons are depressed within this interval, a middle mouse
9051 button down event is generated instead. */);
9052 w32_mouse_button_tolerance = GetDoubleClickTime () / 2;
9054 DEFVAR_INT ("w32-mouse-move-interval",
9055 &w32_mouse_move_interval,
9056 doc: /* Minimum interval between mouse move events.
9057 The value is the minimum time in milliseconds that must elapse between
9058 successive mouse move (or scroll bar drag) events before they are
9059 reported as lisp events. */);
9060 w32_mouse_move_interval = 0;
9062 DEFVAR_BOOL ("w32-pass-extra-mouse-buttons-to-system",
9063 &w32_pass_extra_mouse_buttons_to_system,
9064 doc: /* If non-nil, the fourth and fifth mouse buttons are passed to Windows.
9065 Recent versions of Windows support mice with up to five buttons.
9066 Since most applications don't support these extra buttons, most mouse
9067 drivers will allow you to map them to functions at the system level.
9068 If this variable is non-nil, Emacs will pass them on, allowing the
9069 system to handle them. */);
9070 w32_pass_extra_mouse_buttons_to_system = 0;
9072 DEFVAR_BOOL ("w32-pass-multimedia-buttons-to-system",
9073 &w32_pass_multimedia_buttons_to_system,
9074 doc: /* If non-nil, media buttons are passed to Windows.
9075 Some modern keyboards contain buttons for controlling media players, web
9076 browsers and other applications. Generally these buttons are handled on a
9077 system wide basis, but by setting this to nil they are made available
9078 to Emacs for binding. Depending on your keyboard, additional keys that
9079 may be available are:
9081 browser-back, browser-forward, browser-refresh, browser-stop,
9082 browser-search, browser-favorites, browser-home,
9083 mail, mail-reply, mail-forward, mail-send,
9084 app-1, app-2,
9085 help, find, new, open, close, save, print, undo, redo, copy, cut, paste,
9086 spell-check, correction-list, toggle-dictate-command,
9087 media-next, media-previous, media-stop, media-play-pause, media-select,
9088 media-play, media-pause, media-record, media-fast-forward, media-rewind,
9089 media-channel-up, media-channel-down,
9090 volume-mute, volume-up, volume-down,
9091 mic-volume-mute, mic-volume-down, mic-volume-up, mic-toggle,
9092 bass-down, bass-boost, bass-up, treble-down, treble-up */);
9093 w32_pass_multimedia_buttons_to_system = 1;
9095 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape,
9096 doc: /* The shape of the pointer when over text.
9097 Changing the value does not affect existing frames
9098 unless you set the mouse color. */);
9099 Vx_pointer_shape = Qnil;
9101 Vx_nontext_pointer_shape = Qnil;
9103 Vx_mode_pointer_shape = Qnil;
9105 DEFVAR_LISP ("x-hourglass-pointer-shape", &Vx_hourglass_pointer_shape,
9106 doc: /* The shape of the pointer when Emacs is busy.
9107 This variable takes effect when you create a new frame
9108 or when you set the mouse color. */);
9109 Vx_hourglass_pointer_shape = Qnil;
9111 DEFVAR_BOOL ("display-hourglass", &display_hourglass_p,
9112 doc: /* Non-zero means Emacs displays an hourglass pointer on window systems. */);
9113 display_hourglass_p = 1;
9115 DEFVAR_LISP ("hourglass-delay", &Vhourglass_delay,
9116 doc: /* *Seconds to wait before displaying an hourglass pointer.
9117 Value must be an integer or float. */);
9118 Vhourglass_delay = make_number (DEFAULT_HOURGLASS_DELAY);
9120 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
9121 &Vx_sensitive_text_pointer_shape,
9122 doc: /* The shape of the pointer when over mouse-sensitive text.
9123 This variable takes effect when you create a new frame
9124 or when you set the mouse color. */);
9125 Vx_sensitive_text_pointer_shape = Qnil;
9127 DEFVAR_LISP ("x-window-horizontal-drag-cursor",
9128 &Vx_window_horizontal_drag_shape,
9129 doc: /* Pointer shape to use for indicating a window can be dragged horizontally.
9130 This variable takes effect when you create a new frame
9131 or when you set the mouse color. */);
9132 Vx_window_horizontal_drag_shape = Qnil;
9134 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel,
9135 doc: /* A string indicating the foreground color of the cursor box. */);
9136 Vx_cursor_fore_pixel = Qnil;
9138 DEFVAR_LISP ("x-max-tooltip-size", &Vx_max_tooltip_size,
9139 doc: /* Maximum size for tooltips.
9140 Value is a pair (COLUMNS . ROWS). Text larger than this is clipped. */);
9141 Vx_max_tooltip_size = Fcons (make_number (80), make_number (40));
9143 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager,
9144 doc: /* Non-nil if no window manager is in use.
9145 Emacs doesn't try to figure this out; this is always nil
9146 unless you set it to something else. */);
9147 /* We don't have any way to find this out, so set it to nil
9148 and maybe the user would like to set it to t. */
9149 Vx_no_window_manager = Qnil;
9151 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
9152 &Vx_pixel_size_width_font_regexp,
9153 doc: /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'.
9155 Since Emacs gets width of a font matching with this regexp from
9156 PIXEL_SIZE field of the name, font finding mechanism gets faster for
9157 such a font. This is especially effective for such large fonts as
9158 Chinese, Japanese, and Korean. */);
9159 Vx_pixel_size_width_font_regexp = Qnil;
9161 DEFVAR_LISP ("w32-bdf-filename-alist",
9162 &Vw32_bdf_filename_alist,
9163 doc: /* List of bdf fonts and their corresponding filenames. */);
9164 Vw32_bdf_filename_alist = Qnil;
9166 DEFVAR_BOOL ("w32-strict-fontnames",
9167 &w32_strict_fontnames,
9168 doc: /* Non-nil means only use fonts that are exact matches for those requested.
9169 Default is nil, which allows old fontnames that are not XLFD compliant,
9170 and allows third-party CJK display to work by specifying false charset
9171 fields to trick Emacs into translating to Big5, SJIS etc.
9172 Setting this to t will prevent wrong fonts being selected when
9173 fontsets are automatically created. */);
9174 w32_strict_fontnames = 0;
9176 DEFVAR_BOOL ("w32-strict-painting",
9177 &w32_strict_painting,
9178 doc: /* Non-nil means use strict rules for repainting frames.
9179 Set this to nil to get the old behavior for repainting; this should
9180 only be necessary if the default setting causes problems. */);
9181 w32_strict_painting = 1;
9183 DEFVAR_LISP ("w32-charset-info-alist",
9184 &Vw32_charset_info_alist,
9185 doc: /* Alist linking Emacs character sets to Windows fonts and codepages.
9186 Each entry should be of the form:
9188 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE))
9190 where CHARSET_NAME is a string used in font names to identify the charset,
9191 WINDOWS_CHARSET is a symbol that can be one of:
9192 w32-charset-ansi, w32-charset-default, w32-charset-symbol,
9193 w32-charset-shiftjis, w32-charset-hangeul, w32-charset-gb2312,
9194 w32-charset-chinesebig5,
9195 w32-charset-johab, w32-charset-hebrew,
9196 w32-charset-arabic, w32-charset-greek, w32-charset-turkish,
9197 w32-charset-vietnamese, w32-charset-thai, w32-charset-easteurope,
9198 w32-charset-russian, w32-charset-mac, w32-charset-baltic,
9199 w32-charset-unicode,
9200 or w32-charset-oem.
9201 CODEPAGE should be an integer specifying the codepage that should be used
9202 to display the character set, t to do no translation and output as Unicode,
9203 or nil to do no translation and output as 8 bit (or multibyte on far-east
9204 versions of Windows) characters. */);
9205 Vw32_charset_info_alist = Qnil;
9207 DEFSYM (Qw32_charset_ansi, "w32-charset-ansi");
9208 DEFSYM (Qw32_charset_symbol, "w32-charset-symbol");
9209 DEFSYM (Qw32_charset_default, "w32-charset-default");
9210 DEFSYM (Qw32_charset_shiftjis, "w32-charset-shiftjis");
9211 DEFSYM (Qw32_charset_hangeul, "w32-charset-hangeul");
9212 DEFSYM (Qw32_charset_chinesebig5, "w32-charset-chinesebig5");
9213 DEFSYM (Qw32_charset_gb2312, "w32-charset-gb2312");
9214 DEFSYM (Qw32_charset_oem, "w32-charset-oem");
9216 #ifdef JOHAB_CHARSET
9218 static int w32_extra_charsets_defined = 1;
9219 DEFVAR_BOOL ("w32-extra-charsets-defined", &w32_extra_charsets_defined,
9220 doc: /* Internal variable. */);
9222 DEFSYM (Qw32_charset_johab, "w32-charset-johab");
9223 DEFSYM (Qw32_charset_easteurope, "w32-charset-easteurope");
9224 DEFSYM (Qw32_charset_turkish, "w32-charset-turkish");
9225 DEFSYM (Qw32_charset_baltic, "w32-charset-baltic");
9226 DEFSYM (Qw32_charset_russian, "w32-charset-russian");
9227 DEFSYM (Qw32_charset_arabic, "w32-charset-arabic");
9228 DEFSYM (Qw32_charset_greek, "w32-charset-greek");
9229 DEFSYM (Qw32_charset_hebrew, "w32-charset-hebrew");
9230 DEFSYM (Qw32_charset_vietnamese, "w32-charset-vietnamese");
9231 DEFSYM (Qw32_charset_thai, "w32-charset-thai");
9232 DEFSYM (Qw32_charset_mac, "w32-charset-mac");
9234 #endif
9236 #ifdef UNICODE_CHARSET
9238 static int w32_unicode_charset_defined = 1;
9239 DEFVAR_BOOL ("w32-unicode-charset-defined",
9240 &w32_unicode_charset_defined,
9241 doc: /* Internal variable. */);
9242 DEFSYM (Qw32_charset_unicode, "w32-charset-unicode");
9244 #endif
9246 #if 0 /* TODO: Port to W32 */
9247 defsubr (&Sx_change_window_property);
9248 defsubr (&Sx_delete_window_property);
9249 defsubr (&Sx_window_property);
9250 #endif
9251 defsubr (&Sxw_display_color_p);
9252 defsubr (&Sx_display_grayscale_p);
9253 defsubr (&Sxw_color_defined_p);
9254 defsubr (&Sxw_color_values);
9255 defsubr (&Sx_server_max_request_size);
9256 defsubr (&Sx_server_vendor);
9257 defsubr (&Sx_server_version);
9258 defsubr (&Sx_display_pixel_width);
9259 defsubr (&Sx_display_pixel_height);
9260 defsubr (&Sx_display_mm_width);
9261 defsubr (&Sx_display_mm_height);
9262 defsubr (&Sx_display_screens);
9263 defsubr (&Sx_display_planes);
9264 defsubr (&Sx_display_color_cells);
9265 defsubr (&Sx_display_visual_class);
9266 defsubr (&Sx_display_backing_store);
9267 defsubr (&Sx_display_save_under);
9268 defsubr (&Sx_create_frame);
9269 defsubr (&Sx_open_connection);
9270 defsubr (&Sx_close_connection);
9271 defsubr (&Sx_display_list);
9272 defsubr (&Sx_synchronize);
9273 defsubr (&Sx_focus_frame);
9275 /* W32 specific functions */
9277 defsubr (&Sw32_select_font);
9278 defsubr (&Sw32_define_rgb_color);
9279 defsubr (&Sw32_default_color_map);
9280 defsubr (&Sw32_load_color_file);
9281 defsubr (&Sw32_send_sys_command);
9282 defsubr (&Sw32_shell_execute);
9283 defsubr (&Sw32_register_hot_key);
9284 defsubr (&Sw32_unregister_hot_key);
9285 defsubr (&Sw32_registered_hot_keys);
9286 defsubr (&Sw32_reconstruct_hot_key);
9287 defsubr (&Sw32_toggle_lock_key);
9288 defsubr (&Sw32_window_exists_p);
9289 defsubr (&Sw32_find_bdf_fonts);
9291 defsubr (&Sfile_system_info);
9292 defsubr (&Sdefault_printer_name);
9294 /* Setting callback functions for fontset handler. */
9295 get_font_info_func = w32_get_font_info;
9297 #if 0 /* This function pointer doesn't seem to be used anywhere.
9298 And the pointer assigned has the wrong type, anyway. */
9299 list_fonts_func = w32_list_fonts;
9300 #endif
9302 load_font_func = w32_load_font;
9303 find_ccl_program_func = w32_find_ccl_program;
9304 query_font_func = w32_query_font;
9305 set_frame_fontset_func = x_set_font;
9306 get_font_repertory_func = x_get_font_repertory;
9307 check_window_system_func = check_w32;
9310 hourglass_timer = 0;
9311 hourglass_hwnd = NULL;
9312 hourglass_shown_p = 0;
9313 defsubr (&Sx_show_tip);
9314 defsubr (&Sx_hide_tip);
9315 tip_timer = Qnil;
9316 staticpro (&tip_timer);
9317 tip_frame = Qnil;
9318 staticpro (&tip_frame);
9320 last_show_tip_args = Qnil;
9321 staticpro (&last_show_tip_args);
9323 defsubr (&Sx_file_dialog);
9328 globals_of_w32fns is used to initialize those global variables that
9329 must always be initialized on startup even when the global variable
9330 initialized is non zero (see the function main in emacs.c).
9331 globals_of_w32fns is called from syms_of_w32fns when the global
9332 variable initialized is 0 and directly from main when initialized
9333 is non zero.
9335 void
9336 globals_of_w32fns ()
9338 HMODULE user32_lib = GetModuleHandle ("user32.dll");
9340 TrackMouseEvent not available in all versions of Windows, so must load
9341 it dynamically. Do it once, here, instead of every time it is used.
9343 track_mouse_event_fn = (TrackMouseEvent_Proc)
9344 GetProcAddress (user32_lib, "TrackMouseEvent");
9345 /* ditto for GetClipboardSequenceNumber. */
9346 clipboard_sequence_fn = (ClipboardSequence_Proc)
9347 GetProcAddress (user32_lib, "GetClipboardSequenceNumber");
9349 monitor_from_point_fn = (MonitorFromPoint_Proc)
9350 GetProcAddress (user32_lib, "MonitorFromPoint");
9351 get_monitor_info_fn = (GetMonitorInfo_Proc)
9352 GetProcAddress (user32_lib, "GetMonitorInfoA");
9355 HMODULE imm32_lib = GetModuleHandle ("imm32.dll");
9356 get_composition_string_fn = (ImmGetCompositionString_Proc)
9357 GetProcAddress (imm32_lib, "ImmGetCompositionStringW");
9358 get_ime_context_fn = (ImmGetContext_Proc)
9359 GetProcAddress (imm32_lib, "ImmGetContext");
9361 DEFVAR_INT ("w32-ansi-code-page",
9362 &w32_ansi_code_page,
9363 doc: /* The ANSI code page used by the system. */);
9364 w32_ansi_code_page = GetACP ();
9366 /* MessageBox does not work without this when linked to comctl32.dll 6.0. */
9367 InitCommonControls ();
9369 #ifdef USE_FONT_BACKEND
9370 syms_of_w32uniscribe ();
9371 #endif
9374 #undef abort
9376 void
9377 w32_abort ()
9379 int button;
9380 button = MessageBox (NULL,
9381 "A fatal error has occurred!\n\n"
9382 "Would you like to attach a debugger?\n\n"
9383 "Select YES to debug, NO to abort Emacs"
9384 #if __GNUC__
9385 "\n\n(type \"gdb -p <emacs-PID>\" and\n"
9386 "\"continue\" inside GDB before clicking YES.)"
9387 #endif
9388 , "Emacs Abort Dialog",
9389 MB_ICONEXCLAMATION | MB_TASKMODAL
9390 | MB_SETFOREGROUND | MB_YESNO);
9391 switch (button)
9393 case IDYES:
9394 DebugBreak ();
9395 exit (2); /* tell the compiler we will never return */
9396 case IDNO:
9397 default:
9398 abort ();
9399 break;
9403 /* For convenience when debugging. */
9405 w32_last_error ()
9407 return GetLastError ();
9410 /* arch-tag: 707589ab-b9be-4638-8cdd-74629cc9b446
9411 (do not change this comment) */