1 /* Graphical user interface functions for the Microsoft W32 API.
2 Copyright (C) 1989, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000,
3 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
4 Free Software Foundation, Inc.
6 This file is part of GNU Emacs.
8 GNU Emacs is free software; you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation; either version 3, or (at your option)
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs; see the file COPYING. If not, write to
20 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
21 Boston, MA 02110-1301, USA. */
23 /* Added by Kevin Gallo */
38 #include "intervals.h"
39 #include "dispextern.h"
41 #include "blockinput.h"
43 #include "character.h"
49 #include "termhooks.h"
52 #include "bitmaps/gray.xbm"
63 #define FILE_NAME_TEXT_FIELD edt1
65 #ifdef USE_FONT_BACKEND
69 void syms_of_w32fns ();
70 void globals_of_w32fns ();
72 extern void free_frame_menubar ();
73 extern double atof ();
74 extern int w32_console_toggle_lock_key
P_ ((int, Lisp_Object
));
75 extern void w32_menu_display_help
P_ ((HWND
, HMENU
, UINT
, UINT
));
76 extern void w32_free_menu_strings
P_ ((HWND
));
77 extern XCharStruct
*w32_per_char_metric
P_ ((XFontStruct
*, wchar_t *, int));
81 extern char *lispy_function_keys
[];
83 /* The colormap for converting color names to RGB values */
84 Lisp_Object Vw32_color_map
;
86 /* Non nil if alt key presses are passed on to Windows. */
87 Lisp_Object Vw32_pass_alt_to_system
;
89 /* Non nil if alt key is translated to meta_modifier, nil if it is translated
91 Lisp_Object Vw32_alt_is_meta
;
93 /* If non-zero, the windows virtual key code for an alternative quit key. */
96 /* Non nil if left window key events are passed on to Windows (this only
97 affects whether "tapping" the key opens the Start menu). */
98 Lisp_Object Vw32_pass_lwindow_to_system
;
100 /* Non nil if right window key events are passed on to Windows (this
101 only affects whether "tapping" the key opens the Start menu). */
102 Lisp_Object Vw32_pass_rwindow_to_system
;
104 /* Virtual key code used to generate "phantom" key presses in order
105 to stop system from acting on Windows key events. */
106 Lisp_Object Vw32_phantom_key_code
;
108 /* Modifier associated with the left "Windows" key, or nil to act as a
110 Lisp_Object Vw32_lwindow_modifier
;
112 /* Modifier associated with the right "Windows" key, or nil to act as a
114 Lisp_Object Vw32_rwindow_modifier
;
116 /* Modifier associated with the "Apps" key, or nil to act as a normal
118 Lisp_Object Vw32_apps_modifier
;
120 /* Value is nil if Num Lock acts as a function key. */
121 Lisp_Object Vw32_enable_num_lock
;
123 /* Value is nil if Caps Lock acts as a function key. */
124 Lisp_Object Vw32_enable_caps_lock
;
126 /* Modifier associated with Scroll Lock, or nil to act as a normal key. */
127 Lisp_Object Vw32_scroll_lock_modifier
;
129 /* Switch to control whether we inhibit requests for synthesized bold
130 and italic versions of fonts. */
131 int w32_enable_synthesized_fonts
;
133 /* Enable palette management. */
134 Lisp_Object Vw32_enable_palette
;
136 /* Control how close left/right button down events must be to
137 be converted to a middle button down event. */
138 int w32_mouse_button_tolerance
;
140 /* Minimum interval between mouse movement (and scroll bar drag)
141 events that are passed on to the event loop. */
142 int w32_mouse_move_interval
;
144 /* Flag to indicate if XBUTTON events should be passed on to Windows. */
145 static int w32_pass_extra_mouse_buttons_to_system
;
147 /* Flag to indicate if media keys should be passed on to Windows. */
148 static int w32_pass_multimedia_buttons_to_system
;
150 /* Non nil if no window manager is in use. */
151 Lisp_Object Vx_no_window_manager
;
153 /* Non-zero means we're allowed to display a hourglass pointer. */
155 int display_hourglass_p
;
157 /* The background and shape of the mouse pointer, and shape when not
158 over text or in the modeline. */
160 Lisp_Object Vx_pointer_shape
, Vx_nontext_pointer_shape
, Vx_mode_pointer_shape
;
161 Lisp_Object Vx_hourglass_pointer_shape
, Vx_window_horizontal_drag_shape
;
163 /* The shape when over mouse-sensitive text. */
165 Lisp_Object Vx_sensitive_text_pointer_shape
;
168 #define IDC_HAND MAKEINTRESOURCE(32649)
171 /* Color of chars displayed in cursor box. */
173 Lisp_Object Vx_cursor_fore_pixel
;
175 /* Nonzero if using Windows. */
177 static int w32_in_use
;
179 /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'. */
181 Lisp_Object Vx_pixel_size_width_font_regexp
;
183 /* Alist of bdf fonts and the files that define them. */
184 Lisp_Object Vw32_bdf_filename_alist
;
186 /* A flag to control whether fonts are matched strictly or not. */
187 static int w32_strict_fontnames
;
189 /* A flag to control whether we should only repaint if GetUpdateRect
190 indicates there is an update region. */
191 static int w32_strict_painting
;
193 /* Associative list linking character set strings to Windows codepages. */
194 static Lisp_Object Vw32_charset_info_alist
;
196 /* VIETNAMESE_CHARSET is not defined in some versions of MSVC. */
197 #ifndef VIETNAMESE_CHARSET
198 #define VIETNAMESE_CHARSET 163
202 Lisp_Object Qsuppress_icon
;
203 Lisp_Object Qundefined_color
;
204 Lisp_Object Qcancel_timer
;
210 Lisp_Object Qcontrol
;
213 Lisp_Object Qw32_charset_ansi
;
214 Lisp_Object Qw32_charset_default
;
215 Lisp_Object Qw32_charset_symbol
;
216 Lisp_Object Qw32_charset_shiftjis
;
217 Lisp_Object Qw32_charset_hangeul
;
218 Lisp_Object Qw32_charset_gb2312
;
219 Lisp_Object Qw32_charset_chinesebig5
;
220 Lisp_Object Qw32_charset_oem
;
222 #ifndef JOHAB_CHARSET
223 #define JOHAB_CHARSET 130
226 Lisp_Object Qw32_charset_easteurope
;
227 Lisp_Object Qw32_charset_turkish
;
228 Lisp_Object Qw32_charset_baltic
;
229 Lisp_Object Qw32_charset_russian
;
230 Lisp_Object Qw32_charset_arabic
;
231 Lisp_Object Qw32_charset_greek
;
232 Lisp_Object Qw32_charset_hebrew
;
233 Lisp_Object Qw32_charset_vietnamese
;
234 Lisp_Object Qw32_charset_thai
;
235 Lisp_Object Qw32_charset_johab
;
236 Lisp_Object Qw32_charset_mac
;
239 #ifdef UNICODE_CHARSET
240 Lisp_Object Qw32_charset_unicode
;
243 /* The ANSI codepage. */
244 int w32_ansi_code_page
;
246 /* Prefix for system colors. */
247 #define SYSTEM_COLOR_PREFIX "System"
248 #define SYSTEM_COLOR_PREFIX_LEN (sizeof (SYSTEM_COLOR_PREFIX) - 1)
250 /* State variables for emulating a three button mouse. */
255 static int button_state
= 0;
256 static W32Msg saved_mouse_button_msg
;
257 static unsigned mouse_button_timer
= 0; /* non-zero when timer is active */
258 static W32Msg saved_mouse_move_msg
;
259 static unsigned mouse_move_timer
= 0;
261 /* Window that is tracking the mouse. */
262 static HWND track_mouse_window
;
264 /* Multi-monitor API definitions that are not pulled from the headers
265 since we are compiling for NT 4. */
266 #ifndef MONITOR_DEFAULT_TO_NEAREST
267 #define MONITOR_DEFAULT_TO_NEAREST 2
269 /* MinGW headers define MONITORINFO unconditionally, but MSVC ones don't.
270 To avoid a compile error on one or the other, redefine with a new name. */
279 typedef BOOL (WINAPI
* TrackMouseEvent_Proc
)
280 (IN OUT LPTRACKMOUSEEVENT lpEventTrack
);
281 typedef LONG (WINAPI
* ImmGetCompositionString_Proc
)
282 (IN HIMC context
, IN DWORD index
, OUT LPVOID buffer
, IN DWORD bufLen
);
283 typedef HIMC (WINAPI
* ImmGetContext_Proc
) (IN HWND window
);
284 typedef HMONITOR (WINAPI
* MonitorFromPoint_Proc
) (IN POINT pt
, IN DWORD flags
);
285 typedef BOOL (WINAPI
* GetMonitorInfo_Proc
)
286 (IN HMONITOR monitor
, OUT
struct MONITOR_INFO
* info
);
288 TrackMouseEvent_Proc track_mouse_event_fn
= NULL
;
289 ClipboardSequence_Proc clipboard_sequence_fn
= NULL
;
290 ImmGetCompositionString_Proc get_composition_string_fn
= NULL
;
291 ImmGetContext_Proc get_ime_context_fn
= NULL
;
292 MonitorFromPoint_Proc monitor_from_point_fn
= NULL
;
293 GetMonitorInfo_Proc get_monitor_info_fn
= NULL
;
295 extern AppendMenuW_Proc unicode_append_menu
;
297 /* Flag to selectively ignore WM_IME_CHAR messages. */
298 static int ignore_ime_char
= 0;
300 /* W95 mousewheel handler */
301 unsigned int msh_mousewheel
= 0;
304 #define MOUSE_BUTTON_ID 1
305 #define MOUSE_MOVE_ID 2
306 #define MENU_FREE_ID 3
307 /* The delay (milliseconds) before a menu is freed after WM_EXITMENULOOP
309 #define MENU_FREE_DELAY 1000
310 static unsigned menu_free_timer
= 0;
312 /* The below are defined in frame.c. */
314 extern Lisp_Object Vwindow_system_version
;
317 int image_cache_refcount
, dpyinfo_refcount
;
321 /* From w32term.c. */
322 extern int w32_num_mouse_buttons
;
323 extern Lisp_Object Vw32_recognize_altgr
;
325 extern HWND w32_system_caret_hwnd
;
327 extern int w32_system_caret_height
;
328 extern int w32_system_caret_x
;
329 extern int w32_system_caret_y
;
330 extern int w32_use_visible_system_caret
;
332 static HWND w32_visible_system_caret_hwnd
;
335 extern HMENU current_popup_menu
;
336 static int menubar_in_use
= 0;
339 /* Error if we are not connected to MS-Windows. */
344 error ("MS-Windows not in use or not initialized");
347 /* Nonzero if we can use mouse menus.
348 You should not call this unless HAVE_MENUS is defined. */
356 /* Extract a frame as a FRAME_PTR, defaulting to the selected frame
357 and checking validity for W32. */
360 check_x_frame (frame
)
366 frame
= selected_frame
;
367 CHECK_LIVE_FRAME (frame
);
369 if (! FRAME_W32_P (f
))
370 error ("Non-W32 frame used");
374 /* Let the user specify a display with a frame.
375 nil stands for the selected frame--or, if that is not a w32 frame,
376 the first display on the list. */
378 struct w32_display_info
*
379 check_x_display_info (frame
)
384 struct frame
*sf
= XFRAME (selected_frame
);
386 if (FRAME_W32_P (sf
) && FRAME_LIVE_P (sf
))
387 return FRAME_W32_DISPLAY_INFO (sf
);
389 return &one_w32_display_info
;
391 else if (STRINGP (frame
))
392 return x_display_info_for_name (frame
);
397 CHECK_LIVE_FRAME (frame
);
399 if (! FRAME_W32_P (f
))
400 error ("Non-W32 frame used");
401 return FRAME_W32_DISPLAY_INFO (f
);
405 /* Return the Emacs frame-object corresponding to an w32 window.
406 It could be the frame's main window or an icon window. */
408 /* This function can be called during GC, so use GC_xxx type test macros. */
411 x_window_to_frame (dpyinfo
, wdesc
)
412 struct w32_display_info
*dpyinfo
;
415 Lisp_Object tail
, frame
;
418 for (tail
= Vframe_list
; CONSP (tail
); tail
= XCDR (tail
))
424 if (!FRAME_W32_P (f
) || FRAME_W32_DISPLAY_INFO (f
) != dpyinfo
)
426 if (f
->output_data
.w32
->hourglass_window
== wdesc
)
429 if (FRAME_W32_WINDOW (f
) == wdesc
)
436 static Lisp_Object unwind_create_frame
P_ ((Lisp_Object
));
437 static Lisp_Object unwind_create_tip_frame
P_ ((Lisp_Object
));
438 static void my_create_window
P_ ((struct frame
*));
439 static void my_create_tip_window
P_ ((struct frame
*));
441 /* TODO: Native Input Method support; see x_create_im. */
442 void x_set_foreground_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
443 void x_set_background_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
444 void x_set_mouse_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
445 void x_set_cursor_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
446 void x_set_border_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
447 void x_set_cursor_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
448 void x_set_icon_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
449 void x_set_icon_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
450 void x_explicitly_set_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
451 void x_set_menu_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
452 void x_set_title
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
453 void x_set_tool_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
454 static void x_edge_detection
P_ ((struct frame
*, struct image
*, Lisp_Object
,
460 /* Store the screen positions of frame F into XPTR and YPTR.
461 These are the positions of the containing window manager window,
462 not Emacs's own window. */
465 x_real_positions (f
, xptr
, yptr
)
472 /* Get the bounds of the WM window. */
473 GetWindowRect (FRAME_W32_WINDOW (f
), &rect
);
478 /* Convert (0, 0) in the client area to screen co-ordinates. */
479 ClientToScreen (FRAME_W32_WINDOW (f
), &pt
);
481 /* Remember x_pixels_diff and y_pixels_diff. */
482 f
->x_pixels_diff
= pt
.x
- rect
.left
;
483 f
->y_pixels_diff
= pt
.y
- rect
.top
;
491 DEFUN ("w32-define-rgb-color", Fw32_define_rgb_color
,
492 Sw32_define_rgb_color
, 4, 4, 0,
493 doc
: /* Convert RGB numbers to a windows color reference and associate with NAME.
494 This adds or updates a named color to `w32-color-map', making it
495 available for use. The original entry's RGB ref is returned, or nil
496 if the entry is new. */)
497 (red
, green
, blue
, name
)
498 Lisp_Object red
, green
, blue
, name
;
501 Lisp_Object oldrgb
= Qnil
;
505 CHECK_NUMBER (green
);
509 XSETINT (rgb
, RGB (XUINT (red
), XUINT (green
), XUINT (blue
)));
513 /* replace existing entry in w32-color-map or add new entry. */
514 entry
= Fassoc (name
, Vw32_color_map
);
517 entry
= Fcons (name
, rgb
);
518 Vw32_color_map
= Fcons (entry
, Vw32_color_map
);
522 oldrgb
= Fcdr (entry
);
523 Fsetcdr (entry
, rgb
);
531 DEFUN ("w32-load-color-file", Fw32_load_color_file
,
532 Sw32_load_color_file
, 1, 1, 0,
533 doc
: /* Create an alist of color entries from an external file.
534 Assign this value to `w32-color-map' to replace the existing color map.
536 The file should define one named RGB color per line like so:
538 where R,G,B are numbers between 0 and 255 and name is an arbitrary string. */)
540 Lisp_Object filename
;
543 Lisp_Object cmap
= Qnil
;
546 CHECK_STRING (filename
);
547 abspath
= Fexpand_file_name (filename
, Qnil
);
549 fp
= fopen (SDATA (filename
), "rt");
553 int red
, green
, blue
;
558 while (fgets (buf
, sizeof (buf
), fp
) != NULL
) {
559 if (sscanf (buf
, "%u %u %u %n", &red
, &green
, &blue
, &num
) == 3)
561 char *name
= buf
+ num
;
562 num
= strlen (name
) - 1;
563 if (name
[num
] == '\n')
565 cmap
= Fcons (Fcons (build_string (name
),
566 make_number (RGB (red
, green
, blue
))),
578 /* The default colors for the w32 color map */
579 typedef struct colormap_t
585 colormap_t w32_color_map
[] =
587 {"snow" , PALETTERGB (255,250,250)},
588 {"ghost white" , PALETTERGB (248,248,255)},
589 {"GhostWhite" , PALETTERGB (248,248,255)},
590 {"white smoke" , PALETTERGB (245,245,245)},
591 {"WhiteSmoke" , PALETTERGB (245,245,245)},
592 {"gainsboro" , PALETTERGB (220,220,220)},
593 {"floral white" , PALETTERGB (255,250,240)},
594 {"FloralWhite" , PALETTERGB (255,250,240)},
595 {"old lace" , PALETTERGB (253,245,230)},
596 {"OldLace" , PALETTERGB (253,245,230)},
597 {"linen" , PALETTERGB (250,240,230)},
598 {"antique white" , PALETTERGB (250,235,215)},
599 {"AntiqueWhite" , PALETTERGB (250,235,215)},
600 {"papaya whip" , PALETTERGB (255,239,213)},
601 {"PapayaWhip" , PALETTERGB (255,239,213)},
602 {"blanched almond" , PALETTERGB (255,235,205)},
603 {"BlanchedAlmond" , PALETTERGB (255,235,205)},
604 {"bisque" , PALETTERGB (255,228,196)},
605 {"peach puff" , PALETTERGB (255,218,185)},
606 {"PeachPuff" , PALETTERGB (255,218,185)},
607 {"navajo white" , PALETTERGB (255,222,173)},
608 {"NavajoWhite" , PALETTERGB (255,222,173)},
609 {"moccasin" , PALETTERGB (255,228,181)},
610 {"cornsilk" , PALETTERGB (255,248,220)},
611 {"ivory" , PALETTERGB (255,255,240)},
612 {"lemon chiffon" , PALETTERGB (255,250,205)},
613 {"LemonChiffon" , PALETTERGB (255,250,205)},
614 {"seashell" , PALETTERGB (255,245,238)},
615 {"honeydew" , PALETTERGB (240,255,240)},
616 {"mint cream" , PALETTERGB (245,255,250)},
617 {"MintCream" , PALETTERGB (245,255,250)},
618 {"azure" , PALETTERGB (240,255,255)},
619 {"alice blue" , PALETTERGB (240,248,255)},
620 {"AliceBlue" , PALETTERGB (240,248,255)},
621 {"lavender" , PALETTERGB (230,230,250)},
622 {"lavender blush" , PALETTERGB (255,240,245)},
623 {"LavenderBlush" , PALETTERGB (255,240,245)},
624 {"misty rose" , PALETTERGB (255,228,225)},
625 {"MistyRose" , PALETTERGB (255,228,225)},
626 {"white" , PALETTERGB (255,255,255)},
627 {"black" , PALETTERGB ( 0, 0, 0)},
628 {"dark slate gray" , PALETTERGB ( 47, 79, 79)},
629 {"DarkSlateGray" , PALETTERGB ( 47, 79, 79)},
630 {"dark slate grey" , PALETTERGB ( 47, 79, 79)},
631 {"DarkSlateGrey" , PALETTERGB ( 47, 79, 79)},
632 {"dim gray" , PALETTERGB (105,105,105)},
633 {"DimGray" , PALETTERGB (105,105,105)},
634 {"dim grey" , PALETTERGB (105,105,105)},
635 {"DimGrey" , PALETTERGB (105,105,105)},
636 {"slate gray" , PALETTERGB (112,128,144)},
637 {"SlateGray" , PALETTERGB (112,128,144)},
638 {"slate grey" , PALETTERGB (112,128,144)},
639 {"SlateGrey" , PALETTERGB (112,128,144)},
640 {"light slate gray" , PALETTERGB (119,136,153)},
641 {"LightSlateGray" , PALETTERGB (119,136,153)},
642 {"light slate grey" , PALETTERGB (119,136,153)},
643 {"LightSlateGrey" , PALETTERGB (119,136,153)},
644 {"gray" , PALETTERGB (190,190,190)},
645 {"grey" , PALETTERGB (190,190,190)},
646 {"light grey" , PALETTERGB (211,211,211)},
647 {"LightGrey" , PALETTERGB (211,211,211)},
648 {"light gray" , PALETTERGB (211,211,211)},
649 {"LightGray" , PALETTERGB (211,211,211)},
650 {"midnight blue" , PALETTERGB ( 25, 25,112)},
651 {"MidnightBlue" , PALETTERGB ( 25, 25,112)},
652 {"navy" , PALETTERGB ( 0, 0,128)},
653 {"navy blue" , PALETTERGB ( 0, 0,128)},
654 {"NavyBlue" , PALETTERGB ( 0, 0,128)},
655 {"cornflower blue" , PALETTERGB (100,149,237)},
656 {"CornflowerBlue" , PALETTERGB (100,149,237)},
657 {"dark slate blue" , PALETTERGB ( 72, 61,139)},
658 {"DarkSlateBlue" , PALETTERGB ( 72, 61,139)},
659 {"slate blue" , PALETTERGB (106, 90,205)},
660 {"SlateBlue" , PALETTERGB (106, 90,205)},
661 {"medium slate blue" , PALETTERGB (123,104,238)},
662 {"MediumSlateBlue" , PALETTERGB (123,104,238)},
663 {"light slate blue" , PALETTERGB (132,112,255)},
664 {"LightSlateBlue" , PALETTERGB (132,112,255)},
665 {"medium blue" , PALETTERGB ( 0, 0,205)},
666 {"MediumBlue" , PALETTERGB ( 0, 0,205)},
667 {"royal blue" , PALETTERGB ( 65,105,225)},
668 {"RoyalBlue" , PALETTERGB ( 65,105,225)},
669 {"blue" , PALETTERGB ( 0, 0,255)},
670 {"dodger blue" , PALETTERGB ( 30,144,255)},
671 {"DodgerBlue" , PALETTERGB ( 30,144,255)},
672 {"deep sky blue" , PALETTERGB ( 0,191,255)},
673 {"DeepSkyBlue" , PALETTERGB ( 0,191,255)},
674 {"sky blue" , PALETTERGB (135,206,235)},
675 {"SkyBlue" , PALETTERGB (135,206,235)},
676 {"light sky blue" , PALETTERGB (135,206,250)},
677 {"LightSkyBlue" , PALETTERGB (135,206,250)},
678 {"steel blue" , PALETTERGB ( 70,130,180)},
679 {"SteelBlue" , PALETTERGB ( 70,130,180)},
680 {"light steel blue" , PALETTERGB (176,196,222)},
681 {"LightSteelBlue" , PALETTERGB (176,196,222)},
682 {"light blue" , PALETTERGB (173,216,230)},
683 {"LightBlue" , PALETTERGB (173,216,230)},
684 {"powder blue" , PALETTERGB (176,224,230)},
685 {"PowderBlue" , PALETTERGB (176,224,230)},
686 {"pale turquoise" , PALETTERGB (175,238,238)},
687 {"PaleTurquoise" , PALETTERGB (175,238,238)},
688 {"dark turquoise" , PALETTERGB ( 0,206,209)},
689 {"DarkTurquoise" , PALETTERGB ( 0,206,209)},
690 {"medium turquoise" , PALETTERGB ( 72,209,204)},
691 {"MediumTurquoise" , PALETTERGB ( 72,209,204)},
692 {"turquoise" , PALETTERGB ( 64,224,208)},
693 {"cyan" , PALETTERGB ( 0,255,255)},
694 {"light cyan" , PALETTERGB (224,255,255)},
695 {"LightCyan" , PALETTERGB (224,255,255)},
696 {"cadet blue" , PALETTERGB ( 95,158,160)},
697 {"CadetBlue" , PALETTERGB ( 95,158,160)},
698 {"medium aquamarine" , PALETTERGB (102,205,170)},
699 {"MediumAquamarine" , PALETTERGB (102,205,170)},
700 {"aquamarine" , PALETTERGB (127,255,212)},
701 {"dark green" , PALETTERGB ( 0,100, 0)},
702 {"DarkGreen" , PALETTERGB ( 0,100, 0)},
703 {"dark olive green" , PALETTERGB ( 85,107, 47)},
704 {"DarkOliveGreen" , PALETTERGB ( 85,107, 47)},
705 {"dark sea green" , PALETTERGB (143,188,143)},
706 {"DarkSeaGreen" , PALETTERGB (143,188,143)},
707 {"sea green" , PALETTERGB ( 46,139, 87)},
708 {"SeaGreen" , PALETTERGB ( 46,139, 87)},
709 {"medium sea green" , PALETTERGB ( 60,179,113)},
710 {"MediumSeaGreen" , PALETTERGB ( 60,179,113)},
711 {"light sea green" , PALETTERGB ( 32,178,170)},
712 {"LightSeaGreen" , PALETTERGB ( 32,178,170)},
713 {"pale green" , PALETTERGB (152,251,152)},
714 {"PaleGreen" , PALETTERGB (152,251,152)},
715 {"spring green" , PALETTERGB ( 0,255,127)},
716 {"SpringGreen" , PALETTERGB ( 0,255,127)},
717 {"lawn green" , PALETTERGB (124,252, 0)},
718 {"LawnGreen" , PALETTERGB (124,252, 0)},
719 {"green" , PALETTERGB ( 0,255, 0)},
720 {"chartreuse" , PALETTERGB (127,255, 0)},
721 {"medium spring green" , PALETTERGB ( 0,250,154)},
722 {"MediumSpringGreen" , PALETTERGB ( 0,250,154)},
723 {"green yellow" , PALETTERGB (173,255, 47)},
724 {"GreenYellow" , PALETTERGB (173,255, 47)},
725 {"lime green" , PALETTERGB ( 50,205, 50)},
726 {"LimeGreen" , PALETTERGB ( 50,205, 50)},
727 {"yellow green" , PALETTERGB (154,205, 50)},
728 {"YellowGreen" , PALETTERGB (154,205, 50)},
729 {"forest green" , PALETTERGB ( 34,139, 34)},
730 {"ForestGreen" , PALETTERGB ( 34,139, 34)},
731 {"olive drab" , PALETTERGB (107,142, 35)},
732 {"OliveDrab" , PALETTERGB (107,142, 35)},
733 {"dark khaki" , PALETTERGB (189,183,107)},
734 {"DarkKhaki" , PALETTERGB (189,183,107)},
735 {"khaki" , PALETTERGB (240,230,140)},
736 {"pale goldenrod" , PALETTERGB (238,232,170)},
737 {"PaleGoldenrod" , PALETTERGB (238,232,170)},
738 {"light goldenrod yellow" , PALETTERGB (250,250,210)},
739 {"LightGoldenrodYellow" , PALETTERGB (250,250,210)},
740 {"light yellow" , PALETTERGB (255,255,224)},
741 {"LightYellow" , PALETTERGB (255,255,224)},
742 {"yellow" , PALETTERGB (255,255, 0)},
743 {"gold" , PALETTERGB (255,215, 0)},
744 {"light goldenrod" , PALETTERGB (238,221,130)},
745 {"LightGoldenrod" , PALETTERGB (238,221,130)},
746 {"goldenrod" , PALETTERGB (218,165, 32)},
747 {"dark goldenrod" , PALETTERGB (184,134, 11)},
748 {"DarkGoldenrod" , PALETTERGB (184,134, 11)},
749 {"rosy brown" , PALETTERGB (188,143,143)},
750 {"RosyBrown" , PALETTERGB (188,143,143)},
751 {"indian red" , PALETTERGB (205, 92, 92)},
752 {"IndianRed" , PALETTERGB (205, 92, 92)},
753 {"saddle brown" , PALETTERGB (139, 69, 19)},
754 {"SaddleBrown" , PALETTERGB (139, 69, 19)},
755 {"sienna" , PALETTERGB (160, 82, 45)},
756 {"peru" , PALETTERGB (205,133, 63)},
757 {"burlywood" , PALETTERGB (222,184,135)},
758 {"beige" , PALETTERGB (245,245,220)},
759 {"wheat" , PALETTERGB (245,222,179)},
760 {"sandy brown" , PALETTERGB (244,164, 96)},
761 {"SandyBrown" , PALETTERGB (244,164, 96)},
762 {"tan" , PALETTERGB (210,180,140)},
763 {"chocolate" , PALETTERGB (210,105, 30)},
764 {"firebrick" , PALETTERGB (178,34, 34)},
765 {"brown" , PALETTERGB (165,42, 42)},
766 {"dark salmon" , PALETTERGB (233,150,122)},
767 {"DarkSalmon" , PALETTERGB (233,150,122)},
768 {"salmon" , PALETTERGB (250,128,114)},
769 {"light salmon" , PALETTERGB (255,160,122)},
770 {"LightSalmon" , PALETTERGB (255,160,122)},
771 {"orange" , PALETTERGB (255,165, 0)},
772 {"dark orange" , PALETTERGB (255,140, 0)},
773 {"DarkOrange" , PALETTERGB (255,140, 0)},
774 {"coral" , PALETTERGB (255,127, 80)},
775 {"light coral" , PALETTERGB (240,128,128)},
776 {"LightCoral" , PALETTERGB (240,128,128)},
777 {"tomato" , PALETTERGB (255, 99, 71)},
778 {"orange red" , PALETTERGB (255, 69, 0)},
779 {"OrangeRed" , PALETTERGB (255, 69, 0)},
780 {"red" , PALETTERGB (255, 0, 0)},
781 {"hot pink" , PALETTERGB (255,105,180)},
782 {"HotPink" , PALETTERGB (255,105,180)},
783 {"deep pink" , PALETTERGB (255, 20,147)},
784 {"DeepPink" , PALETTERGB (255, 20,147)},
785 {"pink" , PALETTERGB (255,192,203)},
786 {"light pink" , PALETTERGB (255,182,193)},
787 {"LightPink" , PALETTERGB (255,182,193)},
788 {"pale violet red" , PALETTERGB (219,112,147)},
789 {"PaleVioletRed" , PALETTERGB (219,112,147)},
790 {"maroon" , PALETTERGB (176, 48, 96)},
791 {"medium violet red" , PALETTERGB (199, 21,133)},
792 {"MediumVioletRed" , PALETTERGB (199, 21,133)},
793 {"violet red" , PALETTERGB (208, 32,144)},
794 {"VioletRed" , PALETTERGB (208, 32,144)},
795 {"magenta" , PALETTERGB (255, 0,255)},
796 {"violet" , PALETTERGB (238,130,238)},
797 {"plum" , PALETTERGB (221,160,221)},
798 {"orchid" , PALETTERGB (218,112,214)},
799 {"medium orchid" , PALETTERGB (186, 85,211)},
800 {"MediumOrchid" , PALETTERGB (186, 85,211)},
801 {"dark orchid" , PALETTERGB (153, 50,204)},
802 {"DarkOrchid" , PALETTERGB (153, 50,204)},
803 {"dark violet" , PALETTERGB (148, 0,211)},
804 {"DarkViolet" , PALETTERGB (148, 0,211)},
805 {"blue violet" , PALETTERGB (138, 43,226)},
806 {"BlueViolet" , PALETTERGB (138, 43,226)},
807 {"purple" , PALETTERGB (160, 32,240)},
808 {"medium purple" , PALETTERGB (147,112,219)},
809 {"MediumPurple" , PALETTERGB (147,112,219)},
810 {"thistle" , PALETTERGB (216,191,216)},
811 {"gray0" , PALETTERGB ( 0, 0, 0)},
812 {"grey0" , PALETTERGB ( 0, 0, 0)},
813 {"dark grey" , PALETTERGB (169,169,169)},
814 {"DarkGrey" , PALETTERGB (169,169,169)},
815 {"dark gray" , PALETTERGB (169,169,169)},
816 {"DarkGray" , PALETTERGB (169,169,169)},
817 {"dark blue" , PALETTERGB ( 0, 0,139)},
818 {"DarkBlue" , PALETTERGB ( 0, 0,139)},
819 {"dark cyan" , PALETTERGB ( 0,139,139)},
820 {"DarkCyan" , PALETTERGB ( 0,139,139)},
821 {"dark magenta" , PALETTERGB (139, 0,139)},
822 {"DarkMagenta" , PALETTERGB (139, 0,139)},
823 {"dark red" , PALETTERGB (139, 0, 0)},
824 {"DarkRed" , PALETTERGB (139, 0, 0)},
825 {"light green" , PALETTERGB (144,238,144)},
826 {"LightGreen" , PALETTERGB (144,238,144)},
829 DEFUN ("w32-default-color-map", Fw32_default_color_map
, Sw32_default_color_map
,
830 0, 0, 0, doc
: /* Return the default color map. */)
834 colormap_t
*pc
= w32_color_map
;
841 for (i
= 0; i
< sizeof (w32_color_map
) / sizeof (w32_color_map
[0]);
843 cmap
= Fcons (Fcons (build_string (pc
->name
),
844 make_number (pc
->colorref
)),
862 color
= Frassq (rgb
, Vw32_color_map
);
867 return (Fcar (color
));
873 w32_color_map_lookup (colorname
)
876 Lisp_Object tail
, ret
= Qnil
;
880 for (tail
= Vw32_color_map
; CONSP (tail
); tail
= XCDR (tail
))
882 register Lisp_Object elt
, tem
;
885 if (!CONSP (elt
)) continue;
889 if (lstrcmpi (SDATA (tem
), colorname
) == 0)
906 add_system_logical_colors_to_map (system_colors
)
907 Lisp_Object
*system_colors
;
911 /* Other registry operations are done with input blocked. */
914 /* Look for "Control Panel/Colors" under User and Machine registry
916 if (RegOpenKeyEx (HKEY_CURRENT_USER
, "Control Panel\\Colors", 0,
917 KEY_READ
, &colors_key
) == ERROR_SUCCESS
918 || RegOpenKeyEx (HKEY_LOCAL_MACHINE
, "Control Panel\\Colors", 0,
919 KEY_READ
, &colors_key
) == ERROR_SUCCESS
)
922 char color_buffer
[64];
923 char full_name_buffer
[MAX_PATH
+ SYSTEM_COLOR_PREFIX_LEN
];
925 DWORD name_size
, color_size
;
926 char *name_buffer
= full_name_buffer
+ SYSTEM_COLOR_PREFIX_LEN
;
928 name_size
= sizeof (full_name_buffer
) - SYSTEM_COLOR_PREFIX_LEN
;
929 color_size
= sizeof (color_buffer
);
931 strcpy (full_name_buffer
, SYSTEM_COLOR_PREFIX
);
933 while (RegEnumValueA (colors_key
, index
, name_buffer
, &name_size
,
934 NULL
, NULL
, color_buffer
, &color_size
)
938 if (sscanf (color_buffer
, " %u %u %u", &r
, &g
, &b
) == 3)
939 *system_colors
= Fcons (Fcons (build_string (full_name_buffer
),
940 make_number (RGB (r
, g
, b
))),
943 name_size
= sizeof (full_name_buffer
) - SYSTEM_COLOR_PREFIX_LEN
;
944 color_size
= sizeof (color_buffer
);
947 RegCloseKey (colors_key
);
955 x_to_w32_color (colorname
)
958 register Lisp_Object ret
= Qnil
;
962 if (colorname
[0] == '#')
964 /* Could be an old-style RGB Device specification. */
967 color
= colorname
+ 1;
969 size
= strlen (color
);
970 if (size
== 3 || size
== 6 || size
== 9 || size
== 12)
978 for (i
= 0; i
< 3; i
++)
984 /* The check for 'x' in the following conditional takes into
985 account the fact that strtol allows a "0x" in front of
986 our numbers, and we don't. */
987 if (!isxdigit (color
[0]) || color
[1] == 'x')
991 value
= strtoul (color
, &end
, 16);
993 if (errno
== ERANGE
|| end
- color
!= size
)
998 value
= value
* 0x10;
1009 colorval
|= (value
<< pos
);
1014 XSETINT (ret
, colorval
);
1021 else if (strnicmp (colorname
, "rgb:", 4) == 0)
1029 color
= colorname
+ 4;
1030 for (i
= 0; i
< 3; i
++)
1033 unsigned long value
;
1035 /* The check for 'x' in the following conditional takes into
1036 account the fact that strtol allows a "0x" in front of
1037 our numbers, and we don't. */
1038 if (!isxdigit (color
[0]) || color
[1] == 'x')
1040 value
= strtoul (color
, &end
, 16);
1041 if (errno
== ERANGE
)
1043 switch (end
- color
)
1046 value
= value
* 0x10 + value
;
1059 if (value
== ULONG_MAX
)
1061 colorval
|= (value
<< pos
);
1068 XSETINT (ret
, colorval
);
1076 else if (strnicmp (colorname
, "rgbi:", 5) == 0)
1078 /* This is an RGB Intensity specification. */
1085 color
= colorname
+ 5;
1086 for (i
= 0; i
< 3; i
++)
1092 value
= strtod (color
, &end
);
1093 if (errno
== ERANGE
)
1095 if (value
< 0.0 || value
> 1.0)
1097 val
= (UINT
)(0x100 * value
);
1098 /* We used 0x100 instead of 0xFF to give a continuous
1099 range between 0.0 and 1.0 inclusive. The next statement
1100 fixes the 1.0 case. */
1103 colorval
|= (val
<< pos
);
1110 XSETINT (ret
, colorval
);
1118 /* I am not going to attempt to handle any of the CIE color schemes
1119 or TekHVC, since I don't know the algorithms for conversion to
1122 /* If we fail to lookup the color name in w32_color_map, then check the
1123 colorname to see if it can be crudely approximated: If the X color
1124 ends in a number (e.g., "darkseagreen2"), strip the number and
1125 return the result of looking up the base color name. */
1126 ret
= w32_color_map_lookup (colorname
);
1129 int len
= strlen (colorname
);
1131 if (isdigit (colorname
[len
- 1]))
1133 char *ptr
, *approx
= alloca (len
+ 1);
1135 strcpy (approx
, colorname
);
1136 ptr
= &approx
[len
- 1];
1137 while (ptr
> approx
&& isdigit (*ptr
))
1140 ret
= w32_color_map_lookup (approx
);
1149 w32_regenerate_palette (FRAME_PTR f
)
1151 struct w32_palette_entry
* list
;
1152 LOGPALETTE
* log_palette
;
1153 HPALETTE new_palette
;
1156 /* don't bother trying to create palette if not supported */
1157 if (! FRAME_W32_DISPLAY_INFO (f
)->has_palette
)
1160 log_palette
= (LOGPALETTE
*)
1161 alloca (sizeof (LOGPALETTE
) +
1162 FRAME_W32_DISPLAY_INFO (f
)->num_colors
* sizeof (PALETTEENTRY
));
1163 log_palette
->palVersion
= 0x300;
1164 log_palette
->palNumEntries
= FRAME_W32_DISPLAY_INFO (f
)->num_colors
;
1166 list
= FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1168 i
< FRAME_W32_DISPLAY_INFO (f
)->num_colors
;
1169 i
++, list
= list
->next
)
1170 log_palette
->palPalEntry
[i
] = list
->entry
;
1172 new_palette
= CreatePalette (log_palette
);
1176 if (FRAME_W32_DISPLAY_INFO (f
)->palette
)
1177 DeleteObject (FRAME_W32_DISPLAY_INFO (f
)->palette
);
1178 FRAME_W32_DISPLAY_INFO (f
)->palette
= new_palette
;
1180 /* Realize display palette and garbage all frames. */
1181 release_frame_dc (f
, get_frame_dc (f
));
1186 #define W32_COLOR(pe) RGB (pe.peRed, pe.peGreen, pe.peBlue)
1187 #define SET_W32_COLOR(pe, color) \
1190 pe.peRed = GetRValue (color); \
1191 pe.peGreen = GetGValue (color); \
1192 pe.peBlue = GetBValue (color); \
1197 /* Keep these around in case we ever want to track color usage. */
1199 w32_map_color (FRAME_PTR f
, COLORREF color
)
1201 struct w32_palette_entry
* list
= FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1203 if (NILP (Vw32_enable_palette
))
1206 /* check if color is already mapped */
1209 if (W32_COLOR (list
->entry
) == color
)
1217 /* not already mapped, so add to list and recreate Windows palette */
1218 list
= (struct w32_palette_entry
*)
1219 xmalloc (sizeof (struct w32_palette_entry
));
1220 SET_W32_COLOR (list
->entry
, color
);
1222 list
->next
= FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1223 FRAME_W32_DISPLAY_INFO (f
)->color_list
= list
;
1224 FRAME_W32_DISPLAY_INFO (f
)->num_colors
++;
1226 /* set flag that palette must be regenerated */
1227 FRAME_W32_DISPLAY_INFO (f
)->regen_palette
= TRUE
;
1231 w32_unmap_color (FRAME_PTR f
, COLORREF color
)
1233 struct w32_palette_entry
* list
= FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1234 struct w32_palette_entry
**prev
= &FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1236 if (NILP (Vw32_enable_palette
))
1239 /* check if color is already mapped */
1242 if (W32_COLOR (list
->entry
) == color
)
1244 if (--list
->refcount
== 0)
1248 FRAME_W32_DISPLAY_INFO (f
)->num_colors
--;
1258 /* set flag that palette must be regenerated */
1259 FRAME_W32_DISPLAY_INFO (f
)->regen_palette
= TRUE
;
1264 /* Gamma-correct COLOR on frame F. */
1267 gamma_correct (f
, color
)
1273 *color
= PALETTERGB (
1274 pow (GetRValue (*color
) / 255.0, f
->gamma
) * 255.0 + 0.5,
1275 pow (GetGValue (*color
) / 255.0, f
->gamma
) * 255.0 + 0.5,
1276 pow (GetBValue (*color
) / 255.0, f
->gamma
) * 255.0 + 0.5);
1281 /* Decide if color named COLOR is valid for the display associated with
1282 the selected frame; if so, return the rgb values in COLOR_DEF.
1283 If ALLOC is nonzero, allocate a new colormap cell. */
1286 w32_defined_color (f
, color
, color_def
, alloc
)
1292 register Lisp_Object tem
;
1293 COLORREF w32_color_ref
;
1295 tem
= x_to_w32_color (color
);
1301 /* Apply gamma correction. */
1302 w32_color_ref
= XUINT (tem
);
1303 gamma_correct (f
, &w32_color_ref
);
1304 XSETINT (tem
, w32_color_ref
);
1307 /* Map this color to the palette if it is enabled. */
1308 if (!NILP (Vw32_enable_palette
))
1310 struct w32_palette_entry
* entry
=
1311 one_w32_display_info
.color_list
;
1312 struct w32_palette_entry
** prev
=
1313 &one_w32_display_info
.color_list
;
1315 /* check if color is already mapped */
1318 if (W32_COLOR (entry
->entry
) == XUINT (tem
))
1320 prev
= &entry
->next
;
1321 entry
= entry
->next
;
1324 if (entry
== NULL
&& alloc
)
1326 /* not already mapped, so add to list */
1327 entry
= (struct w32_palette_entry
*)
1328 xmalloc (sizeof (struct w32_palette_entry
));
1329 SET_W32_COLOR (entry
->entry
, XUINT (tem
));
1332 one_w32_display_info
.num_colors
++;
1334 /* set flag that palette must be regenerated */
1335 one_w32_display_info
.regen_palette
= TRUE
;
1338 /* Ensure COLORREF value is snapped to nearest color in (default)
1339 palette by simulating the PALETTERGB macro. This works whether
1340 or not the display device has a palette. */
1341 w32_color_ref
= XUINT (tem
) | 0x2000000;
1343 color_def
->pixel
= w32_color_ref
;
1344 color_def
->red
= GetRValue (w32_color_ref
) * 256;
1345 color_def
->green
= GetGValue (w32_color_ref
) * 256;
1346 color_def
->blue
= GetBValue (w32_color_ref
) * 256;
1356 /* Given a string ARG naming a color, compute a pixel value from it
1357 suitable for screen F.
1358 If F is not a color screen, return DEF (default) regardless of what
1362 x_decode_color (f
, arg
, def
)
1371 if (strcmp (SDATA (arg
), "black") == 0)
1372 return BLACK_PIX_DEFAULT (f
);
1373 else if (strcmp (SDATA (arg
), "white") == 0)
1374 return WHITE_PIX_DEFAULT (f
);
1376 if ((FRAME_W32_DISPLAY_INFO (f
)->n_planes
* FRAME_W32_DISPLAY_INFO (f
)->n_cbits
) == 1)
1379 /* w32_defined_color is responsible for coping with failures
1380 by looking for a near-miss. */
1381 if (w32_defined_color (f
, SDATA (arg
), &cdef
, 1))
1384 /* defined_color failed; return an ultimate default. */
1390 /* Functions called only from `x_set_frame_param'
1391 to set individual parameters.
1393 If FRAME_W32_WINDOW (f) is 0,
1394 the frame is being created and its window does not exist yet.
1395 In that case, just record the parameter's new value
1396 in the standard place; do not attempt to change the window. */
1399 x_set_foreground_color (f
, arg
, oldval
)
1401 Lisp_Object arg
, oldval
;
1403 struct w32_output
*x
= f
->output_data
.w32
;
1404 PIX_TYPE fg
, old_fg
;
1406 fg
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1407 old_fg
= FRAME_FOREGROUND_PIXEL (f
);
1408 FRAME_FOREGROUND_PIXEL (f
) = fg
;
1410 if (FRAME_W32_WINDOW (f
) != 0)
1412 if (x
->cursor_pixel
== old_fg
)
1413 x
->cursor_pixel
= fg
;
1415 update_face_from_frame_parameter (f
, Qforeground_color
, arg
);
1416 if (FRAME_VISIBLE_P (f
))
1422 x_set_background_color (f
, arg
, oldval
)
1424 Lisp_Object arg
, oldval
;
1426 FRAME_BACKGROUND_PIXEL (f
)
1427 = x_decode_color (f
, arg
, WHITE_PIX_DEFAULT (f
));
1429 if (FRAME_W32_WINDOW (f
) != 0)
1431 SetWindowLong (FRAME_W32_WINDOW (f
), WND_BACKGROUND_INDEX
,
1432 FRAME_BACKGROUND_PIXEL (f
));
1434 update_face_from_frame_parameter (f
, Qbackground_color
, arg
);
1436 if (FRAME_VISIBLE_P (f
))
1442 x_set_mouse_color (f
, arg
, oldval
)
1444 Lisp_Object arg
, oldval
;
1446 Cursor cursor
, nontext_cursor
, mode_cursor
, hand_cursor
;
1450 if (!EQ (Qnil
, arg
))
1451 f
->output_data
.w32
->mouse_pixel
1452 = x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1453 mask_color
= FRAME_BACKGROUND_PIXEL (f
);
1455 /* Don't let pointers be invisible. */
1456 if (mask_color
== f
->output_data
.w32
->mouse_pixel
1457 && mask_color
== FRAME_BACKGROUND_PIXEL (f
))
1458 f
->output_data
.w32
->mouse_pixel
= FRAME_FOREGROUND_PIXEL (f
);
1460 #if 0 /* TODO : cursor changes */
1463 /* It's not okay to crash if the user selects a screwy cursor. */
1464 count
= x_catch_errors (FRAME_W32_DISPLAY (f
));
1466 if (!EQ (Qnil
, Vx_pointer_shape
))
1468 CHECK_NUMBER (Vx_pointer_shape
);
1469 cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XINT (Vx_pointer_shape
));
1472 cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_xterm
);
1473 x_check_errors (FRAME_W32_DISPLAY (f
), "bad text pointer cursor: %s");
1475 if (!EQ (Qnil
, Vx_nontext_pointer_shape
))
1477 CHECK_NUMBER (Vx_nontext_pointer_shape
);
1478 nontext_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
),
1479 XINT (Vx_nontext_pointer_shape
));
1482 nontext_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_left_ptr
);
1483 x_check_errors (FRAME_W32_DISPLAY (f
), "bad nontext pointer cursor: %s");
1485 if (!EQ (Qnil
, Vx_hourglass_pointer_shape
))
1487 CHECK_NUMBER (Vx_hourglass_pointer_shape
);
1488 hourglass_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
),
1489 XINT (Vx_hourglass_pointer_shape
));
1492 hourglass_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_watch
);
1493 x_check_errors (FRAME_W32_DISPLAY (f
), "bad busy pointer cursor: %s");
1495 x_check_errors (FRAME_W32_DISPLAY (f
), "bad nontext pointer cursor: %s");
1496 if (!EQ (Qnil
, Vx_mode_pointer_shape
))
1498 CHECK_NUMBER (Vx_mode_pointer_shape
);
1499 mode_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
),
1500 XINT (Vx_mode_pointer_shape
));
1503 mode_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_xterm
);
1504 x_check_errors (FRAME_W32_DISPLAY (f
), "bad modeline pointer cursor: %s");
1506 if (!EQ (Qnil
, Vx_sensitive_text_pointer_shape
))
1508 CHECK_NUMBER (Vx_sensitive_text_pointer_shape
);
1510 = XCreateFontCursor (FRAME_W32_DISPLAY (f
),
1511 XINT (Vx_sensitive_text_pointer_shape
));
1514 hand_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_crosshair
);
1516 if (!NILP (Vx_window_horizontal_drag_shape
))
1518 CHECK_NUMBER (Vx_window_horizontal_drag_shape
);
1519 horizontal_drag_cursor
1520 = XCreateFontCursor (FRAME_X_DISPLAY (f
),
1521 XINT (Vx_window_horizontal_drag_shape
));
1524 horizontal_drag_cursor
1525 = XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_sb_h_double_arrow
);
1527 /* Check and report errors with the above calls. */
1528 x_check_errors (FRAME_W32_DISPLAY (f
), "can't set cursor shape: %s");
1529 x_uncatch_errors (FRAME_W32_DISPLAY (f
), count
);
1532 XColor fore_color
, back_color
;
1534 fore_color
.pixel
= f
->output_data
.w32
->mouse_pixel
;
1535 back_color
.pixel
= mask_color
;
1536 XQueryColor (FRAME_W32_DISPLAY (f
),
1537 DefaultColormap (FRAME_W32_DISPLAY (f
),
1538 DefaultScreen (FRAME_W32_DISPLAY (f
))),
1540 XQueryColor (FRAME_W32_DISPLAY (f
),
1541 DefaultColormap (FRAME_W32_DISPLAY (f
),
1542 DefaultScreen (FRAME_W32_DISPLAY (f
))),
1544 XRecolorCursor (FRAME_W32_DISPLAY (f
), cursor
,
1545 &fore_color
, &back_color
);
1546 XRecolorCursor (FRAME_W32_DISPLAY (f
), nontext_cursor
,
1547 &fore_color
, &back_color
);
1548 XRecolorCursor (FRAME_W32_DISPLAY (f
), mode_cursor
,
1549 &fore_color
, &back_color
);
1550 XRecolorCursor (FRAME_W32_DISPLAY (f
), hand_cursor
,
1551 &fore_color
, &back_color
);
1552 XRecolorCursor (FRAME_W32_DISPLAY (f
), hourglass_cursor
,
1553 &fore_color
, &back_color
);
1556 if (FRAME_W32_WINDOW (f
) != 0)
1557 XDefineCursor (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
), cursor
);
1559 if (cursor
!= f
->output_data
.w32
->text_cursor
&& f
->output_data
.w32
->text_cursor
!= 0)
1560 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->text_cursor
);
1561 f
->output_data
.w32
->text_cursor
= cursor
;
1563 if (nontext_cursor
!= f
->output_data
.w32
->nontext_cursor
1564 && f
->output_data
.w32
->nontext_cursor
!= 0)
1565 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->nontext_cursor
);
1566 f
->output_data
.w32
->nontext_cursor
= nontext_cursor
;
1568 if (hourglass_cursor
!= f
->output_data
.w32
->hourglass_cursor
1569 && f
->output_data
.w32
->hourglass_cursor
!= 0)
1570 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->hourglass_cursor
);
1571 f
->output_data
.w32
->hourglass_cursor
= hourglass_cursor
;
1573 if (mode_cursor
!= f
->output_data
.w32
->modeline_cursor
1574 && f
->output_data
.w32
->modeline_cursor
!= 0)
1575 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->modeline_cursor
);
1576 f
->output_data
.w32
->modeline_cursor
= mode_cursor
;
1578 if (hand_cursor
!= f
->output_data
.w32
->hand_cursor
1579 && f
->output_data
.w32
->hand_cursor
!= 0)
1580 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->hand_cursor
);
1581 f
->output_data
.w32
->hand_cursor
= hand_cursor
;
1583 XFlush (FRAME_W32_DISPLAY (f
));
1586 update_face_from_frame_parameter (f
, Qmouse_color
, arg
);
1591 x_set_cursor_color (f
, arg
, oldval
)
1593 Lisp_Object arg
, oldval
;
1595 unsigned long fore_pixel
, pixel
;
1597 if (!NILP (Vx_cursor_fore_pixel
))
1598 fore_pixel
= x_decode_color (f
, Vx_cursor_fore_pixel
,
1599 WHITE_PIX_DEFAULT (f
));
1601 fore_pixel
= FRAME_BACKGROUND_PIXEL (f
);
1603 pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1605 /* Make sure that the cursor color differs from the background color. */
1606 if (pixel
== FRAME_BACKGROUND_PIXEL (f
))
1608 pixel
= f
->output_data
.w32
->mouse_pixel
;
1609 if (pixel
== fore_pixel
)
1610 fore_pixel
= FRAME_BACKGROUND_PIXEL (f
);
1613 f
->output_data
.w32
->cursor_foreground_pixel
= fore_pixel
;
1614 f
->output_data
.w32
->cursor_pixel
= pixel
;
1616 if (FRAME_W32_WINDOW (f
) != 0)
1619 /* Update frame's cursor_gc. */
1620 f
->output_data
.w32
->cursor_gc
->foreground
= fore_pixel
;
1621 f
->output_data
.w32
->cursor_gc
->background
= pixel
;
1625 if (FRAME_VISIBLE_P (f
))
1627 x_update_cursor (f
, 0);
1628 x_update_cursor (f
, 1);
1632 update_face_from_frame_parameter (f
, Qcursor_color
, arg
);
1635 /* Set the border-color of frame F to pixel value PIX.
1636 Note that this does not fully take effect if done before
1640 x_set_border_pixel (f
, pix
)
1645 f
->output_data
.w32
->border_pixel
= pix
;
1647 if (FRAME_W32_WINDOW (f
) != 0 && f
->border_width
> 0)
1649 if (FRAME_VISIBLE_P (f
))
1654 /* Set the border-color of frame F to value described by ARG.
1655 ARG can be a string naming a color.
1656 The border-color is used for the border that is drawn by the server.
1657 Note that this does not fully take effect if done before
1658 F has a window; it must be redone when the window is created. */
1661 x_set_border_color (f
, arg
, oldval
)
1663 Lisp_Object arg
, oldval
;
1668 pix
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1669 x_set_border_pixel (f
, pix
);
1670 update_face_from_frame_parameter (f
, Qborder_color
, arg
);
1675 x_set_cursor_type (f
, arg
, oldval
)
1677 Lisp_Object arg
, oldval
;
1679 set_frame_cursor_types (f
, arg
);
1681 /* Make sure the cursor gets redrawn. */
1682 cursor_type_changed
= 1;
1686 x_set_icon_type (f
, arg
, oldval
)
1688 Lisp_Object arg
, oldval
;
1692 if (NILP (arg
) && NILP (oldval
))
1695 if (STRINGP (arg
) && STRINGP (oldval
)
1696 && EQ (Fstring_equal (oldval
, arg
), Qt
))
1699 if (SYMBOLP (arg
) && SYMBOLP (oldval
) && EQ (arg
, oldval
))
1704 result
= x_bitmap_icon (f
, arg
);
1708 error ("No icon window available");
1715 x_set_icon_name (f
, arg
, oldval
)
1717 Lisp_Object arg
, oldval
;
1721 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1724 else if (!NILP (arg
) || NILP (oldval
))
1730 if (f
->output_data
.w32
->icon_bitmap
!= 0)
1735 result
= x_text_icon (f
,
1736 (char *) SDATA ((!NILP (f
->icon_name
)
1745 error ("No icon window available");
1748 /* If the window was unmapped (and its icon was mapped),
1749 the new icon is not mapped, so map the window in its stead. */
1750 if (FRAME_VISIBLE_P (f
))
1752 #ifdef USE_X_TOOLKIT
1753 XtPopup (f
->output_data
.w32
->widget
, XtGrabNone
);
1755 XMapWindow (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
));
1758 XFlush (FRAME_W32_DISPLAY (f
));
1765 x_set_menu_bar_lines (f
, value
, oldval
)
1767 Lisp_Object value
, oldval
;
1770 int olines
= FRAME_MENU_BAR_LINES (f
);
1772 /* Right now, menu bars don't work properly in minibuf-only frames;
1773 most of the commands try to apply themselves to the minibuffer
1774 frame itself, and get an error because you can't switch buffers
1775 in or split the minibuffer window. */
1776 if (FRAME_MINIBUF_ONLY_P (f
))
1779 if (INTEGERP (value
))
1780 nlines
= XINT (value
);
1784 FRAME_MENU_BAR_LINES (f
) = 0;
1786 FRAME_EXTERNAL_MENU_BAR (f
) = 1;
1789 if (FRAME_EXTERNAL_MENU_BAR (f
) == 1)
1790 free_frame_menubar (f
);
1791 FRAME_EXTERNAL_MENU_BAR (f
) = 0;
1793 /* Adjust the frame size so that the client (text) dimensions
1794 remain the same. This depends on FRAME_EXTERNAL_MENU_BAR being
1796 x_set_window_size (f
, 0, FRAME_COLS (f
), FRAME_LINES (f
));
1797 do_pending_window_change (0);
1803 /* Set the number of lines used for the tool bar of frame F to VALUE.
1804 VALUE not an integer, or < 0 means set the lines to zero. OLDVAL
1805 is the old number of tool bar lines. This function changes the
1806 height of all windows on frame F to match the new tool bar height.
1807 The frame's height doesn't change. */
1810 x_set_tool_bar_lines (f
, value
, oldval
)
1812 Lisp_Object value
, oldval
;
1814 int delta
, nlines
, root_height
;
1815 Lisp_Object root_window
;
1817 /* Treat tool bars like menu bars. */
1818 if (FRAME_MINIBUF_ONLY_P (f
))
1821 /* Use VALUE only if an integer >= 0. */
1822 if (INTEGERP (value
) && XINT (value
) >= 0)
1823 nlines
= XFASTINT (value
);
1827 /* Make sure we redisplay all windows in this frame. */
1828 ++windows_or_buffers_changed
;
1830 delta
= nlines
- FRAME_TOOL_BAR_LINES (f
);
1832 /* Don't resize the tool-bar to more than we have room for. */
1833 root_window
= FRAME_ROOT_WINDOW (f
);
1834 root_height
= WINDOW_TOTAL_LINES (XWINDOW (root_window
));
1835 if (root_height
- delta
< 1)
1837 delta
= root_height
- 1;
1838 nlines
= FRAME_TOOL_BAR_LINES (f
) + delta
;
1841 FRAME_TOOL_BAR_LINES (f
) = nlines
;
1842 change_window_heights (root_window
, delta
);
1845 /* We also have to make sure that the internal border at the top of
1846 the frame, below the menu bar or tool bar, is redrawn when the
1847 tool bar disappears. This is so because the internal border is
1848 below the tool bar if one is displayed, but is below the menu bar
1849 if there isn't a tool bar. The tool bar draws into the area
1850 below the menu bar. */
1851 if (FRAME_W32_WINDOW (f
) && FRAME_TOOL_BAR_LINES (f
) == 0)
1854 clear_current_matrices (f
);
1857 /* If the tool bar gets smaller, the internal border below it
1858 has to be cleared. It was formerly part of the display
1859 of the larger tool bar, and updating windows won't clear it. */
1862 int height
= FRAME_INTERNAL_BORDER_WIDTH (f
);
1863 int width
= FRAME_PIXEL_WIDTH (f
);
1864 int y
= nlines
* FRAME_LINE_HEIGHT (f
);
1868 HDC hdc
= get_frame_dc (f
);
1869 w32_clear_area (f
, hdc
, 0, y
, width
, height
);
1870 release_frame_dc (f
, hdc
);
1874 if (WINDOWP (f
->tool_bar_window
))
1875 clear_glyph_matrix (XWINDOW (f
->tool_bar_window
)->current_matrix
);
1880 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
1883 If EXPLICIT is non-zero, that indicates that lisp code is setting the
1884 name; if NAME is a string, set F's name to NAME and set
1885 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
1887 If EXPLICIT is zero, that indicates that Emacs redisplay code is
1888 suggesting a new name, which lisp code should override; if
1889 F->explicit_name is set, ignore the new name; otherwise, set it. */
1892 x_set_name (f
, name
, explicit)
1897 /* Make sure that requests from lisp code override requests from
1898 Emacs redisplay code. */
1901 /* If we're switching from explicit to implicit, we had better
1902 update the mode lines and thereby update the title. */
1903 if (f
->explicit_name
&& NILP (name
))
1904 update_mode_lines
= 1;
1906 f
->explicit_name
= ! NILP (name
);
1908 else if (f
->explicit_name
)
1911 /* If NAME is nil, set the name to the w32_id_name. */
1914 /* Check for no change needed in this very common case
1915 before we do any consing. */
1916 if (!strcmp (FRAME_W32_DISPLAY_INFO (f
)->w32_id_name
,
1919 name
= build_string (FRAME_W32_DISPLAY_INFO (f
)->w32_id_name
);
1922 CHECK_STRING (name
);
1924 /* Don't change the name if it's already NAME. */
1925 if (! NILP (Fstring_equal (name
, f
->name
)))
1930 /* For setting the frame title, the title parameter should override
1931 the name parameter. */
1932 if (! NILP (f
->title
))
1935 if (FRAME_W32_WINDOW (f
))
1937 if (STRING_MULTIBYTE (name
))
1938 name
= ENCODE_SYSTEM (name
);
1941 SetWindowText (FRAME_W32_WINDOW (f
), SDATA (name
));
1946 /* This function should be called when the user's lisp code has
1947 specified a name for the frame; the name will override any set by the
1950 x_explicitly_set_name (f
, arg
, oldval
)
1952 Lisp_Object arg
, oldval
;
1954 x_set_name (f
, arg
, 1);
1957 /* This function should be called by Emacs redisplay code to set the
1958 name; names set this way will never override names set by the user's
1961 x_implicitly_set_name (f
, arg
, oldval
)
1963 Lisp_Object arg
, oldval
;
1965 x_set_name (f
, arg
, 0);
1968 /* Change the title of frame F to NAME.
1969 If NAME is nil, use the frame name as the title. */
1972 x_set_title (f
, name
, old_name
)
1974 Lisp_Object name
, old_name
;
1976 /* Don't change the title if it's already NAME. */
1977 if (EQ (name
, f
->title
))
1980 update_mode_lines
= 1;
1987 if (FRAME_W32_WINDOW (f
))
1989 if (STRING_MULTIBYTE (name
))
1990 name
= ENCODE_SYSTEM (name
);
1993 SetWindowText (FRAME_W32_WINDOW (f
), SDATA (name
));
1999 void x_set_scroll_bar_default_width (f
)
2002 int wid
= FRAME_COLUMN_WIDTH (f
);
2004 FRAME_CONFIG_SCROLL_BAR_WIDTH (f
) = GetSystemMetrics (SM_CXVSCROLL
);
2005 FRAME_CONFIG_SCROLL_BAR_COLS (f
) = (FRAME_CONFIG_SCROLL_BAR_WIDTH (f
) +
2010 /* Subroutines of creating a frame. */
2013 /* Return the value of parameter PARAM.
2015 First search ALIST, then Vdefault_frame_alist, then the X defaults
2016 database, using ATTRIBUTE as the attribute name and CLASS as its class.
2018 Convert the resource to the type specified by desired_type.
2020 If no default is specified, return Qunbound. If you call
2021 w32_get_arg, make sure you deal with Qunbound in a reasonable way,
2022 and don't let it get stored in any Lisp-visible variables! */
2025 w32_get_arg (alist
, param
, attribute
, class, type
)
2026 Lisp_Object alist
, param
;
2029 enum resource_types type
;
2031 return x_get_arg (check_x_display_info (Qnil
),
2032 alist
, param
, attribute
, class, type
);
2037 w32_load_cursor (LPCTSTR name
)
2039 /* Try first to load cursor from application resource. */
2040 Cursor cursor
= LoadImage ((HINSTANCE
) GetModuleHandle (NULL
),
2041 name
, IMAGE_CURSOR
, 0, 0,
2042 LR_DEFAULTCOLOR
| LR_DEFAULTSIZE
| LR_SHARED
);
2045 /* Then try to load a shared predefined cursor. */
2046 cursor
= LoadImage (NULL
, name
, IMAGE_CURSOR
, 0, 0,
2047 LR_DEFAULTCOLOR
| LR_DEFAULTSIZE
| LR_SHARED
);
2052 extern LRESULT CALLBACK
w32_wnd_proc ();
2055 w32_init_class (hinst
)
2060 wc
.style
= CS_HREDRAW
| CS_VREDRAW
;
2061 wc
.lpfnWndProc
= (WNDPROC
) w32_wnd_proc
;
2063 wc
.cbWndExtra
= WND_EXTRA_BYTES
;
2064 wc
.hInstance
= hinst
;
2065 wc
.hIcon
= LoadIcon (hinst
, EMACS_CLASS
);
2066 wc
.hCursor
= w32_load_cursor (IDC_ARROW
);
2067 wc
.hbrBackground
= NULL
; /* GetStockObject (WHITE_BRUSH); */
2068 wc
.lpszMenuName
= NULL
;
2069 wc
.lpszClassName
= EMACS_CLASS
;
2071 return (RegisterClass (&wc
));
2075 w32_createscrollbar (f
, bar
)
2077 struct scroll_bar
* bar
;
2079 return (CreateWindow ("SCROLLBAR", "", SBS_VERT
| WS_CHILD
| WS_VISIBLE
,
2080 /* Position and size of scroll bar. */
2081 XINT (bar
->left
) + VERTICAL_SCROLL_BAR_WIDTH_TRIM
,
2083 XINT (bar
->width
) - VERTICAL_SCROLL_BAR_WIDTH_TRIM
* 2,
2085 FRAME_W32_WINDOW (f
),
2092 w32_createwindow (f
)
2097 Lisp_Object top
= Qunbound
;
2098 Lisp_Object left
= Qunbound
;
2100 rect
.left
= rect
.top
= 0;
2101 rect
.right
= FRAME_PIXEL_WIDTH (f
);
2102 rect
.bottom
= FRAME_PIXEL_HEIGHT (f
);
2104 AdjustWindowRect (&rect
, f
->output_data
.w32
->dwStyle
,
2105 FRAME_EXTERNAL_MENU_BAR (f
));
2107 /* Do first time app init */
2111 w32_init_class (hinst
);
2114 if (f
->size_hint_flags
& USPosition
|| f
->size_hint_flags
& PPosition
)
2116 XSETINT (left
, f
->left_pos
);
2117 XSETINT (top
, f
->top_pos
);
2119 else if (EQ (left
, Qunbound
) && EQ (top
, Qunbound
))
2121 /* When called with RES_TYPE_NUMBER, w32_get_arg will return zero
2122 for anything that is not a number and is not Qunbound. */
2123 left
= w32_get_arg (Qnil
, Qleft
, "left", "Left", RES_TYPE_NUMBER
);
2124 top
= w32_get_arg (Qnil
, Qtop
, "top", "Top", RES_TYPE_NUMBER
);
2127 FRAME_W32_WINDOW (f
) = hwnd
2128 = CreateWindow (EMACS_CLASS
,
2130 f
->output_data
.w32
->dwStyle
| WS_CLIPCHILDREN
,
2131 EQ (left
, Qunbound
) ? CW_USEDEFAULT
: XINT (left
),
2132 EQ (top
, Qunbound
) ? CW_USEDEFAULT
: XINT (top
),
2133 rect
.right
- rect
.left
,
2134 rect
.bottom
- rect
.top
,
2142 SetWindowLong (hwnd
, WND_FONTWIDTH_INDEX
, FRAME_COLUMN_WIDTH (f
));
2143 SetWindowLong (hwnd
, WND_LINEHEIGHT_INDEX
, FRAME_LINE_HEIGHT (f
));
2144 SetWindowLong (hwnd
, WND_BORDER_INDEX
, FRAME_INTERNAL_BORDER_WIDTH (f
));
2145 SetWindowLong (hwnd
, WND_SCROLLBAR_INDEX
, f
->scroll_bar_actual_width
);
2146 SetWindowLong (hwnd
, WND_BACKGROUND_INDEX
, FRAME_BACKGROUND_PIXEL (f
));
2148 /* Enable drag-n-drop. */
2149 DragAcceptFiles (hwnd
, TRUE
);
2151 /* Do this to discard the default setting specified by our parent. */
2152 ShowWindow (hwnd
, SW_HIDE
);
2154 /* Update frame positions. */
2155 GetWindowRect (hwnd
, &rect
);
2156 f
->left_pos
= rect
.left
;
2157 f
->top_pos
= rect
.top
;
2162 my_post_msg (wmsg
, hwnd
, msg
, wParam
, lParam
)
2169 wmsg
->msg
.hwnd
= hwnd
;
2170 wmsg
->msg
.message
= msg
;
2171 wmsg
->msg
.wParam
= wParam
;
2172 wmsg
->msg
.lParam
= lParam
;
2173 wmsg
->msg
.time
= GetMessageTime ();
2178 /* GetKeyState and MapVirtualKey on Windows 95 do not actually distinguish
2179 between left and right keys as advertised. We test for this
2180 support dynamically, and set a flag when the support is absent. If
2181 absent, we keep track of the left and right control and alt keys
2182 ourselves. This is particularly necessary on keyboards that rely
2183 upon the AltGr key, which is represented as having the left control
2184 and right alt keys pressed. For these keyboards, we need to know
2185 when the left alt key has been pressed in addition to the AltGr key
2186 so that we can properly support M-AltGr-key sequences (such as M-@
2187 on Swedish keyboards). */
2189 #define EMACS_LCONTROL 0
2190 #define EMACS_RCONTROL 1
2191 #define EMACS_LMENU 2
2192 #define EMACS_RMENU 3
2194 static int modifiers
[4];
2195 static int modifiers_recorded
;
2196 static int modifier_key_support_tested
;
2199 test_modifier_support (unsigned int wparam
)
2203 if (wparam
!= VK_CONTROL
&& wparam
!= VK_MENU
)
2205 if (wparam
== VK_CONTROL
)
2215 if (!(GetKeyState (l
) & 0x8000) && !(GetKeyState (r
) & 0x8000))
2216 modifiers_recorded
= 1;
2218 modifiers_recorded
= 0;
2219 modifier_key_support_tested
= 1;
2223 record_keydown (unsigned int wparam
, unsigned int lparam
)
2227 if (!modifier_key_support_tested
)
2228 test_modifier_support (wparam
);
2230 if ((wparam
!= VK_CONTROL
&& wparam
!= VK_MENU
) || !modifiers_recorded
)
2233 if (wparam
== VK_CONTROL
)
2234 i
= (lparam
& 0x1000000) ? EMACS_RCONTROL
: EMACS_LCONTROL
;
2236 i
= (lparam
& 0x1000000) ? EMACS_RMENU
: EMACS_LMENU
;
2242 record_keyup (unsigned int wparam
, unsigned int lparam
)
2246 if ((wparam
!= VK_CONTROL
&& wparam
!= VK_MENU
) || !modifiers_recorded
)
2249 if (wparam
== VK_CONTROL
)
2250 i
= (lparam
& 0x1000000) ? EMACS_RCONTROL
: EMACS_LCONTROL
;
2252 i
= (lparam
& 0x1000000) ? EMACS_RMENU
: EMACS_LMENU
;
2257 /* Emacs can lose focus while a modifier key has been pressed. When
2258 it regains focus, be conservative and clear all modifiers since
2259 we cannot reconstruct the left and right modifier state. */
2265 if (GetFocus () == NULL
)
2266 /* Emacs doesn't have keyboard focus. Do nothing. */
2269 ctrl
= GetAsyncKeyState (VK_CONTROL
);
2270 alt
= GetAsyncKeyState (VK_MENU
);
2272 if (!(ctrl
& 0x08000))
2273 /* Clear any recorded control modifier state. */
2274 modifiers
[EMACS_RCONTROL
] = modifiers
[EMACS_LCONTROL
] = 0;
2276 if (!(alt
& 0x08000))
2277 /* Clear any recorded alt modifier state. */
2278 modifiers
[EMACS_RMENU
] = modifiers
[EMACS_LMENU
] = 0;
2280 /* Update the state of all modifier keys, because modifiers used in
2281 hot-key combinations can get stuck on if Emacs loses focus as a
2282 result of a hot-key being pressed. */
2286 #define CURRENT_STATE(key) ((GetAsyncKeyState (key) & 0x8000) >> 8)
2288 GetKeyboardState (keystate
);
2289 keystate
[VK_SHIFT
] = CURRENT_STATE (VK_SHIFT
);
2290 keystate
[VK_CONTROL
] = CURRENT_STATE (VK_CONTROL
);
2291 keystate
[VK_LCONTROL
] = CURRENT_STATE (VK_LCONTROL
);
2292 keystate
[VK_RCONTROL
] = CURRENT_STATE (VK_RCONTROL
);
2293 keystate
[VK_MENU
] = CURRENT_STATE (VK_MENU
);
2294 keystate
[VK_LMENU
] = CURRENT_STATE (VK_LMENU
);
2295 keystate
[VK_RMENU
] = CURRENT_STATE (VK_RMENU
);
2296 keystate
[VK_LWIN
] = CURRENT_STATE (VK_LWIN
);
2297 keystate
[VK_RWIN
] = CURRENT_STATE (VK_RWIN
);
2298 keystate
[VK_APPS
] = CURRENT_STATE (VK_APPS
);
2299 SetKeyboardState (keystate
);
2303 /* Synchronize modifier state with what is reported with the current
2304 keystroke. Even if we cannot distinguish between left and right
2305 modifier keys, we know that, if no modifiers are set, then neither
2306 the left or right modifier should be set. */
2310 if (!modifiers_recorded
)
2313 if (!(GetKeyState (VK_CONTROL
) & 0x8000))
2314 modifiers
[EMACS_RCONTROL
] = modifiers
[EMACS_LCONTROL
] = 0;
2316 if (!(GetKeyState (VK_MENU
) & 0x8000))
2317 modifiers
[EMACS_RMENU
] = modifiers
[EMACS_LMENU
] = 0;
2321 modifier_set (int vkey
)
2323 if (vkey
== VK_CAPITAL
|| vkey
== VK_SCROLL
)
2324 return (GetKeyState (vkey
) & 0x1);
2325 if (!modifiers_recorded
)
2326 return (GetKeyState (vkey
) & 0x8000);
2331 return modifiers
[EMACS_LCONTROL
];
2333 return modifiers
[EMACS_RCONTROL
];
2335 return modifiers
[EMACS_LMENU
];
2337 return modifiers
[EMACS_RMENU
];
2339 return (GetKeyState (vkey
) & 0x8000);
2342 /* Convert between the modifier bits W32 uses and the modifier bits
2346 w32_key_to_modifier (int key
)
2348 Lisp_Object key_mapping
;
2353 key_mapping
= Vw32_lwindow_modifier
;
2356 key_mapping
= Vw32_rwindow_modifier
;
2359 key_mapping
= Vw32_apps_modifier
;
2362 key_mapping
= Vw32_scroll_lock_modifier
;
2368 /* NB. This code runs in the input thread, asychronously to the lisp
2369 thread, so we must be careful to ensure access to lisp data is
2370 thread-safe. The following code is safe because the modifier
2371 variable values are updated atomically from lisp and symbols are
2372 not relocated by GC. Also, we don't have to worry about seeing GC
2374 if (EQ (key_mapping
, Qhyper
))
2375 return hyper_modifier
;
2376 if (EQ (key_mapping
, Qsuper
))
2377 return super_modifier
;
2378 if (EQ (key_mapping
, Qmeta
))
2379 return meta_modifier
;
2380 if (EQ (key_mapping
, Qalt
))
2381 return alt_modifier
;
2382 if (EQ (key_mapping
, Qctrl
))
2383 return ctrl_modifier
;
2384 if (EQ (key_mapping
, Qcontrol
)) /* synonym for ctrl */
2385 return ctrl_modifier
;
2386 if (EQ (key_mapping
, Qshift
))
2387 return shift_modifier
;
2389 /* Don't generate any modifier if not explicitly requested. */
2394 w32_get_modifiers ()
2396 return ((modifier_set (VK_SHIFT
) ? shift_modifier
: 0) |
2397 (modifier_set (VK_CONTROL
) ? ctrl_modifier
: 0) |
2398 (modifier_set (VK_LWIN
) ? w32_key_to_modifier (VK_LWIN
) : 0) |
2399 (modifier_set (VK_RWIN
) ? w32_key_to_modifier (VK_RWIN
) : 0) |
2400 (modifier_set (VK_APPS
) ? w32_key_to_modifier (VK_APPS
) : 0) |
2401 (modifier_set (VK_SCROLL
) ? w32_key_to_modifier (VK_SCROLL
) : 0) |
2402 (modifier_set (VK_MENU
) ?
2403 ((NILP (Vw32_alt_is_meta
)) ? alt_modifier
: meta_modifier
) : 0));
2406 /* We map the VK_* modifiers into console modifier constants
2407 so that we can use the same routines to handle both console
2408 and window input. */
2411 construct_console_modifiers ()
2416 mods
|= (modifier_set (VK_SHIFT
)) ? SHIFT_PRESSED
: 0;
2417 mods
|= (modifier_set (VK_CAPITAL
)) ? CAPSLOCK_ON
: 0;
2418 mods
|= (modifier_set (VK_SCROLL
)) ? SCROLLLOCK_ON
: 0;
2419 mods
|= (modifier_set (VK_NUMLOCK
)) ? NUMLOCK_ON
: 0;
2420 mods
|= (modifier_set (VK_LCONTROL
)) ? LEFT_CTRL_PRESSED
: 0;
2421 mods
|= (modifier_set (VK_RCONTROL
)) ? RIGHT_CTRL_PRESSED
: 0;
2422 mods
|= (modifier_set (VK_LMENU
)) ? LEFT_ALT_PRESSED
: 0;
2423 mods
|= (modifier_set (VK_RMENU
)) ? RIGHT_ALT_PRESSED
: 0;
2424 mods
|= (modifier_set (VK_LWIN
)) ? LEFT_WIN_PRESSED
: 0;
2425 mods
|= (modifier_set (VK_RWIN
)) ? RIGHT_WIN_PRESSED
: 0;
2426 mods
|= (modifier_set (VK_APPS
)) ? APPS_PRESSED
: 0;
2432 w32_get_key_modifiers (unsigned int wparam
, unsigned int lparam
)
2436 /* Convert to emacs modifiers. */
2437 mods
= w32_kbd_mods_to_emacs (construct_console_modifiers (), wparam
);
2443 map_keypad_keys (unsigned int virt_key
, unsigned int extended
)
2445 if (virt_key
< VK_CLEAR
|| virt_key
> VK_DELETE
)
2448 if (virt_key
== VK_RETURN
)
2449 return (extended
? VK_NUMPAD_ENTER
: VK_RETURN
);
2451 if (virt_key
>= VK_PRIOR
&& virt_key
<= VK_DOWN
)
2452 return (!extended
? (VK_NUMPAD_PRIOR
+ (virt_key
- VK_PRIOR
)) : virt_key
);
2454 if (virt_key
== VK_INSERT
|| virt_key
== VK_DELETE
)
2455 return (!extended
? (VK_NUMPAD_INSERT
+ (virt_key
- VK_INSERT
)) : virt_key
);
2457 if (virt_key
== VK_CLEAR
)
2458 return (!extended
? VK_NUMPAD_CLEAR
: virt_key
);
2463 /* List of special key combinations which w32 would normally capture,
2464 but Emacs should grab instead. Not directly visible to lisp, to
2465 simplify synchronization. Each item is an integer encoding a virtual
2466 key code and modifier combination to capture. */
2467 static Lisp_Object w32_grabbed_keys
;
2469 #define HOTKEY(vk, mods) make_number (((vk) & 255) | ((mods) << 8))
2470 #define HOTKEY_ID(k) (XFASTINT (k) & 0xbfff)
2471 #define HOTKEY_VK_CODE(k) (XFASTINT (k) & 255)
2472 #define HOTKEY_MODIFIERS(k) (XFASTINT (k) >> 8)
2474 #define RAW_HOTKEY_ID(k) ((k) & 0xbfff)
2475 #define RAW_HOTKEY_VK_CODE(k) ((k) & 255)
2476 #define RAW_HOTKEY_MODIFIERS(k) ((k) >> 8)
2478 /* Register hot-keys for reserved key combinations when Emacs has
2479 keyboard focus, since this is the only way Emacs can receive key
2480 combinations like Alt-Tab which are used by the system. */
2483 register_hot_keys (hwnd
)
2486 Lisp_Object keylist
;
2488 /* Use CONSP, since we are called asynchronously. */
2489 for (keylist
= w32_grabbed_keys
; CONSP (keylist
); keylist
= XCDR (keylist
))
2491 Lisp_Object key
= XCAR (keylist
);
2493 /* Deleted entries get set to nil. */
2494 if (!INTEGERP (key
))
2497 RegisterHotKey (hwnd
, HOTKEY_ID (key
),
2498 HOTKEY_MODIFIERS (key
), HOTKEY_VK_CODE (key
));
2503 unregister_hot_keys (hwnd
)
2506 Lisp_Object keylist
;
2508 for (keylist
= w32_grabbed_keys
; CONSP (keylist
); keylist
= XCDR (keylist
))
2510 Lisp_Object key
= XCAR (keylist
);
2512 if (!INTEGERP (key
))
2515 UnregisterHotKey (hwnd
, HOTKEY_ID (key
));
2519 /* Main message dispatch loop. */
2522 w32_msg_pump (deferred_msg
* msg_buf
)
2528 msh_mousewheel
= RegisterWindowMessage (MSH_MOUSEWHEEL
);
2530 while (GetMessage (&msg
, NULL
, 0, 0))
2532 if (msg
.hwnd
== NULL
)
2534 switch (msg
.message
)
2537 /* Produced by complete_deferred_msg; just ignore. */
2539 case WM_EMACS_CREATEWINDOW
:
2540 /* Initialize COM for this window. Even though we don't use it,
2541 some third party shell extensions can cause it to be used in
2542 system dialogs, which causes a crash if it is not initialized.
2543 This is a known bug in Windows, which was fixed long ago, but
2544 the patch for XP is not publically available until XP SP3,
2545 and older versions will never be patched. */
2546 CoInitialize (NULL
);
2547 w32_createwindow ((struct frame
*) msg
.wParam
);
2548 if (!PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
, 0, 0))
2551 case WM_EMACS_SETLOCALE
:
2552 SetThreadLocale (msg
.wParam
);
2553 /* Reply is not expected. */
2555 case WM_EMACS_SETKEYBOARDLAYOUT
:
2556 result
= (int) ActivateKeyboardLayout ((HKL
) msg
.wParam
, 0);
2557 if (!PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
,
2561 case WM_EMACS_REGISTER_HOT_KEY
:
2562 focus_window
= GetFocus ();
2563 if (focus_window
!= NULL
)
2564 RegisterHotKey (focus_window
,
2565 RAW_HOTKEY_ID (msg
.wParam
),
2566 RAW_HOTKEY_MODIFIERS (msg
.wParam
),
2567 RAW_HOTKEY_VK_CODE (msg
.wParam
));
2568 /* Reply is not expected. */
2570 case WM_EMACS_UNREGISTER_HOT_KEY
:
2571 focus_window
= GetFocus ();
2572 if (focus_window
!= NULL
)
2573 UnregisterHotKey (focus_window
, RAW_HOTKEY_ID (msg
.wParam
));
2574 /* Mark item as erased. NB: this code must be
2575 thread-safe. The next line is okay because the cons
2576 cell is never made into garbage and is not relocated by
2578 XSETCAR ((Lisp_Object
) ((EMACS_INT
) msg
.lParam
), Qnil
);
2579 if (!PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
, 0, 0))
2582 case WM_EMACS_TOGGLE_LOCK_KEY
:
2584 int vk_code
= (int) msg
.wParam
;
2585 int cur_state
= (GetKeyState (vk_code
) & 1);
2586 Lisp_Object new_state
= (Lisp_Object
) ((EMACS_INT
) msg
.lParam
);
2588 /* NB: This code must be thread-safe. It is safe to
2589 call NILP because symbols are not relocated by GC,
2590 and pointer here is not touched by GC (so the markbit
2591 can't be set). Numbers are safe because they are
2592 immediate values. */
2593 if (NILP (new_state
)
2594 || (NUMBERP (new_state
)
2595 && ((XUINT (new_state
)) & 1) != cur_state
))
2597 one_w32_display_info
.faked_key
= vk_code
;
2599 keybd_event ((BYTE
) vk_code
,
2600 (BYTE
) MapVirtualKey (vk_code
, 0),
2601 KEYEVENTF_EXTENDEDKEY
| KEYEVENTF_KEYUP
, 0);
2602 keybd_event ((BYTE
) vk_code
,
2603 (BYTE
) MapVirtualKey (vk_code
, 0),
2604 KEYEVENTF_EXTENDEDKEY
| 0, 0);
2605 keybd_event ((BYTE
) vk_code
,
2606 (BYTE
) MapVirtualKey (vk_code
, 0),
2607 KEYEVENTF_EXTENDEDKEY
| KEYEVENTF_KEYUP
, 0);
2608 cur_state
= !cur_state
;
2610 if (!PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
,
2616 /* Broadcast messages make it here, so you need to be looking
2617 for something in particular for this to be useful. */
2619 DebPrint (("msg %x not expected by w32_msg_pump\n", msg
.message
));
2625 DispatchMessage (&msg
);
2628 /* Exit nested loop when our deferred message has completed. */
2629 if (msg_buf
->completed
)
2634 deferred_msg
* deferred_msg_head
;
2636 static deferred_msg
*
2637 find_deferred_msg (HWND hwnd
, UINT msg
)
2639 deferred_msg
* item
;
2641 /* Don't actually need synchronization for read access, since
2642 modification of single pointer is always atomic. */
2643 /* enter_crit (); */
2645 for (item
= deferred_msg_head
; item
!= NULL
; item
= item
->next
)
2646 if (item
->w32msg
.msg
.hwnd
== hwnd
2647 && item
->w32msg
.msg
.message
== msg
)
2650 /* leave_crit (); */
2656 send_deferred_msg (deferred_msg
* msg_buf
,
2662 /* Only input thread can send deferred messages. */
2663 if (GetCurrentThreadId () != dwWindowsThreadId
)
2666 /* It is an error to send a message that is already deferred. */
2667 if (find_deferred_msg (hwnd
, msg
) != NULL
)
2670 /* Enforced synchronization is not needed because this is the only
2671 function that alters deferred_msg_head, and the following critical
2672 section is guaranteed to only be serially reentered (since only the
2673 input thread can call us). */
2675 /* enter_crit (); */
2677 msg_buf
->completed
= 0;
2678 msg_buf
->next
= deferred_msg_head
;
2679 deferred_msg_head
= msg_buf
;
2680 my_post_msg (&msg_buf
->w32msg
, hwnd
, msg
, wParam
, lParam
);
2682 /* leave_crit (); */
2684 /* Start a new nested message loop to process other messages until
2685 this one is completed. */
2686 w32_msg_pump (msg_buf
);
2688 deferred_msg_head
= msg_buf
->next
;
2690 return msg_buf
->result
;
2694 complete_deferred_msg (HWND hwnd
, UINT msg
, LRESULT result
)
2696 deferred_msg
* msg_buf
= find_deferred_msg (hwnd
, msg
);
2698 if (msg_buf
== NULL
)
2699 /* Message may have been cancelled, so don't abort. */
2702 msg_buf
->result
= result
;
2703 msg_buf
->completed
= 1;
2705 /* Ensure input thread is woken so it notices the completion. */
2706 PostThreadMessage (dwWindowsThreadId
, WM_NULL
, 0, 0);
2710 cancel_all_deferred_msgs ()
2712 deferred_msg
* item
;
2714 /* Don't actually need synchronization for read access, since
2715 modification of single pointer is always atomic. */
2716 /* enter_crit (); */
2718 for (item
= deferred_msg_head
; item
!= NULL
; item
= item
->next
)
2721 item
->completed
= 1;
2724 /* leave_crit (); */
2726 /* Ensure input thread is woken so it notices the completion. */
2727 PostThreadMessage (dwWindowsThreadId
, WM_NULL
, 0, 0);
2731 w32_msg_worker (void *arg
)
2734 deferred_msg dummy_buf
;
2736 /* Ensure our message queue is created */
2738 PeekMessage (&msg
, NULL
, 0, 0, PM_NOREMOVE
);
2740 if (!PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
, 0, 0))
2743 memset (&dummy_buf
, 0, sizeof (dummy_buf
));
2744 dummy_buf
.w32msg
.msg
.hwnd
= NULL
;
2745 dummy_buf
.w32msg
.msg
.message
= WM_NULL
;
2747 /* This is the inital message loop which should only exit when the
2748 application quits. */
2749 w32_msg_pump (&dummy_buf
);
2755 signal_user_input ()
2757 /* Interrupt any lisp that wants to be interrupted by input. */
2758 if (!NILP (Vthrow_on_input
))
2760 Vquit_flag
= Vthrow_on_input
;
2761 /* If we're inside a function that wants immediate quits,
2763 if (immediate_quit
&& NILP (Vinhibit_quit
))
2773 post_character_message (hwnd
, msg
, wParam
, lParam
, modifiers
)
2783 wmsg
.dwModifiers
= modifiers
;
2785 /* Detect quit_char and set quit-flag directly. Note that we
2786 still need to post a message to ensure the main thread will be
2787 woken up if blocked in sys_select, but we do NOT want to post
2788 the quit_char message itself (because it will usually be as if
2789 the user had typed quit_char twice). Instead, we post a dummy
2790 message that has no particular effect. */
2793 if (isalpha (c
) && wmsg
.dwModifiers
== ctrl_modifier
)
2794 c
= make_ctrl_char (c
) & 0377;
2796 || (wmsg
.dwModifiers
== 0 &&
2797 w32_quit_key
&& wParam
== w32_quit_key
))
2801 /* The choice of message is somewhat arbitrary, as long as
2802 the main thread handler just ignores it. */
2805 /* Interrupt any blocking system calls. */
2808 /* As a safety precaution, forcibly complete any deferred
2809 messages. This is a kludge, but I don't see any particularly
2810 clean way to handle the situation where a deferred message is
2811 "dropped" in the lisp thread, and will thus never be
2812 completed, eg. by the user trying to activate the menubar
2813 when the lisp thread is busy, and then typing C-g when the
2814 menubar doesn't open promptly (with the result that the
2815 menubar never responds at all because the deferred
2816 WM_INITMENU message is never completed). Another problem
2817 situation is when the lisp thread calls SendMessage (to send
2818 a window manager command) when a message has been deferred;
2819 the lisp thread gets blocked indefinitely waiting for the
2820 deferred message to be completed, which itself is waiting for
2821 the lisp thread to respond.
2823 Note that we don't want to block the input thread waiting for
2824 a reponse from the lisp thread (although that would at least
2825 solve the deadlock problem above), because we want to be able
2826 to receive C-g to interrupt the lisp thread. */
2827 cancel_all_deferred_msgs ();
2830 signal_user_input ();
2833 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
2836 /* Main window procedure */
2839 w32_wnd_proc (hwnd
, msg
, wParam
, lParam
)
2846 struct w32_display_info
*dpyinfo
= &one_w32_display_info
;
2848 int windows_translate
;
2851 /* Note that it is okay to call x_window_to_frame, even though we are
2852 not running in the main lisp thread, because frame deletion
2853 requires the lisp thread to synchronize with this thread. Thus, if
2854 a frame struct is returned, it can be used without concern that the
2855 lisp thread might make it disappear while we are using it.
2857 NB. Walking the frame list in this thread is safe (as long as
2858 writes of Lisp_Object slots are atomic, which they are on Windows).
2859 Although delete-frame can destructively modify the frame list while
2860 we are walking it, a garbage collection cannot occur until after
2861 delete-frame has synchronized with this thread.
2863 It is also safe to use functions that make GDI calls, such as
2864 w32_clear_rect, because these functions must obtain a DC handle
2865 from the frame struct using get_frame_dc which is thread-aware. */
2870 f
= x_window_to_frame (dpyinfo
, hwnd
);
2873 HDC hdc
= get_frame_dc (f
);
2874 GetUpdateRect (hwnd
, &wmsg
.rect
, FALSE
);
2875 w32_clear_rect (f
, hdc
, &wmsg
.rect
);
2876 release_frame_dc (f
, hdc
);
2878 #if defined (W32_DEBUG_DISPLAY)
2879 DebPrint (("WM_ERASEBKGND (frame %p): erasing %d,%d-%d,%d\n",
2881 wmsg
.rect
.left
, wmsg
.rect
.top
,
2882 wmsg
.rect
.right
, wmsg
.rect
.bottom
));
2883 #endif /* W32_DEBUG_DISPLAY */
2886 case WM_PALETTECHANGED
:
2887 /* ignore our own changes */
2888 if ((HWND
)wParam
!= hwnd
)
2890 f
= x_window_to_frame (dpyinfo
, hwnd
);
2892 /* get_frame_dc will realize our palette and force all
2893 frames to be redrawn if needed. */
2894 release_frame_dc (f
, get_frame_dc (f
));
2899 PAINTSTRUCT paintStruct
;
2901 bzero (&update_rect
, sizeof (update_rect
));
2903 f
= x_window_to_frame (dpyinfo
, hwnd
);
2906 DebPrint (("WM_PAINT received for unknown window %p\n", hwnd
));
2910 /* MSDN Docs say not to call BeginPaint if GetUpdateRect
2911 fails. Apparently this can happen under some
2913 if (GetUpdateRect (hwnd
, &update_rect
, FALSE
) || !w32_strict_painting
)
2916 BeginPaint (hwnd
, &paintStruct
);
2918 /* The rectangles returned by GetUpdateRect and BeginPaint
2919 do not always match. Play it safe by assuming both areas
2921 UnionRect (&(wmsg
.rect
), &update_rect
, &(paintStruct
.rcPaint
));
2923 #if defined (W32_DEBUG_DISPLAY)
2924 DebPrint (("WM_PAINT (frame %p): painting %d,%d-%d,%d\n",
2926 wmsg
.rect
.left
, wmsg
.rect
.top
,
2927 wmsg
.rect
.right
, wmsg
.rect
.bottom
));
2928 DebPrint ((" [update region is %d,%d-%d,%d]\n",
2929 update_rect
.left
, update_rect
.top
,
2930 update_rect
.right
, update_rect
.bottom
));
2932 EndPaint (hwnd
, &paintStruct
);
2935 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
2940 /* If GetUpdateRect returns 0 (meaning there is no update
2941 region), assume the whole window needs to be repainted. */
2942 GetClientRect (hwnd
, &wmsg
.rect
);
2943 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
2947 case WM_INPUTLANGCHANGE
:
2948 /* Inform lisp thread of keyboard layout changes. */
2949 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
2951 /* Clear dead keys in the keyboard state; for simplicity only
2952 preserve modifier key states. */
2957 GetKeyboardState (keystate
);
2958 for (i
= 0; i
< 256; i
++)
2975 SetKeyboardState (keystate
);
2980 /* Synchronize hot keys with normal input. */
2981 PostMessage (hwnd
, WM_KEYDOWN
, HIWORD (lParam
), 0);
2986 record_keyup (wParam
, lParam
);
2991 /* Ignore keystrokes we fake ourself; see below. */
2992 if (dpyinfo
->faked_key
== wParam
)
2994 dpyinfo
->faked_key
= 0;
2995 /* Make sure TranslateMessage sees them though (as long as
2996 they don't produce WM_CHAR messages). This ensures that
2997 indicator lights are toggled promptly on Windows 9x, for
2999 if (wParam
< 256 && lispy_function_keys
[wParam
])
3001 windows_translate
= 1;
3007 /* Synchronize modifiers with current keystroke. */
3009 record_keydown (wParam
, lParam
);
3010 wParam
= map_keypad_keys (wParam
, (lParam
& 0x1000000L
) != 0);
3012 windows_translate
= 0;
3017 if (NILP (Vw32_pass_lwindow_to_system
))
3019 /* Prevent system from acting on keyup (which opens the
3020 Start menu if no other key was pressed) by simulating a
3021 press of Space which we will ignore. */
3022 if (GetAsyncKeyState (wParam
) & 1)
3024 if (NUMBERP (Vw32_phantom_key_code
))
3025 key
= XUINT (Vw32_phantom_key_code
) & 255;
3028 dpyinfo
->faked_key
= key
;
3029 keybd_event (key
, (BYTE
) MapVirtualKey (key
, 0), 0, 0);
3032 if (!NILP (Vw32_lwindow_modifier
))
3036 if (NILP (Vw32_pass_rwindow_to_system
))
3038 if (GetAsyncKeyState (wParam
) & 1)
3040 if (NUMBERP (Vw32_phantom_key_code
))
3041 key
= XUINT (Vw32_phantom_key_code
) & 255;
3044 dpyinfo
->faked_key
= key
;
3045 keybd_event (key
, (BYTE
) MapVirtualKey (key
, 0), 0, 0);
3048 if (!NILP (Vw32_rwindow_modifier
))
3052 if (!NILP (Vw32_apps_modifier
))
3056 if (NILP (Vw32_pass_alt_to_system
))
3057 /* Prevent DefWindowProc from activating the menu bar if an
3058 Alt key is pressed and released by itself. */
3060 windows_translate
= 1;
3063 /* Decide whether to treat as modifier or function key. */
3064 if (NILP (Vw32_enable_caps_lock
))
3065 goto disable_lock_key
;
3066 windows_translate
= 1;
3069 /* Decide whether to treat as modifier or function key. */
3070 if (NILP (Vw32_enable_num_lock
))
3071 goto disable_lock_key
;
3072 windows_translate
= 1;
3075 /* Decide whether to treat as modifier or function key. */
3076 if (NILP (Vw32_scroll_lock_modifier
))
3077 goto disable_lock_key
;
3078 windows_translate
= 1;
3081 /* Ensure the appropriate lock key state (and indicator light)
3082 remains in the same state. We do this by faking another
3083 press of the relevant key. Apparently, this really is the
3084 only way to toggle the state of the indicator lights. */
3085 dpyinfo
->faked_key
= wParam
;
3086 keybd_event ((BYTE
) wParam
, (BYTE
) MapVirtualKey (wParam
, 0),
3087 KEYEVENTF_EXTENDEDKEY
| KEYEVENTF_KEYUP
, 0);
3088 keybd_event ((BYTE
) wParam
, (BYTE
) MapVirtualKey (wParam
, 0),
3089 KEYEVENTF_EXTENDEDKEY
| 0, 0);
3090 keybd_event ((BYTE
) wParam
, (BYTE
) MapVirtualKey (wParam
, 0),
3091 KEYEVENTF_EXTENDEDKEY
| KEYEVENTF_KEYUP
, 0);
3092 /* Ensure indicator lights are updated promptly on Windows 9x
3093 (TranslateMessage apparently does this), after forwarding
3095 post_character_message (hwnd
, msg
, wParam
, lParam
,
3096 w32_get_key_modifiers (wParam
, lParam
));
3097 windows_translate
= 1;
3101 case VK_PROCESSKEY
: /* Generated by IME. */
3102 windows_translate
= 1;
3105 /* Windows maps Ctrl-Pause (aka Ctrl-Break) into VK_CANCEL,
3106 which is confusing for purposes of key binding; convert
3107 VK_CANCEL events into VK_PAUSE events. */
3111 /* Windows maps Ctrl-NumLock into VK_PAUSE, which is confusing
3112 for purposes of key binding; convert these back into
3113 VK_NUMLOCK events, at least when we want to see NumLock key
3114 presses. (Note that there is never any possibility that
3115 VK_PAUSE with Ctrl really is C-Pause as per above.) */
3116 if (NILP (Vw32_enable_num_lock
) && modifier_set (VK_CONTROL
))
3117 wParam
= VK_NUMLOCK
;
3120 /* If not defined as a function key, change it to a WM_CHAR message. */
3121 if (wParam
> 255 || !lispy_function_keys
[wParam
])
3123 DWORD modifiers
= construct_console_modifiers ();
3125 if (!NILP (Vw32_recognize_altgr
)
3126 && modifier_set (VK_LCONTROL
) && modifier_set (VK_RMENU
))
3128 /* Always let TranslateMessage handle AltGr key chords;
3129 for some reason, ToAscii doesn't always process AltGr
3130 chords correctly. */
3131 windows_translate
= 1;
3133 else if ((modifiers
& (~SHIFT_PRESSED
& ~CAPSLOCK_ON
)) != 0)
3135 /* Handle key chords including any modifiers other
3136 than shift directly, in order to preserve as much
3137 modifier information as possible. */
3138 if ('A' <= wParam
&& wParam
<= 'Z')
3140 /* Don't translate modified alphabetic keystrokes,
3141 so the user doesn't need to constantly switch
3142 layout to type control or meta keystrokes when
3143 the normal layout translates alphabetic
3144 characters to non-ascii characters. */
3145 if (!modifier_set (VK_SHIFT
))
3146 wParam
+= ('a' - 'A');
3151 /* Try to handle other keystrokes by determining the
3152 base character (ie. translating the base key plus
3156 KEY_EVENT_RECORD key
;
3158 key
.bKeyDown
= TRUE
;
3159 key
.wRepeatCount
= 1;
3160 key
.wVirtualKeyCode
= wParam
;
3161 key
.wVirtualScanCode
= (lParam
& 0xFF0000) >> 16;
3162 key
.uChar
.AsciiChar
= 0;
3163 key
.dwControlKeyState
= modifiers
;
3165 add
= w32_kbd_patch_key (&key
);
3166 /* 0 means an unrecognised keycode, negative means
3167 dead key. Ignore both. */
3170 /* Forward asciified character sequence. */
3171 post_character_message
3173 (unsigned char) key
.uChar
.AsciiChar
, lParam
,
3174 w32_get_key_modifiers (wParam
, lParam
));
3175 w32_kbd_patch_key (&key
);
3182 /* Let TranslateMessage handle everything else. */
3183 windows_translate
= 1;
3189 if (windows_translate
)
3191 MSG windows_msg
= { hwnd
, msg
, wParam
, lParam
, 0, {0,0} };
3192 windows_msg
.time
= GetMessageTime ();
3193 TranslateMessage (&windows_msg
);
3201 post_character_message (hwnd
, msg
, wParam
, lParam
,
3202 w32_get_key_modifiers (wParam
, lParam
));
3206 /* WM_UNICHAR looks promising from the docs, but the exact
3207 circumstances in which TranslateMessage sends it is one of those
3208 Microsoft secret API things that EU and US courts are supposed
3209 to have put a stop to already. Spy++ shows it being sent to Notepad
3210 and other MS apps, but never to Emacs.
3212 Some third party IMEs send it in accordance with the official
3213 documentation though, so handle it here.
3215 UNICODE_NOCHAR is used to test for support for this message.
3216 TRUE indicates that the message is supported. */
3217 if (wParam
== UNICODE_NOCHAR
)
3222 wmsg
.dwModifiers
= w32_get_key_modifiers (wParam
, lParam
);
3223 signal_user_input ();
3224 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3229 /* If we can't get the IME result as unicode, use default processing,
3230 which will at least allow characters decodable in the system locale
3232 if (!get_composition_string_fn
)
3235 else if (!ignore_ime_char
)
3240 HIMC context
= get_ime_context_fn (hwnd
);
3241 wmsg
.dwModifiers
= w32_get_key_modifiers (wParam
, lParam
);
3242 /* Get buffer size. */
3243 size
= get_composition_string_fn (context
, GCS_RESULTSTR
, buffer
, 0);
3244 buffer
= alloca(size
);
3245 size
= get_composition_string_fn (context
, GCS_RESULTSTR
,
3247 signal_user_input ();
3248 for (i
= 0; i
< size
/ sizeof (wchar_t); i
++)
3250 my_post_msg (&wmsg
, hwnd
, WM_UNICHAR
, (WPARAM
) buffer
[i
],
3253 /* We output the whole string above, so ignore following ones
3254 until we are notified of the end of composition. */
3255 ignore_ime_char
= 1;
3259 case WM_IME_ENDCOMPOSITION
:
3260 ignore_ime_char
= 0;
3263 /* Simulate middle mouse button events when left and right buttons
3264 are used together, but only if user has two button mouse. */
3265 case WM_LBUTTONDOWN
:
3266 case WM_RBUTTONDOWN
:
3267 if (w32_num_mouse_buttons
> 2)
3268 goto handle_plain_button
;
3271 int this = (msg
== WM_LBUTTONDOWN
) ? LMOUSE
: RMOUSE
;
3272 int other
= (msg
== WM_LBUTTONDOWN
) ? RMOUSE
: LMOUSE
;
3274 if (button_state
& this)
3277 if (button_state
== 0)
3280 button_state
|= this;
3282 if (button_state
& other
)
3284 if (mouse_button_timer
)
3286 KillTimer (hwnd
, mouse_button_timer
);
3287 mouse_button_timer
= 0;
3289 /* Generate middle mouse event instead. */
3290 msg
= WM_MBUTTONDOWN
;
3291 button_state
|= MMOUSE
;
3293 else if (button_state
& MMOUSE
)
3295 /* Ignore button event if we've already generated a
3296 middle mouse down event. This happens if the
3297 user releases and press one of the two buttons
3298 after we've faked a middle mouse event. */
3303 /* Flush out saved message. */
3304 post_msg (&saved_mouse_button_msg
);
3306 wmsg
.dwModifiers
= w32_get_modifiers ();
3307 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3308 signal_user_input ();
3310 /* Clear message buffer. */
3311 saved_mouse_button_msg
.msg
.hwnd
= 0;
3315 /* Hold onto message for now. */
3316 mouse_button_timer
=
3317 SetTimer (hwnd
, MOUSE_BUTTON_ID
,
3318 w32_mouse_button_tolerance
, NULL
);
3319 saved_mouse_button_msg
.msg
.hwnd
= hwnd
;
3320 saved_mouse_button_msg
.msg
.message
= msg
;
3321 saved_mouse_button_msg
.msg
.wParam
= wParam
;
3322 saved_mouse_button_msg
.msg
.lParam
= lParam
;
3323 saved_mouse_button_msg
.msg
.time
= GetMessageTime ();
3324 saved_mouse_button_msg
.dwModifiers
= w32_get_modifiers ();
3331 if (w32_num_mouse_buttons
> 2)
3332 goto handle_plain_button
;
3335 int this = (msg
== WM_LBUTTONUP
) ? LMOUSE
: RMOUSE
;
3336 int other
= (msg
== WM_LBUTTONUP
) ? RMOUSE
: LMOUSE
;
3338 if ((button_state
& this) == 0)
3341 button_state
&= ~this;
3343 if (button_state
& MMOUSE
)
3345 /* Only generate event when second button is released. */
3346 if ((button_state
& other
) == 0)
3349 button_state
&= ~MMOUSE
;
3351 if (button_state
) abort ();
3358 /* Flush out saved message if necessary. */
3359 if (saved_mouse_button_msg
.msg
.hwnd
)
3361 post_msg (&saved_mouse_button_msg
);
3364 wmsg
.dwModifiers
= w32_get_modifiers ();
3365 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3366 signal_user_input ();
3368 /* Always clear message buffer and cancel timer. */
3369 saved_mouse_button_msg
.msg
.hwnd
= 0;
3370 KillTimer (hwnd
, mouse_button_timer
);
3371 mouse_button_timer
= 0;
3373 if (button_state
== 0)
3378 case WM_XBUTTONDOWN
:
3380 if (w32_pass_extra_mouse_buttons_to_system
)
3382 /* else fall through and process them. */
3383 case WM_MBUTTONDOWN
:
3385 handle_plain_button
:
3390 /* Ignore middle and extra buttons as long as the menu is active. */
3391 f
= x_window_to_frame (dpyinfo
, hwnd
);
3392 if (f
&& f
->output_data
.w32
->menubar_active
)
3395 if (parse_button (msg
, HIWORD (wParam
), &button
, &up
))
3397 if (up
) ReleaseCapture ();
3398 else SetCapture (hwnd
);
3399 button
= (button
== 0) ? LMOUSE
:
3400 ((button
== 1) ? MMOUSE
: RMOUSE
);
3402 button_state
&= ~button
;
3404 button_state
|= button
;
3408 wmsg
.dwModifiers
= w32_get_modifiers ();
3409 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3410 signal_user_input ();
3412 /* Need to return true for XBUTTON messages, false for others,
3413 to indicate that we processed the message. */
3414 return (msg
== WM_XBUTTONDOWN
|| msg
== WM_XBUTTONUP
);
3417 /* Ignore mouse movements as long as the menu is active. These
3418 movements are processed by the window manager anyway, and
3419 it's wrong to handle them as if they happened on the
3420 underlying frame. */
3421 f
= x_window_to_frame (dpyinfo
, hwnd
);
3422 if (f
&& f
->output_data
.w32
->menubar_active
)
3425 /* If the mouse has just moved into the frame, start tracking
3426 it, so we will be notified when it leaves the frame. Mouse
3427 tracking only works under W98 and NT4 and later. On earlier
3428 versions, there is no way of telling when the mouse leaves the
3429 frame, so we just have to put up with help-echo and mouse
3430 highlighting remaining while the frame is not active. */
3431 if (track_mouse_event_fn
&& !track_mouse_window
)
3433 TRACKMOUSEEVENT tme
;
3434 tme
.cbSize
= sizeof (tme
);
3435 tme
.dwFlags
= TME_LEAVE
;
3436 tme
.hwndTrack
= hwnd
;
3438 track_mouse_event_fn (&tme
);
3439 track_mouse_window
= hwnd
;
3442 if (w32_mouse_move_interval
<= 0
3443 || (msg
== WM_MOUSEMOVE
&& button_state
== 0))
3445 wmsg
.dwModifiers
= w32_get_modifiers ();
3446 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3450 /* Hang onto mouse move and scroll messages for a bit, to avoid
3451 sending such events to Emacs faster than it can process them.
3452 If we get more events before the timer from the first message
3453 expires, we just replace the first message. */
3455 if (saved_mouse_move_msg
.msg
.hwnd
== 0)
3457 SetTimer (hwnd
, MOUSE_MOVE_ID
,
3458 w32_mouse_move_interval
, NULL
);
3460 /* Hold onto message for now. */
3461 saved_mouse_move_msg
.msg
.hwnd
= hwnd
;
3462 saved_mouse_move_msg
.msg
.message
= msg
;
3463 saved_mouse_move_msg
.msg
.wParam
= wParam
;
3464 saved_mouse_move_msg
.msg
.lParam
= lParam
;
3465 saved_mouse_move_msg
.msg
.time
= GetMessageTime ();
3466 saved_mouse_move_msg
.dwModifiers
= w32_get_modifiers ();
3472 wmsg
.dwModifiers
= w32_get_modifiers ();
3473 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3474 signal_user_input ();
3478 if (w32_pass_multimedia_buttons_to_system
)
3480 /* Otherwise, pass to lisp, the same way we do with mousehwheel. */
3481 case WM_MOUSEHWHEEL
:
3482 wmsg
.dwModifiers
= w32_get_modifiers ();
3483 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3484 signal_user_input ();
3485 /* Non-zero must be returned when WM_MOUSEHWHEEL messages are
3486 handled, to prevent the system trying to handle it by faking
3487 scroll bar events. */
3491 /* Flush out saved messages if necessary. */
3492 if (wParam
== mouse_button_timer
)
3494 if (saved_mouse_button_msg
.msg
.hwnd
)
3496 post_msg (&saved_mouse_button_msg
);
3497 signal_user_input ();
3498 saved_mouse_button_msg
.msg
.hwnd
= 0;
3500 KillTimer (hwnd
, mouse_button_timer
);
3501 mouse_button_timer
= 0;
3503 else if (wParam
== mouse_move_timer
)
3505 if (saved_mouse_move_msg
.msg
.hwnd
)
3507 post_msg (&saved_mouse_move_msg
);
3508 saved_mouse_move_msg
.msg
.hwnd
= 0;
3510 KillTimer (hwnd
, mouse_move_timer
);
3511 mouse_move_timer
= 0;
3513 else if (wParam
== menu_free_timer
)
3515 KillTimer (hwnd
, menu_free_timer
);
3516 menu_free_timer
= 0;
3517 f
= x_window_to_frame (dpyinfo
, hwnd
);
3518 /* If a popup menu is active, don't wipe its strings. */
3520 && current_popup_menu
== NULL
)
3522 /* Free memory used by owner-drawn and help-echo strings. */
3523 w32_free_menu_strings (hwnd
);
3524 f
->output_data
.w32
->menubar_active
= 0;
3531 /* Windows doesn't send us focus messages when putting up and
3532 taking down a system popup dialog as for Ctrl-Alt-Del on Windows 95.
3533 The only indication we get that something happened is receiving
3534 this message afterwards. So this is a good time to reset our
3535 keyboard modifiers' state. */
3542 /* We must ensure menu bar is fully constructed and up to date
3543 before allowing user interaction with it. To achieve this
3544 we send this message to the lisp thread and wait for a
3545 reply (whose value is not actually needed) to indicate that
3546 the menu bar is now ready for use, so we can now return.
3548 To remain responsive in the meantime, we enter a nested message
3549 loop that can process all other messages.
3551 However, we skip all this if the message results from calling
3552 TrackPopupMenu - in fact, we must NOT attempt to send the lisp
3553 thread a message because it is blocked on us at this point. We
3554 set menubar_active before calling TrackPopupMenu to indicate
3555 this (there is no possibility of confusion with real menubar
3558 f
= x_window_to_frame (dpyinfo
, hwnd
);
3560 && (f
->output_data
.w32
->menubar_active
3561 /* We can receive this message even in the absence of a
3562 menubar (ie. when the system menu is activated) - in this
3563 case we do NOT want to forward the message, otherwise it
3564 will cause the menubar to suddenly appear when the user
3565 had requested it to be turned off! */
3566 || f
->output_data
.w32
->menubar_widget
== NULL
))
3570 deferred_msg msg_buf
;
3572 /* Detect if message has already been deferred; in this case
3573 we cannot return any sensible value to ignore this. */
3574 if (find_deferred_msg (hwnd
, msg
) != NULL
)
3579 return send_deferred_msg (&msg_buf
, hwnd
, msg
, wParam
, lParam
);
3582 case WM_EXITMENULOOP
:
3583 f
= x_window_to_frame (dpyinfo
, hwnd
);
3585 /* If a menu is still active, check again after a short delay,
3586 since Windows often (always?) sends the WM_EXITMENULOOP
3587 before the corresponding WM_COMMAND message.
3588 Don't do this if a popup menu is active, since it is only
3589 menubar menus that require cleaning up in this way.
3591 if (f
&& menubar_in_use
&& current_popup_menu
== NULL
)
3592 menu_free_timer
= SetTimer (hwnd
, MENU_FREE_ID
, MENU_FREE_DELAY
, NULL
);
3596 /* Direct handling of help_echo in menus. Should be safe now
3597 that we generate the help_echo by placing a help event in the
3600 HMENU menu
= (HMENU
) lParam
;
3601 UINT menu_item
= (UINT
) LOWORD (wParam
);
3602 UINT flags
= (UINT
) HIWORD (wParam
);
3604 w32_menu_display_help (hwnd
, menu
, menu_item
, flags
);
3608 case WM_MEASUREITEM
:
3609 f
= x_window_to_frame (dpyinfo
, hwnd
);
3612 MEASUREITEMSTRUCT
* pMis
= (MEASUREITEMSTRUCT
*) lParam
;
3614 if (pMis
->CtlType
== ODT_MENU
)
3616 /* Work out dimensions for popup menu titles. */
3617 char * title
= (char *) pMis
->itemData
;
3618 HDC hdc
= GetDC (hwnd
);
3619 HFONT menu_font
= GetCurrentObject (hdc
, OBJ_FONT
);
3620 LOGFONT menu_logfont
;
3624 GetObject (menu_font
, sizeof (menu_logfont
), &menu_logfont
);
3625 menu_logfont
.lfWeight
= FW_BOLD
;
3626 menu_font
= CreateFontIndirect (&menu_logfont
);
3627 old_font
= SelectObject (hdc
, menu_font
);
3629 pMis
->itemHeight
= GetSystemMetrics (SM_CYMENUSIZE
);
3632 if (unicode_append_menu
)
3633 GetTextExtentPoint32W (hdc
, (WCHAR
*) title
,
3634 wcslen ((WCHAR
*) title
),
3637 GetTextExtentPoint32 (hdc
, title
, strlen (title
), &size
);
3639 pMis
->itemWidth
= size
.cx
;
3640 if (pMis
->itemHeight
< size
.cy
)
3641 pMis
->itemHeight
= size
.cy
;
3644 pMis
->itemWidth
= 0;
3646 SelectObject (hdc
, old_font
);
3647 DeleteObject (menu_font
);
3648 ReleaseDC (hwnd
, hdc
);
3655 f
= x_window_to_frame (dpyinfo
, hwnd
);
3658 DRAWITEMSTRUCT
* pDis
= (DRAWITEMSTRUCT
*) lParam
;
3660 if (pDis
->CtlType
== ODT_MENU
)
3662 /* Draw popup menu title. */
3663 char * title
= (char *) pDis
->itemData
;
3666 HDC hdc
= pDis
->hDC
;
3667 HFONT menu_font
= GetCurrentObject (hdc
, OBJ_FONT
);
3668 LOGFONT menu_logfont
;
3671 GetObject (menu_font
, sizeof (menu_logfont
), &menu_logfont
);
3672 menu_logfont
.lfWeight
= FW_BOLD
;
3673 menu_font
= CreateFontIndirect (&menu_logfont
);
3674 old_font
= SelectObject (hdc
, menu_font
);
3676 /* Always draw title as if not selected. */
3677 if (unicode_append_menu
)
3680 + GetSystemMetrics (SM_CXMENUCHECK
),
3682 ETO_OPAQUE
, &pDis
->rcItem
,
3684 wcslen ((WCHAR
*) title
), NULL
);
3688 + GetSystemMetrics (SM_CXMENUCHECK
),
3690 ETO_OPAQUE
, &pDis
->rcItem
,
3691 title
, strlen (title
), NULL
);
3693 SelectObject (hdc
, old_font
);
3694 DeleteObject (menu_font
);
3702 /* Still not right - can't distinguish between clicks in the
3703 client area of the frame from clicks forwarded from the scroll
3704 bars - may have to hook WM_NCHITTEST to remember the mouse
3705 position and then check if it is in the client area ourselves. */
3706 case WM_MOUSEACTIVATE
:
3707 /* Discard the mouse click that activates a frame, allowing the
3708 user to click anywhere without changing point (or worse!).
3709 Don't eat mouse clicks on scrollbars though!! */
3710 if (LOWORD (lParam
) == HTCLIENT
)
3711 return MA_ACTIVATEANDEAT
;
3716 /* No longer tracking mouse. */
3717 track_mouse_window
= NULL
;
3719 case WM_ACTIVATEAPP
:
3721 case WM_WINDOWPOSCHANGED
:
3723 /* Inform lisp thread that a frame might have just been obscured
3724 or exposed, so should recheck visibility of all frames. */
3725 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3729 dpyinfo
->faked_key
= 0;
3731 register_hot_keys (hwnd
);
3734 unregister_hot_keys (hwnd
);
3737 /* Relinquish the system caret. */
3738 if (w32_system_caret_hwnd
)
3740 w32_visible_system_caret_hwnd
= NULL
;
3741 w32_system_caret_hwnd
= NULL
;
3747 f
= x_window_to_frame (dpyinfo
, hwnd
);
3748 if (f
&& HIWORD (wParam
) == 0)
3750 if (menu_free_timer
)
3752 KillTimer (hwnd
, menu_free_timer
);
3753 menu_free_timer
= 0;
3759 wmsg
.dwModifiers
= w32_get_modifiers ();
3760 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3768 wmsg
.dwModifiers
= w32_get_modifiers ();
3769 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3772 case WM_WINDOWPOSCHANGING
:
3773 /* Don't restrict the sizing of tip frames. */
3774 if (hwnd
== tip_window
)
3778 LPWINDOWPOS lppos
= (WINDOWPOS
*) lParam
;
3780 wp
.length
= sizeof (WINDOWPLACEMENT
);
3781 GetWindowPlacement (hwnd
, &wp
);
3783 if (wp
.showCmd
!= SW_SHOWMINIMIZED
&& (lppos
->flags
& SWP_NOSIZE
) == 0)
3790 DWORD internal_border
;
3791 DWORD scrollbar_extra
;
3794 wp
.length
= sizeof (wp
);
3795 GetWindowRect (hwnd
, &wr
);
3799 font_width
= GetWindowLong (hwnd
, WND_FONTWIDTH_INDEX
);
3800 line_height
= GetWindowLong (hwnd
, WND_LINEHEIGHT_INDEX
);
3801 internal_border
= GetWindowLong (hwnd
, WND_BORDER_INDEX
);
3802 scrollbar_extra
= GetWindowLong (hwnd
, WND_SCROLLBAR_INDEX
);
3806 memset (&rect
, 0, sizeof (rect
));
3807 AdjustWindowRect (&rect
, GetWindowLong (hwnd
, GWL_STYLE
),
3808 GetMenu (hwnd
) != NULL
);
3810 /* Force width and height of client area to be exact
3811 multiples of the character cell dimensions. */
3812 wdiff
= (lppos
->cx
- (rect
.right
- rect
.left
)
3813 - 2 * internal_border
- scrollbar_extra
)
3815 hdiff
= (lppos
->cy
- (rect
.bottom
- rect
.top
)
3816 - 2 * internal_border
)
3821 /* For right/bottom sizing we can just fix the sizes.
3822 However for top/left sizing we will need to fix the X
3823 and Y positions as well. */
3825 int cx_mintrack
= GetSystemMetrics (SM_CXMINTRACK
);
3826 int cy_mintrack
= GetSystemMetrics (SM_CYMINTRACK
);
3828 lppos
->cx
= max (lppos
->cx
- wdiff
, cx_mintrack
);
3829 lppos
->cy
= max (lppos
->cy
- hdiff
, cy_mintrack
);
3831 if (wp
.showCmd
!= SW_SHOWMAXIMIZED
3832 && (lppos
->flags
& SWP_NOMOVE
) == 0)
3834 if (lppos
->x
!= wr
.left
|| lppos
->y
!= wr
.top
)
3841 lppos
->flags
|= SWP_NOMOVE
;
3852 case WM_GETMINMAXINFO
:
3853 /* Hack to allow resizing the Emacs frame above the screen size.
3854 Note that Windows 9x limits coordinates to 16-bits. */
3855 ((LPMINMAXINFO
) lParam
)->ptMaxTrackSize
.x
= 32767;
3856 ((LPMINMAXINFO
) lParam
)->ptMaxTrackSize
.y
= 32767;
3860 if (LOWORD (lParam
) == HTCLIENT
)
3865 case WM_EMACS_SETCURSOR
:
3867 Cursor cursor
= (Cursor
) wParam
;
3873 case WM_EMACS_CREATESCROLLBAR
:
3874 return (LRESULT
) w32_createscrollbar ((struct frame
*) wParam
,
3875 (struct scroll_bar
*) lParam
);
3877 case WM_EMACS_SHOWWINDOW
:
3878 return ShowWindow ((HWND
) wParam
, (WPARAM
) lParam
);
3880 case WM_EMACS_SETFOREGROUND
:
3882 HWND foreground_window
;
3883 DWORD foreground_thread
, retval
;
3885 /* On NT 5.0, and apparently Windows 98, it is necessary to
3886 attach to the thread that currently has focus in order to
3887 pull the focus away from it. */
3888 foreground_window
= GetForegroundWindow ();
3889 foreground_thread
= GetWindowThreadProcessId (foreground_window
, NULL
);
3890 if (!foreground_window
3891 || foreground_thread
== GetCurrentThreadId ()
3892 || !AttachThreadInput (GetCurrentThreadId (),
3893 foreground_thread
, TRUE
))
3894 foreground_thread
= 0;
3896 retval
= SetForegroundWindow ((HWND
) wParam
);
3898 /* Detach from the previous foreground thread. */
3899 if (foreground_thread
)
3900 AttachThreadInput (GetCurrentThreadId (),
3901 foreground_thread
, FALSE
);
3906 case WM_EMACS_SETWINDOWPOS
:
3908 WINDOWPOS
* pos
= (WINDOWPOS
*) wParam
;
3909 return SetWindowPos (hwnd
, pos
->hwndInsertAfter
,
3910 pos
->x
, pos
->y
, pos
->cx
, pos
->cy
, pos
->flags
);
3913 case WM_EMACS_DESTROYWINDOW
:
3914 DragAcceptFiles ((HWND
) wParam
, FALSE
);
3915 return DestroyWindow ((HWND
) wParam
);
3917 case WM_EMACS_HIDE_CARET
:
3918 return HideCaret (hwnd
);
3920 case WM_EMACS_SHOW_CARET
:
3921 return ShowCaret (hwnd
);
3923 case WM_EMACS_DESTROY_CARET
:
3924 w32_system_caret_hwnd
= NULL
;
3925 w32_visible_system_caret_hwnd
= NULL
;
3926 return DestroyCaret ();
3928 case WM_EMACS_TRACK_CARET
:
3929 /* If there is currently no system caret, create one. */
3930 if (w32_system_caret_hwnd
== NULL
)
3932 /* Use the default caret width, and avoid changing it
3933 unneccesarily, as it confuses screen reader software. */
3934 w32_system_caret_hwnd
= hwnd
;
3935 CreateCaret (hwnd
, NULL
, 0,
3936 w32_system_caret_height
);
3939 if (!SetCaretPos (w32_system_caret_x
, w32_system_caret_y
))
3941 /* Ensure visible caret gets turned on when requested. */
3942 else if (w32_use_visible_system_caret
3943 && w32_visible_system_caret_hwnd
!= hwnd
)
3945 w32_visible_system_caret_hwnd
= hwnd
;
3946 return ShowCaret (hwnd
);
3948 /* Ensure visible caret gets turned off when requested. */
3949 else if (!w32_use_visible_system_caret
3950 && w32_visible_system_caret_hwnd
)
3952 w32_visible_system_caret_hwnd
= NULL
;
3953 return HideCaret (hwnd
);
3958 case WM_EMACS_TRACKPOPUPMENU
:
3963 pos
= (POINT
*)lParam
;
3964 flags
= TPM_CENTERALIGN
;
3965 if (button_state
& LMOUSE
)
3966 flags
|= TPM_LEFTBUTTON
;
3967 else if (button_state
& RMOUSE
)
3968 flags
|= TPM_RIGHTBUTTON
;
3970 /* Remember we did a SetCapture on the initial mouse down event,
3971 so for safety, we make sure the capture is cancelled now. */
3975 /* Use menubar_active to indicate that WM_INITMENU is from
3976 TrackPopupMenu below, and should be ignored. */
3977 f
= x_window_to_frame (dpyinfo
, hwnd
);
3979 f
->output_data
.w32
->menubar_active
= 1;
3981 if (TrackPopupMenu ((HMENU
)wParam
, flags
, pos
->x
, pos
->y
,
3985 /* Eat any mouse messages during popupmenu */
3986 while (PeekMessage (&amsg
, hwnd
, WM_MOUSEFIRST
, WM_MOUSELAST
,
3988 /* Get the menu selection, if any */
3989 if (PeekMessage (&amsg
, hwnd
, WM_COMMAND
, WM_COMMAND
, PM_REMOVE
))
3991 retval
= LOWORD (amsg
.wParam
);
4007 /* Check for messages registered at runtime. */
4008 if (msg
== msh_mousewheel
)
4010 wmsg
.dwModifiers
= w32_get_modifiers ();
4011 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4012 signal_user_input ();
4017 return DefWindowProc (hwnd
, msg
, wParam
, lParam
);
4021 /* The most common default return code for handled messages is 0. */
4026 my_create_window (f
)
4031 if (!PostThreadMessage (dwWindowsThreadId
, WM_EMACS_CREATEWINDOW
, (WPARAM
)f
, 0))
4033 GetMessage (&msg
, NULL
, WM_EMACS_DONE
, WM_EMACS_DONE
);
4037 /* Create a tooltip window. Unlike my_create_window, we do not do this
4038 indirectly via the Window thread, as we do not need to process Window
4039 messages for the tooltip. Creating tooltips indirectly also creates
4040 deadlocks when tooltips are created for menu items. */
4042 my_create_tip_window (f
)
4047 rect
.left
= rect
.top
= 0;
4048 rect
.right
= FRAME_PIXEL_WIDTH (f
);
4049 rect
.bottom
= FRAME_PIXEL_HEIGHT (f
);
4051 AdjustWindowRect (&rect
, f
->output_data
.w32
->dwStyle
,
4052 FRAME_EXTERNAL_MENU_BAR (f
));
4054 tip_window
= FRAME_W32_WINDOW (f
)
4055 = CreateWindow (EMACS_CLASS
,
4057 f
->output_data
.w32
->dwStyle
,
4060 rect
.right
- rect
.left
,
4061 rect
.bottom
- rect
.top
,
4062 FRAME_W32_WINDOW (SELECTED_FRAME ()), /* owner */
4069 SetWindowLong (tip_window
, WND_FONTWIDTH_INDEX
, FRAME_COLUMN_WIDTH (f
));
4070 SetWindowLong (tip_window
, WND_LINEHEIGHT_INDEX
, FRAME_LINE_HEIGHT (f
));
4071 SetWindowLong (tip_window
, WND_BORDER_INDEX
, FRAME_INTERNAL_BORDER_WIDTH (f
));
4072 SetWindowLong (tip_window
, WND_BACKGROUND_INDEX
, FRAME_BACKGROUND_PIXEL (f
));
4074 /* Tip frames have no scrollbars. */
4075 SetWindowLong (tip_window
, WND_SCROLLBAR_INDEX
, 0);
4077 /* Do this to discard the default setting specified by our parent. */
4078 ShowWindow (tip_window
, SW_HIDE
);
4083 /* Create and set up the w32 window for frame F. */
4086 w32_window (f
, window_prompting
, minibuffer_only
)
4088 long window_prompting
;
4089 int minibuffer_only
;
4093 /* Use the resource name as the top-level window name
4094 for looking up resources. Make a non-Lisp copy
4095 for the window manager, so GC relocation won't bother it.
4097 Elsewhere we specify the window name for the window manager. */
4100 char *str
= (char *) SDATA (Vx_resource_name
);
4101 f
->namebuf
= (char *) xmalloc (strlen (str
) + 1);
4102 strcpy (f
->namebuf
, str
);
4105 my_create_window (f
);
4107 validate_x_resource_name ();
4109 /* x_set_name normally ignores requests to set the name if the
4110 requested name is the same as the current name. This is the one
4111 place where that assumption isn't correct; f->name is set, but
4112 the server hasn't been told. */
4115 int explicit = f
->explicit_name
;
4117 f
->explicit_name
= 0;
4120 x_set_name (f
, name
, explicit);
4125 if (!minibuffer_only
&& FRAME_EXTERNAL_MENU_BAR (f
))
4126 initialize_frame_menubar (f
);
4128 if (FRAME_W32_WINDOW (f
) == 0)
4129 error ("Unable to create window");
4132 /* Handle the icon stuff for this window. Perhaps later we might
4133 want an x_set_icon_position which can be called interactively as
4141 Lisp_Object icon_x
, icon_y
;
4143 /* Set the position of the icon. Note that Windows 95 groups all
4144 icons in the tray. */
4145 icon_x
= w32_get_arg (parms
, Qicon_left
, 0, 0, RES_TYPE_NUMBER
);
4146 icon_y
= w32_get_arg (parms
, Qicon_top
, 0, 0, RES_TYPE_NUMBER
);
4147 if (!EQ (icon_x
, Qunbound
) && !EQ (icon_y
, Qunbound
))
4149 CHECK_NUMBER (icon_x
);
4150 CHECK_NUMBER (icon_y
);
4152 else if (!EQ (icon_x
, Qunbound
) || !EQ (icon_y
, Qunbound
))
4153 error ("Both left and top icon corners of icon must be specified");
4157 if (! EQ (icon_x
, Qunbound
))
4158 x_wm_set_icon_position (f
, XINT (icon_x
), XINT (icon_y
));
4161 /* Start up iconic or window? */
4162 x_wm_set_window_state
4163 (f
, (EQ (w32_get_arg (parms
, Qvisibility
, 0, 0, RES_TYPE_SYMBOL
), Qicon
)
4167 x_text_icon (f
, (char *) SDATA ((!NILP (f
->icon_name
)
4180 XGCValues gc_values
;
4184 /* Create the GC's of this frame.
4185 Note that many default values are used. */
4188 gc_values
.font
= FRAME_FONT (f
);
4190 /* Cursor has cursor-color background, background-color foreground. */
4191 gc_values
.foreground
= FRAME_BACKGROUND_PIXEL (f
);
4192 gc_values
.background
= f
->output_data
.w32
->cursor_pixel
;
4193 f
->output_data
.w32
->cursor_gc
4194 = XCreateGC (NULL
, FRAME_W32_WINDOW (f
),
4195 (GCFont
| GCForeground
| GCBackground
),
4199 f
->output_data
.w32
->white_relief
.gc
= 0;
4200 f
->output_data
.w32
->black_relief
.gc
= 0;
4206 /* Handler for signals raised during x_create_frame and
4207 x_create_top_frame. FRAME is the frame which is partially
4211 unwind_create_frame (frame
)
4214 struct frame
*f
= XFRAME (frame
);
4216 /* If frame is ``official'', nothing to do. */
4217 if (!CONSP (Vframe_list
) || !EQ (XCAR (Vframe_list
), frame
))
4220 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
4223 x_free_frame_resources (f
);
4225 /* Check that reference counts are indeed correct. */
4226 xassert (dpyinfo
->reference_count
== dpyinfo_refcount
);
4227 xassert (dpyinfo
->image_cache
->refcount
== image_cache_refcount
);
4235 #ifdef USE_FONT_BACKEND
4237 x_default_font_parameter (f
, parms
)
4241 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
4242 Lisp_Object font
= x_get_arg (dpyinfo
, parms
, Qfont
, "font", "Font",
4245 if (!STRINGP (font
))
4248 static char *names
[]
4249 = { "Courier New-10",
4250 "-*-Courier-normal-r-*-*-13-*-*-*-c-*-iso8859-1",
4251 "-*-Fixedsys-normal-r-*-*-12-*-*-*-c-*-iso8859-1",
4255 for (i
= 0; names
[i
]; i
++)
4257 font
= font_open_by_name (f
, names
[i
]);
4262 error ("No suitable font was found");
4264 x_default_parameter (f
, parms
, Qfont
, font
, "font", "Font", RES_TYPE_STRING
);
4268 DEFUN ("x-create-frame", Fx_create_frame
, Sx_create_frame
,
4270 doc
: /* Make a new window, which is called a \"frame\" in Emacs terms.
4271 Return an Emacs frame object.
4272 PARAMETERS is an alist of frame parameters.
4273 If the parameters specify that the frame should not have a minibuffer,
4274 and do not specify a specific minibuffer window to use,
4275 then `default-minibuffer-frame' must be a frame whose minibuffer can
4276 be shared by the new frame.
4278 This function is an internal primitive--use `make-frame' instead. */)
4280 Lisp_Object parameters
;
4283 Lisp_Object frame
, tem
;
4285 int minibuffer_only
= 0;
4286 long window_prompting
= 0;
4288 int count
= SPECPDL_INDEX ();
4289 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
4290 Lisp_Object display
;
4291 struct w32_display_info
*dpyinfo
= NULL
;
4297 /* Make copy of frame parameters because the original is in pure
4299 parameters
= Fcopy_alist (parameters
);
4301 /* Use this general default value to start with
4302 until we know if this frame has a specified name. */
4303 Vx_resource_name
= Vinvocation_name
;
4305 display
= w32_get_arg (parameters
, Qdisplay
, 0, 0, RES_TYPE_STRING
);
4306 if (EQ (display
, Qunbound
))
4308 dpyinfo
= check_x_display_info (display
);
4310 kb
= dpyinfo
->terminal
->kboard
;
4312 kb
= &the_only_kboard
;
4315 name
= w32_get_arg (parameters
, Qname
, "name", "Name", RES_TYPE_STRING
);
4317 && ! EQ (name
, Qunbound
)
4319 error ("Invalid frame name--not a string or nil");
4322 Vx_resource_name
= name
;
4324 /* See if parent window is specified. */
4325 parent
= w32_get_arg (parameters
, Qparent_id
, NULL
, NULL
, RES_TYPE_NUMBER
);
4326 if (EQ (parent
, Qunbound
))
4328 if (! NILP (parent
))
4329 CHECK_NUMBER (parent
);
4331 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
4332 /* No need to protect DISPLAY because that's not used after passing
4333 it to make_frame_without_minibuffer. */
4335 GCPRO4 (parameters
, parent
, name
, frame
);
4336 tem
= w32_get_arg (parameters
, Qminibuffer
, "minibuffer", "Minibuffer",
4338 if (EQ (tem
, Qnone
) || NILP (tem
))
4339 f
= make_frame_without_minibuffer (Qnil
, kb
, display
);
4340 else if (EQ (tem
, Qonly
))
4342 f
= make_minibuffer_frame ();
4343 minibuffer_only
= 1;
4345 else if (WINDOWP (tem
))
4346 f
= make_frame_without_minibuffer (tem
, kb
, display
);
4350 XSETFRAME (frame
, f
);
4352 /* Note that Windows does support scroll bars. */
4353 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 1;
4355 /* By default, make scrollbars the system standard width. */
4356 FRAME_CONFIG_SCROLL_BAR_WIDTH (f
) = GetSystemMetrics (SM_CXVSCROLL
);
4358 f
->terminal
= dpyinfo
->terminal
;
4359 f
->terminal
->reference_count
++;
4361 f
->output_method
= output_w32
;
4362 f
->output_data
.w32
=
4363 (struct w32_output
*) xmalloc (sizeof (struct w32_output
));
4364 bzero (f
->output_data
.w32
, sizeof (struct w32_output
));
4365 FRAME_FONTSET (f
) = -1;
4366 record_unwind_protect (unwind_create_frame
, frame
);
4369 = w32_get_arg (parameters
, Qicon_name
, "iconName", "Title", RES_TYPE_STRING
);
4370 if (! STRINGP (f
->icon_name
))
4371 f
->icon_name
= Qnil
;
4373 /* FRAME_W32_DISPLAY_INFO (f) = dpyinfo; */
4375 FRAME_KBOARD (f
) = kb
;
4378 /* Specify the parent under which to make this window. */
4382 f
->output_data
.w32
->parent_desc
= (Window
) XFASTINT (parent
);
4383 f
->output_data
.w32
->explicit_parent
= 1;
4387 f
->output_data
.w32
->parent_desc
= FRAME_W32_DISPLAY_INFO (f
)->root_window
;
4388 f
->output_data
.w32
->explicit_parent
= 0;
4391 /* Set the name; the functions to which we pass f expect the name to
4393 if (EQ (name
, Qunbound
) || NILP (name
))
4395 f
->name
= build_string (dpyinfo
->w32_id_name
);
4396 f
->explicit_name
= 0;
4401 f
->explicit_name
= 1;
4402 /* use the frame's title when getting resources for this frame. */
4403 specbind (Qx_resource_name
, name
);
4406 f
->resx
= dpyinfo
->resx
;
4407 f
->resy
= dpyinfo
->resy
;
4409 #ifdef USE_FONT_BACKEND
4410 if (enable_font_backend
)
4412 /* Perhaps, we must allow frame parameter, say `font-backend',
4413 to specify which font backends to use. */
4414 register_font_driver (&w32font_driver
, f
);
4416 x_default_parameter (f
, parameters
, Qfont_backend
, Qnil
,
4417 "fontBackend", "FontBackend", RES_TYPE_STRING
);
4419 #endif /* USE_FONT_BACKEND */
4421 /* Extract the window parameters from the supplied values
4422 that are needed to determine window geometry. */
4423 #ifdef USE_FONT_BACKEND
4424 if (enable_font_backend
)
4425 x_default_font_parameter (f
, parameters
);
4431 font
= w32_get_arg (parameters
, Qfont
, "font", "Font", RES_TYPE_STRING
);
4434 /* First, try whatever font the caller has specified. */
4437 tem
= Fquery_fontset (font
, Qnil
);
4439 font
= x_new_fontset (f
, tem
);
4441 font
= x_new_font (f
, SDATA (font
));
4443 /* Try out a font which we hope has bold and italic variations. */
4444 if (!STRINGP (font
))
4445 font
= x_new_font (f
, "-*-Courier New-normal-r-*-*-*-100-*-*-c-*-iso8859-1");
4446 if (! STRINGP (font
))
4447 font
= x_new_font (f
, "-*-Courier-normal-r-*-*-13-*-*-*-c-*-iso8859-1");
4448 /* If those didn't work, look for something which will at least work. */
4449 if (! STRINGP (font
))
4450 font
= x_new_font (f
, "-*-Fixedsys-normal-r-*-*-12-*-*-*-c-*-iso8859-1");
4452 if (! STRINGP (font
))
4453 font
= build_string ("Fixedsys");
4455 x_default_parameter (f
, parameters
, Qfont
, font
,
4456 "font", "Font", RES_TYPE_STRING
);
4459 x_default_parameter (f
, parameters
, Qborder_width
, make_number (2),
4460 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
4461 /* This defaults to 2 in order to match xterm. We recognize either
4462 internalBorderWidth or internalBorder (which is what xterm calls
4464 if (NILP (Fassq (Qinternal_border_width
, parameters
)))
4468 value
= w32_get_arg (parameters
, Qinternal_border_width
,
4469 "internalBorder", "InternalBorder", RES_TYPE_NUMBER
);
4470 if (! EQ (value
, Qunbound
))
4471 parameters
= Fcons (Fcons (Qinternal_border_width
, value
),
4474 /* Default internalBorderWidth to 0 on Windows to match other programs. */
4475 x_default_parameter (f
, parameters
, Qinternal_border_width
, make_number (0),
4476 "internalBorderWidth", "InternalBorder", RES_TYPE_NUMBER
);
4477 x_default_parameter (f
, parameters
, Qvertical_scroll_bars
, Qright
,
4478 "verticalScrollBars", "ScrollBars", RES_TYPE_SYMBOL
);
4480 /* Also do the stuff which must be set before the window exists. */
4481 x_default_parameter (f
, parameters
, Qforeground_color
, build_string ("black"),
4482 "foreground", "Foreground", RES_TYPE_STRING
);
4483 x_default_parameter (f
, parameters
, Qbackground_color
, build_string ("white"),
4484 "background", "Background", RES_TYPE_STRING
);
4485 x_default_parameter (f
, parameters
, Qmouse_color
, build_string ("black"),
4486 "pointerColor", "Foreground", RES_TYPE_STRING
);
4487 x_default_parameter (f
, parameters
, Qcursor_color
, build_string ("black"),
4488 "cursorColor", "Foreground", RES_TYPE_STRING
);
4489 x_default_parameter (f
, parameters
, Qborder_color
, build_string ("black"),
4490 "borderColor", "BorderColor", RES_TYPE_STRING
);
4491 x_default_parameter (f
, parameters
, Qscreen_gamma
, Qnil
,
4492 "screenGamma", "ScreenGamma", RES_TYPE_FLOAT
);
4493 x_default_parameter (f
, parameters
, Qline_spacing
, Qnil
,
4494 "lineSpacing", "LineSpacing", RES_TYPE_NUMBER
);
4495 x_default_parameter (f
, parameters
, Qleft_fringe
, Qnil
,
4496 "leftFringe", "LeftFringe", RES_TYPE_NUMBER
);
4497 x_default_parameter (f
, parameters
, Qright_fringe
, Qnil
,
4498 "rightFringe", "RightFringe", RES_TYPE_NUMBER
);
4501 /* Init faces before x_default_parameter is called for scroll-bar
4502 parameters because that function calls x_set_scroll_bar_width,
4503 which calls change_frame_size, which calls Fset_window_buffer,
4504 which runs hooks, which call Fvertical_motion. At the end, we
4505 end up in init_iterator with a null face cache, which should not
4507 init_frame_faces (f
);
4509 x_default_parameter (f
, parameters
, Qmenu_bar_lines
, make_number (1),
4510 "menuBar", "MenuBar", RES_TYPE_NUMBER
);
4511 x_default_parameter (f
, parameters
, Qtool_bar_lines
, make_number (1),
4512 "toolBar", "ToolBar", RES_TYPE_NUMBER
);
4514 x_default_parameter (f
, parameters
, Qbuffer_predicate
, Qnil
,
4515 "bufferPredicate", "BufferPredicate", RES_TYPE_SYMBOL
);
4516 x_default_parameter (f
, parameters
, Qtitle
, Qnil
,
4517 "title", "Title", RES_TYPE_STRING
);
4518 x_default_parameter (f
, parameters
, Qfullscreen
, Qnil
,
4519 "fullscreen", "Fullscreen", RES_TYPE_SYMBOL
);
4521 f
->output_data
.w32
->dwStyle
= WS_OVERLAPPEDWINDOW
;
4522 f
->output_data
.w32
->parent_desc
= FRAME_W32_DISPLAY_INFO (f
)->root_window
;
4524 f
->output_data
.w32
->text_cursor
= w32_load_cursor (IDC_IBEAM
);
4525 f
->output_data
.w32
->nontext_cursor
= w32_load_cursor (IDC_ARROW
);
4526 f
->output_data
.w32
->modeline_cursor
= w32_load_cursor (IDC_ARROW
);
4527 f
->output_data
.w32
->hand_cursor
= w32_load_cursor (IDC_HAND
);
4528 f
->output_data
.w32
->hourglass_cursor
= w32_load_cursor (IDC_WAIT
);
4529 f
->output_data
.w32
->horizontal_drag_cursor
= w32_load_cursor (IDC_SIZEWE
);
4531 window_prompting
= x_figure_window_size (f
, parameters
, 1);
4533 tem
= w32_get_arg (parameters
, Qunsplittable
, 0, 0, RES_TYPE_BOOLEAN
);
4534 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
4536 w32_window (f
, window_prompting
, minibuffer_only
);
4537 x_icon (f
, parameters
);
4541 /* Now consider the frame official. */
4542 FRAME_W32_DISPLAY_INFO (f
)->reference_count
++;
4543 Vframe_list
= Fcons (frame
, Vframe_list
);
4545 /* We need to do this after creating the window, so that the
4546 icon-creation functions can say whose icon they're describing. */
4547 x_default_parameter (f
, parameters
, Qicon_type
, Qnil
,
4548 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL
);
4550 x_default_parameter (f
, parameters
, Qauto_raise
, Qnil
,
4551 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
4552 x_default_parameter (f
, parameters
, Qauto_lower
, Qnil
,
4553 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
4554 x_default_parameter (f
, parameters
, Qcursor_type
, Qbox
,
4555 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
4556 x_default_parameter (f
, parameters
, Qscroll_bar_width
, Qnil
,
4557 "scrollBarWidth", "ScrollBarWidth", RES_TYPE_NUMBER
);
4559 /* Dimensions, especially FRAME_LINES (f), must be done via change_frame_size.
4560 Change will not be effected unless different from the current
4562 width
= FRAME_COLS (f
);
4563 height
= FRAME_LINES (f
);
4565 FRAME_LINES (f
) = 0;
4566 SET_FRAME_COLS (f
, 0);
4567 change_frame_size (f
, height
, width
, 1, 0, 0);
4569 /* Tell the server what size and position, etc, we want, and how
4570 badly we want them. This should be done after we have the menu
4571 bar so that its size can be taken into account. */
4573 x_wm_set_size_hint (f
, window_prompting
, 0);
4576 /* Make the window appear on the frame and enable display, unless
4577 the caller says not to. However, with explicit parent, Emacs
4578 cannot control visibility, so don't try. */
4579 if (! f
->output_data
.w32
->explicit_parent
)
4581 Lisp_Object visibility
;
4583 visibility
= w32_get_arg (parameters
, Qvisibility
, 0, 0, RES_TYPE_SYMBOL
);
4584 if (EQ (visibility
, Qunbound
))
4587 if (EQ (visibility
, Qicon
))
4588 x_iconify_frame (f
);
4589 else if (! NILP (visibility
))
4590 x_make_frame_visible (f
);
4592 /* Must have been Qnil. */
4596 /* Initialize `default-minibuffer-frame' in case this is the first
4597 frame on this terminal. */
4598 if (FRAME_HAS_MINIBUF_P (f
)
4599 && (!FRAMEP (kb
->Vdefault_minibuffer_frame
)
4600 || !FRAME_LIVE_P (XFRAME (kb
->Vdefault_minibuffer_frame
))))
4601 kb
->Vdefault_minibuffer_frame
= frame
;
4603 /* All remaining specified parameters, which have not been "used"
4604 by x_get_arg and friends, now go in the misc. alist of the frame. */
4605 for (tem
= parameters
; CONSP (tem
); tem
= XCDR (tem
))
4606 if (CONSP (XCAR (tem
)) && !NILP (XCAR (XCAR (tem
))))
4607 f
->param_alist
= Fcons (XCAR (tem
), f
->param_alist
);
4611 /* Make sure windows on this frame appear in calls to next-window
4612 and similar functions. */
4613 Vwindow_list
= Qnil
;
4615 return unbind_to (count
, frame
);
4618 /* FRAME is used only to get a handle on the X display. We don't pass the
4619 display info directly because we're called from frame.c, which doesn't
4620 know about that structure. */
4622 x_get_focus_frame (frame
)
4623 struct frame
*frame
;
4625 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (frame
);
4627 if (! dpyinfo
->w32_focus_frame
)
4630 XSETFRAME (xfocus
, dpyinfo
->w32_focus_frame
);
4634 DEFUN ("x-focus-frame", Fx_focus_frame
, Sx_focus_frame
, 1, 1, 0,
4635 doc
: /* Give FRAME input focus, raising to foreground if necessary. */)
4639 x_focus_on_frame (check_x_frame (frame
));
4644 /* Return the charset portion of a font name. */
4646 xlfd_charset_of_font (char * fontname
)
4648 char *charset
, *encoding
;
4650 encoding
= strrchr (fontname
, '-');
4651 if (!encoding
|| encoding
== fontname
)
4654 for (charset
= encoding
- 1; charset
>= fontname
; charset
--)
4655 if (*charset
== '-')
4658 if (charset
== fontname
|| strcmp (charset
, "-*-*") == 0)
4664 struct font_info
*w32_load_bdf_font (struct frame
*f
, char *fontname
,
4665 int size
, char* filename
);
4666 static Lisp_Object
w32_list_bdf_fonts (Lisp_Object pattern
, int max_names
);
4667 static BOOL
w32_to_x_font (LOGFONT
* lplf
, char * lpxstr
, int len
,
4669 static BOOL
x_to_w32_font (char *lpxstr
, LOGFONT
*lplogfont
);
4671 static struct font_info
*
4672 w32_load_system_font (f
, fontname
, size
)
4677 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
4678 Lisp_Object font_names
;
4680 /* Get a list of all the fonts that match this name. Once we
4681 have a list of matching fonts, we compare them against the fonts
4682 we already have loaded by comparing names. */
4683 font_names
= w32_list_fonts (f
, build_string (fontname
), size
, 100);
4685 if (!NILP (font_names
))
4690 /* First check if any are already loaded, as that is cheaper
4691 than loading another one. */
4692 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
4693 for (tail
= font_names
; CONSP (tail
); tail
= XCDR (tail
))
4694 if (dpyinfo
->font_table
[i
].name
4695 && (!strcmp (dpyinfo
->font_table
[i
].name
,
4696 SDATA (XCAR (tail
)))
4697 || !strcmp (dpyinfo
->font_table
[i
].full_name
,
4698 SDATA (XCAR (tail
)))))
4699 return (dpyinfo
->font_table
+ i
);
4701 fontname
= (char *) SDATA (XCAR (font_names
));
4703 else if (w32_strict_fontnames
)
4705 /* If EnumFontFamiliesEx was available, we got a full list of
4706 fonts back so stop now to avoid the possibility of loading a
4707 random font. If we had to fall back to EnumFontFamilies, the
4708 list is incomplete, so continue whether the font we want was
4710 HMODULE gdi32
= GetModuleHandle ("gdi32.dll");
4711 FARPROC enum_font_families_ex
4712 = GetProcAddress (gdi32
, "EnumFontFamiliesExA");
4713 if (enum_font_families_ex
)
4717 /* Load the font and add it to the table. */
4719 char *full_name
, *encoding
, *charset
;
4721 struct font_info
*fontp
;
4727 if (!fontname
|| !x_to_w32_font (fontname
, &lf
))
4730 if (!*lf
.lfFaceName
)
4731 /* If no name was specified for the font, we get a random font
4732 from CreateFontIndirect - this is not particularly
4733 desirable, especially since CreateFontIndirect does not
4734 fill out the missing name in lf, so we never know what we
4738 lf
.lfQuality
= DEFAULT_QUALITY
;
4740 font
= (XFontStruct
*) xmalloc (sizeof (XFontStruct
));
4741 bzero (font
, sizeof (*font
));
4743 /* Set bdf to NULL to indicate that this is a Windows font. */
4748 font
->hfont
= CreateFontIndirect (&lf
);
4750 if (font
->hfont
== NULL
)
4759 codepage
= w32_codepage_for_font (fontname
);
4761 hdc
= GetDC (dpyinfo
->root_window
);
4762 oldobj
= SelectObject (hdc
, font
->hfont
);
4764 ok
= GetTextMetrics (hdc
, &font
->tm
);
4765 if (codepage
== CP_UNICODE
)
4766 font
->double_byte_p
= 1;
4769 /* Unfortunately, some fonts (eg. MingLiU, a big5 ttf font)
4770 don't report themselves as double byte fonts, when
4771 patently they are. So instead of trusting
4772 GetFontLanguageInfo, we check the properties of the
4773 codepage directly, since that is ultimately what we are
4774 working from anyway. */
4775 /* font->double_byte_p = GetFontLanguageInfo (hdc) & GCP_DBCS; */
4777 GetCPInfo (codepage
, &cpi
);
4778 font
->double_byte_p
= cpi
.MaxCharSize
> 1;
4781 SelectObject (hdc
, oldobj
);
4782 ReleaseDC (dpyinfo
->root_window
, hdc
);
4783 /* Fill out details in lf according to the font that was
4785 lf
.lfHeight
= font
->tm
.tmInternalLeading
- font
->tm
.tmHeight
;
4786 lf
.lfWidth
= font
->tm
.tmMaxCharWidth
;
4787 lf
.lfWeight
= font
->tm
.tmWeight
;
4788 lf
.lfItalic
= font
->tm
.tmItalic
;
4789 lf
.lfCharSet
= font
->tm
.tmCharSet
;
4790 lf
.lfPitchAndFamily
= ((font
->tm
.tmPitchAndFamily
& TMPF_FIXED_PITCH
)
4791 ? VARIABLE_PITCH
: FIXED_PITCH
);
4792 lf
.lfOutPrecision
= ((font
->tm
.tmPitchAndFamily
& TMPF_VECTOR
)
4793 ? OUT_STROKE_PRECIS
: OUT_STRING_PRECIS
);
4795 w32_cache_char_metrics (font
);
4802 w32_unload_font (dpyinfo
, font
);
4806 /* Find a free slot in the font table. */
4807 for (i
= 0; i
< dpyinfo
->n_fonts
; ++i
)
4808 if (dpyinfo
->font_table
[i
].name
== NULL
)
4811 /* If no free slot found, maybe enlarge the font table. */
4812 if (i
== dpyinfo
->n_fonts
4813 && dpyinfo
->n_fonts
== dpyinfo
->font_table_size
)
4816 dpyinfo
->font_table_size
= max (16, 2 * dpyinfo
->font_table_size
);
4817 sz
= dpyinfo
->font_table_size
* sizeof *dpyinfo
->font_table
;
4819 = (struct font_info
*) xrealloc (dpyinfo
->font_table
, sz
);
4822 fontp
= dpyinfo
->font_table
+ i
;
4823 if (i
== dpyinfo
->n_fonts
)
4826 /* Now fill in the slots of *FONTP. */
4828 bzero (fontp
, sizeof (*fontp
));
4830 fontp
->font_idx
= i
;
4831 fontp
->name
= (char *) xmalloc (strlen (fontname
) + 1);
4832 bcopy (fontname
, fontp
->name
, strlen (fontname
) + 1);
4834 if ((lf
.lfPitchAndFamily
& 0x03) == FIXED_PITCH
)
4836 /* Fixed width font. */
4837 fontp
->average_width
= fontp
->space_width
= FONT_AVG_WIDTH (font
);
4843 pcm
= w32_per_char_metric (font
, &space
, ANSI_FONT
);
4845 fontp
->space_width
= pcm
->width
;
4847 fontp
->space_width
= FONT_AVG_WIDTH (font
);
4849 fontp
->average_width
= font
->tm
.tmAveCharWidth
;
4852 fontp
->charset
= -1;
4853 charset
= xlfd_charset_of_font (fontname
);
4855 /* Cache the W32 codepage for a font. This makes w32_encode_char
4856 (called for every glyph during redisplay) much faster. */
4857 fontp
->codepage
= codepage
;
4859 /* Work out the font's full name. */
4860 full_name
= (char *)xmalloc (100);
4861 if (full_name
&& w32_to_x_font (&lf
, full_name
, 100, charset
))
4862 fontp
->full_name
= full_name
;
4865 /* If all else fails - just use the name we used to load it. */
4867 fontp
->full_name
= fontp
->name
;
4870 fontp
->size
= FONT_WIDTH (font
);
4871 fontp
->height
= FONT_HEIGHT (font
);
4873 /* The slot `encoding' specifies how to map a character
4874 code-points (0x20..0x7F or 0x2020..0x7F7F) of each charset to
4875 the font code-points (0:0x20..0x7F, 1:0xA0..0xFF), or
4876 (0:0x20..0x7F, 1:0xA0..0xFF,
4877 (0:0x2020..0x7F7F, 1:0xA0A0..0xFFFF, 3:0x20A0..0x7FFF,
4878 2:0xA020..0xFF7F). For the moment, we don't know which charset
4879 uses this font. So, we set information in fontp->encoding_type
4880 which is never used by any charset. If mapping can't be
4881 decided, set FONT_ENCODING_NOT_DECIDED. */
4883 /* SJIS fonts need to be set to type 4, all others seem to work as
4884 type FONT_ENCODING_NOT_DECIDED. */
4885 encoding
= strrchr (fontp
->name
, '-');
4886 if (encoding
&& strnicmp (encoding
+1, "sjis", 4) == 0)
4887 fontp
->encoding_type
= 4;
4889 fontp
->encoding_type
= FONT_ENCODING_NOT_DECIDED
;
4891 /* The following three values are set to 0 under W32, which is
4892 what they get set to if XGetFontProperty fails under X. */
4893 fontp
->baseline_offset
= 0;
4894 fontp
->relative_compose
= 0;
4895 fontp
->default_ascent
= 0;
4897 /* Set global flag fonts_changed_p to non-zero if the font loaded
4898 has a character with a smaller width than any other character
4899 before, or if the font loaded has a smaller height than any
4900 other font loaded before. If this happens, it will make a
4901 glyph matrix reallocation necessary. */
4902 fonts_changed_p
|= x_compute_min_glyph_bounds (f
);
4908 /* Load font named FONTNAME of size SIZE for frame F, and return a
4909 pointer to the structure font_info while allocating it dynamically.
4910 If loading fails, return NULL. */
4912 w32_load_font (f
, fontname
, size
)
4917 Lisp_Object bdf_fonts
;
4918 struct font_info
*retval
= NULL
;
4919 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
4921 bdf_fonts
= w32_list_bdf_fonts (build_string (fontname
), 1);
4923 while (!retval
&& CONSP (bdf_fonts
))
4925 char *bdf_name
, *bdf_file
;
4926 Lisp_Object bdf_pair
;
4929 bdf_name
= SDATA (XCAR (bdf_fonts
));
4930 bdf_pair
= Fassoc (XCAR (bdf_fonts
), Vw32_bdf_filename_alist
);
4931 bdf_file
= SDATA (XCDR (bdf_pair
));
4933 /* If the font is already loaded, do not load it again. */
4934 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
4936 if ((dpyinfo
->font_table
[i
].name
4937 && !strcmp (dpyinfo
->font_table
[i
].name
, bdf_name
))
4938 || (dpyinfo
->font_table
[i
].full_name
4939 && !strcmp (dpyinfo
->font_table
[i
].full_name
, bdf_name
)))
4940 return dpyinfo
->font_table
+ i
;
4943 retval
= w32_load_bdf_font (f
, bdf_name
, size
, bdf_file
);
4945 bdf_fonts
= XCDR (bdf_fonts
);
4951 return w32_load_system_font (f
, fontname
, size
);
4956 w32_unload_font (dpyinfo
, font
)
4957 struct w32_display_info
*dpyinfo
;
4962 if (font
->per_char
) xfree (font
->per_char
);
4963 if (font
->bdf
) w32_free_bdf_font (font
->bdf
);
4965 if (font
->hfont
) DeleteObject (font
->hfont
);
4970 /* The font conversion stuff between x and w32 */
4972 /* X font string is as follows (from faces.el)
4976 * (weight "\\(bold\\|demibold\\|medium\\)") ; 1
4977 * (weight\? "\\([^-]*\\)") ; 1
4978 * (slant "\\([ior]\\)") ; 2
4979 * (slant\? "\\([^-]?\\)") ; 2
4980 * (swidth "\\([^-]*\\)") ; 3
4981 * (adstyle "[^-]*") ; 4
4982 * (pixelsize "[0-9]+")
4983 * (pointsize "[0-9][0-9]+")
4984 * (resx "[0-9][0-9]+")
4985 * (resy "[0-9][0-9]+")
4986 * (spacing "[cmp?*]")
4987 * (avgwidth "[0-9]+")
4988 * (registry "[^-]+")
4989 * (encoding "[^-]+")
4994 x_to_w32_weight (lpw
)
4997 if (!lpw
) return (FW_DONTCARE
);
4999 if (stricmp (lpw
, "heavy") == 0) return FW_HEAVY
;
5000 else if (stricmp (lpw
, "extrabold") == 0) return FW_EXTRABOLD
;
5001 else if (stricmp (lpw
, "bold") == 0) return FW_BOLD
;
5002 else if (stricmp (lpw
, "demibold") == 0) return FW_SEMIBOLD
;
5003 else if (stricmp (lpw
, "semibold") == 0) return FW_SEMIBOLD
;
5004 else if (stricmp (lpw
, "medium") == 0) return FW_MEDIUM
;
5005 else if (stricmp (lpw
, "normal") == 0) return FW_NORMAL
;
5006 else if (stricmp (lpw
, "light") == 0) return FW_LIGHT
;
5007 else if (stricmp (lpw
, "extralight") == 0) return FW_EXTRALIGHT
;
5008 else if (stricmp (lpw
, "thin") == 0) return FW_THIN
;
5015 w32_to_x_weight (fnweight
)
5018 if (fnweight
>= FW_HEAVY
) return "heavy";
5019 if (fnweight
>= FW_EXTRABOLD
) return "extrabold";
5020 if (fnweight
>= FW_BOLD
) return "bold";
5021 if (fnweight
>= FW_SEMIBOLD
) return "demibold";
5022 if (fnweight
>= FW_MEDIUM
) return "medium";
5023 if (fnweight
>= FW_NORMAL
) return "normal";
5024 if (fnweight
>= FW_LIGHT
) return "light";
5025 if (fnweight
>= FW_EXTRALIGHT
) return "extralight";
5026 if (fnweight
>= FW_THIN
) return "thin";
5032 x_to_w32_charset (lpcs
)
5035 Lisp_Object this_entry
, w32_charset
;
5037 int len
= strlen (lpcs
);
5039 /* Support "*-#nnn" format for unknown charsets. */
5040 if (strncmp (lpcs
, "*-#", 3) == 0)
5041 return atoi (lpcs
+ 3);
5043 /* All Windows fonts qualify as unicode. */
5044 if (!strncmp (lpcs
, "iso10646", 8))
5045 return DEFAULT_CHARSET
;
5047 /* Handle wildcards by ignoring them; eg. treat "big5*-*" as "big5". */
5048 charset
= alloca (len
+ 1);
5049 strcpy (charset
, lpcs
);
5050 lpcs
= strchr (charset
, '*');
5054 /* Look through w32-charset-info-alist for the character set.
5055 Format of each entry is
5056 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
5058 this_entry
= Fassoc (build_string (charset
), Vw32_charset_info_alist
);
5060 if (NILP (this_entry
))
5062 /* At startup, we want iso8859-1 fonts to come up properly. */
5063 if (stricmp (charset
, "iso8859-1") == 0)
5064 return ANSI_CHARSET
;
5066 return DEFAULT_CHARSET
;
5069 w32_charset
= Fcar (Fcdr (this_entry
));
5071 /* Translate Lisp symbol to number. */
5072 if (EQ (w32_charset
, Qw32_charset_ansi
))
5073 return ANSI_CHARSET
;
5074 if (EQ (w32_charset
, Qw32_charset_symbol
))
5075 return SYMBOL_CHARSET
;
5076 if (EQ (w32_charset
, Qw32_charset_shiftjis
))
5077 return SHIFTJIS_CHARSET
;
5078 if (EQ (w32_charset
, Qw32_charset_hangeul
))
5079 return HANGEUL_CHARSET
;
5080 if (EQ (w32_charset
, Qw32_charset_chinesebig5
))
5081 return CHINESEBIG5_CHARSET
;
5082 if (EQ (w32_charset
, Qw32_charset_gb2312
))
5083 return GB2312_CHARSET
;
5084 if (EQ (w32_charset
, Qw32_charset_oem
))
5086 #ifdef JOHAB_CHARSET
5087 if (EQ (w32_charset
, Qw32_charset_johab
))
5088 return JOHAB_CHARSET
;
5089 if (EQ (w32_charset
, Qw32_charset_easteurope
))
5090 return EASTEUROPE_CHARSET
;
5091 if (EQ (w32_charset
, Qw32_charset_turkish
))
5092 return TURKISH_CHARSET
;
5093 if (EQ (w32_charset
, Qw32_charset_baltic
))
5094 return BALTIC_CHARSET
;
5095 if (EQ (w32_charset
, Qw32_charset_russian
))
5096 return RUSSIAN_CHARSET
;
5097 if (EQ (w32_charset
, Qw32_charset_arabic
))
5098 return ARABIC_CHARSET
;
5099 if (EQ (w32_charset
, Qw32_charset_greek
))
5100 return GREEK_CHARSET
;
5101 if (EQ (w32_charset
, Qw32_charset_hebrew
))
5102 return HEBREW_CHARSET
;
5103 if (EQ (w32_charset
, Qw32_charset_vietnamese
))
5104 return VIETNAMESE_CHARSET
;
5105 if (EQ (w32_charset
, Qw32_charset_thai
))
5106 return THAI_CHARSET
;
5107 if (EQ (w32_charset
, Qw32_charset_mac
))
5109 #endif /* JOHAB_CHARSET */
5110 #ifdef UNICODE_CHARSET
5111 if (EQ (w32_charset
, Qw32_charset_unicode
))
5112 return UNICODE_CHARSET
;
5115 return DEFAULT_CHARSET
;
5120 w32_to_x_charset (fncharset
, matching
)
5124 static char buf
[32];
5125 Lisp_Object charset_type
;
5130 /* If fully specified, accept it as it is. Otherwise use a
5132 char *wildcard
= strchr (matching
, '*');
5135 else if (strchr (matching
, '-'))
5138 match_len
= strlen (matching
);
5144 /* Handle startup case of w32-charset-info-alist not
5145 being set up yet. */
5146 if (NILP (Vw32_charset_info_alist
))
5148 charset_type
= Qw32_charset_ansi
;
5150 case DEFAULT_CHARSET
:
5151 charset_type
= Qw32_charset_default
;
5153 case SYMBOL_CHARSET
:
5154 charset_type
= Qw32_charset_symbol
;
5156 case SHIFTJIS_CHARSET
:
5157 charset_type
= Qw32_charset_shiftjis
;
5159 case HANGEUL_CHARSET
:
5160 charset_type
= Qw32_charset_hangeul
;
5162 case GB2312_CHARSET
:
5163 charset_type
= Qw32_charset_gb2312
;
5165 case CHINESEBIG5_CHARSET
:
5166 charset_type
= Qw32_charset_chinesebig5
;
5169 charset_type
= Qw32_charset_oem
;
5172 /* More recent versions of Windows (95 and NT4.0) define more
5174 #ifdef EASTEUROPE_CHARSET
5175 case EASTEUROPE_CHARSET
:
5176 charset_type
= Qw32_charset_easteurope
;
5178 case TURKISH_CHARSET
:
5179 charset_type
= Qw32_charset_turkish
;
5181 case BALTIC_CHARSET
:
5182 charset_type
= Qw32_charset_baltic
;
5184 case RUSSIAN_CHARSET
:
5185 charset_type
= Qw32_charset_russian
;
5187 case ARABIC_CHARSET
:
5188 charset_type
= Qw32_charset_arabic
;
5191 charset_type
= Qw32_charset_greek
;
5193 case HEBREW_CHARSET
:
5194 charset_type
= Qw32_charset_hebrew
;
5196 case VIETNAMESE_CHARSET
:
5197 charset_type
= Qw32_charset_vietnamese
;
5200 charset_type
= Qw32_charset_thai
;
5203 charset_type
= Qw32_charset_mac
;
5206 charset_type
= Qw32_charset_johab
;
5210 #ifdef UNICODE_CHARSET
5211 case UNICODE_CHARSET
:
5212 charset_type
= Qw32_charset_unicode
;
5216 /* Encode numerical value of unknown charset. */
5217 sprintf (buf
, "*-#%u", fncharset
);
5223 char * best_match
= NULL
;
5224 int matching_found
= 0;
5226 /* Look through w32-charset-info-alist for the character set.
5227 Prefer ISO codepages, and prefer lower numbers in the ISO
5228 range. Only return charsets for codepages which are installed.
5230 Format of each entry is
5231 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
5233 for (rest
= Vw32_charset_info_alist
; CONSP (rest
); rest
= XCDR (rest
))
5236 Lisp_Object w32_charset
;
5237 Lisp_Object codepage
;
5239 Lisp_Object this_entry
= XCAR (rest
);
5241 /* Skip invalid entries in alist. */
5242 if (!CONSP (this_entry
) || !STRINGP (XCAR (this_entry
))
5243 || !CONSP (XCDR (this_entry
))
5244 || !SYMBOLP (XCAR (XCDR (this_entry
))))
5247 x_charset
= SDATA (XCAR (this_entry
));
5248 w32_charset
= XCAR (XCDR (this_entry
));
5249 codepage
= XCDR (XCDR (this_entry
));
5251 /* Look for Same charset and a valid codepage (or non-int
5252 which means ignore). */
5253 if (EQ (w32_charset
, charset_type
)
5254 && (!INTEGERP (codepage
) || XINT (codepage
) == CP_DEFAULT
5255 || IsValidCodePage (XINT (codepage
))))
5257 /* If we don't have a match already, then this is the
5261 best_match
= x_charset
;
5262 if (matching
&& !strnicmp (x_charset
, matching
, match_len
))
5265 /* If we already found a match for MATCHING, then
5266 only consider other matches. */
5267 else if (matching_found
5268 && strnicmp (x_charset
, matching
, match_len
))
5270 /* If this matches what we want, and the best so far doesn't,
5271 then this is better. */
5272 else if (!matching_found
&& matching
5273 && !strnicmp (x_charset
, matching
, match_len
))
5275 best_match
= x_charset
;
5278 /* If this is fully specified, and the best so far isn't,
5279 then this is better. */
5280 else if ((!strchr (best_match
, '-') && strchr (x_charset
, '-'))
5281 /* If this is an ISO codepage, and the best so far isn't,
5282 then this is better, but only if it fully specifies the
5284 || (strnicmp (best_match
, "iso", 3) != 0
5285 && strnicmp (x_charset
, "iso", 3) == 0
5286 && strchr (x_charset
, '-')))
5287 best_match
= x_charset
;
5288 /* If both are ISO8859 codepages, choose the one with the
5289 lowest number in the encoding field. */
5290 else if (strnicmp (best_match
, "iso8859-", 8) == 0
5291 && strnicmp (x_charset
, "iso8859-", 8) == 0)
5293 int best_enc
= atoi (best_match
+ 8);
5294 int this_enc
= atoi (x_charset
+ 8);
5295 if (this_enc
> 0 && this_enc
< best_enc
)
5296 best_match
= x_charset
;
5301 /* If no match, encode the numeric value. */
5304 sprintf (buf
, "*-#%u", fncharset
);
5308 strncpy (buf
, best_match
, 31);
5309 /* If the charset is not fully specified, put -0 on the end. */
5310 if (!strchr (best_match
, '-'))
5312 int pos
= strlen (best_match
);
5313 /* Charset specifiers shouldn't be very long. If it is a made
5314 up one, truncating it should not do any harm since it isn't
5315 recognized anyway. */
5318 strcpy (buf
+ pos
, "-0");
5326 /* Return all the X charsets that map to a font. */
5328 w32_to_all_x_charsets (fncharset
)
5331 static char buf
[32];
5332 Lisp_Object charset_type
;
5333 Lisp_Object retval
= Qnil
;
5338 /* Handle startup case of w32-charset-info-alist not
5339 being set up yet. */
5340 if (NILP (Vw32_charset_info_alist
))
5341 return Fcons (build_string ("iso8859-1"), Qnil
);
5343 charset_type
= Qw32_charset_ansi
;
5345 case DEFAULT_CHARSET
:
5346 charset_type
= Qw32_charset_default
;
5348 case SYMBOL_CHARSET
:
5349 charset_type
= Qw32_charset_symbol
;
5351 case SHIFTJIS_CHARSET
:
5352 charset_type
= Qw32_charset_shiftjis
;
5354 case HANGEUL_CHARSET
:
5355 charset_type
= Qw32_charset_hangeul
;
5357 case GB2312_CHARSET
:
5358 charset_type
= Qw32_charset_gb2312
;
5360 case CHINESEBIG5_CHARSET
:
5361 charset_type
= Qw32_charset_chinesebig5
;
5364 charset_type
= Qw32_charset_oem
;
5367 /* More recent versions of Windows (95 and NT4.0) define more
5369 #ifdef EASTEUROPE_CHARSET
5370 case EASTEUROPE_CHARSET
:
5371 charset_type
= Qw32_charset_easteurope
;
5373 case TURKISH_CHARSET
:
5374 charset_type
= Qw32_charset_turkish
;
5376 case BALTIC_CHARSET
:
5377 charset_type
= Qw32_charset_baltic
;
5379 case RUSSIAN_CHARSET
:
5380 charset_type
= Qw32_charset_russian
;
5382 case ARABIC_CHARSET
:
5383 charset_type
= Qw32_charset_arabic
;
5386 charset_type
= Qw32_charset_greek
;
5388 case HEBREW_CHARSET
:
5389 charset_type
= Qw32_charset_hebrew
;
5391 case VIETNAMESE_CHARSET
:
5392 charset_type
= Qw32_charset_vietnamese
;
5395 charset_type
= Qw32_charset_thai
;
5398 charset_type
= Qw32_charset_mac
;
5401 charset_type
= Qw32_charset_johab
;
5405 #ifdef UNICODE_CHARSET
5406 case UNICODE_CHARSET
:
5407 charset_type
= Qw32_charset_unicode
;
5411 /* Encode numerical value of unknown charset. */
5412 sprintf (buf
, "*-#%u", fncharset
);
5413 return Fcons (build_string (buf
), Qnil
);
5418 /* Look through w32-charset-info-alist for the character set.
5419 Only return fully specified charsets for codepages which are
5422 Format of each entry in Vw32_charset_info_alist is
5423 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
5425 for (rest
= Vw32_charset_info_alist
; CONSP (rest
); rest
= XCDR (rest
))
5427 Lisp_Object x_charset
;
5428 Lisp_Object w32_charset
;
5429 Lisp_Object codepage
;
5431 Lisp_Object this_entry
= XCAR (rest
);
5433 /* Skip invalid entries in alist. */
5434 if (!CONSP (this_entry
) || !STRINGP (XCAR (this_entry
))
5435 || !CONSP (XCDR (this_entry
))
5436 || !SYMBOLP (XCAR (XCDR (this_entry
))))
5439 x_charset
= XCAR (this_entry
);
5440 w32_charset
= XCAR (XCDR (this_entry
));
5441 codepage
= XCDR (XCDR (this_entry
));
5443 if (!strchr (SDATA (x_charset
), '-'))
5446 /* Look for Same charset and a valid codepage (or non-int
5447 which means ignore). */
5448 if (EQ (w32_charset
, charset_type
)
5449 && (!INTEGERP (codepage
) || XINT (codepage
) == CP_DEFAULT
5450 || IsValidCodePage (XINT (codepage
))))
5452 retval
= Fcons (x_charset
, retval
);
5456 /* If no match, encode the numeric value. */
5459 sprintf (buf
, "*-#%u", fncharset
);
5460 return Fcons (build_string (buf
), Qnil
);
5467 /* Get the Windows codepage corresponding to the specified font. The
5468 charset info in the font name is used to look up
5469 w32-charset-to-codepage-alist. */
5471 w32_codepage_for_font (char *fontname
)
5473 Lisp_Object codepage
, entry
;
5474 char *charset_str
, *charset
, *end
;
5476 /* Extract charset part of font string. */
5477 charset
= xlfd_charset_of_font (fontname
);
5482 charset_str
= (char *) alloca (strlen (charset
) + 1);
5483 strcpy (charset_str
, charset
);
5486 /* Remove leading "*-". */
5487 if (strncmp ("*-", charset_str
, 2) == 0)
5488 charset
= charset_str
+ 2;
5491 charset
= charset_str
;
5493 /* Stop match at wildcard (including preceding '-'). */
5494 if (end
= strchr (charset
, '*'))
5496 if (end
> charset
&& *(end
-1) == '-')
5501 if (!strcmp (charset
, "iso10646"))
5504 if (NILP (Vw32_charset_info_alist
))
5507 entry
= Fassoc (build_string(charset
), Vw32_charset_info_alist
);
5511 codepage
= Fcdr (Fcdr (entry
));
5513 if (NILP (codepage
))
5515 else if (XFASTINT (codepage
) == XFASTINT (Qt
))
5517 else if (INTEGERP (codepage
))
5518 return XINT (codepage
);
5525 w32_to_x_font (lplogfont
, lpxstr
, len
, specific_charset
)
5526 LOGFONT
* lplogfont
;
5529 char * specific_charset
;
5533 char height_pixels
[8];
5535 char width_pixels
[8];
5536 char *fontname_dash
;
5537 int display_resy
= (int) one_w32_display_info
.resy
;
5538 int display_resx
= (int) one_w32_display_info
.resx
;
5539 struct coding_system coding
;
5541 if (!lpxstr
) abort ();
5546 if (lplogfont
->lfOutPrecision
== OUT_STRING_PRECIS
)
5547 fonttype
= "raster";
5548 else if (lplogfont
->lfOutPrecision
== OUT_STROKE_PRECIS
)
5549 fonttype
= "outline";
5551 fonttype
= "unknown";
5553 setup_coding_system (Fcheck_coding_system (Vlocale_coding_system
),
5555 coding
.src_multibyte
= 0;
5556 coding
.dst_multibyte
= 1;
5557 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5558 /* We explicitely disable composition handling because selection
5559 data should not contain any composition sequence. */
5560 coding
.common_flags
&= ~CODING_ANNOTATION_MASK
;
5562 coding
.dst_bytes
= LF_FACESIZE
* 2;
5563 coding
.destination
= (unsigned char *) xmalloc (coding
.dst_bytes
+ 1);
5564 decode_coding_c_string (&coding
, lplogfont
->lfFaceName
,
5565 strlen(lplogfont
->lfFaceName
), Qnil
);
5566 fontname
= coding
.destination
;
5568 *(fontname
+ coding
.produced
) = '\0';
5570 /* Replace dashes with underscores so the dashes are not
5572 fontname_dash
= fontname
;
5573 while (fontname_dash
= strchr (fontname_dash
, '-'))
5574 *fontname_dash
= '_';
5576 if (lplogfont
->lfHeight
)
5578 sprintf (height_pixels
, "%u", eabs (lplogfont
->lfHeight
));
5579 sprintf (height_dpi
, "%u",
5580 eabs (lplogfont
->lfHeight
) * 720 / display_resy
);
5584 strcpy (height_pixels
, "*");
5585 strcpy (height_dpi
, "*");
5588 #if 0 /* Never put the width in the xfld. It fails on fonts with
5589 double-width characters. */
5590 if (lplogfont
->lfWidth
)
5591 sprintf (width_pixels
, "%u", lplogfont
->lfWidth
* 10);
5594 strcpy (width_pixels
, "*");
5596 _snprintf (lpxstr
, len
- 1,
5597 "-%s-%s-%s-%c-normal-normal-%s-%s-%d-%d-%c-%s-%s",
5598 fonttype
, /* foundry */
5599 fontname
, /* family */
5600 w32_to_x_weight (lplogfont
->lfWeight
), /* weight */
5601 lplogfont
->lfItalic
?'i':'r', /* slant */
5603 /* add style name */
5604 height_pixels
, /* pixel size */
5605 height_dpi
, /* point size */
5606 display_resx
, /* resx */
5607 display_resy
, /* resy */
5608 ((lplogfont
->lfPitchAndFamily
& 0x3) == VARIABLE_PITCH
)
5609 ? 'p' : 'c', /* spacing */
5610 width_pixels
, /* avg width */
5611 w32_to_x_charset (lplogfont
->lfCharSet
, specific_charset
)
5612 /* charset registry and encoding */
5615 lpxstr
[len
- 1] = 0; /* just to be sure */
5620 x_to_w32_font (lpxstr
, lplogfont
)
5622 LOGFONT
* lplogfont
;
5624 struct coding_system coding
;
5626 if (!lplogfont
) return (FALSE
);
5628 memset (lplogfont
, 0, sizeof (*lplogfont
));
5630 /* Set default value for each field. */
5632 lplogfont
->lfOutPrecision
= OUT_DEFAULT_PRECIS
;
5633 lplogfont
->lfClipPrecision
= CLIP_DEFAULT_PRECIS
;
5634 lplogfont
->lfQuality
= DEFAULT_QUALITY
;
5636 /* go for maximum quality */
5637 lplogfont
->lfOutPrecision
= OUT_STROKE_PRECIS
;
5638 lplogfont
->lfClipPrecision
= CLIP_STROKE_PRECIS
;
5639 lplogfont
->lfQuality
= PROOF_QUALITY
;
5642 lplogfont
->lfCharSet
= DEFAULT_CHARSET
;
5643 lplogfont
->lfWeight
= FW_DONTCARE
;
5644 lplogfont
->lfPitchAndFamily
= DEFAULT_PITCH
| FF_DONTCARE
;
5649 /* Provide a simple escape mechanism for specifying Windows font names
5650 * directly -- if font spec does not beginning with '-', assume this
5652 * "<font name>[:height in pixels[:width in pixels[:weight]]]"
5658 char name
[50], weight
[20], slant
, pitch
, pixels
[10], height
[10],
5659 width
[10], resy
[10], remainder
[50];
5661 int dpi
= (int) one_w32_display_info
.resy
;
5663 fields
= sscanf (lpxstr
,
5664 "-%*[^-]-%49[^-]-%19[^-]-%c-%*[^-]-%*[^-]-%9[^-]-%9[^-]-%*[^-]-%9[^-]-%c-%9[^-]-%49s",
5665 name
, weight
, &slant
, pixels
, height
, resy
, &pitch
, width
, remainder
);
5669 /* In the general case when wildcards cover more than one field,
5670 we don't know which field is which, so don't fill any in.
5671 However, we need to cope with this particular form, which is
5672 generated by font_list_1 (invoked by try_font_list):
5673 "-raster-6x10-*-gb2312*-*"
5674 and make sure to correctly parse the charset field. */
5677 fields
= sscanf (lpxstr
,
5678 "-%*[^-]-%49[^-]-*-%49s",
5681 else if (fields
< 9)
5687 if (fields
> 0 && name
[0] != '*')
5689 Lisp_Object string
= build_string (name
);
5691 (Fcheck_coding_system (Vlocale_coding_system
), &coding
);
5692 coding
.mode
|= (CODING_MODE_SAFE_ENCODING
| CODING_MODE_LAST_BLOCK
);
5693 /* Disable composition/charset annotation. */
5694 coding
.common_flags
&= ~CODING_ANNOTATION_MASK
;
5695 coding
.dst_bytes
= SCHARS (string
) * 2;
5697 coding
.destination
= (unsigned char *) xmalloc (coding
.dst_bytes
);
5698 encode_coding_object (&coding
, string
, 0, 0,
5699 SCHARS (string
), SBYTES (string
), Qnil
);
5700 if (coding
.produced
>= LF_FACESIZE
)
5701 coding
.produced
= LF_FACESIZE
- 1;
5703 coding
.destination
[coding
.produced
] = '\0';
5705 strcpy (lplogfont
->lfFaceName
, coding
.destination
);
5706 xfree (coding
.destination
);
5710 lplogfont
->lfFaceName
[0] = '\0';
5715 lplogfont
->lfWeight
= x_to_w32_weight ((fields
> 0 ? weight
: ""));
5719 lplogfont
->lfItalic
= (fields
> 0 && slant
== 'i');
5723 if (fields
> 0 && pixels
[0] != '*')
5724 lplogfont
->lfHeight
= atoi (pixels
);
5728 if (fields
> 0 && resy
[0] != '*')
5731 if (tem
> 0) dpi
= tem
;
5734 if (fields
> -1 && lplogfont
->lfHeight
== 0 && height
[0] != '*')
5735 lplogfont
->lfHeight
= atoi (height
) * dpi
/ 720;
5740 lplogfont
->lfPitchAndFamily
= VARIABLE_PITCH
| FF_DONTCARE
;
5741 else if (pitch
== 'c')
5742 lplogfont
->lfPitchAndFamily
= FIXED_PITCH
| FF_DONTCARE
;
5747 if (fields
> 0 && width
[0] != '*')
5748 lplogfont
->lfWidth
= atoi (width
) / 10;
5752 /* Strip the trailing '-' if present. (it shouldn't be, as it
5753 fails the test against xlfd-tight-regexp in fontset.el). */
5755 int len
= strlen (remainder
);
5756 if (len
> 0 && remainder
[len
-1] == '-')
5757 remainder
[len
-1] = 0;
5759 encoding
= remainder
;
5761 if (strncmp (encoding
, "*-", 2) == 0)
5764 lplogfont
->lfCharSet
= x_to_w32_charset (encoding
);
5769 char name
[100], height
[10], width
[10], weight
[20];
5771 fields
= sscanf (lpxstr
,
5772 "%99[^:]:%9[^:]:%9[^:]:%19s",
5773 name
, height
, width
, weight
);
5775 if (fields
== EOF
) return (FALSE
);
5779 strncpy (lplogfont
->lfFaceName
, name
, LF_FACESIZE
);
5780 lplogfont
->lfFaceName
[LF_FACESIZE
-1] = 0;
5784 lplogfont
->lfFaceName
[0] = 0;
5790 lplogfont
->lfHeight
= atoi (height
);
5795 lplogfont
->lfWidth
= atoi (width
);
5799 lplogfont
->lfWeight
= x_to_w32_weight ((fields
> 0 ? weight
: ""));
5802 /* This makes TrueType fonts work better. */
5803 lplogfont
->lfHeight
= - eabs (lplogfont
->lfHeight
);
5808 /* Strip the pixel height and point height from the given xlfd, and
5809 return the pixel height. If no pixel height is specified, calculate
5810 one from the point height, or if that isn't defined either, return
5811 0 (which usually signifies a scalable font).
5814 xlfd_strip_height (char *fontname
)
5816 int pixel_height
, field_number
;
5817 char *read_from
, *write_to
;
5821 pixel_height
= field_number
= 0;
5824 /* Look for height fields. */
5825 for (read_from
= fontname
; *read_from
; read_from
++)
5827 if (*read_from
== '-')
5830 if (field_number
== 7) /* Pixel height. */
5833 write_to
= read_from
;
5835 /* Find end of field. */
5836 for (;*read_from
&& *read_from
!= '-'; read_from
++)
5839 /* Split the fontname at end of field. */
5845 pixel_height
= atoi (write_to
);
5846 /* Blank out field. */
5847 if (read_from
> write_to
)
5852 /* If the pixel height field is at the end (partial xlfd),
5855 return pixel_height
;
5857 /* If we got a pixel height, the point height can be
5858 ignored. Just blank it out and break now. */
5861 /* Find end of point size field. */
5862 for (; *read_from
&& *read_from
!= '-'; read_from
++)
5868 /* Blank out the point size field. */
5869 if (read_from
> write_to
)
5875 return pixel_height
;
5879 /* If the point height is already blank, break now. */
5880 if (*read_from
== '-')
5886 else if (field_number
== 8)
5888 /* If we didn't get a pixel height, try to get the point
5889 height and convert that. */
5891 char *point_size_start
= read_from
++;
5893 /* Find end of field. */
5894 for (; *read_from
&& *read_from
!= '-'; read_from
++)
5903 point_size
= atoi (point_size_start
);
5905 /* Convert to pixel height. */
5906 pixel_height
= point_size
5907 * one_w32_display_info
.height_in
/ 720;
5909 /* Blank out this field and break. */
5917 /* Shift the rest of the font spec into place. */
5918 if (write_to
&& read_from
> write_to
)
5920 for (; *read_from
; read_from
++, write_to
++)
5921 *write_to
= *read_from
;
5925 return pixel_height
;
5928 /* Assume parameter 1 is fully qualified, no wildcards. */
5930 w32_font_match (fontname
, pattern
)
5935 char *font_name_copy
;
5936 char *regex
= alloca (strlen (pattern
) * 2 + 3);
5938 font_name_copy
= alloca (strlen (fontname
) + 1);
5939 strcpy (font_name_copy
, fontname
);
5944 /* Turn pattern into a regexp and do a regexp match. */
5945 for (; *pattern
; pattern
++)
5947 if (*pattern
== '?')
5949 else if (*pattern
== '*')
5960 /* Strip out font heights and compare them seperately, since
5961 rounding error can cause mismatches. This also allows a
5962 comparison between a font that declares only a pixel height and a
5963 pattern that declares the point height.
5966 int font_height
, pattern_height
;
5968 font_height
= xlfd_strip_height (font_name_copy
);
5969 pattern_height
= xlfd_strip_height (regex
);
5971 /* Compare now, and don't bother doing expensive regexp matching
5972 if the heights differ. */
5973 if (font_height
&& pattern_height
&& (font_height
!= pattern_height
))
5977 return (fast_string_match_ignore_case (build_string (regex
),
5978 build_string (font_name_copy
)) >= 0);
5981 /* Callback functions, and a structure holding info they need, for
5982 listing system fonts on W32. We need one set of functions to do the
5983 job properly, but these don't work on NT 3.51 and earlier, so we
5984 have a second set which don't handle character sets properly to
5987 In both cases, there are two passes made. The first pass gets one
5988 font from each family, the second pass lists all the fonts from
5991 typedef struct enumfont_t
5996 XFontStruct
*size_ref
;
5997 Lisp_Object pattern
;
6003 enum_font_maybe_add_to_list (enumfont_t
*, LOGFONT
*, char *, Lisp_Object
);
6007 enum_font_cb2 (lplf
, lptm
, FontType
, lpef
)
6009 NEWTEXTMETRIC
* lptm
;
6013 /* Ignore struck out and underlined versions of fonts. */
6014 if (lplf
->elfLogFont
.lfStrikeOut
|| lplf
->elfLogFont
.lfUnderline
)
6017 /* Only return fonts with names starting with @ if they were
6018 explicitly specified, since Microsoft uses an initial @ to
6019 denote fonts for vertical writing, without providing a more
6020 convenient way of identifying them. */
6021 if (lplf
->elfLogFont
.lfFaceName
[0] == '@'
6022 && lpef
->logfont
.lfFaceName
[0] != '@')
6025 /* Check that the character set matches if it was specified */
6026 if (lpef
->logfont
.lfCharSet
!= DEFAULT_CHARSET
&&
6027 lplf
->elfLogFont
.lfCharSet
!= lpef
->logfont
.lfCharSet
)
6030 if (FontType
== RASTER_FONTTYPE
)
6032 /* DBCS raster fonts have problems displaying, so skip them. */
6033 int charset
= lplf
->elfLogFont
.lfCharSet
;
6034 if (charset
== SHIFTJIS_CHARSET
6035 || charset
== HANGEUL_CHARSET
6036 || charset
== CHINESEBIG5_CHARSET
6037 || charset
== GB2312_CHARSET
6038 #ifdef JOHAB_CHARSET
6039 || charset
== JOHAB_CHARSET
6047 Lisp_Object width
= Qnil
;
6048 Lisp_Object charset_list
= Qnil
;
6049 char *charset
= NULL
;
6051 /* Truetype fonts do not report their true metrics until loaded */
6052 if (FontType
!= RASTER_FONTTYPE
)
6054 if (!NILP (lpef
->pattern
))
6056 /* Scalable fonts are as big as you want them to be. */
6057 lplf
->elfLogFont
.lfHeight
= lpef
->logfont
.lfHeight
;
6058 lplf
->elfLogFont
.lfWidth
= lpef
->logfont
.lfWidth
;
6059 width
= make_number (lpef
->logfont
.lfWidth
);
6063 lplf
->elfLogFont
.lfHeight
= 0;
6064 lplf
->elfLogFont
.lfWidth
= 0;
6068 /* Make sure the height used here is the same as everywhere
6069 else (ie character height, not cell height). */
6070 if (lplf
->elfLogFont
.lfHeight
> 0)
6072 /* lptm can be trusted for RASTER fonts, but not scalable ones. */
6073 if (FontType
== RASTER_FONTTYPE
)
6074 lplf
->elfLogFont
.lfHeight
= lptm
->tmInternalLeading
- lptm
->tmHeight
;
6076 lplf
->elfLogFont
.lfHeight
= -lplf
->elfLogFont
.lfHeight
;
6079 if (!NILP (lpef
->pattern
))
6081 charset
= xlfd_charset_of_font (SDATA (lpef
->pattern
));
6083 /* We already checked charsets above, but DEFAULT_CHARSET
6084 slipped through. So only allow exact matches for DEFAULT_CHARSET. */
6086 && strncmp (charset
, "*-*", 3) != 0
6087 && lpef
->logfont
.lfCharSet
== DEFAULT_CHARSET
6088 && strcmp (charset
, w32_to_x_charset (DEFAULT_CHARSET
, NULL
)) != 0)
6091 /* Reject raster fonts if we are looking for a unicode font. */
6093 && FontType
== RASTER_FONTTYPE
6094 && strncmp (charset
, "iso10646", 8) == 0)
6099 charset_list
= Fcons (build_string (charset
), Qnil
);
6101 /* Always prefer unicode. */
6103 = Fcons (build_string ("iso10646-1"),
6104 w32_to_all_x_charsets (lplf
->elfLogFont
.lfCharSet
));
6106 /* Loop through the charsets. */
6107 for ( ; CONSP (charset_list
); charset_list
= Fcdr (charset_list
))
6109 Lisp_Object this_charset
= Fcar (charset_list
);
6110 charset
= SDATA (this_charset
);
6112 /* Don't list raster fonts as unicode. */
6114 && FontType
== RASTER_FONTTYPE
6115 && strncmp (charset
, "iso10646", 8) == 0)
6118 enum_font_maybe_add_to_list (lpef
, &(lplf
->elfLogFont
),
6121 /* List bold and italic variations if w32-enable-synthesized-fonts
6122 is non-nil and this is a plain font. */
6123 if (w32_enable_synthesized_fonts
6124 && lplf
->elfLogFont
.lfWeight
== FW_NORMAL
6125 && lplf
->elfLogFont
.lfItalic
== FALSE
)
6128 lplf
->elfLogFont
.lfWeight
= FW_BOLD
;
6129 enum_font_maybe_add_to_list (lpef
, &(lplf
->elfLogFont
),
6132 lplf
->elfLogFont
.lfItalic
= TRUE
;
6133 enum_font_maybe_add_to_list (lpef
, &(lplf
->elfLogFont
),
6136 lplf
->elfLogFont
.lfWeight
= FW_NORMAL
;
6137 enum_font_maybe_add_to_list (lpef
, &(lplf
->elfLogFont
),
6147 enum_font_maybe_add_to_list (lpef
, logfont
, match_charset
, width
)
6150 char * match_charset
;
6155 if (!w32_to_x_font (logfont
, buf
, 100, match_charset
))
6158 if (NILP (lpef
->pattern
)
6159 || w32_font_match (buf
, SDATA (lpef
->pattern
)))
6161 /* Check if we already listed this font. This may happen if
6162 w32_enable_synthesized_fonts is non-nil, and there are real
6163 bold and italic versions of the font. */
6164 Lisp_Object font_name
= build_string (buf
);
6165 if (NILP (Fmember (font_name
, lpef
->list
)))
6167 Lisp_Object entry
= Fcons (font_name
, width
);
6168 lpef
->list
= Fcons (entry
, lpef
->list
);
6176 enum_font_cb1 (lplf
, lptm
, FontType
, lpef
)
6178 NEWTEXTMETRIC
* lptm
;
6182 return EnumFontFamilies (lpef
->hdc
,
6183 lplf
->elfLogFont
.lfFaceName
,
6184 (FONTENUMPROC
) enum_font_cb2
,
6190 enum_fontex_cb2 (lplf
, lptm
, font_type
, lpef
)
6191 ENUMLOGFONTEX
* lplf
;
6192 NEWTEXTMETRICEX
* lptm
;
6196 /* We are not interested in the extra info we get back from the 'Ex
6197 version - only the fact that we get character set variations
6198 enumerated seperately. */
6199 return enum_font_cb2 ((ENUMLOGFONT
*) lplf
, (NEWTEXTMETRIC
*) lptm
,
6204 enum_fontex_cb1 (lplf
, lptm
, font_type
, lpef
)
6205 ENUMLOGFONTEX
* lplf
;
6206 NEWTEXTMETRICEX
* lptm
;
6210 HMODULE gdi32
= GetModuleHandle ("gdi32.dll");
6211 FARPROC enum_font_families_ex
6212 = GetProcAddress ( gdi32
, "EnumFontFamiliesExA");
6213 /* We don't really expect EnumFontFamiliesEx to disappear once we
6214 get here, so don't bother handling it gracefully. */
6215 if (enum_font_families_ex
== NULL
)
6216 error ("gdi32.dll has disappeared!");
6217 return enum_font_families_ex (lpef
->hdc
,
6219 (FONTENUMPROC
) enum_fontex_cb2
,
6223 /* Interface to fontset handler. (adapted from mw32font.c in Meadow
6224 and xterm.c in Emacs 20.3) */
6227 w32_list_bdf_fonts (Lisp_Object pattern
, int max_names
)
6229 char *fontname
, *ptnstr
;
6230 Lisp_Object list
, tem
, newlist
= Qnil
;
6233 list
= Vw32_bdf_filename_alist
;
6234 ptnstr
= SDATA (pattern
);
6236 for ( ; CONSP (list
); list
= XCDR (list
))
6240 fontname
= SDATA (XCAR (tem
));
6241 else if (STRINGP (tem
))
6242 fontname
= SDATA (tem
);
6246 if (w32_font_match (fontname
, ptnstr
))
6248 newlist
= Fcons (XCAR (tem
), newlist
);
6250 if (max_names
>= 0 && n_fonts
>= max_names
)
6259 /* Return a list of names of available fonts matching PATTERN on frame
6260 F. If SIZE is not 0, it is the size (maximum bound width) of fonts
6261 to be listed. Frame F NULL means we have not yet created any
6262 frame, which means we can't get proper size info, as we don't have
6263 a device context to use for GetTextMetrics.
6264 MAXNAMES sets a limit on how many fonts to match. If MAXNAMES is
6265 negative, then all matching fonts are returned. */
6268 w32_list_fonts (f
, pattern
, size
, maxnames
)
6270 Lisp_Object pattern
;
6274 Lisp_Object patterns
, key
= Qnil
, tem
, tpat
;
6275 Lisp_Object list
= Qnil
, newlist
= Qnil
, second_best
= Qnil
;
6276 struct w32_display_info
*dpyinfo
= &one_w32_display_info
;
6279 patterns
= Fassoc (pattern
, Valternate_fontname_alist
);
6280 if (NILP (patterns
))
6281 patterns
= Fcons (pattern
, Qnil
);
6283 for (; CONSP (patterns
); patterns
= XCDR (patterns
))
6288 tpat
= XCAR (patterns
);
6290 if (!STRINGP (tpat
))
6293 /* Avoid expensive EnumFontFamilies functions if we are not
6294 going to be able to output one of these anyway. */
6295 codepage
= w32_codepage_for_font (SDATA (tpat
));
6296 if (codepage
!= CP_8BIT
&& codepage
!= CP_UNICODE
6297 && codepage
!= CP_DEFAULT
&& codepage
!= CP_UNKNOWN
6298 && !IsValidCodePage (codepage
))
6301 /* See if we cached the result for this particular query.
6302 The cache is an alist of the form:
6303 ((PATTERN (FONTNAME . WIDTH) ...) ...)
6305 if (tem
= XCDR (dpyinfo
->name_list_element
),
6306 !NILP (list
= Fassoc (tpat
, tem
)))
6308 list
= Fcdr_safe (list
);
6309 /* We have a cached list. Don't have to get the list again. */
6314 /* At first, put PATTERN in the cache. */
6319 /* Use EnumFontFamiliesEx where it is available, as it knows
6320 about character sets. Fall back to EnumFontFamilies for
6321 older versions of NT that don't support the 'Ex function. */
6322 x_to_w32_font (SDATA (tpat
), &ef
.logfont
);
6324 LOGFONT font_match_pattern
;
6325 HMODULE gdi32
= GetModuleHandle ("gdi32.dll");
6326 FARPROC enum_font_families_ex
6327 = GetProcAddress ( gdi32
, "EnumFontFamiliesExA");
6329 /* We do our own pattern matching so we can handle wildcards. */
6330 font_match_pattern
.lfFaceName
[0] = 0;
6331 font_match_pattern
.lfPitchAndFamily
= 0;
6332 /* We can use the charset, because if it is a wildcard it will
6333 be DEFAULT_CHARSET anyway. */
6334 font_match_pattern
.lfCharSet
= ef
.logfont
.lfCharSet
;
6336 ef
.hdc
= GetDC (dpyinfo
->root_window
);
6338 if (enum_font_families_ex
)
6339 enum_font_families_ex (ef
.hdc
,
6340 &font_match_pattern
,
6341 (FONTENUMPROC
) enum_fontex_cb1
,
6344 EnumFontFamilies (ef
.hdc
, NULL
, (FONTENUMPROC
) enum_font_cb1
,
6347 ReleaseDC (dpyinfo
->root_window
, ef
.hdc
);
6353 /* Make a list of the fonts we got back.
6354 Store that in the font cache for the display. */
6355 XSETCDR (dpyinfo
->name_list_element
,
6356 Fcons (Fcons (tpat
, list
),
6357 XCDR (dpyinfo
->name_list_element
)));
6360 if (NILP (list
)) continue; /* Try the remaining alternatives. */
6362 newlist
= second_best
= Qnil
;
6364 /* Make a list of the fonts that have the right width. */
6365 for (; CONSP (list
); list
= XCDR (list
))
6372 if (NILP (XCAR (tem
)))
6376 newlist
= Fcons (XCAR (tem
), newlist
);
6378 if (maxnames
>= 0 && n_fonts
>= maxnames
)
6383 if (!INTEGERP (XCDR (tem
)))
6385 /* Since we don't yet know the size of the font, we must
6386 load it and try GetTextMetrics. */
6387 W32FontStruct thisinfo
;
6392 if (!x_to_w32_font (SDATA (XCAR (tem
)), &lf
))
6396 thisinfo
.bdf
= NULL
;
6397 thisinfo
.hfont
= CreateFontIndirect (&lf
);
6398 if (thisinfo
.hfont
== NULL
)
6401 hdc
= GetDC (dpyinfo
->root_window
);
6402 oldobj
= SelectObject (hdc
, thisinfo
.hfont
);
6403 if (GetTextMetrics (hdc
, &thisinfo
.tm
))
6404 XSETCDR (tem
, make_number (FONT_AVG_WIDTH (&thisinfo
)));
6406 XSETCDR (tem
, make_number (0));
6407 SelectObject (hdc
, oldobj
);
6408 ReleaseDC (dpyinfo
->root_window
, hdc
);
6409 DeleteObject (thisinfo
.hfont
);
6412 found_size
= XINT (XCDR (tem
));
6413 if (found_size
== size
)
6415 newlist
= Fcons (XCAR (tem
), newlist
);
6417 if (maxnames
>= 0 && n_fonts
>= maxnames
)
6420 /* keep track of the closest matching size in case
6421 no exact match is found. */
6422 else if (found_size
> 0)
6424 if (NILP (second_best
))
6427 else if (found_size
< size
)
6429 if (XINT (XCDR (second_best
)) > size
6430 || XINT (XCDR (second_best
)) < found_size
)
6435 if (XINT (XCDR (second_best
)) > size
6436 && XINT (XCDR (second_best
)) >
6443 if (!NILP (newlist
))
6445 else if (!NILP (second_best
))
6447 newlist
= Fcons (XCAR (second_best
), Qnil
);
6452 /* Include any bdf fonts. */
6453 if (n_fonts
< maxnames
|| maxnames
< 0)
6455 Lisp_Object combined
[2];
6456 combined
[0] = w32_list_bdf_fonts (pattern
, maxnames
- n_fonts
);
6457 combined
[1] = newlist
;
6458 newlist
= Fnconc (2, combined
);
6465 /* Return a pointer to struct font_info of font FONT_IDX of frame F. */
6467 w32_get_font_info (f
, font_idx
)
6471 return (FRAME_W32_FONT_TABLE (f
) + font_idx
);
6476 w32_query_font (struct frame
*f
, char *fontname
)
6479 struct font_info
*pfi
;
6481 pfi
= FRAME_W32_FONT_TABLE (f
);
6483 for (i
= 0; i
< one_w32_display_info
.n_fonts
;i
++, pfi
++)
6485 if (stricmp (pfi
->name
, fontname
) == 0) return pfi
;
6491 /* Find a CCL program for a font specified by FONTP, and set the member
6492 `encoder' of the structure. */
6495 w32_find_ccl_program (fontp
)
6496 struct font_info
*fontp
;
6498 Lisp_Object list
, elt
;
6500 for (list
= Vfont_ccl_encoder_alist
; CONSP (list
); list
= XCDR (list
))
6504 && STRINGP (XCAR (elt
))
6505 && (fast_c_string_match_ignore_case (XCAR (elt
), fontp
->name
)
6511 struct ccl_program
*ccl
6512 = (struct ccl_program
*) xmalloc (sizeof (struct ccl_program
));
6514 if (setup_ccl_program (ccl
, XCDR (elt
)) < 0)
6517 fontp
->font_encoder
= ccl
;
6521 /* directory-files from dired.c. */
6522 Lisp_Object Fdirectory_files
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
, Lisp_Object
));
6525 /* Find BDF files in a specified directory. (use GCPRO when calling,
6526 as this calls lisp to get a directory listing). */
6528 w32_find_bdf_fonts_in_dir (Lisp_Object directory
)
6530 Lisp_Object filelist
, list
= Qnil
;
6533 if (!STRINGP (directory
))
6536 filelist
= Fdirectory_files (directory
, Qt
,
6537 build_string (".*\\.[bB][dD][fF]"), Qt
);
6539 for ( ; CONSP (filelist
); filelist
= XCDR (filelist
))
6541 Lisp_Object filename
= XCAR (filelist
);
6542 if (w32_BDF_to_x_font (SDATA (filename
), fontname
, 100))
6543 store_in_alist (&list
, build_string (fontname
), filename
);
6548 DEFUN ("w32-find-bdf-fonts", Fw32_find_bdf_fonts
, Sw32_find_bdf_fonts
,
6550 doc
: /* Return a list of BDF fonts in DIRECTORY.
6551 The list is suitable for appending to `w32-bdf-filename-alist'.
6552 Fonts which do not contain an xlfd description will not be included
6553 in the list. DIRECTORY may be a list of directories. */)
6555 Lisp_Object directory
;
6557 Lisp_Object list
= Qnil
;
6558 struct gcpro gcpro1
, gcpro2
;
6560 if (!CONSP (directory
))
6561 return w32_find_bdf_fonts_in_dir (directory
);
6563 for ( ; CONSP (directory
); directory
= XCDR (directory
))
6565 Lisp_Object pair
[2];
6568 GCPRO2 (directory
, list
);
6569 pair
[1] = w32_find_bdf_fonts_in_dir ( XCAR (directory
) );
6570 list
= Fnconc ( 2, pair
);
6577 DEFUN ("xw-color-defined-p", Fxw_color_defined_p
, Sxw_color_defined_p
, 1, 2, 0,
6578 doc
: /* Internal function called by `color-defined-p', which see. */)
6580 Lisp_Object color
, frame
;
6583 FRAME_PTR f
= check_x_frame (frame
);
6585 CHECK_STRING (color
);
6587 if (w32_defined_color (f
, SDATA (color
), &foo
, 0))
6593 DEFUN ("xw-color-values", Fxw_color_values
, Sxw_color_values
, 1, 2, 0,
6594 doc
: /* Internal function called by `color-values', which see. */)
6596 Lisp_Object color
, frame
;
6599 FRAME_PTR f
= check_x_frame (frame
);
6601 CHECK_STRING (color
);
6603 if (w32_defined_color (f
, SDATA (color
), &foo
, 0))
6604 return list3 (make_number ((GetRValue (foo
.pixel
) << 8)
6605 | GetRValue (foo
.pixel
)),
6606 make_number ((GetGValue (foo
.pixel
) << 8)
6607 | GetGValue (foo
.pixel
)),
6608 make_number ((GetBValue (foo
.pixel
) << 8)
6609 | GetBValue (foo
.pixel
)));
6614 DEFUN ("xw-display-color-p", Fxw_display_color_p
, Sxw_display_color_p
, 0, 1, 0,
6615 doc
: /* Internal function called by `display-color-p', which see. */)
6617 Lisp_Object display
;
6619 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6621 if ((dpyinfo
->n_planes
* dpyinfo
->n_cbits
) <= 2)
6627 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p
,
6628 Sx_display_grayscale_p
, 0, 1, 0,
6629 doc
: /* Return t if DISPLAY supports shades of gray.
6630 Note that color displays do support shades of gray.
6631 The optional argument DISPLAY specifies which display to ask about.
6632 DISPLAY should be either a frame or a display name (a string).
6633 If omitted or nil, that stands for the selected frame's display. */)
6635 Lisp_Object display
;
6637 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6639 if ((dpyinfo
->n_planes
* dpyinfo
->n_cbits
) <= 1)
6645 DEFUN ("x-display-pixel-width", Fx_display_pixel_width
,
6646 Sx_display_pixel_width
, 0, 1, 0,
6647 doc
: /* Return the width in pixels of DISPLAY.
6648 The optional argument DISPLAY specifies which display to ask about.
6649 DISPLAY should be either a frame or a display name (a string).
6650 If omitted or nil, that stands for the selected frame's display. */)
6652 Lisp_Object display
;
6654 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6656 return make_number (dpyinfo
->width
);
6659 DEFUN ("x-display-pixel-height", Fx_display_pixel_height
,
6660 Sx_display_pixel_height
, 0, 1, 0,
6661 doc
: /* Return the height in pixels of DISPLAY.
6662 The optional argument DISPLAY specifies which display to ask about.
6663 DISPLAY should be either a frame or a display name (a string).
6664 If omitted or nil, that stands for the selected frame's display. */)
6666 Lisp_Object display
;
6668 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6670 return make_number (dpyinfo
->height
);
6673 DEFUN ("x-display-planes", Fx_display_planes
, Sx_display_planes
,
6675 doc
: /* Return the number of bitplanes of DISPLAY.
6676 The optional argument DISPLAY specifies which display to ask about.
6677 DISPLAY should be either a frame or a display name (a string).
6678 If omitted or nil, that stands for the selected frame's display. */)
6680 Lisp_Object display
;
6682 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6684 return make_number (dpyinfo
->n_planes
* dpyinfo
->n_cbits
);
6687 DEFUN ("x-display-color-cells", Fx_display_color_cells
, Sx_display_color_cells
,
6689 doc
: /* Return the number of color cells of DISPLAY.
6690 The optional argument DISPLAY specifies which display to ask about.
6691 DISPLAY should be either a frame or a display name (a string).
6692 If omitted or nil, that stands for the selected frame's display. */)
6694 Lisp_Object display
;
6696 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6700 hdc
= GetDC (dpyinfo
->root_window
);
6701 if (dpyinfo
->has_palette
)
6702 cap
= GetDeviceCaps (hdc
, SIZEPALETTE
);
6704 cap
= GetDeviceCaps (hdc
, NUMCOLORS
);
6706 /* We force 24+ bit depths to 24-bit, both to prevent an overflow
6707 and because probably is more meaningful on Windows anyway */
6709 cap
= 1 << min (dpyinfo
->n_planes
* dpyinfo
->n_cbits
, 24);
6711 ReleaseDC (dpyinfo
->root_window
, hdc
);
6713 return make_number (cap
);
6716 DEFUN ("x-server-max-request-size", Fx_server_max_request_size
,
6717 Sx_server_max_request_size
,
6719 doc
: /* Return the maximum request size of the server of DISPLAY.
6720 The optional argument DISPLAY specifies which display to ask about.
6721 DISPLAY should be either a frame or a display name (a string).
6722 If omitted or nil, that stands for the selected frame's display. */)
6724 Lisp_Object display
;
6726 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6728 return make_number (1);
6731 DEFUN ("x-server-vendor", Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
6732 doc
: /* Return the "vendor ID" string of the W32 system (Microsoft).
6733 The optional argument DISPLAY specifies which display to ask about.
6734 DISPLAY should be either a frame or a display name (a string).
6735 If omitted or nil, that stands for the selected frame's display. */)
6737 Lisp_Object display
;
6739 return build_string ("Microsoft Corp.");
6742 DEFUN ("x-server-version", Fx_server_version
, Sx_server_version
, 0, 1, 0,
6743 doc
: /* Return the version numbers of the server of DISPLAY.
6744 The value is a list of three integers: the major and minor
6745 version numbers of the X Protocol in use, and the distributor-specific
6746 release number. See also the function `x-server-vendor'.
6748 The optional argument DISPLAY specifies which display to ask about.
6749 DISPLAY should be either a frame or a display name (a string).
6750 If omitted or nil, that stands for the selected frame's display. */)
6752 Lisp_Object display
;
6754 return Fcons (make_number (w32_major_version
),
6755 Fcons (make_number (w32_minor_version
),
6756 Fcons (make_number (w32_build_number
), Qnil
)));
6759 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
6760 doc
: /* Return the number of screens on the server of DISPLAY.
6761 The optional argument DISPLAY specifies which display to ask about.
6762 DISPLAY should be either a frame or a display name (a string).
6763 If omitted or nil, that stands for the selected frame's display. */)
6765 Lisp_Object display
;
6767 return make_number (1);
6770 DEFUN ("x-display-mm-height", Fx_display_mm_height
,
6771 Sx_display_mm_height
, 0, 1, 0,
6772 doc
: /* Return the height in millimeters of DISPLAY.
6773 The optional argument DISPLAY specifies which display to ask about.
6774 DISPLAY should be either a frame or a display name (a string).
6775 If omitted or nil, that stands for the selected frame's display. */)
6777 Lisp_Object display
;
6779 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6783 hdc
= GetDC (dpyinfo
->root_window
);
6785 cap
= GetDeviceCaps (hdc
, VERTSIZE
);
6787 ReleaseDC (dpyinfo
->root_window
, hdc
);
6789 return make_number (cap
);
6792 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
6793 doc
: /* Return the width in millimeters of DISPLAY.
6794 The optional argument DISPLAY specifies which display to ask about.
6795 DISPLAY should be either a frame or a display name (a string).
6796 If omitted or nil, that stands for the selected frame's display. */)
6798 Lisp_Object display
;
6800 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6805 hdc
= GetDC (dpyinfo
->root_window
);
6807 cap
= GetDeviceCaps (hdc
, HORZSIZE
);
6809 ReleaseDC (dpyinfo
->root_window
, hdc
);
6811 return make_number (cap
);
6814 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
6815 Sx_display_backing_store
, 0, 1, 0,
6816 doc
: /* Return an indication of whether DISPLAY does backing store.
6817 The value may be `always', `when-mapped', or `not-useful'.
6818 The optional argument DISPLAY specifies which display to ask about.
6819 DISPLAY should be either a frame or a display name (a string).
6820 If omitted or nil, that stands for the selected frame's display. */)
6822 Lisp_Object display
;
6824 return intern ("not-useful");
6827 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
6828 Sx_display_visual_class
, 0, 1, 0,
6829 doc
: /* Return the visual class of DISPLAY.
6830 The value is one of the symbols `static-gray', `gray-scale',
6831 `static-color', `pseudo-color', `true-color', or `direct-color'.
6833 The optional argument DISPLAY specifies which display to ask about.
6834 DISPLAY should be either a frame or a display name (a string).
6835 If omitted or nil, that stands for the selected frame's display. */)
6837 Lisp_Object display
;
6839 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6840 Lisp_Object result
= Qnil
;
6842 if (dpyinfo
->has_palette
)
6843 result
= intern ("pseudo-color");
6844 else if (dpyinfo
->n_planes
* dpyinfo
->n_cbits
== 1)
6845 result
= intern ("static-grey");
6846 else if (dpyinfo
->n_planes
* dpyinfo
->n_cbits
== 4)
6847 result
= intern ("static-color");
6848 else if (dpyinfo
->n_planes
* dpyinfo
->n_cbits
> 8)
6849 result
= intern ("true-color");
6854 DEFUN ("x-display-save-under", Fx_display_save_under
,
6855 Sx_display_save_under
, 0, 1, 0,
6856 doc
: /* Return t if DISPLAY supports the save-under feature.
6857 The optional argument DISPLAY specifies which display to ask about.
6858 DISPLAY should be either a frame or a display name (a string).
6859 If omitted or nil, that stands for the selected frame's display. */)
6861 Lisp_Object display
;
6868 register struct frame
*f
;
6870 return FRAME_PIXEL_WIDTH (f
);
6875 register struct frame
*f
;
6877 return FRAME_PIXEL_HEIGHT (f
);
6882 register struct frame
*f
;
6884 return FRAME_COLUMN_WIDTH (f
);
6889 register struct frame
*f
;
6891 return FRAME_LINE_HEIGHT (f
);
6896 register struct frame
*f
;
6898 return FRAME_W32_DISPLAY_INFO (f
)->n_planes
;
6901 /* Return the display structure for the display named NAME.
6902 Open a new connection if necessary. */
6904 struct w32_display_info
*
6905 x_display_info_for_name (name
)
6909 struct w32_display_info
*dpyinfo
;
6911 CHECK_STRING (name
);
6913 for (dpyinfo
= &one_w32_display_info
, names
= w32_display_name_list
;
6915 dpyinfo
= dpyinfo
->next
, names
= XCDR (names
))
6918 tem
= Fstring_equal (XCAR (XCAR (names
)), name
);
6923 /* Use this general default value to start with. */
6924 Vx_resource_name
= Vinvocation_name
;
6926 validate_x_resource_name ();
6928 dpyinfo
= w32_term_init (name
, (unsigned char *)0,
6929 (char *) SDATA (Vx_resource_name
));
6932 error ("Cannot connect to server %s", SDATA (name
));
6935 XSETFASTINT (Vwindow_system_version
, 3);
6940 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
6941 1, 3, 0, doc
: /* Open a connection to a server.
6942 DISPLAY is the name of the display to connect to.
6943 Optional second arg XRM-STRING is a string of resources in xrdb format.
6944 If the optional third arg MUST-SUCCEED is non-nil,
6945 terminate Emacs if we can't open the connection. */)
6946 (display
, xrm_string
, must_succeed
)
6947 Lisp_Object display
, xrm_string
, must_succeed
;
6949 unsigned char *xrm_option
;
6950 struct w32_display_info
*dpyinfo
;
6952 /* If initialization has already been done, return now to avoid
6953 overwriting critical parts of one_w32_display_info. */
6957 CHECK_STRING (display
);
6958 if (! NILP (xrm_string
))
6959 CHECK_STRING (xrm_string
);
6962 if (! EQ (Vwindow_system
, intern ("w32")))
6963 error ("Not using Microsoft Windows");
6966 /* Allow color mapping to be defined externally; first look in user's
6967 HOME directory, then in Emacs etc dir for a file called rgb.txt. */
6969 Lisp_Object color_file
;
6970 struct gcpro gcpro1
;
6972 color_file
= build_string ("~/rgb.txt");
6974 GCPRO1 (color_file
);
6976 if (NILP (Ffile_readable_p (color_file
)))
6978 Fexpand_file_name (build_string ("rgb.txt"),
6979 Fsymbol_value (intern ("data-directory")));
6981 Vw32_color_map
= Fw32_load_color_file (color_file
);
6985 if (NILP (Vw32_color_map
))
6986 Vw32_color_map
= Fw32_default_color_map ();
6988 /* Merge in system logical colors. */
6989 add_system_logical_colors_to_map (&Vw32_color_map
);
6991 if (! NILP (xrm_string
))
6992 xrm_option
= (unsigned char *) SDATA (xrm_string
);
6994 xrm_option
= (unsigned char *) 0;
6996 /* Use this general default value to start with. */
6997 /* First remove .exe suffix from invocation-name - it looks ugly. */
6999 char basename
[ MAX_PATH
], *str
;
7001 strcpy (basename
, SDATA (Vinvocation_name
));
7002 str
= strrchr (basename
, '.');
7004 Vinvocation_name
= build_string (basename
);
7006 Vx_resource_name
= Vinvocation_name
;
7008 validate_x_resource_name ();
7010 /* This is what opens the connection and sets x_current_display.
7011 This also initializes many symbols, such as those used for input. */
7012 dpyinfo
= w32_term_init (display
, xrm_option
,
7013 (char *) SDATA (Vx_resource_name
));
7017 if (!NILP (must_succeed
))
7018 fatal ("Cannot connect to server %s.\n",
7021 error ("Cannot connect to server %s", SDATA (display
));
7026 XSETFASTINT (Vwindow_system_version
, 3);
7030 DEFUN ("x-close-connection", Fx_close_connection
,
7031 Sx_close_connection
, 1, 1, 0,
7032 doc
: /* Close the connection to DISPLAY's server.
7033 For DISPLAY, specify either a frame or a display name (a string).
7034 If DISPLAY is nil, that stands for the selected frame's display. */)
7036 Lisp_Object display
;
7038 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7041 if (dpyinfo
->reference_count
> 0)
7042 error ("Display still has frames on it");
7045 /* Free the fonts in the font table. */
7046 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
7047 if (dpyinfo
->font_table
[i
].name
)
7049 if (dpyinfo
->font_table
[i
].name
!= dpyinfo
->font_table
[i
].full_name
)
7050 xfree (dpyinfo
->font_table
[i
].full_name
);
7051 xfree (dpyinfo
->font_table
[i
].name
);
7052 w32_unload_font (dpyinfo
, dpyinfo
->font_table
[i
].font
);
7054 x_destroy_all_bitmaps (dpyinfo
);
7056 x_delete_display (dpyinfo
);
7062 DEFUN ("x-display-list", Fx_display_list
, Sx_display_list
, 0, 0, 0,
7063 doc
: /* Return the list of display names that Emacs has connections to. */)
7066 Lisp_Object tail
, result
;
7069 for (tail
= w32_display_name_list
; CONSP (tail
); tail
= XCDR (tail
))
7070 result
= Fcons (XCAR (XCAR (tail
)), result
);
7075 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
, 1, 2, 0,
7076 doc
: /* This is a noop on W32 systems. */)
7078 Lisp_Object display
, on
;
7085 /***********************************************************************
7087 ***********************************************************************/
7089 DEFUN ("x-change-window-property", Fx_change_window_property
,
7090 Sx_change_window_property
, 2, 6, 0,
7091 doc
: /* Change window property PROP to VALUE on the X window of FRAME.
7092 VALUE may be a string or a list of conses, numbers and/or strings.
7093 If an element in the list is a string, it is converted to
7094 an Atom and the value of the Atom is used. If an element is a cons,
7095 it is converted to a 32 bit number where the car is the 16 top bits and the
7096 cdr is the lower 16 bits.
7097 FRAME nil or omitted means use the selected frame.
7098 If TYPE is given and non-nil, it is the name of the type of VALUE.
7099 If TYPE is not given or nil, the type is STRING.
7100 FORMAT gives the size in bits of each element if VALUE is a list.
7101 It must be one of 8, 16 or 32.
7102 If VALUE is a string or FORMAT is nil or not given, FORMAT defaults to 8.
7103 If OUTER_P is non-nil, the property is changed for the outer X window of
7104 FRAME. Default is to change on the edit X window.
7107 (prop
, value
, frame
, type
, format
, outer_p
)
7108 Lisp_Object prop
, value
, frame
, type
, format
, outer_p
;
7110 #if 0 /* TODO : port window properties to W32 */
7111 struct frame
*f
= check_x_frame (frame
);
7114 CHECK_STRING (prop
);
7115 CHECK_STRING (value
);
7118 prop_atom
= XInternAtom (FRAME_W32_DISPLAY (f
), SDATA (prop
), False
);
7119 XChangeProperty (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
),
7120 prop_atom
, XA_STRING
, 8, PropModeReplace
,
7121 SDATA (value
), SCHARS (value
));
7123 /* Make sure the property is set when we return. */
7124 XFlush (FRAME_W32_DISPLAY (f
));
7133 DEFUN ("x-delete-window-property", Fx_delete_window_property
,
7134 Sx_delete_window_property
, 1, 2, 0,
7135 doc
: /* Remove window property PROP from X window of FRAME.
7136 FRAME nil or omitted means use the selected frame. Value is PROP. */)
7138 Lisp_Object prop
, frame
;
7140 #if 0 /* TODO : port window properties to W32 */
7142 struct frame
*f
= check_x_frame (frame
);
7145 CHECK_STRING (prop
);
7147 prop_atom
= XInternAtom (FRAME_W32_DISPLAY (f
), SDATA (prop
), False
);
7148 XDeleteProperty (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
), prop_atom
);
7150 /* Make sure the property is removed when we return. */
7151 XFlush (FRAME_W32_DISPLAY (f
));
7159 DEFUN ("x-window-property", Fx_window_property
, Sx_window_property
,
7161 doc
: /* Value is the value of window property PROP on FRAME.
7162 If FRAME is nil or omitted, use the selected frame. Value is nil
7163 if FRAME hasn't a property with name PROP or if PROP has no string
7166 Lisp_Object prop
, frame
;
7168 #if 0 /* TODO : port window properties to W32 */
7170 struct frame
*f
= check_x_frame (frame
);
7173 Lisp_Object prop_value
= Qnil
;
7174 char *tmp_data
= NULL
;
7177 unsigned long actual_size
, bytes_remaining
;
7179 CHECK_STRING (prop
);
7181 prop_atom
= XInternAtom (FRAME_W32_DISPLAY (f
), SDATA (prop
), False
);
7182 rc
= XGetWindowProperty (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
),
7183 prop_atom
, 0, 0, False
, XA_STRING
,
7184 &actual_type
, &actual_format
, &actual_size
,
7185 &bytes_remaining
, (unsigned char **) &tmp_data
);
7188 int size
= bytes_remaining
;
7193 rc
= XGetWindowProperty (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
),
7194 prop_atom
, 0, bytes_remaining
,
7196 &actual_type
, &actual_format
,
7197 &actual_size
, &bytes_remaining
,
7198 (unsigned char **) &tmp_data
);
7200 prop_value
= make_string (tmp_data
, size
);
7215 /***********************************************************************
7217 ***********************************************************************/
7219 /* If non-null, an asynchronous timer that, when it expires, displays
7220 an hourglass cursor on all frames. */
7222 static struct atimer
*hourglass_atimer
;
7224 /* Non-zero means an hourglass cursor is currently shown. */
7226 static int hourglass_shown_p
;
7228 /* Number of seconds to wait before displaying an hourglass cursor. */
7230 static Lisp_Object Vhourglass_delay
;
7232 /* Default number of seconds to wait before displaying an hourglass
7235 #define DEFAULT_HOURGLASS_DELAY 1
7237 /* Function prototypes. */
7239 static void show_hourglass
P_ ((struct atimer
*));
7240 static void hide_hourglass
P_ ((void));
7243 /* Cancel a currently active hourglass timer, and start a new one. */
7248 #if 0 /* TODO: cursor shape changes. */
7250 int secs
, usecs
= 0;
7252 cancel_hourglass ();
7254 if (INTEGERP (Vhourglass_delay
)
7255 && XINT (Vhourglass_delay
) > 0)
7256 secs
= XFASTINT (Vhourglass_delay
);
7257 else if (FLOATP (Vhourglass_delay
)
7258 && XFLOAT_DATA (Vhourglass_delay
) > 0)
7261 tem
= Ftruncate (Vhourglass_delay
, Qnil
);
7262 secs
= XFASTINT (tem
);
7263 usecs
= (XFLOAT_DATA (Vhourglass_delay
) - secs
) * 1000000;
7266 secs
= DEFAULT_HOURGLASS_DELAY
;
7268 EMACS_SET_SECS_USECS (delay
, secs
, usecs
);
7269 hourglass_atimer
= start_atimer (ATIMER_RELATIVE
, delay
,
7270 show_hourglass
, NULL
);
7275 /* Cancel the hourglass cursor timer if active, hide an hourglass
7281 if (hourglass_atimer
)
7283 cancel_atimer (hourglass_atimer
);
7284 hourglass_atimer
= NULL
;
7287 if (hourglass_shown_p
)
7292 /* Timer function of hourglass_atimer. TIMER is equal to
7295 Display an hourglass cursor on all frames by mapping the frames'
7296 hourglass_window. Set the hourglass_p flag in the frames'
7297 output_data.x structure to indicate that an hourglass cursor is
7298 shown on the frames. */
7301 show_hourglass (timer
)
7302 struct atimer
*timer
;
7304 #if 0 /* TODO: cursor shape changes. */
7305 /* The timer implementation will cancel this timer automatically
7306 after this function has run. Set hourglass_atimer to null
7307 so that we know the timer doesn't have to be canceled. */
7308 hourglass_atimer
= NULL
;
7310 if (!hourglass_shown_p
)
7312 Lisp_Object rest
, frame
;
7316 FOR_EACH_FRAME (rest
, frame
)
7317 if (FRAME_W32_P (XFRAME (frame
)))
7319 struct frame
*f
= XFRAME (frame
);
7321 f
->output_data
.w32
->hourglass_p
= 1;
7323 if (!f
->output_data
.w32
->hourglass_window
)
7325 unsigned long mask
= CWCursor
;
7326 XSetWindowAttributes attrs
;
7328 attrs
.cursor
= f
->output_data
.w32
->hourglass_cursor
;
7330 f
->output_data
.w32
->hourglass_window
7331 = XCreateWindow (FRAME_X_DISPLAY (f
),
7332 FRAME_OUTER_WINDOW (f
),
7333 0, 0, 32000, 32000, 0, 0,
7339 XMapRaised (FRAME_X_DISPLAY (f
),
7340 f
->output_data
.w32
->hourglass_window
);
7341 XFlush (FRAME_X_DISPLAY (f
));
7344 hourglass_shown_p
= 1;
7351 /* Hide the hourglass cursor on all frames, if it is currently shown. */
7356 #if 0 /* TODO: cursor shape changes. */
7357 if (hourglass_shown_p
)
7359 Lisp_Object rest
, frame
;
7362 FOR_EACH_FRAME (rest
, frame
)
7364 struct frame
*f
= XFRAME (frame
);
7367 /* Watch out for newly created frames. */
7368 && f
->output_data
.x
->hourglass_window
)
7370 XUnmapWindow (FRAME_X_DISPLAY (f
),
7371 f
->output_data
.x
->hourglass_window
);
7372 /* Sync here because XTread_socket looks at the
7373 hourglass_p flag that is reset to zero below. */
7374 XSync (FRAME_X_DISPLAY (f
), False
);
7375 f
->output_data
.x
->hourglass_p
= 0;
7379 hourglass_shown_p
= 0;
7387 /***********************************************************************
7389 ***********************************************************************/
7391 static Lisp_Object x_create_tip_frame
P_ ((struct w32_display_info
*,
7392 Lisp_Object
, Lisp_Object
));
7393 static void compute_tip_xy
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
7394 Lisp_Object
, int, int, int *, int *));
7396 /* The frame of a currently visible tooltip. */
7398 Lisp_Object tip_frame
;
7400 /* If non-nil, a timer started that hides the last tooltip when it
7403 Lisp_Object tip_timer
;
7406 /* If non-nil, a vector of 3 elements containing the last args
7407 with which x-show-tip was called. See there. */
7409 Lisp_Object last_show_tip_args
;
7411 /* Maximum size for tooltips; a cons (COLUMNS . ROWS). */
7413 Lisp_Object Vx_max_tooltip_size
;
7417 unwind_create_tip_frame (frame
)
7420 Lisp_Object deleted
;
7422 deleted
= unwind_create_frame (frame
);
7423 if (EQ (deleted
, Qt
))
7433 /* Create a frame for a tooltip on the display described by DPYINFO.
7434 PARMS is a list of frame parameters. TEXT is the string to
7435 display in the tip frame. Value is the frame.
7437 Note that functions called here, esp. x_default_parameter can
7438 signal errors, for instance when a specified color name is
7439 undefined. We have to make sure that we're in a consistent state
7440 when this happens. */
7443 x_create_tip_frame (dpyinfo
, parms
, text
)
7444 struct w32_display_info
*dpyinfo
;
7445 Lisp_Object parms
, text
;
7448 Lisp_Object frame
, tem
;
7450 long window_prompting
= 0;
7452 int count
= SPECPDL_INDEX ();
7453 struct gcpro gcpro1
, gcpro2
, gcpro3
;
7455 int face_change_count_before
= face_change_count
;
7457 struct buffer
*old_buffer
;
7461 /* Use this general default value to start with until we know if
7462 this frame has a specified name. */
7463 Vx_resource_name
= Vinvocation_name
;
7466 kb
= dpyinfo
->terminal
->kboard
;
7468 kb
= &the_only_kboard
;
7471 /* Get the name of the frame to use for resource lookup. */
7472 name
= w32_get_arg (parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
7474 && !EQ (name
, Qunbound
)
7476 error ("Invalid frame name--not a string or nil");
7477 Vx_resource_name
= name
;
7480 GCPRO3 (parms
, name
, frame
);
7481 /* Make a frame without minibuffer nor mode-line. */
7483 f
->wants_modeline
= 0;
7484 XSETFRAME (frame
, f
);
7486 buffer
= Fget_buffer_create (build_string (" *tip*"));
7487 Fset_window_buffer (FRAME_ROOT_WINDOW (f
), buffer
, Qnil
);
7488 old_buffer
= current_buffer
;
7489 set_buffer_internal_1 (XBUFFER (buffer
));
7490 current_buffer
->truncate_lines
= Qnil
;
7491 specbind (Qinhibit_read_only
, Qt
);
7492 specbind (Qinhibit_modification_hooks
, Qt
);
7495 set_buffer_internal_1 (old_buffer
);
7497 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 0;
7498 record_unwind_protect (unwind_create_tip_frame
, frame
);
7500 /* By setting the output method, we're essentially saying that
7501 the frame is live, as per FRAME_LIVE_P. If we get a signal
7502 from this point on, x_destroy_window might screw up reference
7504 f
->terminal
= dpyinfo
->terminal
;
7505 f
->terminal
->reference_count
++;
7506 f
->output_method
= output_w32
;
7507 f
->output_data
.w32
=
7508 (struct w32_output
*) xmalloc (sizeof (struct w32_output
));
7509 bzero (f
->output_data
.w32
, sizeof (struct w32_output
));
7511 FRAME_FONTSET (f
) = -1;
7512 f
->icon_name
= Qnil
;
7514 #if 0 /* GLYPH_DEBUG TODO: image support. */
7515 image_cache_refcount
= FRAME_IMAGE_CACHE (f
)->refcount
;
7516 dpyinfo_refcount
= dpyinfo
->reference_count
;
7517 #endif /* GLYPH_DEBUG */
7519 FRAME_KBOARD (f
) = kb
;
7521 f
->output_data
.w32
->parent_desc
= FRAME_W32_DISPLAY_INFO (f
)->root_window
;
7522 f
->output_data
.w32
->explicit_parent
= 0;
7524 /* Set the name; the functions to which we pass f expect the name to
7526 if (EQ (name
, Qunbound
) || NILP (name
))
7528 f
->name
= build_string (dpyinfo
->w32_id_name
);
7529 f
->explicit_name
= 0;
7534 f
->explicit_name
= 1;
7535 /* use the frame's title when getting resources for this frame. */
7536 specbind (Qx_resource_name
, name
);
7539 f
->resx
= dpyinfo
->resx
;
7540 f
->resy
= dpyinfo
->resy
;
7542 #ifdef USE_FONT_BACKEND
7543 if (enable_font_backend
)
7545 /* Perhaps, we must allow frame parameter, say `font-backend',
7546 to specify which font backends to use. */
7547 register_font_driver (&w32font_driver
, f
);
7549 x_default_parameter (f
, parms
, Qfont_backend
, Qnil
,
7550 "fontBackend", "FontBackend", RES_TYPE_STRING
);
7552 #endif /* USE_FONT_BACKEND */
7554 /* Extract the window parameters from the supplied values
7555 that are needed to determine window geometry. */
7556 #ifdef USE_FONT_BACKEND
7557 if (enable_font_backend
)
7558 x_default_font_parameter (f
, parms
);
7560 #endif /* USE_FONT_BACKEND */
7564 font
= w32_get_arg (parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
7567 /* First, try whatever font the caller has specified. */
7570 tem
= Fquery_fontset (font
, Qnil
);
7572 font
= x_new_fontset (f
, tem
);
7574 font
= x_new_font (f
, SDATA (font
));
7577 /* Try out a font which we hope has bold and italic variations. */
7578 if (!STRINGP (font
))
7579 font
= x_new_font (f
, "-*-Courier New-normal-r-*-*-*-100-*-*-c-*-iso8859-1");
7580 if (! STRINGP (font
))
7581 font
= x_new_font (f
, "-*-Courier-normal-r-*-*-13-*-*-*-c-*-iso8859-1");
7582 /* If those didn't work, look for something which will at least work. */
7583 if (! STRINGP (font
))
7584 font
= x_new_font (f
, "-*-Fixedsys-normal-r-*-*-12-*-*-*-c-*-iso8859-1");
7586 if (! STRINGP (font
))
7587 font
= build_string ("Fixedsys");
7589 x_default_parameter (f
, parms
, Qfont
, font
,
7590 "font", "Font", RES_TYPE_STRING
);
7593 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
7594 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
7595 /* This defaults to 2 in order to match xterm. We recognize either
7596 internalBorderWidth or internalBorder (which is what xterm calls
7598 if (NILP (Fassq (Qinternal_border_width
, parms
)))
7602 value
= w32_get_arg (parms
, Qinternal_border_width
,
7603 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
7604 if (! EQ (value
, Qunbound
))
7605 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
7608 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
7609 "internalBorderWidth", "internalBorderWidth",
7612 /* Also do the stuff which must be set before the window exists. */
7613 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
7614 "foreground", "Foreground", RES_TYPE_STRING
);
7615 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
7616 "background", "Background", RES_TYPE_STRING
);
7617 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
7618 "pointerColor", "Foreground", RES_TYPE_STRING
);
7619 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
7620 "cursorColor", "Foreground", RES_TYPE_STRING
);
7621 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
7622 "borderColor", "BorderColor", RES_TYPE_STRING
);
7624 /* Init faces before x_default_parameter is called for scroll-bar
7625 parameters because that function calls x_set_scroll_bar_width,
7626 which calls change_frame_size, which calls Fset_window_buffer,
7627 which runs hooks, which call Fvertical_motion. At the end, we
7628 end up in init_iterator with a null face cache, which should not
7630 init_frame_faces (f
);
7632 f
->output_data
.w32
->dwStyle
= WS_BORDER
| WS_POPUP
| WS_DISABLED
;
7633 f
->output_data
.w32
->parent_desc
= FRAME_W32_DISPLAY_INFO (f
)->root_window
;
7635 window_prompting
= x_figure_window_size (f
, parms
, 0);
7637 /* No fringes on tip frame. */
7639 f
->left_fringe_width
= 0;
7640 f
->right_fringe_width
= 0;
7643 my_create_tip_window (f
);
7648 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
7649 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
7650 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
7651 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
7652 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
7653 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
7655 /* Dimensions, especially FRAME_LINES (f), must be done via change_frame_size.
7656 Change will not be effected unless different from the current
7658 width
= FRAME_COLS (f
);
7659 height
= FRAME_LINES (f
);
7660 FRAME_LINES (f
) = 0;
7661 SET_FRAME_COLS (f
, 0);
7662 change_frame_size (f
, height
, width
, 1, 0, 0);
7664 /* Add `tooltip' frame parameter's default value. */
7665 if (NILP (Fframe_parameter (frame
, intern ("tooltip"))))
7666 Fmodify_frame_parameters (frame
, Fcons (Fcons (intern ("tooltip"), Qt
),
7669 /* Set up faces after all frame parameters are known. This call
7670 also merges in face attributes specified for new frames.
7672 Frame parameters may be changed if .Xdefaults contains
7673 specifications for the default font. For example, if there is an
7674 `Emacs.default.attributeBackground: pink', the `background-color'
7675 attribute of the frame get's set, which let's the internal border
7676 of the tooltip frame appear in pink. Prevent this. */
7678 Lisp_Object bg
= Fframe_parameter (frame
, Qbackground_color
);
7680 /* Set tip_frame here, so that */
7682 call1 (Qface_set_after_frame_default
, frame
);
7684 if (!EQ (bg
, Fframe_parameter (frame
, Qbackground_color
)))
7685 Fmodify_frame_parameters (frame
, Fcons (Fcons (Qbackground_color
, bg
),
7693 /* It is now ok to make the frame official even if we get an error
7694 below. And the frame needs to be on Vframe_list or making it
7695 visible won't work. */
7696 Vframe_list
= Fcons (frame
, Vframe_list
);
7698 /* Now that the frame is official, it counts as a reference to
7700 FRAME_W32_DISPLAY_INFO (f
)->reference_count
++;
7702 /* Setting attributes of faces of the tooltip frame from resources
7703 and similar will increment face_change_count, which leads to the
7704 clearing of all current matrices. Since this isn't necessary
7705 here, avoid it by resetting face_change_count to the value it
7706 had before we created the tip frame. */
7707 face_change_count
= face_change_count_before
;
7709 /* Discard the unwind_protect. */
7710 return unbind_to (count
, frame
);
7714 /* Compute where to display tip frame F. PARMS is the list of frame
7715 parameters for F. DX and DY are specified offsets from the current
7716 location of the mouse. WIDTH and HEIGHT are the width and height
7717 of the tooltip. Return coordinates relative to the root window of
7718 the display in *ROOT_X, and *ROOT_Y. */
7721 compute_tip_xy (f
, parms
, dx
, dy
, width
, height
, root_x
, root_y
)
7723 Lisp_Object parms
, dx
, dy
;
7725 int *root_x
, *root_y
;
7727 Lisp_Object left
, top
;
7728 int min_x
, min_y
, max_x
, max_y
;
7730 /* User-specified position? */
7731 left
= Fcdr (Fassq (Qleft
, parms
));
7732 top
= Fcdr (Fassq (Qtop
, parms
));
7734 /* Move the tooltip window where the mouse pointer is. Resize and
7736 if (!INTEGERP (left
) || !INTEGERP (top
))
7740 /* Default min and max values. */
7743 max_x
= FRAME_W32_DISPLAY_INFO (f
)->width
;
7744 max_y
= FRAME_W32_DISPLAY_INFO (f
)->height
;
7752 /* If multiple monitor support is available, constrain the tip onto
7753 the current monitor. This improves the above by allowing negative
7754 co-ordinates if monitor positions are such that they are valid, and
7755 snaps a tooltip onto a single monitor if we are close to the edge
7756 where it would otherwise flow onto the other monitor (or into
7757 nothingness if there is a gap in the overlap). */
7758 if (monitor_from_point_fn
&& get_monitor_info_fn
)
7760 struct MONITOR_INFO info
;
7762 = monitor_from_point_fn (pt
, MONITOR_DEFAULT_TO_NEAREST
);
7763 info
.cbSize
= sizeof (info
);
7765 if (get_monitor_info_fn (monitor
, &info
))
7767 min_x
= info
.rcWork
.left
;
7768 min_y
= info
.rcWork
.top
;
7769 max_x
= info
.rcWork
.right
;
7770 max_y
= info
.rcWork
.bottom
;
7776 *root_y
= XINT (top
);
7777 else if (*root_y
+ XINT (dy
) <= min_y
)
7778 *root_y
= min_y
; /* Can happen for negative dy */
7779 else if (*root_y
+ XINT (dy
) + height
<= max_y
)
7780 /* It fits below the pointer */
7781 *root_y
+= XINT (dy
);
7782 else if (height
+ XINT (dy
) + min_y
<= *root_y
)
7783 /* It fits above the pointer. */
7784 *root_y
-= height
+ XINT (dy
);
7786 /* Put it on the top. */
7789 if (INTEGERP (left
))
7790 *root_x
= XINT (left
);
7791 else if (*root_x
+ XINT (dx
) <= min_x
)
7792 *root_x
= 0; /* Can happen for negative dx */
7793 else if (*root_x
+ XINT (dx
) + width
<= max_x
)
7794 /* It fits to the right of the pointer. */
7795 *root_x
+= XINT (dx
);
7796 else if (width
+ XINT (dx
) + min_x
<= *root_x
)
7797 /* It fits to the left of the pointer. */
7798 *root_x
-= width
+ XINT (dx
);
7800 /* Put it left justified on the screen -- it ought to fit that way. */
7805 DEFUN ("x-show-tip", Fx_show_tip
, Sx_show_tip
, 1, 6, 0,
7806 doc
: /* Show STRING in a \"tooltip\" window on frame FRAME.
7807 A tooltip window is a small window displaying a string.
7809 This is an internal function; Lisp code should call `tooltip-show'.
7811 FRAME nil or omitted means use the selected frame.
7813 PARMS is an optional list of frame parameters which can be
7814 used to change the tooltip's appearance.
7816 Automatically hide the tooltip after TIMEOUT seconds. TIMEOUT nil
7817 means use the default timeout of 5 seconds.
7819 If the list of frame parameters PARMS contains a `left' parameter,
7820 the tooltip is displayed at that x-position. Otherwise it is
7821 displayed at the mouse position, with offset DX added (default is 5 if
7822 DX isn't specified). Likewise for the y-position; if a `top' frame
7823 parameter is specified, it determines the y-position of the tooltip
7824 window, otherwise it is displayed at the mouse position, with offset
7825 DY added (default is -10).
7827 A tooltip's maximum size is specified by `x-max-tooltip-size'.
7828 Text larger than the specified size is clipped. */)
7829 (string
, frame
, parms
, timeout
, dx
, dy
)
7830 Lisp_Object string
, frame
, parms
, timeout
, dx
, dy
;
7835 struct buffer
*old_buffer
;
7836 struct text_pos pos
;
7837 int i
, width
, height
;
7838 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
7839 int old_windows_or_buffers_changed
= windows_or_buffers_changed
;
7840 int count
= SPECPDL_INDEX ();
7842 specbind (Qinhibit_redisplay
, Qt
);
7844 GCPRO4 (string
, parms
, frame
, timeout
);
7846 CHECK_STRING (string
);
7847 f
= check_x_frame (frame
);
7849 timeout
= make_number (5);
7851 CHECK_NATNUM (timeout
);
7854 dx
= make_number (5);
7859 dy
= make_number (-10);
7863 if (NILP (last_show_tip_args
))
7864 last_show_tip_args
= Fmake_vector (make_number (3), Qnil
);
7866 if (!NILP (tip_frame
))
7868 Lisp_Object last_string
= AREF (last_show_tip_args
, 0);
7869 Lisp_Object last_frame
= AREF (last_show_tip_args
, 1);
7870 Lisp_Object last_parms
= AREF (last_show_tip_args
, 2);
7872 if (EQ (frame
, last_frame
)
7873 && !NILP (Fequal (last_string
, string
))
7874 && !NILP (Fequal (last_parms
, parms
)))
7876 struct frame
*f
= XFRAME (tip_frame
);
7878 /* Only DX and DY have changed. */
7879 if (!NILP (tip_timer
))
7881 Lisp_Object timer
= tip_timer
;
7883 call1 (Qcancel_timer
, timer
);
7887 compute_tip_xy (f
, parms
, dx
, dy
, FRAME_PIXEL_WIDTH (f
),
7888 FRAME_PIXEL_HEIGHT (f
), &root_x
, &root_y
);
7890 /* Put tooltip in topmost group and in position. */
7891 SetWindowPos (FRAME_W32_WINDOW (f
), HWND_TOPMOST
,
7892 root_x
, root_y
, 0, 0,
7893 SWP_NOSIZE
| SWP_NOACTIVATE
);
7895 /* Ensure tooltip is on top of other topmost windows (eg menus). */
7896 SetWindowPos (FRAME_W32_WINDOW (f
), HWND_TOP
,
7898 SWP_NOMOVE
| SWP_NOSIZE
| SWP_NOACTIVATE
);
7905 /* Hide a previous tip, if any. */
7908 ASET (last_show_tip_args
, 0, string
);
7909 ASET (last_show_tip_args
, 1, frame
);
7910 ASET (last_show_tip_args
, 2, parms
);
7912 /* Add default values to frame parameters. */
7913 if (NILP (Fassq (Qname
, parms
)))
7914 parms
= Fcons (Fcons (Qname
, build_string ("tooltip")), parms
);
7915 if (NILP (Fassq (Qinternal_border_width
, parms
)))
7916 parms
= Fcons (Fcons (Qinternal_border_width
, make_number (3)), parms
);
7917 if (NILP (Fassq (Qborder_width
, parms
)))
7918 parms
= Fcons (Fcons (Qborder_width
, make_number (1)), parms
);
7919 if (NILP (Fassq (Qborder_color
, parms
)))
7920 parms
= Fcons (Fcons (Qborder_color
, build_string ("lightyellow")), parms
);
7921 if (NILP (Fassq (Qbackground_color
, parms
)))
7922 parms
= Fcons (Fcons (Qbackground_color
, build_string ("lightyellow")),
7925 /* Block input until the tip has been fully drawn, to avoid crashes
7926 when drawing tips in menus. */
7929 /* Create a frame for the tooltip, and record it in the global
7930 variable tip_frame. */
7931 frame
= x_create_tip_frame (FRAME_W32_DISPLAY_INFO (f
), parms
, string
);
7934 /* Set up the frame's root window. */
7935 w
= XWINDOW (FRAME_ROOT_WINDOW (f
));
7936 w
->left_col
= w
->top_line
= make_number (0);
7938 if (CONSP (Vx_max_tooltip_size
)
7939 && INTEGERP (XCAR (Vx_max_tooltip_size
))
7940 && XINT (XCAR (Vx_max_tooltip_size
)) > 0
7941 && INTEGERP (XCDR (Vx_max_tooltip_size
))
7942 && XINT (XCDR (Vx_max_tooltip_size
)) > 0)
7944 w
->total_cols
= XCAR (Vx_max_tooltip_size
);
7945 w
->total_lines
= XCDR (Vx_max_tooltip_size
);
7949 w
->total_cols
= make_number (80);
7950 w
->total_lines
= make_number (40);
7953 FRAME_TOTAL_COLS (f
) = XINT (w
->total_cols
);
7955 w
->pseudo_window_p
= 1;
7957 /* Display the tooltip text in a temporary buffer. */
7958 old_buffer
= current_buffer
;
7959 set_buffer_internal_1 (XBUFFER (XWINDOW (FRAME_ROOT_WINDOW (f
))->buffer
));
7960 current_buffer
->truncate_lines
= Qnil
;
7961 clear_glyph_matrix (w
->desired_matrix
);
7962 clear_glyph_matrix (w
->current_matrix
);
7963 SET_TEXT_POS (pos
, BEGV
, BEGV_BYTE
);
7964 try_window (FRAME_ROOT_WINDOW (f
), pos
, 0);
7966 /* Compute width and height of the tooltip. */
7968 for (i
= 0; i
< w
->desired_matrix
->nrows
; ++i
)
7970 struct glyph_row
*row
= &w
->desired_matrix
->rows
[i
];
7974 /* Stop at the first empty row at the end. */
7975 if (!row
->enabled_p
|| !row
->displays_text_p
)
7978 /* Let the row go over the full width of the frame. */
7979 row
->full_width_p
= 1;
7981 #ifdef TODO /* Investigate why some fonts need more width than is
7982 calculated for some tooltips. */
7983 /* There's a glyph at the end of rows that is use to place
7984 the cursor there. Don't include the width of this glyph. */
7985 if (row
->used
[TEXT_AREA
])
7987 last
= &row
->glyphs
[TEXT_AREA
][row
->used
[TEXT_AREA
] - 1];
7988 row_width
= row
->pixel_width
- last
->pixel_width
;
7992 row_width
= row
->pixel_width
;
7994 /* TODO: find why tips do not draw along baseline as instructed. */
7995 height
+= row
->height
;
7996 width
= max (width
, row_width
);
7999 /* Add the frame's internal border to the width and height the X
8000 window should have. */
8001 height
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
8002 width
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
8004 /* Move the tooltip window where the mouse pointer is. Resize and
8006 compute_tip_xy (f
, parms
, dx
, dy
, width
, height
, &root_x
, &root_y
);
8009 /* Adjust Window size to take border into account. */
8011 rect
.left
= rect
.top
= 0;
8013 rect
.bottom
= height
;
8014 AdjustWindowRect (&rect
, f
->output_data
.w32
->dwStyle
,
8015 FRAME_EXTERNAL_MENU_BAR (f
));
8017 /* Position and size tooltip, and put it in the topmost group.
8018 The add-on of 3 to the 5th argument is a kludge: without it,
8019 some fonts cause the last character of the tip to be truncated,
8020 for some obscure reason. */
8021 SetWindowPos (FRAME_W32_WINDOW (f
), HWND_TOPMOST
,
8022 root_x
, root_y
, rect
.right
- rect
.left
+ 3,
8023 rect
.bottom
- rect
.top
, SWP_NOACTIVATE
);
8025 /* Ensure tooltip is on top of other topmost windows (eg menus). */
8026 SetWindowPos (FRAME_W32_WINDOW (f
), HWND_TOP
,
8028 SWP_NOMOVE
| SWP_NOSIZE
| SWP_NOACTIVATE
);
8030 /* Let redisplay know that we have made the frame visible already. */
8031 f
->async_visible
= 1;
8033 ShowWindow (FRAME_W32_WINDOW (f
), SW_SHOWNOACTIVATE
);
8036 /* Draw into the window. */
8037 w
->must_be_updated_p
= 1;
8038 update_single_window (w
, 1);
8042 /* Restore original current buffer. */
8043 set_buffer_internal_1 (old_buffer
);
8044 windows_or_buffers_changed
= old_windows_or_buffers_changed
;
8047 /* Let the tip disappear after timeout seconds. */
8048 tip_timer
= call3 (intern ("run-at-time"), timeout
, Qnil
,
8049 intern ("x-hide-tip"));
8052 return unbind_to (count
, Qnil
);
8056 DEFUN ("x-hide-tip", Fx_hide_tip
, Sx_hide_tip
, 0, 0, 0,
8057 doc
: /* Hide the current tooltip window, if there is any.
8058 Value is t if tooltip was open, nil otherwise. */)
8062 Lisp_Object deleted
, frame
, timer
;
8063 struct gcpro gcpro1
, gcpro2
;
8065 /* Return quickly if nothing to do. */
8066 if (NILP (tip_timer
) && NILP (tip_frame
))
8071 GCPRO2 (frame
, timer
);
8072 tip_frame
= tip_timer
= deleted
= Qnil
;
8074 count
= SPECPDL_INDEX ();
8075 specbind (Qinhibit_redisplay
, Qt
);
8076 specbind (Qinhibit_quit
, Qt
);
8079 call1 (Qcancel_timer
, timer
);
8083 Fdelete_frame (frame
, Qnil
);
8088 return unbind_to (count
, deleted
);
8093 /***********************************************************************
8094 File selection dialog
8095 ***********************************************************************/
8096 extern Lisp_Object Qfile_name_history
;
8098 /* Callback for altering the behaviour of the Open File dialog.
8099 Makes the Filename text field contain "Current Directory" and be
8100 read-only when "Directories" is selected in the filter. This
8101 allows us to work around the fact that the standard Open File
8102 dialog does not support directories. */
8104 file_dialog_callback (hwnd
, msg
, wParam
, lParam
)
8110 if (msg
== WM_NOTIFY
)
8112 OFNOTIFY
* notify
= (OFNOTIFY
*)lParam
;
8113 /* Detect when the Filter dropdown is changed. */
8114 if (notify
->hdr
.code
== CDN_TYPECHANGE
8115 || notify
->hdr
.code
== CDN_INITDONE
)
8117 HWND dialog
= GetParent (hwnd
);
8118 HWND edit_control
= GetDlgItem (dialog
, FILE_NAME_TEXT_FIELD
);
8120 /* Directories is in index 2. */
8121 if (notify
->lpOFN
->nFilterIndex
== 2)
8123 CommDlg_OpenSave_SetControlText (dialog
, FILE_NAME_TEXT_FIELD
,
8124 "Current Directory");
8125 EnableWindow (edit_control
, FALSE
);
8129 /* Don't override default filename on init done. */
8130 if (notify
->hdr
.code
== CDN_TYPECHANGE
)
8131 CommDlg_OpenSave_SetControlText (dialog
,
8132 FILE_NAME_TEXT_FIELD
, "");
8133 EnableWindow (edit_control
, TRUE
);
8140 /* Since we compile with _WIN32_WINNT set to 0x0400 (for NT4 compatibility)
8141 we end up with the old file dialogs. Define a big enough struct for the
8142 new dialog to trick GetOpenFileName into giving us the new dialogs on
8143 Windows 2000 and XP. */
8146 OPENFILENAME real_details
;
8153 DEFUN ("x-file-dialog", Fx_file_dialog
, Sx_file_dialog
, 2, 5, 0,
8154 doc
: /* Read file name, prompting with PROMPT in directory DIR.
8155 Use a file selection dialog.
8156 Select DEFAULT-FILENAME in the dialog's file selection box, if
8157 specified. Ensure that file exists if MUSTMATCH is non-nil.
8158 If ONLY-DIR-P is non-nil, the user can only select directories. */)
8159 (prompt
, dir
, default_filename
, mustmatch
, only_dir_p
)
8160 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, only_dir_p
;
8162 struct frame
*f
= SELECTED_FRAME ();
8163 Lisp_Object file
= Qnil
;
8164 int count
= SPECPDL_INDEX ();
8165 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
;
8166 char filename
[MAX_PATH
+ 1];
8167 char init_dir
[MAX_PATH
+ 1];
8168 int default_filter_index
= 1; /* 1: All Files, 2: Directories only */
8170 GCPRO6 (prompt
, dir
, default_filename
, mustmatch
, only_dir_p
, file
);
8171 CHECK_STRING (prompt
);
8174 /* Create the dialog with PROMPT as title, using DIR as initial
8175 directory and using "*" as pattern. */
8176 dir
= Fexpand_file_name (dir
, Qnil
);
8177 strncpy (init_dir
, SDATA (ENCODE_FILE (dir
)), MAX_PATH
);
8178 init_dir
[MAX_PATH
] = '\0';
8179 unixtodos_filename (init_dir
);
8181 if (STRINGP (default_filename
))
8183 char *file_name_only
;
8184 char *full_path_name
= SDATA (ENCODE_FILE (default_filename
));
8186 unixtodos_filename (full_path_name
);
8188 file_name_only
= strrchr (full_path_name
, '\\');
8189 if (!file_name_only
)
8190 file_name_only
= full_path_name
;
8194 strncpy (filename
, file_name_only
, MAX_PATH
);
8195 filename
[MAX_PATH
] = '\0';
8201 NEWOPENFILENAME new_file_details
;
8202 BOOL file_opened
= FALSE
;
8203 OPENFILENAME
* file_details
= &new_file_details
.real_details
;
8205 /* Prevent redisplay. */
8206 specbind (Qinhibit_redisplay
, Qt
);
8209 bzero (&new_file_details
, sizeof (new_file_details
));
8210 /* Apparently NT4 crashes if you give it an unexpected size.
8211 I'm not sure about Windows 9x, so play it safe. */
8212 if (w32_major_version
> 4 && w32_major_version
< 95)
8213 file_details
->lStructSize
= sizeof (NEWOPENFILENAME
);
8215 file_details
->lStructSize
= sizeof (OPENFILENAME
);
8217 file_details
->hwndOwner
= FRAME_W32_WINDOW (f
);
8218 /* Undocumented Bug in Common File Dialog:
8219 If a filter is not specified, shell links are not resolved. */
8220 file_details
->lpstrFilter
= "All Files (*.*)\0*.*\0Directories\0*|*\0\0";
8221 file_details
->lpstrFile
= filename
;
8222 file_details
->nMaxFile
= sizeof (filename
);
8223 file_details
->lpstrInitialDir
= init_dir
;
8224 file_details
->lpstrTitle
= SDATA (prompt
);
8226 if (! NILP (only_dir_p
))
8227 default_filter_index
= 2;
8229 file_details
->nFilterIndex
= default_filter_index
;
8231 file_details
->Flags
= (OFN_HIDEREADONLY
| OFN_NOCHANGEDIR
8232 | OFN_EXPLORER
| OFN_ENABLEHOOK
);
8233 if (!NILP (mustmatch
))
8235 /* Require that the path to the parent directory exists. */
8236 file_details
->Flags
|= OFN_PATHMUSTEXIST
;
8237 /* If we are looking for a file, require that it exists. */
8238 if (NILP (only_dir_p
))
8239 file_details
->Flags
|= OFN_FILEMUSTEXIST
;
8242 file_details
->lpfnHook
= (LPOFNHOOKPROC
) file_dialog_callback
;
8244 file_opened
= GetOpenFileName (file_details
);
8250 dostounix_filename (filename
);
8252 if (file_details
->nFilterIndex
== 2)
8254 /* "Directories" selected - strip dummy file name. */
8255 char * last
= strrchr (filename
, '/');
8259 file
= DECODE_FILE (build_string (filename
));
8261 /* User cancelled the dialog without making a selection. */
8262 else if (!CommDlgExtendedError ())
8264 /* An error occurred, fallback on reading from the mini-buffer. */
8266 file
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
8267 dir
, mustmatch
, dir
, Qfile_name_history
,
8268 default_filename
, Qnil
);
8270 file
= unbind_to (count
, file
);
8275 /* Make "Cancel" equivalent to C-g. */
8277 Fsignal (Qquit
, Qnil
);
8279 return unbind_to (count
, file
);
8284 /***********************************************************************
8285 w32 specialized functions
8286 ***********************************************************************/
8288 DEFUN ("w32-select-font", Fw32_select_font
, Sw32_select_font
, 0, 2, 0,
8289 doc
: /* Select a font for the named FRAME using the W32 font dialog.
8290 Return an X-style font string corresponding to the selection.
8292 If FRAME is omitted or nil, it defaults to the selected frame.
8293 If INCLUDE-PROPORTIONAL is non-nil, include proportional fonts
8294 in the font selection dialog. */)
8295 (frame
, include_proportional
)
8296 Lisp_Object frame
, include_proportional
;
8298 FRAME_PTR f
= check_x_frame (frame
);
8306 bzero (&cf
, sizeof (cf
));
8307 bzero (&lf
, sizeof (lf
));
8309 cf
.lStructSize
= sizeof (cf
);
8310 cf
.hwndOwner
= FRAME_W32_WINDOW (f
);
8311 cf
.Flags
= CF_FORCEFONTEXIST
| CF_SCREENFONTS
| CF_NOVERTFONTS
;
8313 /* Unless include_proportional is non-nil, limit the selection to
8314 monospaced fonts. */
8315 if (NILP (include_proportional
))
8316 cf
.Flags
|= CF_FIXEDPITCHONLY
;
8320 /* Initialize as much of the font details as we can from the current
8322 hdc
= GetDC (FRAME_W32_WINDOW (f
));
8323 oldobj
= SelectObject (hdc
, FRAME_FONT (f
)->hfont
);
8324 GetTextFace (hdc
, LF_FACESIZE
, lf
.lfFaceName
);
8325 if (GetTextMetrics (hdc
, &tm
))
8327 lf
.lfHeight
= tm
.tmInternalLeading
- tm
.tmHeight
;
8328 lf
.lfWeight
= tm
.tmWeight
;
8329 lf
.lfItalic
= tm
.tmItalic
;
8330 lf
.lfUnderline
= tm
.tmUnderlined
;
8331 lf
.lfStrikeOut
= tm
.tmStruckOut
;
8332 lf
.lfCharSet
= tm
.tmCharSet
;
8333 cf
.Flags
|= CF_INITTOLOGFONTSTRUCT
;
8335 SelectObject (hdc
, oldobj
);
8336 ReleaseDC (FRAME_W32_WINDOW (f
), hdc
);
8338 if (!ChooseFont (&cf
) || !w32_to_x_font (&lf
, buf
, 100, NULL
))
8341 return build_string (buf
);
8344 DEFUN ("w32-send-sys-command", Fw32_send_sys_command
,
8345 Sw32_send_sys_command
, 1, 2, 0,
8346 doc
: /* Send frame a Windows WM_SYSCOMMAND message of type COMMAND.
8347 Some useful values for COMMAND are #xf030 to maximize frame (#xf020
8348 to minimize), #xf120 to restore frame to original size, and #xf100
8349 to activate the menubar for keyboard access. #xf140 activates the
8350 screen saver if defined.
8352 If optional parameter FRAME is not specified, use selected frame. */)
8354 Lisp_Object command
, frame
;
8356 FRAME_PTR f
= check_x_frame (frame
);
8358 CHECK_NUMBER (command
);
8360 PostMessage (FRAME_W32_WINDOW (f
), WM_SYSCOMMAND
, XINT (command
), 0);
8365 DEFUN ("w32-shell-execute", Fw32_shell_execute
, Sw32_shell_execute
, 2, 4, 0,
8366 doc
: /* Get Windows to perform OPERATION on DOCUMENT.
8367 This is a wrapper around the ShellExecute system function, which
8368 invokes the application registered to handle OPERATION for DOCUMENT.
8370 OPERATION is either nil or a string that names a supported operation.
8371 What operations can be used depends on the particular DOCUMENT and its
8372 handler application, but typically it is one of the following common
8375 \"open\" - open DOCUMENT, which could be a file, a directory, or an
8376 executable program. If it is an application, that
8377 application is launched in the current buffer's default
8378 directory. Otherwise, the application associated with
8379 DOCUMENT is launched in the buffer's default directory.
8380 \"print\" - print DOCUMENT, which must be a file
8381 \"explore\" - start the Windows Explorer on DOCUMENT
8382 \"edit\" - launch an editor and open DOCUMENT for editing; which
8383 editor is launched depends on the association for the
8385 \"find\" - initiate search starting from DOCUMENT which must specify
8387 nil - invoke the default OPERATION, or \"open\" if default is
8388 not defined or unavailable
8390 DOCUMENT is typically the name of a document file or a URL, but can
8391 also be a program executable to run, or a directory to open in the
8394 If DOCUMENT is a program executable, the optional third arg PARAMETERS
8395 can be a string containing command line parameters that will be passed
8396 to the program; otherwise, PARAMETERS should be nil or unspecified.
8398 Optional fourth argument SHOW-FLAG can be used to control how the
8399 application will be displayed when it is invoked. If SHOW-FLAG is nil
8400 or unspecified, the application is displayed normally, otherwise it is
8401 an integer representing a ShowWindow flag:
8406 6 - start minimized */)
8407 (operation
, document
, parameters
, show_flag
)
8408 Lisp_Object operation
, document
, parameters
, show_flag
;
8410 Lisp_Object current_dir
;
8412 CHECK_STRING (document
);
8414 /* Encode filename, current directory and parameters. */
8415 current_dir
= ENCODE_FILE (current_buffer
->directory
);
8416 document
= ENCODE_FILE (document
);
8417 if (STRINGP (parameters
))
8418 parameters
= ENCODE_SYSTEM (parameters
);
8420 if ((int) ShellExecute (NULL
,
8421 (STRINGP (operation
) ?
8422 SDATA (operation
) : NULL
),
8424 (STRINGP (parameters
) ?
8425 SDATA (parameters
) : NULL
),
8426 SDATA (current_dir
),
8427 (INTEGERP (show_flag
) ?
8428 XINT (show_flag
) : SW_SHOWDEFAULT
))
8431 error ("ShellExecute failed: %s", w32_strerror (0));
8434 /* Lookup virtual keycode from string representing the name of a
8435 non-ascii keystroke into the corresponding virtual key, using
8436 lispy_function_keys. */
8438 lookup_vk_code (char *key
)
8442 for (i
= 0; i
< 256; i
++)
8443 if (lispy_function_keys
[i
]
8444 && strcmp (lispy_function_keys
[i
], key
) == 0)
8450 /* Convert a one-element vector style key sequence to a hot key
8453 w32_parse_hot_key (key
)
8456 /* Copied from Fdefine_key and store_in_keymap. */
8457 register Lisp_Object c
;
8461 struct gcpro gcpro1
;
8465 if (XFASTINT (Flength (key
)) != 1)
8470 c
= Faref (key
, make_number (0));
8472 if (CONSP (c
) && lucid_event_type_list_p (c
))
8473 c
= Fevent_convert_list (c
);
8477 if (! INTEGERP (c
) && ! SYMBOLP (c
))
8478 error ("Key definition is invalid");
8480 /* Work out the base key and the modifiers. */
8483 c
= parse_modifiers (c
);
8484 lisp_modifiers
= XINT (Fcar (Fcdr (c
)));
8488 vk_code
= lookup_vk_code (SDATA (SYMBOL_NAME (c
)));
8490 else if (INTEGERP (c
))
8492 lisp_modifiers
= XINT (c
) & ~CHARACTERBITS
;
8493 /* Many ascii characters are their own virtual key code. */
8494 vk_code
= XINT (c
) & CHARACTERBITS
;
8497 if (vk_code
< 0 || vk_code
> 255)
8500 if ((lisp_modifiers
& meta_modifier
) != 0
8501 && !NILP (Vw32_alt_is_meta
))
8502 lisp_modifiers
|= alt_modifier
;
8504 /* Supply defs missing from mingw32. */
8506 #define MOD_ALT 0x0001
8507 #define MOD_CONTROL 0x0002
8508 #define MOD_SHIFT 0x0004
8509 #define MOD_WIN 0x0008
8512 /* Convert lisp modifiers to Windows hot-key form. */
8513 w32_modifiers
= (lisp_modifiers
& hyper_modifier
) ? MOD_WIN
: 0;
8514 w32_modifiers
|= (lisp_modifiers
& alt_modifier
) ? MOD_ALT
: 0;
8515 w32_modifiers
|= (lisp_modifiers
& ctrl_modifier
) ? MOD_CONTROL
: 0;
8516 w32_modifiers
|= (lisp_modifiers
& shift_modifier
) ? MOD_SHIFT
: 0;
8518 return HOTKEY (vk_code
, w32_modifiers
);
8521 DEFUN ("w32-register-hot-key", Fw32_register_hot_key
,
8522 Sw32_register_hot_key
, 1, 1, 0,
8523 doc
: /* Register KEY as a hot-key combination.
8524 Certain key combinations like Alt-Tab are reserved for system use on
8525 Windows, and therefore are normally intercepted by the system. However,
8526 most of these key combinations can be received by registering them as
8527 hot-keys, overriding their special meaning.
8529 KEY must be a one element key definition in vector form that would be
8530 acceptable to `define-key' (e.g. [A-tab] for Alt-Tab). The meta
8531 modifier is interpreted as Alt if `w32-alt-is-meta' is t, and hyper
8532 is always interpreted as the Windows modifier keys.
8534 The return value is the hotkey-id if registered, otherwise nil. */)
8538 key
= w32_parse_hot_key (key
);
8540 if (!NILP (key
) && NILP (Fmemq (key
, w32_grabbed_keys
)))
8542 /* Reuse an empty slot if possible. */
8543 Lisp_Object item
= Fmemq (Qnil
, w32_grabbed_keys
);
8545 /* Safe to add new key to list, even if we have focus. */
8547 w32_grabbed_keys
= Fcons (key
, w32_grabbed_keys
);
8549 XSETCAR (item
, key
);
8551 /* Notify input thread about new hot-key definition, so that it
8552 takes effect without needing to switch focus. */
8553 #ifdef USE_LISP_UNION_TYPE
8554 PostThreadMessage (dwWindowsThreadId
, WM_EMACS_REGISTER_HOT_KEY
,
8557 PostThreadMessage (dwWindowsThreadId
, WM_EMACS_REGISTER_HOT_KEY
,
8565 DEFUN ("w32-unregister-hot-key", Fw32_unregister_hot_key
,
8566 Sw32_unregister_hot_key
, 1, 1, 0,
8567 doc
: /* Unregister KEY as a hot-key combination. */)
8573 if (!INTEGERP (key
))
8574 key
= w32_parse_hot_key (key
);
8576 item
= Fmemq (key
, w32_grabbed_keys
);
8580 /* Notify input thread about hot-key definition being removed, so
8581 that it takes effect without needing focus switch. */
8582 #ifdef USE_LISP_UNION_TYPE
8583 if (PostThreadMessage (dwWindowsThreadId
, WM_EMACS_UNREGISTER_HOT_KEY
,
8584 (WPARAM
) XINT (XCAR (item
)), (LPARAM
) item
.i
))
8586 if (PostThreadMessage (dwWindowsThreadId
, WM_EMACS_UNREGISTER_HOT_KEY
,
8587 (WPARAM
) XINT (XCAR (item
)), (LPARAM
) item
))
8591 GetMessage (&msg
, NULL
, WM_EMACS_DONE
, WM_EMACS_DONE
);
8598 DEFUN ("w32-registered-hot-keys", Fw32_registered_hot_keys
,
8599 Sw32_registered_hot_keys
, 0, 0, 0,
8600 doc
: /* Return list of registered hot-key IDs. */)
8603 return Fdelq (Qnil
, Fcopy_sequence (w32_grabbed_keys
));
8606 DEFUN ("w32-reconstruct-hot-key", Fw32_reconstruct_hot_key
,
8607 Sw32_reconstruct_hot_key
, 1, 1, 0,
8608 doc
: /* Convert hot-key ID to a lisp key combination.
8609 usage: (w32-reconstruct-hot-key ID) */)
8611 Lisp_Object hotkeyid
;
8613 int vk_code
, w32_modifiers
;
8616 CHECK_NUMBER (hotkeyid
);
8618 vk_code
= HOTKEY_VK_CODE (hotkeyid
);
8619 w32_modifiers
= HOTKEY_MODIFIERS (hotkeyid
);
8621 if (vk_code
< 256 && lispy_function_keys
[vk_code
])
8622 key
= intern (lispy_function_keys
[vk_code
]);
8624 key
= make_number (vk_code
);
8626 key
= Fcons (key
, Qnil
);
8627 if (w32_modifiers
& MOD_SHIFT
)
8628 key
= Fcons (Qshift
, key
);
8629 if (w32_modifiers
& MOD_CONTROL
)
8630 key
= Fcons (Qctrl
, key
);
8631 if (w32_modifiers
& MOD_ALT
)
8632 key
= Fcons (NILP (Vw32_alt_is_meta
) ? Qalt
: Qmeta
, key
);
8633 if (w32_modifiers
& MOD_WIN
)
8634 key
= Fcons (Qhyper
, key
);
8639 DEFUN ("w32-toggle-lock-key", Fw32_toggle_lock_key
,
8640 Sw32_toggle_lock_key
, 1, 2, 0,
8641 doc
: /* Toggle the state of the lock key KEY.
8642 KEY can be `capslock', `kp-numlock', or `scroll'.
8643 If the optional parameter NEW-STATE is a number, then the state of KEY
8644 is set to off if the low bit of NEW-STATE is zero, otherwise on. */)
8646 Lisp_Object key
, new_state
;
8650 if (EQ (key
, intern ("capslock")))
8651 vk_code
= VK_CAPITAL
;
8652 else if (EQ (key
, intern ("kp-numlock")))
8653 vk_code
= VK_NUMLOCK
;
8654 else if (EQ (key
, intern ("scroll")))
8655 vk_code
= VK_SCROLL
;
8659 if (!dwWindowsThreadId
)
8660 return make_number (w32_console_toggle_lock_key (vk_code
, new_state
));
8662 #ifdef USE_LISP_UNION_TYPE
8663 if (PostThreadMessage (dwWindowsThreadId
, WM_EMACS_TOGGLE_LOCK_KEY
,
8664 (WPARAM
) vk_code
, (LPARAM
) new_state
.i
))
8666 if (PostThreadMessage (dwWindowsThreadId
, WM_EMACS_TOGGLE_LOCK_KEY
,
8667 (WPARAM
) vk_code
, (LPARAM
) new_state
))
8671 GetMessage (&msg
, NULL
, WM_EMACS_DONE
, WM_EMACS_DONE
);
8672 return make_number (msg
.wParam
);
8677 DEFUN ("w32-window-exists-p", Fw32_window_exists_p
, Sw32_window_exists_p
,
8679 doc
: /* Return non-nil if a window exists with the specified CLASS and NAME.
8681 This is a direct interface to the Windows API FindWindow function. */)
8683 Lisp_Object
class, name
;
8688 CHECK_STRING (class);
8690 CHECK_STRING (name
);
8692 hnd
= FindWindow (STRINGP (class) ? ((LPCTSTR
) SDATA (class)) : NULL
,
8693 STRINGP (name
) ? ((LPCTSTR
) SDATA (name
)) : NULL
);
8701 DEFUN ("file-system-info", Ffile_system_info
, Sfile_system_info
, 1, 1, 0,
8702 doc
: /* Return storage information about the file system FILENAME is on.
8703 Value is a list of floats (TOTAL FREE AVAIL), where TOTAL is the total
8704 storage of the file system, FREE is the free storage, and AVAIL is the
8705 storage available to a non-superuser. All 3 numbers are in bytes.
8706 If the underlying system call fails, value is nil. */)
8708 Lisp_Object filename
;
8710 Lisp_Object encoded
, value
;
8712 CHECK_STRING (filename
);
8713 filename
= Fexpand_file_name (filename
, Qnil
);
8714 encoded
= ENCODE_FILE (filename
);
8718 /* Determining the required information on Windows turns out, sadly,
8719 to be more involved than one would hope. The original Win32 api
8720 call for this will return bogus information on some systems, but we
8721 must dynamically probe for the replacement api, since that was
8722 added rather late on. */
8724 HMODULE hKernel
= GetModuleHandle ("kernel32");
8725 BOOL (*pfn_GetDiskFreeSpaceEx
)
8726 (char *, PULARGE_INTEGER
, PULARGE_INTEGER
, PULARGE_INTEGER
)
8727 = (void *) GetProcAddress (hKernel
, "GetDiskFreeSpaceEx");
8729 /* On Windows, we may need to specify the root directory of the
8730 volume holding FILENAME. */
8731 char rootname
[MAX_PATH
];
8732 char *name
= SDATA (encoded
);
8734 /* find the root name of the volume if given */
8735 if (isalpha (name
[0]) && name
[1] == ':')
8737 rootname
[0] = name
[0];
8738 rootname
[1] = name
[1];
8742 else if (IS_DIRECTORY_SEP (name
[0]) && IS_DIRECTORY_SEP (name
[1]))
8744 char *str
= rootname
;
8748 if (IS_DIRECTORY_SEP (*name
) && --slashes
== 0)
8758 if (pfn_GetDiskFreeSpaceEx
)
8760 /* Unsigned large integers cannot be cast to double, so
8761 use signed ones instead. */
8762 LARGE_INTEGER availbytes
;
8763 LARGE_INTEGER freebytes
;
8764 LARGE_INTEGER totalbytes
;
8766 if (pfn_GetDiskFreeSpaceEx (rootname
,
8767 (ULARGE_INTEGER
*)&availbytes
,
8768 (ULARGE_INTEGER
*)&totalbytes
,
8769 (ULARGE_INTEGER
*)&freebytes
))
8770 value
= list3 (make_float ((double) totalbytes
.QuadPart
),
8771 make_float ((double) freebytes
.QuadPart
),
8772 make_float ((double) availbytes
.QuadPart
));
8776 DWORD sectors_per_cluster
;
8777 DWORD bytes_per_sector
;
8778 DWORD free_clusters
;
8779 DWORD total_clusters
;
8781 if (GetDiskFreeSpace (rootname
,
8782 §ors_per_cluster
,
8786 value
= list3 (make_float ((double) total_clusters
8787 * sectors_per_cluster
* bytes_per_sector
),
8788 make_float ((double) free_clusters
8789 * sectors_per_cluster
* bytes_per_sector
),
8790 make_float ((double) free_clusters
8791 * sectors_per_cluster
* bytes_per_sector
));
8798 DEFUN ("default-printer-name", Fdefault_printer_name
, Sdefault_printer_name
,
8799 0, 0, 0, doc
: /* Return the name of Windows default printer device. */)
8802 static char pname_buf
[256];
8805 PRINTER_INFO_2
*ppi2
= NULL
;
8806 DWORD dwNeeded
= 0, dwReturned
= 0;
8808 /* Retrieve the default string from Win.ini (the registry).
8809 * String will be in form "printername,drivername,portname".
8810 * This is the most portable way to get the default printer. */
8811 if (GetProfileString ("windows", "device", ",,", pname_buf
, sizeof (pname_buf
)) <= 0)
8813 /* printername precedes first "," character */
8814 strtok (pname_buf
, ",");
8815 /* We want to know more than the printer name */
8816 if (!OpenPrinter (pname_buf
, &hPrn
, NULL
))
8818 GetPrinter (hPrn
, 2, NULL
, 0, &dwNeeded
);
8821 ClosePrinter (hPrn
);
8824 /* Allocate memory for the PRINTER_INFO_2 struct */
8825 ppi2
= (PRINTER_INFO_2
*) xmalloc (dwNeeded
);
8828 ClosePrinter (hPrn
);
8831 /* Call GetPrinter again with big enouth memory block */
8832 err
= GetPrinter (hPrn
, 2, (LPBYTE
)ppi2
, dwNeeded
, &dwReturned
);
8833 ClosePrinter (hPrn
);
8842 if (ppi2
->Attributes
& PRINTER_ATTRIBUTE_SHARED
&& ppi2
->pServerName
)
8844 /* a remote printer */
8845 if (*ppi2
->pServerName
== '\\')
8846 _snprintf (pname_buf
, sizeof (pname_buf
), "%s\\%s", ppi2
->pServerName
,
8849 _snprintf (pname_buf
, sizeof (pname_buf
), "\\\\%s\\%s", ppi2
->pServerName
,
8851 pname_buf
[sizeof (pname_buf
) - 1] = '\0';
8855 /* a local printer */
8856 strncpy (pname_buf
, ppi2
->pPortName
, sizeof (pname_buf
));
8857 pname_buf
[sizeof (pname_buf
) - 1] = '\0';
8858 /* `pPortName' can include several ports, delimited by ','.
8859 * we only use the first one. */
8860 strtok (pname_buf
, ",");
8865 return build_string (pname_buf
);
8868 /***********************************************************************
8870 ***********************************************************************/
8872 /* Keep this list in the same order as frame_parms in frame.c.
8873 Use 0 for unsupported frame parameters. */
8875 frame_parm_handler w32_frame_parm_handlers
[] =
8879 x_set_background_color
,
8885 x_set_foreground_color
,
8888 x_set_internal_border_width
,
8889 x_set_menu_bar_lines
,
8891 x_explicitly_set_name
,
8892 x_set_scroll_bar_width
,
8895 x_set_vertical_scroll_bars
,
8897 x_set_tool_bar_lines
,
8898 0, /* x_set_scroll_bar_foreground, */
8899 0, /* x_set_scroll_bar_background, */
8904 0, /* x_set_wait_for_wm, */
8906 #ifdef USE_FONT_BACKEND
8914 globals_of_w32fns ();
8915 /* This is zero if not using MS-Windows. */
8917 track_mouse_window
= NULL
;
8919 w32_visible_system_caret_hwnd
= NULL
;
8921 DEFSYM (Qnone
, "none");
8922 DEFSYM (Qsuppress_icon
, "suppress-icon");
8923 DEFSYM (Qundefined_color
, "undefined-color");
8924 DEFSYM (Qcancel_timer
, "cancel-timer");
8925 DEFSYM (Qhyper
, "hyper");
8926 DEFSYM (Qsuper
, "super");
8927 DEFSYM (Qmeta
, "meta");
8928 DEFSYM (Qalt
, "alt");
8929 DEFSYM (Qctrl
, "ctrl");
8930 DEFSYM (Qcontrol
, "control");
8931 DEFSYM (Qshift
, "shift");
8932 /* This is the end of symbol initialization. */
8934 /* Text property `display' should be nonsticky by default. */
8935 Vtext_property_default_nonsticky
8936 = Fcons (Fcons (Qdisplay
, Qt
), Vtext_property_default_nonsticky
);
8939 Fput (Qundefined_color
, Qerror_conditions
,
8940 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
8941 Fput (Qundefined_color
, Qerror_message
,
8942 build_string ("Undefined color"));
8944 staticpro (&w32_grabbed_keys
);
8945 w32_grabbed_keys
= Qnil
;
8947 DEFVAR_LISP ("w32-color-map", &Vw32_color_map
,
8948 doc
: /* An array of color name mappings for Windows. */);
8949 Vw32_color_map
= Qnil
;
8951 DEFVAR_LISP ("w32-pass-alt-to-system", &Vw32_pass_alt_to_system
,
8952 doc
: /* Non-nil if Alt key presses are passed on to Windows.
8953 When non-nil, for example, Alt pressed and released and then space will
8954 open the System menu. When nil, Emacs processes the Alt key events, and
8955 then silently swallows them. */);
8956 Vw32_pass_alt_to_system
= Qnil
;
8958 DEFVAR_LISP ("w32-alt-is-meta", &Vw32_alt_is_meta
,
8959 doc
: /* Non-nil if the Alt key is to be considered the same as the META key.
8960 When nil, Emacs will translate the Alt key to the ALT modifier, not to META. */);
8961 Vw32_alt_is_meta
= Qt
;
8963 DEFVAR_INT ("w32-quit-key", &w32_quit_key
,
8964 doc
: /* If non-zero, the virtual key code for an alternative quit key. */);
8967 DEFVAR_LISP ("w32-pass-lwindow-to-system",
8968 &Vw32_pass_lwindow_to_system
,
8969 doc
: /* If non-nil, the left \"Windows\" key is passed on to Windows.
8971 When non-nil, the Start menu is opened by tapping the key.
8972 If you set this to nil, the left \"Windows\" key is processed by Emacs
8973 according to the value of `w32-lwindow-modifier', which see.
8975 Note that some combinations of the left \"Windows\" key with other keys are
8976 caught by Windows at low level, and so binding them in Emacs will have no
8977 effect. For example, <lwindow>-r always pops up the Windows Run dialog,
8978 <lwindow>-<Pause> pops up the "System Properties" dialog, etc. However, see
8979 the doc string of `w32-phantom-key-code'. */);
8980 Vw32_pass_lwindow_to_system
= Qt
;
8982 DEFVAR_LISP ("w32-pass-rwindow-to-system",
8983 &Vw32_pass_rwindow_to_system
,
8984 doc
: /* If non-nil, the right \"Windows\" key is passed on to Windows.
8986 When non-nil, the Start menu is opened by tapping the key.
8987 If you set this to nil, the right \"Windows\" key is processed by Emacs
8988 according to the value of `w32-rwindow-modifier', which see.
8990 Note that some combinations of the right \"Windows\" key with other keys are
8991 caught by Windows at low level, and so binding them in Emacs will have no
8992 effect. For example, <rwindow>-r always pops up the Windows Run dialog,
8993 <rwindow>-<Pause> pops up the "System Properties" dialog, etc. However, see
8994 the doc string of `w32-phantom-key-code'. */);
8995 Vw32_pass_rwindow_to_system
= Qt
;
8997 DEFVAR_LISP ("w32-phantom-key-code",
8998 &Vw32_phantom_key_code
,
8999 doc
: /* Virtual key code used to generate \"phantom\" key presses.
9000 Value is a number between 0 and 255.
9002 Phantom key presses are generated in order to stop the system from
9003 acting on \"Windows\" key events when `w32-pass-lwindow-to-system' or
9004 `w32-pass-rwindow-to-system' is nil. */);
9005 /* Although 255 is technically not a valid key code, it works and
9006 means that this hack won't interfere with any real key code. */
9007 XSETINT (Vw32_phantom_key_code
, 255);
9009 DEFVAR_LISP ("w32-enable-num-lock",
9010 &Vw32_enable_num_lock
,
9011 doc
: /* If non-nil, the Num Lock key acts normally.
9012 Set to nil to handle Num Lock as the `kp-numlock' key. */);
9013 Vw32_enable_num_lock
= Qt
;
9015 DEFVAR_LISP ("w32-enable-caps-lock",
9016 &Vw32_enable_caps_lock
,
9017 doc
: /* If non-nil, the Caps Lock key acts normally.
9018 Set to nil to handle Caps Lock as the `capslock' key. */);
9019 Vw32_enable_caps_lock
= Qt
;
9021 DEFVAR_LISP ("w32-scroll-lock-modifier",
9022 &Vw32_scroll_lock_modifier
,
9023 doc
: /* Modifier to use for the Scroll Lock ON state.
9024 The value can be hyper, super, meta, alt, control or shift for the
9025 respective modifier, or nil to handle Scroll Lock as the `scroll' key.
9026 Any other value will cause the Scroll Lock key to be ignored. */);
9027 Vw32_scroll_lock_modifier
= Qt
;
9029 DEFVAR_LISP ("w32-lwindow-modifier",
9030 &Vw32_lwindow_modifier
,
9031 doc
: /* Modifier to use for the left \"Windows\" key.
9032 The value can be hyper, super, meta, alt, control or shift for the
9033 respective modifier, or nil to appear as the `lwindow' key.
9034 Any other value will cause the key to be ignored. */);
9035 Vw32_lwindow_modifier
= Qnil
;
9037 DEFVAR_LISP ("w32-rwindow-modifier",
9038 &Vw32_rwindow_modifier
,
9039 doc
: /* Modifier to use for the right \"Windows\" key.
9040 The value can be hyper, super, meta, alt, control or shift for the
9041 respective modifier, or nil to appear as the `rwindow' key.
9042 Any other value will cause the key to be ignored. */);
9043 Vw32_rwindow_modifier
= Qnil
;
9045 DEFVAR_LISP ("w32-apps-modifier",
9046 &Vw32_apps_modifier
,
9047 doc
: /* Modifier to use for the \"Apps\" key.
9048 The value can be hyper, super, meta, alt, control or shift for the
9049 respective modifier, or nil to appear as the `apps' key.
9050 Any other value will cause the key to be ignored. */);
9051 Vw32_apps_modifier
= Qnil
;
9053 DEFVAR_BOOL ("w32-enable-synthesized-fonts", &w32_enable_synthesized_fonts
,
9054 doc
: /* Non-nil enables selection of artificially italicized and bold fonts. */);
9055 w32_enable_synthesized_fonts
= 0;
9057 DEFVAR_LISP ("w32-enable-palette", &Vw32_enable_palette
,
9058 doc
: /* Non-nil enables Windows palette management to map colors exactly. */);
9059 Vw32_enable_palette
= Qt
;
9061 DEFVAR_INT ("w32-mouse-button-tolerance",
9062 &w32_mouse_button_tolerance
,
9063 doc
: /* Analogue of double click interval for faking middle mouse events.
9064 The value is the minimum time in milliseconds that must elapse between
9065 left and right button down events before they are considered distinct events.
9066 If both mouse buttons are depressed within this interval, a middle mouse
9067 button down event is generated instead. */);
9068 w32_mouse_button_tolerance
= GetDoubleClickTime () / 2;
9070 DEFVAR_INT ("w32-mouse-move-interval",
9071 &w32_mouse_move_interval
,
9072 doc
: /* Minimum interval between mouse move events.
9073 The value is the minimum time in milliseconds that must elapse between
9074 successive mouse move (or scroll bar drag) events before they are
9075 reported as lisp events. */);
9076 w32_mouse_move_interval
= 0;
9078 DEFVAR_BOOL ("w32-pass-extra-mouse-buttons-to-system",
9079 &w32_pass_extra_mouse_buttons_to_system
,
9080 doc
: /* If non-nil, the fourth and fifth mouse buttons are passed to Windows.
9081 Recent versions of Windows support mice with up to five buttons.
9082 Since most applications don't support these extra buttons, most mouse
9083 drivers will allow you to map them to functions at the system level.
9084 If this variable is non-nil, Emacs will pass them on, allowing the
9085 system to handle them. */);
9086 w32_pass_extra_mouse_buttons_to_system
= 0;
9088 DEFVAR_BOOL ("w32-pass-multimedia-buttons-to-system",
9089 &w32_pass_multimedia_buttons_to_system
,
9090 doc
: /* If non-nil, media buttons are passed to Windows.
9091 Some modern keyboards contain buttons for controlling media players, web
9092 browsers and other applications. Generally these buttons are handled on a
9093 system wide basis, but by setting this to nil they are made available
9094 to Emacs for binding. Depending on your keyboard, additional keys that
9095 may be available are:
9097 browser-back, browser-forward, browser-refresh, browser-stop,
9098 browser-search, browser-favorites, browser-home,
9099 mail, mail-reply, mail-forward, mail-send,
9101 help, find, new, open, close, save, print, undo, redo, copy, cut, paste,
9102 spell-check, correction-list, toggle-dictate-command,
9103 media-next, media-previous, media-stop, media-play-pause, media-select,
9104 media-play, media-pause, media-record, media-fast-forward, media-rewind,
9105 media-channel-up, media-channel-down,
9106 volume-mute, volume-up, volume-down,
9107 mic-volume-mute, mic-volume-down, mic-volume-up, mic-toggle,
9108 bass-down, bass-boost, bass-up, treble-down, treble-up */);
9109 w32_pass_multimedia_buttons_to_system
= 1;
9111 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape
,
9112 doc
: /* The shape of the pointer when over text.
9113 Changing the value does not affect existing frames
9114 unless you set the mouse color. */);
9115 Vx_pointer_shape
= Qnil
;
9117 Vx_nontext_pointer_shape
= Qnil
;
9119 Vx_mode_pointer_shape
= Qnil
;
9121 DEFVAR_LISP ("x-hourglass-pointer-shape", &Vx_hourglass_pointer_shape
,
9122 doc
: /* The shape of the pointer when Emacs is busy.
9123 This variable takes effect when you create a new frame
9124 or when you set the mouse color. */);
9125 Vx_hourglass_pointer_shape
= Qnil
;
9127 DEFVAR_BOOL ("display-hourglass", &display_hourglass_p
,
9128 doc
: /* Non-zero means Emacs displays an hourglass pointer on window systems. */);
9129 display_hourglass_p
= 1;
9131 DEFVAR_LISP ("hourglass-delay", &Vhourglass_delay
,
9132 doc
: /* *Seconds to wait before displaying an hourglass pointer.
9133 Value must be an integer or float. */);
9134 Vhourglass_delay
= make_number (DEFAULT_HOURGLASS_DELAY
);
9136 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
9137 &Vx_sensitive_text_pointer_shape
,
9138 doc
: /* The shape of the pointer when over mouse-sensitive text.
9139 This variable takes effect when you create a new frame
9140 or when you set the mouse color. */);
9141 Vx_sensitive_text_pointer_shape
= Qnil
;
9143 DEFVAR_LISP ("x-window-horizontal-drag-cursor",
9144 &Vx_window_horizontal_drag_shape
,
9145 doc
: /* Pointer shape to use for indicating a window can be dragged horizontally.
9146 This variable takes effect when you create a new frame
9147 or when you set the mouse color. */);
9148 Vx_window_horizontal_drag_shape
= Qnil
;
9150 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
9151 doc
: /* A string indicating the foreground color of the cursor box. */);
9152 Vx_cursor_fore_pixel
= Qnil
;
9154 DEFVAR_LISP ("x-max-tooltip-size", &Vx_max_tooltip_size
,
9155 doc
: /* Maximum size for tooltips.
9156 Value is a pair (COLUMNS . ROWS). Text larger than this is clipped. */);
9157 Vx_max_tooltip_size
= Fcons (make_number (80), make_number (40));
9159 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
9160 doc
: /* Non-nil if no window manager is in use.
9161 Emacs doesn't try to figure this out; this is always nil
9162 unless you set it to something else. */);
9163 /* We don't have any way to find this out, so set it to nil
9164 and maybe the user would like to set it to t. */
9165 Vx_no_window_manager
= Qnil
;
9167 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
9168 &Vx_pixel_size_width_font_regexp
,
9169 doc
: /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'.
9171 Since Emacs gets width of a font matching with this regexp from
9172 PIXEL_SIZE field of the name, font finding mechanism gets faster for
9173 such a font. This is especially effective for such large fonts as
9174 Chinese, Japanese, and Korean. */);
9175 Vx_pixel_size_width_font_regexp
= Qnil
;
9177 DEFVAR_LISP ("w32-bdf-filename-alist",
9178 &Vw32_bdf_filename_alist
,
9179 doc
: /* List of bdf fonts and their corresponding filenames. */);
9180 Vw32_bdf_filename_alist
= Qnil
;
9182 DEFVAR_BOOL ("w32-strict-fontnames",
9183 &w32_strict_fontnames
,
9184 doc
: /* Non-nil means only use fonts that are exact matches for those requested.
9185 Default is nil, which allows old fontnames that are not XLFD compliant,
9186 and allows third-party CJK display to work by specifying false charset
9187 fields to trick Emacs into translating to Big5, SJIS etc.
9188 Setting this to t will prevent wrong fonts being selected when
9189 fontsets are automatically created. */);
9190 w32_strict_fontnames
= 0;
9192 DEFVAR_BOOL ("w32-strict-painting",
9193 &w32_strict_painting
,
9194 doc
: /* Non-nil means use strict rules for repainting frames.
9195 Set this to nil to get the old behavior for repainting; this should
9196 only be necessary if the default setting causes problems. */);
9197 w32_strict_painting
= 1;
9199 DEFVAR_LISP ("w32-charset-info-alist",
9200 &Vw32_charset_info_alist
,
9201 doc
: /* Alist linking Emacs character sets to Windows fonts and codepages.
9202 Each entry should be of the form:
9204 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE))
9206 where CHARSET_NAME is a string used in font names to identify the charset,
9207 WINDOWS_CHARSET is a symbol that can be one of:
9208 w32-charset-ansi, w32-charset-default, w32-charset-symbol,
9209 w32-charset-shiftjis, w32-charset-hangeul, w32-charset-gb2312,
9210 w32-charset-chinesebig5,
9211 w32-charset-johab, w32-charset-hebrew,
9212 w32-charset-arabic, w32-charset-greek, w32-charset-turkish,
9213 w32-charset-vietnamese, w32-charset-thai, w32-charset-easteurope,
9214 w32-charset-russian, w32-charset-mac, w32-charset-baltic,
9215 w32-charset-unicode,
9217 CODEPAGE should be an integer specifying the codepage that should be used
9218 to display the character set, t to do no translation and output as Unicode,
9219 or nil to do no translation and output as 8 bit (or multibyte on far-east
9220 versions of Windows) characters. */);
9221 Vw32_charset_info_alist
= Qnil
;
9223 DEFSYM (Qw32_charset_ansi
, "w32-charset-ansi");
9224 DEFSYM (Qw32_charset_symbol
, "w32-charset-symbol");
9225 DEFSYM (Qw32_charset_default
, "w32-charset-default");
9226 DEFSYM (Qw32_charset_shiftjis
, "w32-charset-shiftjis");
9227 DEFSYM (Qw32_charset_hangeul
, "w32-charset-hangeul");
9228 DEFSYM (Qw32_charset_chinesebig5
, "w32-charset-chinesebig5");
9229 DEFSYM (Qw32_charset_gb2312
, "w32-charset-gb2312");
9230 DEFSYM (Qw32_charset_oem
, "w32-charset-oem");
9232 #ifdef JOHAB_CHARSET
9234 static int w32_extra_charsets_defined
= 1;
9235 DEFVAR_BOOL ("w32-extra-charsets-defined", &w32_extra_charsets_defined
,
9236 doc
: /* Internal variable. */);
9238 DEFSYM (Qw32_charset_johab
, "w32-charset-johab");
9239 DEFSYM (Qw32_charset_easteurope
, "w32-charset-easteurope");
9240 DEFSYM (Qw32_charset_turkish
, "w32-charset-turkish");
9241 DEFSYM (Qw32_charset_baltic
, "w32-charset-baltic");
9242 DEFSYM (Qw32_charset_russian
, "w32-charset-russian");
9243 DEFSYM (Qw32_charset_arabic
, "w32-charset-arabic");
9244 DEFSYM (Qw32_charset_greek
, "w32-charset-greek");
9245 DEFSYM (Qw32_charset_hebrew
, "w32-charset-hebrew");
9246 DEFSYM (Qw32_charset_vietnamese
, "w32-charset-vietnamese");
9247 DEFSYM (Qw32_charset_thai
, "w32-charset-thai");
9248 DEFSYM (Qw32_charset_mac
, "w32-charset-mac");
9252 #ifdef UNICODE_CHARSET
9254 static int w32_unicode_charset_defined
= 1;
9255 DEFVAR_BOOL ("w32-unicode-charset-defined",
9256 &w32_unicode_charset_defined
,
9257 doc
: /* Internal variable. */);
9258 DEFSYM (Qw32_charset_unicode
, "w32-charset-unicode");
9262 #if 0 /* TODO: Port to W32 */
9263 defsubr (&Sx_change_window_property
);
9264 defsubr (&Sx_delete_window_property
);
9265 defsubr (&Sx_window_property
);
9267 defsubr (&Sxw_display_color_p
);
9268 defsubr (&Sx_display_grayscale_p
);
9269 defsubr (&Sxw_color_defined_p
);
9270 defsubr (&Sxw_color_values
);
9271 defsubr (&Sx_server_max_request_size
);
9272 defsubr (&Sx_server_vendor
);
9273 defsubr (&Sx_server_version
);
9274 defsubr (&Sx_display_pixel_width
);
9275 defsubr (&Sx_display_pixel_height
);
9276 defsubr (&Sx_display_mm_width
);
9277 defsubr (&Sx_display_mm_height
);
9278 defsubr (&Sx_display_screens
);
9279 defsubr (&Sx_display_planes
);
9280 defsubr (&Sx_display_color_cells
);
9281 defsubr (&Sx_display_visual_class
);
9282 defsubr (&Sx_display_backing_store
);
9283 defsubr (&Sx_display_save_under
);
9284 defsubr (&Sx_create_frame
);
9285 defsubr (&Sx_open_connection
);
9286 defsubr (&Sx_close_connection
);
9287 defsubr (&Sx_display_list
);
9288 defsubr (&Sx_synchronize
);
9289 defsubr (&Sx_focus_frame
);
9291 /* W32 specific functions */
9293 defsubr (&Sw32_select_font
);
9294 defsubr (&Sw32_define_rgb_color
);
9295 defsubr (&Sw32_default_color_map
);
9296 defsubr (&Sw32_load_color_file
);
9297 defsubr (&Sw32_send_sys_command
);
9298 defsubr (&Sw32_shell_execute
);
9299 defsubr (&Sw32_register_hot_key
);
9300 defsubr (&Sw32_unregister_hot_key
);
9301 defsubr (&Sw32_registered_hot_keys
);
9302 defsubr (&Sw32_reconstruct_hot_key
);
9303 defsubr (&Sw32_toggle_lock_key
);
9304 defsubr (&Sw32_window_exists_p
);
9305 defsubr (&Sw32_find_bdf_fonts
);
9307 defsubr (&Sfile_system_info
);
9308 defsubr (&Sdefault_printer_name
);
9310 /* Setting callback functions for fontset handler. */
9311 get_font_info_func
= w32_get_font_info
;
9313 #if 0 /* This function pointer doesn't seem to be used anywhere.
9314 And the pointer assigned has the wrong type, anyway. */
9315 list_fonts_func
= w32_list_fonts
;
9318 load_font_func
= w32_load_font
;
9319 find_ccl_program_func
= w32_find_ccl_program
;
9320 query_font_func
= w32_query_font
;
9321 set_frame_fontset_func
= x_set_font
;
9322 get_font_repertory_func
= x_get_font_repertory
;
9323 check_window_system_func
= check_w32
;
9326 hourglass_atimer
= NULL
;
9327 hourglass_shown_p
= 0;
9328 defsubr (&Sx_show_tip
);
9329 defsubr (&Sx_hide_tip
);
9331 staticpro (&tip_timer
);
9333 staticpro (&tip_frame
);
9335 last_show_tip_args
= Qnil
;
9336 staticpro (&last_show_tip_args
);
9338 defsubr (&Sx_file_dialog
);
9343 globals_of_w32fns is used to initialize those global variables that
9344 must always be initialized on startup even when the global variable
9345 initialized is non zero (see the function main in emacs.c).
9346 globals_of_w32fns is called from syms_of_w32fns when the global
9347 variable initialized is 0 and directly from main when initialized
9351 globals_of_w32fns ()
9353 HMODULE user32_lib
= GetModuleHandle ("user32.dll");
9355 TrackMouseEvent not available in all versions of Windows, so must load
9356 it dynamically. Do it once, here, instead of every time it is used.
9358 track_mouse_event_fn
= (TrackMouseEvent_Proc
)
9359 GetProcAddress (user32_lib
, "TrackMouseEvent");
9360 /* ditto for GetClipboardSequenceNumber. */
9361 clipboard_sequence_fn
= (ClipboardSequence_Proc
)
9362 GetProcAddress (user32_lib
, "GetClipboardSequenceNumber");
9364 monitor_from_point_fn
= (MonitorFromPoint_Proc
)
9365 GetProcAddress (user32_lib
, "MonitorFromPoint");
9366 get_monitor_info_fn
= (GetMonitorInfo_Proc
)
9367 GetProcAddress (user32_lib
, "GetMonitorInfoA");
9370 HMODULE imm32_lib
= GetModuleHandle ("imm32.dll");
9371 get_composition_string_fn
= (ImmGetCompositionString_Proc
)
9372 GetProcAddress (imm32_lib
, "ImmGetCompositionStringW");
9373 get_ime_context_fn
= (ImmGetContext_Proc
)
9374 GetProcAddress (imm32_lib
, "ImmGetContext");
9376 DEFVAR_INT ("w32-ansi-code-page",
9377 &w32_ansi_code_page
,
9378 doc
: /* The ANSI code page used by the system. */);
9379 w32_ansi_code_page
= GetACP ();
9381 /* MessageBox does not work without this when linked to comctl32.dll 6.0. */
9382 InitCommonControls ();
9391 button
= MessageBox (NULL
,
9392 "A fatal error has occurred!\n\n"
9393 "Would you like to attach a debugger?\n\n"
9394 "Select YES to debug, NO to abort Emacs"
9396 "\n\n(type \"gdb -p <emacs-PID>\" and\n"
9397 "\"continue\" inside GDB before clicking YES.)"
9399 , "Emacs Abort Dialog",
9400 MB_ICONEXCLAMATION
| MB_TASKMODAL
9401 | MB_SETFOREGROUND
| MB_YESNO
);
9406 exit (2); /* tell the compiler we will never return */
9414 /* For convenience when debugging. */
9418 return GetLastError ();
9421 /* arch-tag: 707589ab-b9be-4638-8cdd-74629cc9b446
9422 (do not change this comment) */