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